From: Keith Packard Date: Fri, 1 Dec 2017 09:12:38 +0000 (+0100) Subject: altos/lisp: Add quasiquote X-Git-Tag: 1.8.3~1^2~34 X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=commitdiff_plain;h=cd0bd9791a77868c226d285bf4d57e8c321755d5 altos/lisp: Add quasiquote This adds read support for quasiquote syntax, and then adds a quasiquote implementation in lisp Signed-off-by: Keith Packard --- diff --git a/src/lisp/ao_lisp_builtin.txt b/src/lisp/ao_lisp_builtin.txt index 236cadb4..6925ac17 100644 --- a/src/lisp/ao_lisp_builtin.txt +++ b/src/lisp/ao_lisp_builtin.txt @@ -10,6 +10,9 @@ f_lambda cons f_lambda last f_lambda length nlambda quote +atom quasiquote +atom unquote +atom unquote_splicing unquote-splicing f_lambda set macro setq set! nlambda cond diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index f8a70979..f1c2ed00 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -14,107 +14,320 @@ ; Lisp code placed in ROM ; return a list containing all of the arguments - (set (quote list) (lexpr (l) l)) - ; - ; Define a variable without returning the value - ; Useful when defining functions to avoid - ; having lots of output generated - ; +(set (quote set!) + (macro (name value rest) + (list + set + (list + quote + name) + value) + ) + ) -(set (quote define) (macro (name val rest) - (list - 'begin - (list - 'set - (list 'quote name) - val) - (list 'quote name) - ) - ) +(set! append + (lexpr (args) + ((lambda (append-list append-lists) + (set! append-list + (lambda (a b) + (cond ((null? a) b) + (else (cons (car a) (append-list (cdr a) b))) + ) + ) + ) + (set! append-lists + (lambda (lists) + (cond ((null? lists) lists) + ((null? (cdr lists)) (car lists)) + (else (append-list (car lists) (append-lists (cdr lists)))) + ) + ) + ) + (append-lists args) + ) () ()) + ) + ) + +(append '(a b c) '(d e f) '(g h i)) + + ; boolean operators + +(set! or + (macro (l) + ((lambda (_or) + (set! _or + (lambda (l) + (cond ((null? l) #f) + ((null? (cdr l)) + (car l)) + (else + (list + cond + (list + (car l)) + (list + 'else + (_or (cdr l)) + ) + ) + ) + ) + ) + ) + (_or l)) ()))) + + ; execute to resolve macros + +(or #f #t) + + +(set! and + (macro (l) + ((lambda (_and) + (set! _and + (lambda (l) + (cond ((null? l) #t) + ((null? (cdr l)) + (car l)) + (else + (list + cond + (list + (car l) + (_and (cdr l)) + ) + ) + ) + ) + ) + ) + (_and l)) ()) + ) ) + + ; execute to resolve macros + +(and #t #f) + +(set! quasiquote + (macro (x rest) + ((lambda (constant? combine-skeletons expand-quasiquote) + (set! constant? + ; A constant value is either a pair starting with quote, + ; or anything which is neither a pair nor a symbol + + (lambda (exp) + (cond ((pair? exp) + (eq? (car exp) 'quote) + ) + (else + (not (symbol? exp)) + ) + ) + ) + ) + (set! combine-skeletons + (lambda (left right exp) + (cond + ((and (constant? left) (constant? right)) + (cond ((and (eqv? (eval left) (car exp)) + (eqv? (eval right) (cdr exp))) + (list 'quote exp) + ) + (else + (list 'quote (cons (eval left) (eval right))) + ) + ) + ) + ((null? right) + (list 'list left) + ) + ((and (pair? right) (eq? (car right) 'list)) + (cons 'list (cons left (cdr right))) + ) + (else + (list 'cons left right) + ) + ) + ) + ) + + (set! expand-quasiquote + (lambda (exp nesting) + (cond + + ; non cons -- constants + ; themselves, others are + ; quoted + + ((not (pair? exp)) + (cond ((constant? exp) + exp + ) + (else + (list 'quote exp) + ) + ) + ) + + ; check for an unquote exp and + ; add the param unquoted + + ((and (eq? (car exp) 'unquote) (= (length exp) 2)) + (cond ((= nesting 0) + (car (cdr exp)) + ) + (else + (combine-skeletons ''unquote + (expand-quasiquote (cdr exp) (- nesting 1)) + exp)) + ) + ) + + ; nested quasi-quote -- + ; construct the right + ; expression + + ((and (eq? (car exp) 'quasiquote) (= (length exp) 2)) + (combine-skeletons ''quasiquote + (expand-quasiquote (cdr exp) (+ nesting 1)) + exp)) + + ; check for an + ; unquote-splicing member, + ; compute the expansion of the + ; value and append the rest of + ; the quasiquote result to it + + ((and (pair? (car exp)) + (eq? (car (car exp)) 'unquote-splicing) + (= (length (car exp)) 2)) + (cond ((= nesting 0) + (list 'append (car (cdr (car exp))) + (expand-quasiquote (cdr exp) nesting)) + ) + (else + (combine-skeletons (expand-quasiquote (car exp) (- nesting 1)) + (expand-quasiquote (cdr exp) nesting) + exp)) + ) + ) + + ; for other lists, just glue + ; the expansion of the first + ; element to the expansion of + ; the rest of the list + + (else (combine-skeletons (expand-quasiquote (car exp) nesting) + (expand-quasiquote (cdr exp) nesting) + exp) + ) + ) + ) + ) + (expand-quasiquote x 0) + ) () () ()) + ) + ) ; - ; A slightly more convenient form - ; for defining lambdas. + ; Define a variable without returning the value + ; Useful when defining functions to avoid + ; having lots of output generated. ; - ; (defun () s-exprs) + ; Also accepts the alternate + ; form for defining lambdas of + ; (define (name x y z) sexprs ...) ; -(define defun (macro (name args exprs) - (list - define - name - (cons 'lambda (cons args exprs)) +(set! define + (macro (first rest) + + ; check for alternate lambda definition form + + (cond ((list? first) + (set! rest + (append + (list + 'lambda + (cdr first)) + rest)) + (set! first (car first)) + ) + (else + (set! rest (car rest)) + ) ) - ) - ) + `(begin + (set! ,first ,rest) + (quote ,first)) + ) + ) ; basic list accessors -(defun caar (l) (car (car l))) +(define (caar l) (car (car l))) -(defun cadr (l) (car (cdr l))) +(define (cadr l) (car (cdr l))) -(defun caddr (l) (car (cdr (cdr l)))) +(define (cdar l) (cdr (car l))) -(define list-tail (lambda (x k) - (if (zero? k) - x - (list-tail (cdr x (- k 1))) - ) - ) - ) +(define (caddr l) (car (cdr (cdr l)))) -(define list-ref (lambda (x k) - (car (list-tail x k)) - ) +(define (list-tail x k) + (if (zero? k) + x + (list-tail (cdr x (- k 1))) + ) ) - ; simple math operators +(define (list-ref x k) + (car (list-tail x k)) + ) -(defun 1+ (x) (+ x 1)) -(defun 1- (x) (- x 1)) + ; (if ) + ; (if 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) + + ; simple math operators + +(define zero? (macro (value rest) `(eq? ,value 0))) + (zero? 1) (zero? 0) (zero? "hello") -(define positive? (macro (value rest) - (list - > - value - 0) - ) - ) +(define positive? (macro (value rest) `(> ,value 0))) (positive? 12) (positive? -12) -(define negative? (macro (value rest) - (list - < - value - 0) - ) - ) +(define negative? (macro (value rest) `(< ,value 0))) (negative? 12) (negative? -12) -(defun abs (x) (cond ((>= x 0) x) - (else (- x))) - ) +(define (abs x) (if (>= x 0) x (- x))) (abs 12) (abs -12) @@ -145,44 +358,20 @@ (min 1 2 3) (min 3 2 1) -(defun even? (x) (zero? (% x 2))) +(define (even? x) (zero? (% x 2))) (even? 2) (even? -2) (even? 3) (even? -1) -(defun odd? (x) (not (even? x))) +(define (odd? x) (not (even? x))) (odd? 2) (odd? -2) (odd? 3) (odd? -1) - ; (if ) - ; (if 3 2) 'yes) -(if (> 3 2) 'yes 'no) -(if (> 2 3) 'no 'yes) -(if (> 2 3) 'no) ; define a set of local ; variables and then evaluate @@ -213,6 +402,7 @@ (cond ((not (null? vars)) (cons (car (car vars)) (make-names (cdr vars)))) + (else ()) ) ) ) @@ -235,7 +425,7 @@ (make-exprs (cdr vars) exprs) ) ) - (exprs) + (else exprs) ) ) ) @@ -245,6 +435,7 @@ (set! make-nils (lambda (vars) (cond ((not (null? vars)) (cons () (make-nils (cdr vars)))) + (else ()) ) ) ) @@ -269,65 +460,22 @@ (let ((x 1)) x) (define let* let) - ; boolean operators -(define or (lexpr (l) - (let ((ret #f)) - (while (not (null? l)) - (cond ((car l) (set! ret #t) (set! l ())) - ((set! l (cdr l))))) - ret - ) - ) - ) +(define when (macro (test l) + (list + cond + (cons test l)))) - ; execute to resolve macros - -(or #f #t) +(when #t (display 'when)) -(define and (lexpr (l) - (let ((ret #t)) - (while (not (null? l)) - (cond ((car l) - (set! l (cdr l))) - (#t - (set! ret #f) - (set! l ())) - ) - ) - ret - ) - ) - ) - - ; execute to resolve macros - -(and #t #f) - - -(define append (lexpr (args) - (let ((append-list (lambda (a b) - (cond ((null? a) b) - (else (cons (car a) (append-list (cdr a) b))) - ) - ) - ) - (append-lists (lambda (lists) - (cond ((null? lists) lists) - ((null? (cdr lists)) (car lists)) - (else (append-list (car lists) (append-lists (cdr lists)))) - ) - ) - ) - ) - (append-lists args) - ) - ) - ) +(define unless (macro (test l) + (list + cond + (cons (list not test) l)))) -(append '(a b c) '(d e f) '(g h i)) +(unless #f (display 'unless)) -(defun reverse (list) +(define (reverse list) (let ((result ())) (while (not (null? list)) (set! result (cons (car list) result)) @@ -338,22 +486,20 @@ (reverse '(1 2 3)) -(define list-tail - (lambda (x k) - (if (zero? k) - x - (list-tail (cdr x) (- k 1))))) +(define (list-tail x k) + (if (zero? k) + x + (list-tail (cdr x) (- k 1))))) (list-tail '(1 2 3) 2) -(defun list-ref (x k) (car (list-tail x k))) +(define (list-ref x k) (car (list-tail x k))) (list-ref '(1 2 3) 2) - ; recursive equality -(defun equal? (a b) +(define (equal? a b) (cond ((eq? a b) #t) ((and (pair? a) (pair? b)) (and (equal? (car a) (car b)) @@ -366,32 +512,32 @@ (equal? '(a b c) '(a b c)) (equal? '(a b c) '(a b b)) -(defun _member (obj list test?) +(define (_member obj list test?) (if (null? list) #f (if (test? obj (car list)) list (memq obj (cdr list))))) -(defun memq (obj list) (_member obj list eq?)) +(define (memq obj list) (_member obj list eq?)) (memq 2 '(1 2 3)) (memq 4 '(1 2 3)) -(defun memv (obj list) (_member obj list eqv?)) +(define (memv obj list) (_member obj list eqv?)) (memv 2 '(1 2 3)) (memv 4 '(1 2 3)) -(defun member (obj list) (_member obj list equal?)) +(define (member obj list) (_member obj list equal?)) (member '(2) '((1) (2) (3))) (member '(4) '((1) (2) (3))) -(defun _assoc (obj list test?) +(define (_assoc obj list test?) (if (null? list) #f (if (test? obj (caar list)) @@ -401,9 +547,9 @@ ) ) -(defun assq (obj list) (_assoc obj list eq?)) -(defun assv (obj list) (_assoc obj list eqv?)) -(defun assoc (obj list) (_assoc obj list equal?)) +(define (assq obj list) (_assoc obj list eq?)) +(define (assv obj list) (_assoc obj list eqv?)) +(define (assoc obj list) (_assoc obj list equal?)) (assq 'a '((a 1) (b 2) (c 3))) (assv 'b '((a 1) (b 2) (c 3))) @@ -414,52 +560,52 @@ (char? #\q) (char? "h") -(defun char-upper-case? (c) (<= #\A c #\Z)) +(define (char-upper-case? c) (<= #\A c #\Z)) (char-upper-case? #\a) (char-upper-case? #\B) (char-upper-case? #\0) (char-upper-case? #\space) -(defun char-lower-case? (c) (<= #\a c #\a)) +(define (char-lower-case? c) (<= #\a c #\a)) (char-lower-case? #\a) (char-lower-case? #\B) (char-lower-case? #\0) (char-lower-case? #\space) -(defun char-alphabetic? (c) (or (char-upper-case? c) (char-lower-case? c))) +(define (char-alphabetic? c) (or (char-upper-case? c) (char-lower-case? c))) (char-alphabetic? #\a) (char-alphabetic? #\B) (char-alphabetic? #\0) (char-alphabetic? #\space) -(defun char-numeric? (c) (<= #\0 c #\9)) +(define (char-numeric? c) (<= #\0 c #\9)) (char-numeric? #\a) (char-numeric? #\B) (char-numeric? #\0) (char-numeric? #\space) -(defun char-whitespace? (c) (or (<= #\tab c #\return) (= #\space c))) +(define (char-whitespace? c) (or (<= #\tab c #\return) (= #\space c))) (char-whitespace? #\a) (char-whitespace? #\B) (char-whitespace? #\0) (char-whitespace? #\space) -(defun char->integer (c) c) -(defun integer->char (c) char-integer) +(define (char->integer c) c) +(define (integer->char c) char-integer) -(defun char-upcase (c) (if (char-lower-case? c) (+ c (- #\A #\a)) c)) +(define (char-upcase c) (if (char-lower-case? c) (+ c (- #\A #\a)) c)) (char-upcase #\a) (char-upcase #\B) (char-upcase #\0) (char-upcase #\space) -(defun char-downcase (c) (if (char-upper-case? c) (+ c (- #\a #\A)) c)) +(define (char-downcase c) (if (char-upper-case? c) (+ c (- #\a #\A)) c)) (char-downcase #\a) (char-downcase #\B) @@ -493,17 +639,17 @@ (for-each display '("hello" " " "world" "\n")) -(define -string-ml (lambda (strings) +(define _string-ml (lambda (strings) (if (null? strings) () - (cons (string->list (car strings)) (-string-ml (cdr strings)))))) + (cons (string->list (car strings)) (_string-ml (cdr strings)))))) (define string-map (lexpr (proc strings) - (list->string (apply map proc (-string-ml strings)))))) + (list->string (apply map proc (_string-ml strings)))))) -(string-map 1+ "HAL") +(string-map (lambda (x) (+ 1 x)) "HAL") (define string-for-each (lexpr (proc strings) - (apply for-each proc (-string-ml strings)))) + (apply for-each proc (_string-ml strings)))) (string-for-each write-char "IBM\n") @@ -520,25 +666,64 @@ '(54 0 37 -3 245 19)) #t)) + + ; `q -> (quote q) + ; `(q) -> (append (quote (q))) + ; `(a ,(+ 1 2)) -> (append (quote (a)) (list (+ 1 2))) + ; `(a ,@(list 1 2 3) -> (append (quote (a)) (list 1 2 3)) + + + +`(hello ,(+ 1 2) ,@(list 1 2 3) `foo) + (define repeat (macro (count rest) - (list - let - (list - (list '__count__ count)) - (append - (list - while - (list - <= - 0 - (list - set! - '__count__ - (list - - - '__count__ - 1)))) - rest)))) + `(let ((__count__ ,count)) + (while (<= 0 (set! __count__ (- __count__ 1))) ,@rest)))) + +(repeat 2 (write 'hello)) +(repeat 3 (write 'goodbye)) + +(define case (macro (test l) + (let ((_unarrow + ; construct the body of the + ; case, dealing with the + ; lambda version ( => lambda) + + (lambda (l) + (cond ((null? l) l) + ((eq? (car l) '=>) `(( ,(cadr l) __key__))) + (else l)))) + (_case (lambda (l) + + ; Build the case elements, which is + ; simply a list of cond clauses + + (cond ((null? l) ()) + + ; else case + + ((eq? (caar l) 'else) + `((else ,@(_unarrow (cdr (car l)))))) + + ; regular case + + (else + (cons + `((eqv? ,(caar l) __key__) + ,@(_unarrow (cdr (car l)))) + (_case (cdr l))) + ) + )))) + + ; now construct the overall + ; expression, using a lambda + ; to hold the computed value + ; of the test expression + + `((lambda (__key__) + (cond ,@(_case l))) ,test)))) + +(case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) ;(define number->string (lexpr (arg opt) ; (let ((base (if (null? opt) 10 (car opt))) diff --git a/src/lisp/ao_lisp_make_builtin b/src/lisp/ao_lisp_make_builtin index 531e388d..c4ba9d94 100644 --- a/src/lisp/ao_lisp_make_builtin +++ b/src/lisp/ao_lisp_make_builtin @@ -13,6 +13,7 @@ string[string] type_map = { "macro" => "MACRO", "f_lambda" => "F_LAMBDA", "f_lexpr" => "F_LEXPR", + "atom" => "atom", }; string[*] @@ -50,13 +51,16 @@ read_builtins(file f) { return builtins; } +bool is_atom(builtin_t b) = b.type == "atom"; + void dump_ids(builtin_t[*] builtins) { printf("#ifdef AO_LISP_BUILTIN_ID\n"); printf("#undef AO_LISP_BUILTIN_ID\n"); printf("enum ao_lisp_builtin_id {\n"); for (int i = 0; i < dim(builtins); i++) - printf("\tbuiltin_%s,\n", builtins[i].c_name); + if (!is_atom(builtins[i])) + printf("\tbuiltin_%s,\n", builtins[i].c_name); printf("\t_builtin_last\n"); printf("};\n"); printf("#endif /* AO_LISP_BUILTIN_ID */\n"); @@ -69,8 +73,9 @@ dump_casename(builtin_t[*] builtins) { printf("static char *ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {\n"); printf("\tswitch(b) {\n"); for (int i = 0; i < dim(builtins); i++) - printf("\tcase builtin_%s: return ao_lisp_poly_atom(_atom(\"%s\"))->name;\n", - builtins[i].c_name, builtins[i].lisp_names[0]); + if (!is_atom(builtins[i])) + printf("\tcase builtin_%s: return ao_lisp_poly_atom(_atom(\"%s\"))->name;\n", + builtins[i].c_name, builtins[i].lisp_names[0]); printf("\tdefault: return \"???\";\n"); printf("\t}\n"); printf("}\n"); @@ -94,10 +99,12 @@ dump_arrayname(builtin_t[*] builtins) { printf("#undef AO_LISP_BUILTIN_ARRAYNAME\n"); printf("static const ao_poly builtin_names[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - printf("\t[builtin_%s] = _ao_lisp_atom_", - builtins[i].c_name); - cify_lisp(builtins[i].lisp_names[0]); - printf(",\n"); + if (!is_atom(builtins[i])) { + printf("\t[builtin_%s] = _ao_lisp_atom_", + builtins[i].c_name); + cify_lisp(builtins[i].lisp_names[0]); + printf(",\n"); + } } printf("};\n"); printf("#endif /* AO_LISP_BUILTIN_ARRAYNAME */\n"); @@ -109,9 +116,10 @@ dump_funcs(builtin_t[*] builtins) { printf("#undef AO_LISP_BUILTIN_FUNCS\n"); printf("const ao_lisp_func_t ao_lisp_builtins[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - printf("\t[builtin_%s] = ao_lisp_do_%s,\n", - builtins[i].c_name, - builtins[i].c_name); + if (!is_atom(builtins[i])) + printf("\t[builtin_%s] = ao_lisp_do_%s,\n", + builtins[i].c_name, + builtins[i].c_name); } printf("};\n"); printf("#endif /* AO_LISP_BUILTIN_FUNCS */\n"); @@ -122,9 +130,11 @@ dump_decls(builtin_t[*] builtins) { printf("#ifdef AO_LISP_BUILTIN_DECLS\n"); printf("#undef AO_LISP_BUILTIN_DECLS\n"); for (int i = 0; i < dim(builtins); i++) { - printf("ao_poly\n"); - printf("ao_lisp_do_%s(struct ao_lisp_cons *cons);\n", - builtins[i].c_name); + if (!is_atom(builtins[i])) { + printf("ao_poly\n"); + printf("ao_lisp_do_%s(struct ao_lisp_cons *cons);\n", + builtins[i].c_name); + } } printf("#endif /* AO_LISP_BUILTIN_DECLS */\n"); } @@ -135,11 +145,13 @@ dump_consts(builtin_t[*] builtins) { printf("#undef AO_LISP_BUILTIN_CONSTS\n"); printf("struct builtin_func funcs[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - for (int j = 0; j < dim(builtins[i].lisp_names); j++) { - printf ("\t{ .name = \"%s\", .args = AO_LISP_FUNC_%s, .func = builtin_%s },\n", - builtins[i].lisp_names[j], - builtins[i].type, - builtins[i].c_name); + if (!is_atom(builtins[i])) { + for (int j = 0; j < dim(builtins[i].lisp_names); j++) { + printf ("\t{ .name = \"%s\", .args = AO_LISP_FUNC_%s, .func = builtin_%s },\n", + builtins[i].lisp_names[j], + builtins[i].type, + builtins[i].c_name); + } } } printf("};\n"); diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c index c5a238cc..747963ab 100644 --- a/src/lisp/ao_lisp_read.c +++ b/src/lisp/ao_lisp_read.c @@ -61,7 +61,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE|SPECIAL, /* ) */ PRINTABLE, /* * */ PRINTABLE|SIGN, /* + */ - PRINTABLE, /* , */ + PRINTABLE|SPECIAL, /* , */ PRINTABLE|SIGN, /* - */ PRINTABLE|DOTC|FLOATC, /* . */ PRINTABLE, /* / */ @@ -113,7 +113,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* ] */ PRINTABLE, /* ^ */ PRINTABLE, /* _ */ - PRINTABLE, /* ` */ + PRINTABLE|SPECIAL, /* ` */ PRINTABLE, /* a */ PRINTABLE, /* b */ PRINTABLE, /* c */ @@ -314,6 +314,18 @@ _lex(void) return QUOTE; case '.': return DOT; + case '`': + return QUASIQUOTE; + case ',': + c = lexc(); + if (c == '@') { + add_token(c); + end_token(); + return UNQUOTE_SPLICING; + } else { + lex_unget(c); + return UNQUOTE; + } } } if (lex_class & POUND) { @@ -562,11 +574,27 @@ ao_lisp_read(void) v = AO_LISP_NIL; break; case QUOTE: + case QUASIQUOTE: + case UNQUOTE: + case UNQUOTE_SPLICING: if (!push_read_stack(cons, read_state)) return AO_LISP_NIL; cons++; read_state = READ_IN_QUOTE; - v = _ao_lisp_atom_quote; + switch (parse_token) { + case QUOTE: + v = _ao_lisp_atom_quote; + break; + case QUASIQUOTE: + v = _ao_lisp_atom_quasiquote; + break; + case UNQUOTE: + v = _ao_lisp_atom_unquote; + break; + case UNQUOTE_SPLICING: + v = _ao_lisp_atom_unquote2dsplicing; + break; + } break; case CLOSE: if (!cons) { diff --git a/src/lisp/ao_lisp_read.h b/src/lisp/ao_lisp_read.h index 20c9c18a..8f6bf130 100644 --- a/src/lisp/ao_lisp_read.h +++ b/src/lisp/ao_lisp_read.h @@ -19,23 +19,26 @@ * token classes */ -# define END 0 -# define NAME 1 -# define OPEN 2 -# define CLOSE 3 -# define QUOTE 4 -# define STRING 5 -# define NUM 6 -# define FLOAT 7 -# define DOT 8 -# define BOOL 9 +# define END 0 +# define NAME 1 +# define OPEN 2 +# define CLOSE 3 +# define QUOTE 4 +# define QUASIQUOTE 5 +# define UNQUOTE 6 +# define UNQUOTE_SPLICING 7 +# define STRING 8 +# define NUM 9 +# define FLOAT 10 +# define DOT 11 +# define BOOL 12 /* * character classes */ -# define PRINTABLE 0x0001 /* \t \n ' ' - '~' */ -# define SPECIAL 0x0002 /* ( [ { ) ] } ' */ +# define PRINTABLE 0x0001 /* \t \n ' ' - ~ */ +# define SPECIAL 0x0002 /* ( [ { ) ] } ' ` , */ # define DOTC 0x0004 /* . */ # define WHITE 0x0008 /* ' ' \t \n */ # define DIGIT 0x0010 /* [0-9] */