Allow inerts in Boot.

7 files changed, 39 insertions, 10 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 14259ebd..f3f2b12c 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -811,8 +811,11 @@ bfHas(expr,prop) ==
 bfKeyArg(k,x) ==
   ['%Key,k,x]
 
+bfInert x ==
+  makeSymbol(stringUpcase x,'"KEYWORD")
+
 lispKey k ==
-  makeSymbol(stringUpcase symbolName k,'"KEYWORD")
+  bfInert symbolName k
 
 bfExpandKeys l ==
   args := nil
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 43507640..f49ebc5d 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -429,6 +429,7 @@ bpName ps ==
 ++   LINE
 ++   QUOTE S-Expression
 ++   STRING
+++   INERT
 bpConstTok ps ==
   parserTokenClass ps in '(INTEGER FLOAT) =>
     bpPush(ps,parserTokenValue ps)
@@ -443,7 +444,12 @@ bpConstTok ps ==
     bpNext ps
     bpRequire(ps,function bpSexp) and
       bpPush(ps,bfSymbol bpPop1 ps)
-  bpString ps or bpFunction ps
+  bpString ps or bpFunction ps or bpInert ps
+
+bpInert ps ==
+  parserTokenClass ps = 'INERT =>
+    bpPush(ps,bfInert parserTokenValue ps) and bpNext ps
+  nil
 
 bpChar ps ==
   parserTokenClass ps = "ID" and parserTokenValue ps is "char" =>
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 8b9a5e5e..bf7ba428 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -212,6 +212,7 @@ shoeToken lex ==
     ch = shoeTAB =>
       lexerAdvancePosition! lex
       []
+    ch = char "&" => shoeInert lex
     shoeError lex
   b = nil => nil
   dqUnit makeToken(linepos,b,n)
@@ -410,6 +411,10 @@ shoeWord(lex,esp) ==
      shoeLeafKey w
    shoeLeafId  w
  
+shoeInert lex ==
+  lexerAdvancePosition! lex
+  ['INERT,second shoeW(lex,false)]
+
 shoeInteger lex ==
   shoeInteger1(lex,false)
  
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 6cb05e57..3fca935f 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1223,7 +1223,9 @@
 
 (DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|))
 
-(DEFUN |lispKey| (|k|) (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD"))
+(DEFUN |bfInert| (|x|) (INTERN (STRING-UPCASE |x|) "KEYWORD"))
+
+(DEFUN |lispKey| (|k|) (|bfInert| (SYMBOL-NAME |k|)))
 
 (DEFUN |bfExpandKeys| (|l|)
   (LET* (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index fcb8a2ef..7684716b 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -466,7 +466,14 @@
    ((|bpEqPeek| |ps| 'QUOTE) (|bpNext| |ps|)
     (AND (|bpRequire| |ps| #'|bpSexp|)
          (|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|)))))
-   (T (OR (|bpString| |ps|) (|bpFunction| |ps|)))))
+   (T (OR (|bpString| |ps|) (|bpFunction| |ps|) (|bpInert| |ps|)))))
+
+(DEFUN |bpInert| (|ps|)
+  (COND
+   ((EQ (|parserTokenClass| |ps|) 'INERT)
+    (AND (|bpPush| |ps| (|bfInert| (|parserTokenValue| |ps|)))
+         (|bpNext| |ps|)))
+   (T NIL)))
 
 (DEFUN |bpChar| (|ps|)
   (LET* (|ISTMP#1| |s| |a|)
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 744d4e28..92912515 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -194,6 +194,7 @@
                    ((DIGIT-CHAR-P |ch|) (|shoeNumber| |lex|))
                    ((CHAR= |ch| (|char| '_)) (|shoeEscape| |lex|))
                    ((EQUAL |ch| |shoeTAB|) (|lexerAdvancePosition!| |lex|) NIL)
+                   ((CHAR= |ch| (|char| '&)) (|shoeInert| |lex|))
                    (T (|shoeError| |lex|))))
      (COND ((NULL |b|) NIL) (T (|dqUnit| (|makeToken| |linepos| |b| |n|)))))))
 
@@ -426,6 +427,11 @@
            ((|shoeKeyWordP| |w|) (SETQ |$floatok| T) (|shoeLeafKey| |w|))
            (T (|shoeLeafId| |w|))))))
 
+(DEFUN |shoeInert| (|lex|)
+  (PROGN
+   (|lexerAdvancePosition!| |lex|)
+   (LIST 'INERT (CADR (|shoeW| |lex| NIL)))))
+
 (DEFUN |shoeInteger| (|lex|) (|shoeInteger1| |lex| NIL))
 
 (DEFUN |shoeInteger1| (|lex| |zro|)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 55653a76..6fa7d340 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -225,9 +225,9 @@
              (LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR)
              (LIST '|freshLine| 'FRESH-LINE) (LIST '|function?| 'FUNCTIONP)
              (LIST '|functionSymbol?| 'FBOUNDP) (LIST '|gensym| 'GENSYM)
-             (LIST '|genvar| 'GENVAR) (LIST '|inert?| 'KEYWORDP)
-             (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|)
-             (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
+             (LIST '|genvar| 'GENVAR) (LIST '|importSymbol| 'IMPORT)
+             (LIST '|inert?| 'KEYWORDP) (LIST '|integer?| 'INTEGERP)
+             (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
              (LIST '|lowerCase?| 'LOWER-CASE-P)
              (LIST '|makeFilePath| 'MAKE-PATHNAME) (LIST '|makeSymbol| 'INTERN)
              (LIST '|mergeFilePaths| 'MERGE-PATHNAMES) (LIST '|mkpf| 'MKPF)