From f19998f7fd9db2bd1ed4eb80ea1744a013b166fa Mon Sep 17 00:00:00 2001
From: Thomas Albers Raviola <thomas@thomaslabs.org>
Date: Thu, 16 May 2024 18:31:28 +0200
Subject: Define types for primitives instead of using lists

* src/parser.lisp: Add alias for shorting chain calls. First symbol may be
outside chain.
* src/types.lisp: Remove specialp from closure class
---
 src/parser.lisp | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

(limited to 'src/parser.lisp')

diff --git a/src/parser.lisp b/src/parser.lisp
index 60e7ac4..f0821fc 100644
--- a/src/parser.lisp
+++ b/src/parser.lisp
@@ -1,7 +1,7 @@
 (in-package #:chains)
 
 (defconstant +special-characters+
-  '(#\\ #\% #\# #\@ #\$ #\{ #\} #\[ #\] #\Newline)
+  '(#\\ #\% #\@ #\$ #\{ #\} #\[ #\] #\Newline)
   "")
 
 (defconstant +whitespace+ '(#\Tab #\Newline #\Return #\Space)
@@ -43,7 +43,8 @@
            (ensure-list text)))))
 
 (defun atom-char-p (char)
-  (or (alphanumericp char) (eql char #\-)))
+  "Is CHAR allowed as an atom char"
+  (or (alphanumericp char) (member char '(#\- #\*))))
 
 (defun next-token (stream start-of-line &aux c)
   "Read the next token inside STREAM"
@@ -60,16 +61,14 @@
     ((#\@ #\$)
      (let* ((text (read-if #'atom-char-p stream))
             (value (read-from-string text))
-            (type (cond ((symbolp value) 'symbol)
-                        ((integerp value) 'integer)
+            (type (cond ((symbolp value)
+                         (setf value (intern (symbol-name value) *interpreter-package*))
+                         :symbol)
+                        ((integerp value) :integer)
                         (t (error "Unknown type of object @~A~%" text)))))
        ;; (unless (or (symbolp value) (integerp value))
        ;;   (error "Unknown type of object @~A~%" text))
-       (cons type value)))
-    (#\#
-     (case (read-char stream nil)
-       (#\@ (cons 'raw-function (read-if #'alphanumericp stream)))
-       (#\$ (cons 'inline-raw-function (read-if #'alphanumericp stream)))))
+       (make-object type value)))
     (#\{ 'link-start)
     (#\} 'link-end)
     (#\[ 'raw-link-start)
@@ -101,10 +100,16 @@ tokens."
             ((eq head 'separator)
              (multiple-value-bind (tree rest) (build-tree tail)
                (values tree rest)))
+            ;; @a{...} <-> {@a}{...}
+            ((and (object-symbolp head)
+                  (eq (first tail) 'link-start))
+             (multiple-value-bind (links rest) (build-chain (rest tail))
+               (multiple-value-bind (tree rest) (build-tree rest)
+                 (values (cons (make-chain (cons (list head) links)) tree) rest))))
             ((eq head 'link-start)
              (multiple-value-bind (links rest) (build-chain tail)
                (multiple-value-bind (tree rest) (build-tree rest)
-                 (values (cons (cons 'chain links) tree) rest))))
+                 (values (cons (make-chain links) tree) rest))))
             (t
              (multiple-value-bind (tree rest) (build-tree tail)
                (values (cons head tree) rest)))))))
-- 
cgit v1.2.3