* boot/parser.boot (bpDefinition): Accept macro definition

	starting with the keyword "MACRO".
	* boot/translator.boot (exportNames): Export them in all
	evaluation contexts.
	* interp/c-util.boot: "macro" is now a keyword.
	* interp/define.boot: Likewise.
	* interp/g-util.boot: Likewise.
	* interp/i-syscmd.boot: Likewise.
	* interp/postpar.boot: Likewise.

7 files changed, 57 insertions, 46 deletions

diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 1358e6c0..6d4261b4 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -860,7 +860,10 @@ bpExit()==
 	   or true)
 
 bpDefinition()==
-  a:=bpState()
+  bpEqKey "MACRO" =>
+    bpName() and bpStoreName() and bpCompoundDefinitionTail function %Macro
+      or bpTrap()
+  a := bpState()
   bpExit() =>
     bpEqPeek "DEF" =>
        bpRestore a
@@ -882,9 +885,9 @@ bpStoreName()==
   true
 
 bpDef() ==  
-  bpName() and bpStoreName() and bpDefTail()
+  bpName() and bpStoreName() and bpDefTail function %Definition
  
-bpDDef() ==  bpName() and bpDefTail()
+bpDDef() ==  bpName() and bpDefTail function %Definition
 
 ++ Parse the remaining of a simple definition.
 bpSimpleDefinitionTail() ==
@@ -893,18 +896,18 @@ bpSimpleDefinitionTail() ==
       and bpPush %ConstantDefinition(bpPop2(), bpPop1())
 
 ++ Parse the remaining of a compound definition.
-bpCompoundDefinitionTail() ==
+bpCompoundDefinitionTail f ==
   bpVariable() and 
     bpEqKey "DEF" and (bpWhere() or bpTrap()) and 
-      bpPush %Definition(bpPop3(),bpPop2(),bpPop1())
+      bpPush apply(f,[bpPop3(),bpPop2(),bpPop1()])
 
 
 ++ Parse the remainding of a definition.  When we reach this point
 ++ we know we must parse a definition and we have already parsed
 ++ the name of the main operator in the definition.
-bpDefTail() ==
+bpDefTail f ==
   bpSimpleDefinitionTail()
-    or bpCompoundDefinitionTail()
+    or bpCompoundDefinitionTail f
  
  
 bpMDefTail()==
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 6cd172a6..be5c6276 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -914,17 +914,21 @@
 (DEFUN |bpDefinition| ()
   (PROG (|a|)
     (RETURN
-      (PROGN
-        (SETQ |a| (|bpState|))
-        (COND
-          ((|bpExit|)
+      (COND
+        ((|bpEqKey| 'MACRO)
+         (OR (AND (|bpName|) (|bpStoreName|)
+                  (|bpCompoundDefinitionTail| #'|%Macro|))
+             (|bpTrap|)))
+        (T (SETQ |a| (|bpState|))
            (COND
-             ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef|))
-             ((|bpEqPeek| 'TDEF) (|bpRestore| |a|)
-              (|bpTypeAliasDefition|))
-             ((|bpEqPeek| 'MDEF) (|bpRestore| |a|) (|bpMdef|))
-             (T T)))
-          (T (|bpRestore| |a|) NIL))))))
+             ((|bpExit|)
+              (COND
+                ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef|))
+                ((|bpEqPeek| 'TDEF) (|bpRestore| |a|)
+                 (|bpTypeAliasDefition|))
+                ((|bpEqPeek| 'MDEF) (|bpRestore| |a|) (|bpMdef|))
+                (T T)))
+             (T (|bpRestore| |a|) NIL)))))))
 
 (DEFUN |bpStoreName| ()
   (DECLARE (SPECIAL |$typings| |$wheredefs| |$op| |$stack|))
@@ -934,20 +938,21 @@
     (SETQ |$typings| NIL)
     T))
 
