aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog12
-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
-rw-r--r--src/interp/c-util.boot2
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/g-util.boot4
-rw-r--r--src/interp/i-syscmd.boot26
-rw-r--r--src/interp/postpar.boot2
13 files changed, 89 insertions, 66 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 44815356..a6f84486 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,17 @@
2011-05-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * 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.
+
+2011-05-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/macros.lisp (WI, tryLine, embrace indentNB, tryBreak)
(tryBreakNB, MARKHASH): Remove.
* interp/spad.lisp (NEWNAMTRANS): Likewise.
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"
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 7dfad406..a96c8693 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -143,7 +143,7 @@ substituteDollarIfRepHack m ==
getRepresentation: %Env -> %Maybe %Mode
getRepresentation e ==
u := get('Rep,'value,e) => u.expr
- get('Rep,'macro,e)
+ get('Rep,"macro",e)
++ Returns true if the form `t' is an instance of the Tuple constructor.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index e5c8fefa..896e78aa 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -623,7 +623,7 @@ macroExpandInPlace(x,e) ==
macroExpand: (%Form,%Env) -> %Form
macroExpand(x,e) == --not worked out yet
atom x =>
- not IDENTP x or (u := get(x,'macro,e)) = nil => x
+ not IDENTP x or (u := get(x,"macro",e)) = nil => x
-- Don't expand a functional macro name by itself.
u is ['%mlambda,:.] => x
macroExpand(u,e)
@@ -633,8 +633,8 @@ macroExpand(x,e) == --not worked out yet
-- macros should override niladic props
[op,:args] := x
IDENTP op and args = nil and niladicConstructorFromDB op and
- (u := get(op,'macro, e)) => macroExpand(u,e)
- IDENTP op and (get(op,'macro,e) is ['%mlambda,parms,body]) =>
+ (u := get(op,"macro", e)) => macroExpand(u,e)
+ IDENTP op and (get(op,"macro",e) is ['%mlambda,parms,body]) =>
nargs := #args
nparms := #parms
msg :=
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index e1ff661a..d2636c16 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -290,9 +290,9 @@ addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) ==
e
putMacro(lhs,rhs,e) ==
- atom lhs => put(lhs,'macro,rhs,e)
+ atom lhs => put(lhs,"macro",rhs,e)
parms := [gensym() for p in lhs.args]
- put(lhs.op,'macro,
+ put(lhs.op,"macro",
['%mlambda,parms,applySubst(pairList(lhs.args,parms),rhs)],e)
--% Syntax manipulation
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index e25e6290..fbab587a 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -1016,35 +1016,35 @@ displayMacros names ==
-- first do user defined ones
first := true
- for macro in macros repeat
- symbolMember?(macro,pmacs) =>
+ for m in macros repeat
+ symbolMember?(m,pmacs) =>
if first then
sayBrightly ['"%l",'"User-defined macros:"]
first := nil
- displayParserMacro macro
- symbolMember?(macro,imacs) => 'iterate
- sayBrightly ([" ",'"%b", macro, '"%d", " is not a known OpenAxiom macro."])
+ displayParserMacro m
+ symbolMember?(m,imacs) => 'iterate
+ sayBrightly ([" ",'"%b", m, '"%d", " is not a known OpenAxiom macro."])
-- now system ones
first := true
- for macro in macros repeat
- symbolMember?(macro,imacs) =>
- macro in pmacs => 'iterate
+ for m in macros repeat
+ symbolMember?(m,imacs) =>
+ m in pmacs => 'iterate
if first then
sayBrightly ['"%l",'"System-defined macros:"]
first := nil
- displayMacro macro
- symbolMember?(macro,pmacs) => 'iterate
+ displayMacro m
+ symbolMember?(m,pmacs) => 'iterate
nil
getParserMacroNames() ==
removeDuplicates [first mac for mac in getParserMacros()]
-clearParserMacro(macro) ==
+clearParserMacro(m) ==
-- first see if it is one
- not IFCDR assoc(macro, $pfMacros) => nil
- $pfMacros := REMALIST($pfMacros, macro)
+ not IFCDR assoc(m, $pfMacros) => nil
+ $pfMacros := REMALIST($pfMacros, m)
displayMacro name ==
m := isInterpMacro name
diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot
index 3b8d9ec8..736baa83 100644
--- a/src/interp/postpar.boot
+++ b/src/interp/postpar.boot
@@ -217,7 +217,7 @@ postComma u ==
postDef: %ParseTree -> %ParseForm
postDef t ==
t isnt [defOp,lhs,rhs] => systemErrorHere ["postDef",t]
- lhs is ['macro,name] => postMDef ["==>",name,rhs]
+ lhs is ["macro",name] => postMDef ["==>",name,rhs]
recordHeaderDocumentation nil
if $maxSignatureLineNumber ~= 0 then
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 07:33:43 +0000