diff options
Diffstat (limited to 'src/boot/strap')
-rw-r--r-- | src/boot/strap/ast.clisp | 2 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 8 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 39 |
3 files changed, 37 insertions, 12 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index e90f8223..8d1d93f4 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -179,6 +179,8 @@ (DEFUN |bfSymbol| (|x|) (COND ((STRINGP |x|) |x|) (T (|quote| |x|)))) +(DEFUN |bfFunction| (|x|) (LIST 'FUNCTION |x|)) + (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfDot|)) (DEFUN |bfDot| () 'DOT) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 34fff72f..dd1d4dfd 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -388,7 +388,7 @@ (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|))) ((|bpEqPeek| 'QUOTE) (|bpNext|) (AND (|bpRequire| #'|bpSexp|) (|bpPush| (|bfSymbol| (|bpPop1|))))) - (T (|bpString|)))) + (T (OR (|bpString|) (|bpFunction|))))) (DEFUN |bpChar| () (PROG (|ISTMP#1| |s| |a|) @@ -530,7 +530,7 @@ (COND ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (NOT (|bpExceptions|))) (SETQ |a| (GET |$ttok| 'SHOEINF)) - (COND ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|))) + (COND ((NULL |a|) (AND (|bpPush| (|keywordId| |$ttok|)) (|bpNext|))) (T (AND (|bpPush| |a|) (|bpNext|))))) (T NIL))))) @@ -655,6 +655,10 @@ (AND (EQ (|shoeTokType| |$stok|) 'STRING) (|bpPush| (|quote| (INTERN |$ttok|))) (|bpNext|))) +(DEFUN |bpFunction| () + (AND (|bpEqKey| 'FUNCTION) (|bpRequire| #'|bpPrimary1|) + (|bpPush| (|bfFunction| (|bpPop1|))))) + (DEFUN |bpThetaName| () (DECLARE (SPECIAL |$stok| |$ttok|)) (COND diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index c259bda3..7b16a885 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -29,8 +29,8 @@ (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE) (LIST "catch" 'CATCH) (LIST "cross" 'CROSS) (LIST "do" 'DO) (LIST "else" 'ELSE) (LIST "finally" 'FINALLY) (LIST "for" 'FOR) - (LIST "forall" 'FORALL) (LIST "has" 'HAS) (LIST "if" 'IF) - (LIST "import" 'IMPORT) (LIST "in" 'IN) (LIST "is" 'IS) + (LIST "forall" 'FORALL) (LIST "function" 'FUNCTION) (LIST "has" 'HAS) + (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN) (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "leave" 'LEAVE) (LIST "macro" 'MACRO) (LIST "module" 'MODULE) (LIST "namespace" 'NAMESPACE) (LIST "of" 'OF) (LIST "or" 'OR) (LIST "rem" 'REM) (LIST "repeat" 'REPEAT) @@ -64,6 +64,26 @@ (DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|)) +(DEFUN |keywordId| (|t|) + (PROG (|s|) + (RETURN + (COND + ((SETQ |s| + (WITH-HASH-TABLE-ITERATOR (#1=#:G719 |shoeKeyTable|) + (LET ((|bfVar#1| NIL)) + (LOOP + (MULTIPLE-VALUE-BIND (#2=#:G720 |k| |v|) + (#1#) + (COND ((NOT #2#) (RETURN |bfVar#1|)) + (T + (AND (EQ |v| |t|) + (PROGN + (SETQ |bfVar#1| |k|) + (COND + (|bfVar#1| (RETURN |bfVar#1|)))))))))))) + (INTERN |s|)) + (T |t|))))) + (DEFUN |shoeInsert| (|s| |d|) (PROG (|v| |k| |n| |u| |h| |l|) (RETURN @@ -106,9 +126,9 @@ (T (SETF (ELT |a| |i|) |b|))) (SETQ |i| (+ |i| 1)))) |a|)) - (WITH-HASH-TABLE-ITERATOR (#1=#:G719 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G721 |shoeKeyTable|) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G720 |s| #:G721) + (MULTIPLE-VALUE-BIND (#2=#:G722 |s| #:G723) (#1#) (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|)))))) |d|)))) @@ -123,9 +143,9 @@ (LET ((|i| 0)) (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0))) (SETQ |i| (+ |i| 1)))) - (WITH-HASH-TABLE-ITERATOR (#1=#:G722 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G724 |shoeKeyTable|) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G723 |k| #:G724) + (MULTIPLE-VALUE-BIND (#2=#:G725 |k| #:G726) (#1#) (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL) (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1)))))) @@ -187,10 +207,9 @@ (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) (LIST '|fifth| 'FIFTH) (LIST '|first| 'CAR) (LIST '|float?| 'FLOATP) (LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR) - (LIST '|function| 'FUNCTION) (LIST '|function?| 'FUNCTIONP) - (LIST '|gensym| 'GENSYM) (LIST '|genvar| 'GENVAR) - (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|) - (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL) + (LIST '|function?| 'FUNCTIONP) (LIST '|gensym| 'GENSYM) + (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP) + (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL) (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN) (LIST '|maxIndex| 'MAXINDEX) (LIST '|mkpf| 'MKPF) (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL) |