diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/boot/ast.boot | 2 | ||||
| -rw-r--r-- | src/boot/parser.boot | 6 | ||||
| -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 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 2 |
7 files changed, 52 insertions, 14 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 21d8c56a..01e6ee3f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2012-01-12 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/parser.boot (bpFunction): New. + (bpConstTok): Include it. + * boot/ast.boot (bfFunction): New. + * boot/tokens.boot: `function' is now a keyword. + 2012-01-11 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot/tokens.boot (keywordId): New. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 23bd1425..c45ade39 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -151,6 +151,8 @@ bfSymbol x== string? x=> x quote x +bfFunction x == + ["FUNCTION",x] bfDot: () -> %Symbol bfDot() == diff --git a/src/boot/parser.boot b/src/boot/parser.boot index a7706e9a..516b47de 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -385,7 +385,7 @@ bpConstTok() == bpNext() bpRequire function bpSexp and bpPush bfSymbol bpPop1() - bpString() + bpString() or bpFunction() bpChar() == $stok is ["ID",:.] and $ttok is "char" => @@ -663,6 +663,10 @@ bpString()== shoeTokType $stok is "STRING" and bpPush(quote makeSymbol $ttok) and bpNext() +bpFunction() == + bpEqKey "FUNCTION" and bpRequire function bpPrimary1 + and bpPush bfFunction bpPop1() + bpThetaName() == $stok is ["ID",:.] and $ttok has SHOETHETA => bpPushId() 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) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index a008556c..b9a2e2a8 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -67,6 +67,7 @@ shoeKeyWords == [ _ ['"finally", "FINALLY"], _ ['"for", "FOR"] , _ ['"forall", "FORALL"] , _ + ['"function", "FUNCTION"] , _ ['"has", "HAS"] , _ ['"if", "IF"], _ ['"import", "IMPORT"], _ @@ -269,7 +270,6 @@ for i in [ _ ["float?", "FLOATP"] , _ ["flushOutput", "FORCE-OUTPUT"], _ ["fourth", "CADDDR"] , _ - ["function","FUNCTION"] , _ ["function?","FUNCTIONP"] , _ ["gensym", "GENSYM"] , _ ["genvar", "GENVAR"] , _ |