-(DEFUN |bpDef| () (AND (|bpName|) (|bpStoreName|) (|bpDefTail|)))
+(DEFUN |bpDef| ()
+  (AND (|bpName|) (|bpStoreName|) (|bpDefTail| #'|%Definition|)))
 
-(DEFUN |bpDDef| () (AND (|bpName|) (|bpDefTail|)))
+(DEFUN |bpDDef| () (AND (|bpName|) (|bpDefTail| #'|%Definition|)))
 
 (DEFUN |bpSimpleDefinitionTail| ()
   (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
        (|bpPush| (|%ConstantDefinition| (|bpPop2|) (|bpPop1|)))))
 
-(DEFUN |bpCompoundDefinitionTail| ()
+(DEFUN |bpCompoundDefinitionTail| (|f|)
   (AND (|bpVariable|) (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
-       (|bpPush| (|%Definition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
+       (|bpPush| (APPLY |f| (LIST (|bpPop3|) (|bpPop2|) (|bpPop1|))))))
 
-(DEFUN |bpDefTail| ()
-  (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail|)))
+(DEFUN |bpDefTail| (|f|)
+  (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail| |f|)))
 
 (DEFUN |bpMDefTail| ()
   (AND (OR (|bpVariable|) (|bpTrap|)) (|bpEqKey| 'MDEF)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 64772c34..226429a2 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -28,14 +28,14 @@
           (LIST "for" 'FOR) (LIST "forall" 'FORALL) (LIST "has" 'HAS)
           (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
           (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "leave" 'LEAVE)
-          (LIST "module" 'MODULE) (LIST "namespace" 'NAMESPACE)
-          (LIST "of" 'OF) (LIST "or" 'OR) (LIST "rem" 'REM)
-          (LIST "repeat" 'REPEAT) (LIST "return" 'RETURN)
-          (LIST "quo" 'QUO) (LIST "structure" 'STRUCTURE)
-          (LIST "then" 'THEN) (LIST "throw" 'THROW) (LIST "try" 'TRY)
-          (LIST "until" 'UNTIL) (LIST "where" 'WHERE)
-          (LIST "while" 'WHILE) (LIST "." 'DOT) (LIST ":" 'COLON)
-          (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
+          (LIST "macro" 'MACRO) (LIST "module" 'MODULE)
+          (LIST "namespace" 'NAMESPACE) (LIST "of" 'OF) (LIST "or" 'OR)
+          (LIST "rem" 'REM) (LIST "repeat" 'REPEAT)
+          (LIST "return" 'RETURN) (LIST "quo" 'QUO)
+          (LIST "structure" 'STRUCTURE) (LIST "then" 'THEN)
+          (LIST "throw" 'THROW) (LIST "try" 'TRY) (LIST "until" 'UNTIL)
+          (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT)
+          (LIST ":" 'COLON) (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
           (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
           (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS)
           (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index a66191d3..ed424b1e 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -13,7 +13,8 @@
 
 (PROVIDE "translator")
 
-(EXPORT '|evalBootFile|)
+(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
+  (EXPORT '|evalBootFile|))
 
 (DEFPARAMETER |$currentModuleName| NIL)
 
@@ -621,15 +622,15 @@
           (|$InteractiveMode| |expr'|)
           (T (|shoeEVALANDFILEACTQ| |expr'|)))))))
 
-(DEFUN |exportNames| (|ns|)
-  (COND
-    ((NULL |ns|) NIL)
-    (T (LIST (LIST 'EXPORT (LIST 'QUOTE |ns|))))))
-
 (DEFUN |inAllContexts| (|x|)
   (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
         |x|))
 
+(DEFUN |exportNames| (|ns|)
+  (COND
+    ((NULL |ns|) NIL)
+    (T (LIST (|inAllContexts| (LIST 'EXPORT (LIST 'QUOTE |ns|)))))))
+
 (DEFUN |translateToplevel| (|b| |export?|)
   (PROG (|lhs| |t| |ISTMP#2| |sig| |n| |ISTMP#1| |xs|)
     (DECLARE (SPECIAL |$activeNamespace| |$InteractiveMode|
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index f10a1749..7606ffc9 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -5,11 +5,12 @@
 
 (PROVIDE "utility")
 
-(EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
-             |scalarMember?| |listMember?| |reverse| |reverse!|
-             |lastNode| |append| |append!| |copyList| |substitute|
-             |substitute!| |setDifference| |applySubst| |applySubst!|
-             |applySubstNQ| |remove| |removeSymbol|))
+(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
+  (EXPORT '(|objectMember?| |symbolMember?| |stringMember?|
+               |charMember?| |scalarMember?| |listMember?| |reverse|
+               |reverse!| |lastNode| |append| |append!| |copyList|
+               |substitute| |substitute!| |setDifference| |applySubst|
+               |applySubst!| |applySubstNQ| |remove| |removeSymbol|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|)
                 |substitute|))
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 3a4eff6b..81c0f3b6 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -70,6 +70,7 @@ shoeKeyWords == [  _
             ['"is", "IS"], _
             ['"isnt", "ISNT"] , _
             ['"leave", "LEAVE"], _
+            ['"macro", "MACRO"], _
             ['"module", "MODULE"], _
             ['"namespace", "NAMESPACE"], _
             ['"of",   "OF"] , _
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 3ac9a1c5..9ecde37e 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -407,15 +407,15 @@ translateToplevelExpression expr ==
   $InteractiveMode => expr'
   shoeEVALANDFILEACTQ expr'
 
-exportNames ns ==
-  ns = nil => nil
-  [["EXPORT",["QUOTE",ns]]]
-
 inAllContexts x ==
   ["EVAL-WHEN",[KEYWORD::COMPILE_-TOPLEVEL,
                   KEYWORD::LOAD_-TOPLEVEL,
                     KEYWORD::EXECUTE], x]
 
+exportNames ns ==
+  ns = nil => nil
+  [inAllContexts ["EXPORT",["QUOTE",ns]]]
+
 translateToplevel(b,export?) ==
   atom b => [b]  -- generally happens in interactive mode.
   b is ["TUPLE",:xs] => coreError '"invalid AST"