* boot/parser.boot (bpFunction): New.

	(bpConstTok): Include it.
	* boot/ast.boot (bfFunction): New.
	* boot/tokens.boot: `function' is now a keyword.

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)