aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog7
-rw-r--r--src/boot/ast.boot2
-rw-r--r--src/boot/parser.boot6
-rw-r--r--src/boot/strap/ast.clisp2
-rw-r--r--src/boot/strap/parser.clisp8
-rw-r--r--src/boot/strap/tokens.clisp39
-rw-r--r--src/boot/tokens.boot2
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"] , _