aesthetic.computer
Monorepo for Aesthetic.Computer
aesthetic.computer
1;;; kidlisp-parser.lisp — Tokenizer + reader for KidLisp dialect
2;;; Handles auto-wrapping bare lines, comma separation, timing syntax.
3
4(in-package :ac-native.kidlisp)
5
6(defun timing-token-p (s)
7 "Is S a timing token like '1s', '2s...', '0.5s!'?"
8 (and (stringp s)
9 (> (length s) 1)
10 (let ((base (string-right-trim ".!" s)))
11 (and (> (length base) 0)
12 (char= (char base (1- (length base))) #\s)
13 (every (lambda (c) (or (digit-char-p c) (char= c #\.)))
14 (subseq base 0 (1- (length base))))))))
15
16(defun parse-number (s)
17 "Try to parse S as a number. Returns number or NIL."
18 (handler-case
19 (let ((n (read-from-string s)))
20 (when (numberp n) n))
21 (error () nil)))
22
23(defun tokenize (source)
24 "Split KidLisp source into tokens (strings)."
25 (let ((tokens nil)
26 (i 0)
27 (len (length source)))
28 (flet ((peek () (when (< i len) (char source i)))
29 (advance () (prog1 (char source i) (incf i))))
30 (loop while (< i len) do
31 (let ((c (peek)))
32 (cond
33 ;; Whitespace
34 ((member c '(#\Space #\Tab #\Newline #\Return))
35 (advance))
36 ;; Comment
37 ((char= c #\;)
38 (loop while (and (< i len) (not (char= (peek) #\Newline)))
39 do (advance)))
40 ;; Parens and comma
41 ((char= c #\() (push "(" tokens) (advance))
42 ((char= c #\)) (push ")" tokens) (advance))
43 ((char= c #\,) (advance)) ; skip commas as separators
44 ;; Quoted string
45 ((or (char= c #\") (char= c #\'))
46 (let ((quote c)
47 (start i))
48 (advance) ; skip opening quote
49 (loop while (and (< i len) (not (char= (peek) quote)))
50 do (when (char= (peek) #\\) (advance)) ; skip escape
51 (advance))
52 (when (< i len) (advance)) ; skip closing quote
53 (push (subseq source (1+ start) (1- i)) tokens)))
54 ;; Atom (symbol, number, color name, timing token)
55 (t
56 (let ((start i))
57 (loop while (and (< i len)
58 (not (member (peek) '(#\Space #\Tab #\Newline #\Return
59 #\( #\) #\, #\;))))
60 do (advance))
61 (push (subseq source start i) tokens)))))))
62 (nreverse tokens)))
63
64(defun bare-line-p (line)
65 "Is LINE a bare expression that needs auto-wrapping in parens?
66Bare lines start with a word (not a paren) and have arguments."
67 (let ((trimmed (string-trim '(#\Space #\Tab) line)))
68 (and (> (length trimmed) 0)
69 (not (char= (char trimmed 0) #\())
70 (not (char= (char trimmed 0) #\;))
71 ;; Has a space (i.e., has arguments)
72 (position #\Space trimmed))))
73
74(defun preprocess (source)
75 "Pre-process KidLisp source: auto-wrap bare lines, handle commas."
76 (let ((lines (uiop:split-string source :separator '(#\Newline))))
77 ;; Process each line
78 (let ((processed
79 (mapcar (lambda (line)
80 (let ((trimmed (string-trim '(#\Space #\Tab #\Return) line)))
81 (cond
82 ;; Empty or comment
83 ((or (= (length trimmed) 0)
84 (char= (char trimmed 0) #\;))
85 "")
86 ;; Already wrapped in parens
87 ((char= (char trimmed 0) #\()
88 trimmed)
89 ;; Bare line: auto-wrap
90 ((bare-line-p trimmed)
91 (format nil "(~A)" trimmed))
92 ;; Single word (color name on line 1, etc.)
93 (t trimmed))))
94 lines)))
95 ;; Join all lines, wrap in implicit progn
96 (format nil "(progn ~{~A ~})" processed))))
97
98(defun read-tokens (tokens)
99 "Read a list of tokens into a nested list AST."
100 (let ((pos 0))
101 (labels ((read-expr ()
102 (when (>= pos (length tokens))
103 (return-from read-expr nil))
104 (let ((tok (nth pos tokens)))
105 (cond
106 ((string= tok "(")
107 (incf pos)
108 (let ((items nil))
109 (loop while (and (< pos (length tokens))
110 (not (string= (nth pos tokens) ")")))
111 do (push (read-expr) items))
112 (when (and (< pos (length tokens))
113 (string= (nth pos tokens) ")"))
114 (incf pos))
115 (nreverse items)))
116 ((string= tok ")")
117 (incf pos)
118 nil)
119 (t
120 (incf pos)
121 ;; Try to parse as number
122 (or (parse-number tok) tok))))))
123 (let ((results nil))
124 (loop while (< pos (length tokens))
125 do (push (read-expr) results))
126 (if (= (length results) 1)
127 (first results)
128 (cons "progn" (nreverse results)))))))
129
130(defun kidlisp-parse (source)
131 "Parse KidLisp source string into an AST (nested lists)."
132 (let* ((preprocessed (preprocess source))
133 (tokens (tokenize preprocessed)))
134 (read-tokens tokens)))