From e31e3e472aa2a91c0b6f12af8723472cd80fe0eb Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 9 Aug 2008 02:45:08 +0000 Subject: * 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. --- src/ChangeLog | 19 ++++++++++++++++++- src/interp/i-spec1.boot | 2 +- src/interp/i-spec2.boot | 38 +++++++++++++++++++++++++++++--------- src/interp/macex.boot | 20 +++++++++----------- src/interp/pf2sex.boot | 13 +++++++++---- 5 files changed, 66 insertions(+), 26 deletions(-) (limited to 'src') 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 - * 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 + * 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] -- cgit v1.2.3