From 4ebf86fc014d407548be8af728191fe02401bf1a Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 12 Jan 2012 12:50:31 +0000 Subject: * boot/parser.boot (bpFunction): New. (bpConstTok): Include it. * boot/ast.boot (bfFunction): New. * boot/tokens.boot: `function' is now a keyword. --- src/ChangeLog | 7 +++++++ src/boot/ast.boot | 2 ++ src/boot/parser.boot | 6 +++++- src/boot/strap/ast.clisp | 2 ++ src/boot/strap/parser.clisp | 8 ++++++-- src/boot/strap/tokens.clisp | 39 +++++++++++++++++++++++++++++---------- src/boot/tokens.boot | 2 +- 7 files changed, 52 insertions(+), 14 deletions(-) (limited to 'src') 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 + + * 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 * 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"] , _ -- cgit v1.2.3