aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/parser.boot17
-rw-r--r--src/boot/strap/parser.clisp37
-rw-r--r--src/boot/strap/tokens.clisp16
-rw-r--r--src/boot/strap/translator.clisp13
-rw-r--r--src/boot/strap/utility.clisp11
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/boot/translator.boot8
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"
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 10:39:10 +0000