aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog19
-rw-r--r--src/interp/i-spec1.boot2
-rw-r--r--src/interp/i-spec2.boot38
-rw-r--r--src/interp/macex.boot20
-rw-r--r--src/interp/pf2sex.boot13
5 files changed, 66 insertions, 26 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 87bce549..cd818564 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,9 +1,26 @@
2008-08-08 Gabriel Dos Reis <gdr@cs.tamu.edu>
- * lib/Makefile.in ($(axiom_target_libdir)/libopen-axiom-core.$(LIBEXT)): Tidy.
+ * interp/pf2sex.boot (pfMacro2Sex): New.
+ (pfMLambda2Sex): Likewise.
+ (pf2Sex1): Use them.
+ * interp/i-spec2.boot ($VoidValueObject): New.
+ ($VoidCodeObject): Likewise.
+ (setValueToVoid): Likewise.
+ (setCodeToVoid): Likewise.
+ (upDEF): Call setValueToVoid.
+ (upfree): Call setCodeToVoid
+ (uplocal): Likewise.
+ (interpIF): Call setValueToVoid.
+ (up%Macro): New.
+ (up%MLambda): Likewise.
+ * interp/i-spec1.boot ($specialOps): Add %Macro and %MLambda.
+ * interp/macex.boot (macMacro): Really return the original macro
+ as the documentation says.
2008-08-08 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * lib/Makefile.in ($(axiom_target_libdir)/libopen-axiom-core.$(LIBEXT)): Tidy.
+
* interp/pf2sex.boot (pfApplication2Sex): Don't transform ">",
"=>", and "<=" expressions.
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 986e0f6b..90942e57 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -42,7 +42,7 @@ $specialOps := '(
ADEF AlgExtension _and _case COERCE COLLECT construct Declare DEF Dollar
equation error free has IF _is _isnt iterate _break LET _local MDEF _or
pretend QUOTE REDUCE REPEAT _return SEQ TARGET tuple typeOf _where
- _[_|_|_] )
+ _[_|_|_] %Macro %MLambda)
$repeatLabel := NIL
$breakCount := 0
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index 58c737af..27c6ad32 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -35,6 +35,18 @@
import i_-spec1
namespace BOOT
+++ The `void' value object (an oxymoron). There really are constants.
+$VoidValueObject := objNew(voidValue(), $Void)
+$VoidCodeObject := objNew('(voidValue), $Void)
+
+setValueToVoid t ==
+ putValue(t,$VoidValueObject)
+ putModeSet(t,[$Void])
+
+setCodeToVoid t ==
+ putValue(t,$VoidCodeObject)
+ putModeSet(t,[$Void])
+
++ Interpreter macros
$InterpreterMacroAlist ==
'((%i . (complex 0 1))
@@ -62,8 +74,7 @@ upDEF t ==
keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
mapOp := first mapOp
put(mapOp,"value",v,$e)
- putValue(op,objNew(voidValue(), $Void))
- putModeSet(op,[$Void])
+ setValueToVoid op
--% Handler for package calling and $ constants
@@ -180,12 +191,10 @@ uperror t ==
--% Handlers for free and local
upfree t ==
- putValue(t,objNew('(voidValue),$Void))
- putModeSet(t,[$Void])
+ setCodeToVoid t
uplocal t ==
- putValue(t,objNew('(voidValue),$Void))
- putModeSet(t,[$Void])
+ setCodeToVoid t
upfreeWithType(var,type) ==
sayKeyedMsg("S2IS0055",['"free",var])
@@ -306,9 +315,7 @@ interpIF(op,cond,a,b) ==
val:= getValue cond
val:= coerceInteractive(val,$Boolean) =>
objValUnwrap(val) => upIFgenValue(op,a)
- EQ(b,"%noBranch") =>
- putValue(op,objNew(voidValue(), $Void))
- putModeSet(op,[$Void])
+ EQ(b,"%noBranch") => setValueToVoid op
upIFgenValue(op,b)
throwKeyedMsg("S2IS0031",NIL)
@@ -1153,6 +1160,19 @@ copyHack(env) ==
CONS(CAR p,[(EQCAR(q,'localModemap) => q; copy q) for q in CDR p])
[[d]]
+--% Macro handling
+
+-- Well, in fact we never handle macros in the interpreter directly.
+-- Rather, they are saved in the `macro processing phase' (phMacro)
+-- to be used in future macro expansions, and the AST we get at this
+-- point already went through the macro expansion massage. So, all we
+-- have to do is to the rubber stamp.
+up%Macro t ==
+ setValueToVoid t
+
+up%MLambda t ==
+ setValueToVoid t
+
-- Creates the function names of the special function handlers and puts
-- them on the property list of the function name
diff --git a/src/interp/macex.boot b/src/interp/macex.boot
index 26796b5c..ff0804c7 100644
--- a/src/interp/macex.boot
+++ b/src/interp/macex.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -108,16 +108,14 @@ mac0SubstituteOuter( replist , pform ) ==
-- This function adds the appropriate definition and returns
-- the original Macro pform.
macMacro pf ==
- lhs := pfMacroLhs pf
- rhs := pfMacroRhs pf
- not pfId? lhs =>
- ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] )
- pf
- sy := pfIdSymbol lhs
-
- mac0Define(sy, if pfMLambda? rhs then 'mlambda else 'mbody, macSubstituteOuter rhs)
-
- if pfNothing? rhs then pf else pfMacro(lhs, pfNothing())
+ lhs := pfMacroLhs pf
+ rhs := pfMacroRhs pf
+ not pfId? lhs =>
+ ncSoftError (pfSourcePosition lhs, 'S2CM0001, [%pform lhs] )
+ pf
+ sy := pfIdSymbol lhs
+ mac0Define(sy, (pfMLambda? rhs => 'mlambda; 'mbody), macSubstituteOuter rhs)
+ pf
mac0Define(sy, state, body) ==
$pfMacros := cons([sy, state, body], $pfMacros)
diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot
index 0c8aa475..bcb9d514 100644
--- a/src/interp/pf2sex.boot
+++ b/src/interp/pf2sex.boot
@@ -125,8 +125,7 @@ pf2Sex1 pf ==
pfDefinition2Sex pf
pfLambda? pf =>
pfLambda2Sex pf
- pfMLambda? pf =>
- "/throwAway"
+ pfMLambda? pf => pfMLambda2Sex pf
pfRestrict? pf =>
["@", pf2Sex1 pfRestrictExpr pf, pf2Sex1 pfRestrictType pf]
pfFree? pf =>
@@ -148,8 +147,7 @@ pf2Sex1 pf ==
pfRule2Sex pf
pfBreak? pf =>
["break", pfBreakFrom pf]
- pfMacro? pf =>
- "/throwAway"
+ pfMacro? pf => pfMacro2Sex pf
pfReturn? pf =>
["return", pf2Sex1 pfReturnExpr pf]
pfIterate? pf =>
@@ -478,3 +476,10 @@ pfSuchThat2Sex args ==
pfQuantified2Sex(quantifier,vars,expr) ==
[quantifier, [pf2Sex1 t for t in pfParts vars], pf2Sex1 expr]
+
+pfMacro2Sex pf ==
+ ["%Macro", pf2Sex1 pfMacroLhs pf, pf2Sex1 pfMacroRhs pf]
+
+pfMLambda2Sex pf ==
+ ["%MLambda", [pf2Sex1 a for a in pf0MLambdaArgs pf],
+ pf2Sex1 pfMLambdaBody pf]