diff options
author | dos-reis <gdr@axiomatics.org> | 2011-10-18 23:10:24 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-10-18 23:10:24 +0000 |
commit | 8eb956703b1347fe2ced725dfba56d35c6aecd74 (patch) | |
tree | b47fb6b57b4350a6d5bb7a77ca1fd69f4ce78677 /src/interp | |
parent | 630b6f25ff2900a31326141b67a187a685e7e9b8 (diff) | |
download | open-axiom-8eb956703b1347fe2ced725dfba56d35c6aecd74.tar.gz |
* interp/postpar.boot (displayPreCompilationErrors): Dot not check
for interactive mode.
(postBigFloat): Likewise.
(postDef): Likewise.
(postMDef): Likewise.
(tuple2List): Likewise.
(postReduce): Likewise.
(postQUOTE): Remove.
(postQuot): Likewise.
(postOp): Likewise.
(postTran): Adjust.
* interp/newaux.lisp: Replace %LET with ':='.
* interp/property.lisp: Likewise.
* interp/g-util.boot (getTypeOfSyntax): Likewise.
* interp/define.boot (checkRepresentation): Likewise.
(doIt): Likewise.
* interp/compiler.boot (compSetq): Likewise.
(compRecoverGuard): Likewise.
(compReduce1): Likewise.
* interp/c-util.boot (lhsOfAssignment): Likewise.
(isAlmostSimple): Likewise.
* interp/c-doc.boot (recordAttributeDocumentation): Likewise.
* interp/parse.boot (parseLeftArrow): Remove.
(parseLETD): Likewise.
(parseAssign): Rename from parseLET.
* algebra/syntax.spad.pamphlet (SpadAst): Handle both cases.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/c-doc.boot | 2 | ||||
-rw-r--r-- | src/interp/c-util.boot | 6 | ||||
-rw-r--r-- | src/interp/compiler.boot | 12 | ||||
-rw-r--r-- | src/interp/define.boot | 6 | ||||
-rw-r--r-- | src/interp/g-util.boot | 2 | ||||
-rw-r--r-- | src/interp/newaux.lisp | 2 | ||||
-rw-r--r-- | src/interp/parse.boot | 27 | ||||
-rw-r--r-- | src/interp/postpar.boot | 46 | ||||
-rw-r--r-- | src/interp/property.lisp | 5 | ||||
-rw-r--r-- | src/interp/spad-parser.boot | 2 | ||||
-rw-r--r-- | src/interp/spad.lisp | 9 |
11 files changed, 38 insertions, 81 deletions
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 0b341a16..63473e10 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -97,7 +97,7 @@ readForDoc fn == recordSignatureDocumentation(opSig,lineno) == recordDocumentation(rest postTransform opSig,lineno) -recordAttributeDocumentation(['%Attribute,att],lineno) == +recordAttributeDocumentation(['ATTRIBUTE,att],lineno) == name := opOf att upperCase? stringChar(symbolName name,0) => nil recordDocumentation([name,['attribute,:IFCDR postTransform att]],lineno) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 8145cd36..a6931e5c 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -510,7 +510,7 @@ makeCommonEnvironment(e,e') == ++ Return the lexically leftmost location in an assignment for. lhsOfAssignment x == - x is ["%LET",lhs,:.] => lhsOfAssignment lhs + x is [":=",lhs,:.] => lhsOfAssignment lhs x getSuccessEnvironment(a,e) == @@ -793,9 +793,9 @@ isAlmostSimple x == [op,y,:l]:= x op="has" => x op="is" => x - op="%LET" => + op=":=" => ident? y => (setAssignment [x]; y) - (setAssignment [["%LET",g:= genVariable(),:l],["%LET",y,g]]; g) + (setAssignment [[":=",g:= genVariable(),:l],[":=",y,g]]; g) op = "case" and ident? y => x isSideEffectFree op => [op,:mapInto(rest x, function fn)] $assignmentList:= "failed" diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 5a93d546..44dc7d4d 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -780,7 +780,7 @@ compCons1(["CONS",x,y],m,e) == compSetq: (%Instantiation,%Mode,%Env) -> %Maybe %Triple compSetq1: (%Form,%Form,%Mode,%Env) -> %Maybe %Triple -compSetq(["%LET",form,val],m,E) == +compSetq([":=",form,val],m,E) == compSetq1(form,val,m,E) compSetq1(form,val,m,E) == @@ -2078,7 +2078,7 @@ compRecoverGuard(x,t,sn,sm,e) == -- assignment scope (e.g. "%LET") as opposed to local assignment -- because the recovered type may be needed in the body of -- the alternative. - varDef := ["%LET",[":",var',$Type], + varDef := [":=",[":",var',$Type], [["elt",["Foreign","Builtin"],"evalDomain"], [["elt",["Foreign","Builtin"],"CAR"], sn]]] [def,.,e] := compOrCroak(varDef,$EmptyMode,e) @@ -2247,11 +2247,11 @@ compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == itl := [([.,e]:= compIterator(x,e) or return "failed").0 for x in itl] itl="failed" => return nil b := gensym() -- holds value of the body - [bval,bmode,e] := comp(['%LET,b,body],$EmptyMode,e) or return nil + [bval,bmode,e] := comp([":=",b,body],$EmptyMode,e) or return nil accu := gensym() -- holds value of the accumulator - [move,.,e] := comp(['%LET,accu,b],$EmptyMode,e) or return nil + [move,.,e] := comp([":=",accu,b],$EmptyMode,e) or return nil move.op := '%store -- in reality, we are not defining a new variable - [update,mode,e] := comp(['%LET,accu,[op,accu,b]],m,e) or return nil + [update,mode,e] := comp([":=",accu,[op,accu,b]],m,e) or return nil update.op := '%store -- just update the accumulation variable. nval := id := getIdentity(op,e) => u.expr where @@ -2674,7 +2674,7 @@ for x in [["|", :"compSuchthat"],_ ["is", :"compIs"],_ ["Join", :"compJoin"],_ ["leave", :"compLeave"],_ - ["%LET", :"compSetq"],_ + [":=", :"compSetq"],_ ["MDEF", :"compMacro"],_ ["not", :"compLogicalNot"],_ ["pretend", :"compPretend"],_ diff --git a/src/interp/define.boot b/src/interp/define.boot index 3c73dfb0..05e87331 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -732,7 +732,7 @@ checkRepresentation(addForm,body,env) == -- Locate possible Rep definition for [stmt,:.] in tails body repeat - stmt is ["%LET","Rep",val] => + stmt is [":=","Rep",val] => domainRep ~= nil => stackAndThrow('"You cannot assign to constant domain %1b",["Rep"]) if addForm = val then @@ -766,7 +766,7 @@ checkRepresentation(addForm,body,env) == stackAndThrow('"You cannot specify type for %1b",["Rep"]) -- Now, trick the rest of the compiler into believing that -- `Rep' was defined the Old Way, for lookup purpose. - stmt.op := "%LET" + stmt.op := ":=" stmt.rest := ["Rep",domainRep] $useRepresentationHack := false -- Don't confuse `Rep' and `%'. @@ -2224,7 +2224,7 @@ doIt(item,$predl) == item.op := u.op item.rest := rest u doIt(item,$predl) - item is ["%LET",lhs,rhs,:.] => + item is [":=",lhs,rhs,:.] => compOrCroak(item,$EmptyMode,$e) isnt [code,.,$e] => stackSemanticError(["cannot compile assigned value to",:bright lhs],nil) not (code is ["%LET",lhs',rhs',:.] and lhs' isnt [.,:.]) => diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index f49a61ec..de1ad58d 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -371,7 +371,7 @@ getTypeOfSyntax t == op = "pretend" => '(PretendAst) op = "::" => '(CoerceAst) op = "@" => '(RestrictAst) - op = "%LET" => '(LetAst) + op = "%LET" or op = ":=" => '(LetAst) op = "|" => '(SuchThatAst) op = ":" => '(ColonAst) op = ":=" => '(LetAst) diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp index 3e85eb7d..2d937c33 100644 --- a/src/interp/newaux.lisp +++ b/src/interp/newaux.lisp @@ -127,7 +127,7 @@ (== DEF 122 121) (==> MDEF 122 121) (\| 108 111) ;was 190 190 - (\:- LETD 125 124) (\:= %LET 125 124))) + (\:- 125 124) (\:= 125 124))) (mapcar #'(LAMBDA (J) (MAKENEWOP J `|Nud|)) '((|for| 130 350 (|parseLoop|)) diff --git a/src/interp/parse.boot b/src/interp/parse.boot index f980de7c..8fd23a1c 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -97,11 +97,6 @@ parseConstruct u == $insideConstructIfTrue: local:= true [first u,:parseTranList rest u] --- ??? This parser is unused at the moment. -parseLeftArrow: %ParseForm -> %Form -parseLeftArrow u == - parseTran ["%LET",:rest u] - parseIs: %ParseForm -> %Form parseIs t == t isnt ["is",a,b] => systemErrorHere ["parseIs",t] @@ -139,19 +134,14 @@ transIs1 u == [h,:v] u -parseLET: %ParseForm -> %Form -parseLET t == - t isnt ["%LET",x,y] => systemErrorHere ["parseLET",t] - p := ["%LET",parseTran x,parseTranCheckForRecord(y,opOf x)] - opOf x = "cons" => ["%LET",transIs p.1,p.2] +parseAssign: %ParseForm -> %Form +parseAssign t == + t isnt [":=",x,y] => systemErrorHere ["parseAssign",t] + p := [":=",parseTran x,parseTranCheckForRecord(y,opOf x)] + opOf x = "cons" => [":=",transIs p.1,p.2] p -parseLETD: %ParseForm -> %Form -parseLETD t == - t isnt ["LETD",x,y] => systemErrorHere ["parseLETD",t] - ["%Decl",parseTran x,parseTran y] - parseColon: %ParseForm -> %Form parseColon u == u isnt [":",:.] => systemErrorHere ["parseColon",u] @@ -355,7 +345,7 @@ makeSimplePredicateOrNil: %ParseForm -> %Form makeSimplePredicateOrNil p == isSimple p => nil u:= isAlmostSimple p => u - wrapSEQExit [["%LET",g:= gensym(),p],g] + wrapSEQExit [[":=",g:= gensym(),p],g] parseWhere: %List %Form -> %Form @@ -378,7 +368,7 @@ transSeq l == l is [x] => decExitLevel x [item,:tail] := l item is ["SEQ",:l,["exit",1,["IF",p,["exit", =2,q],"%noBranch"]]] and - (and/[x is ["%LET",:.] for x in l]) => + (and/[x is [":=",:.] for x in l]) => ["SEQ",:[decExitLevel x for x in l],["exit",1,["IF",decExitLevel p, decExitLevel q,transSeq tail]]] item is ["IF",a,["exit",1,b],"%noBranch"] => @@ -457,8 +447,7 @@ for x in [[":", :"parseColon"],_ ["isnt", :"parseIsnt"],_ ["Join", :"parseJoin"],_ ["leave", :"doParseLeave"],_ - ["%LET", :"parseLET"],_ - ["LETD", :"parseLETD"],_ + [":=", :"parseAssign"],_ ["MDEF", :"parseMDEF"],_ ["or", :"parseOr"],_ ["pretend", :"parsePretend"],_ diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index aba24540..e4148a8f 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -66,13 +66,10 @@ displayPreCompilationErrors() == errors:= 1<n => '"errors" '"error" - if $InteractiveMode - then sayBrightly ['" Semantic ",errors,'" detected: "] - else - heading:= - $topOp ~= '$topOp => ['" ",$topOp,'" has"] - ['" You have"] - sayBrightly [:heading,'"%b",n,'"%d",'"precompilation ",errors,'":"] + heading:= + $topOp ~= '$topOp => ['" ",$topOp,'" has"] + ['" You have"] + sayBrightly [:heading,'"%b",n,'"%d",'"precompilation ",errors,'":"] if 1<n then (for x in $postStack for i in 1.. repeat sayMath ['" ",i,'"_) ",:x]) else sayMath ['" ",:first $postStack] @@ -83,11 +80,11 @@ postTran x == x isnt [.,:.] => postAtom x op := first x + op is 'QUOTE => x symbol? op and (f:= property(op,'postTran)) => FUNCALL(f,x) op is ["elt",a,b] => u:= postTran [b,:rest x] [postTran op,:rest u] - op ~= (y:= postOp op) => [y,:postTranList rest x] postForm x postTranList: %List %ParseTree -> %List %ParseForm @@ -97,8 +94,7 @@ postTranList x == postBigFloat: %ParseTree -> %ParseTree postBigFloat x == [.,mant,:expon] := x - eltword := if $InteractiveMode then "$elt" else "elt" - postTran [[eltword,$Float,"float"],[",",[",",mant,expon],10]] + postTran [['elt,$Float,"float"],[",",[",",mant,expon],10]] postAdd: %ParseTree -> %ParseForm postAdd x == @@ -122,10 +118,6 @@ postCapsule x == op = "if" => ["CAPSULE",postBlockItem x] checkWarningIndentation() -postQUOTE: %ParseTree -> %ParseForm -postQUOTE x == - x - postColon: %ParseTree -> %ParseForm postColon u == u is [":",x] => [":",postTran x] @@ -157,7 +149,7 @@ postError: %Thing -> %Thing postError msg == BUMPERRORCOUNT 'precompilation xmsg:= - $defOp ~= nil and not $InteractiveMode => [$defOp,'": ",:msg] + $defOp ~= nil => [$defOp,'": ",:msg] msg $postStack:= [xmsg,:$postStack] nil @@ -226,7 +218,7 @@ postDef t == [form,targetType]:= lhs is [":",:.] => rest lhs [lhs,nil] - if not $InteractiveMode and form isnt [.,:.] then form := [form] + if form isnt [.,:.] then form := [form] newLhs:= form isnt [.,:.] => form [op,:argl]:= [(x is [":",a,.] => a; x) for x in form] @@ -253,11 +245,7 @@ postDefArgs argl == postMDef: %ParseTree -> %ParseForm postMDef(t) == [.,lhs,rhs] := t - $InteractiveMode => - lhs := postTran lhs - not ident? lhs => throwKeyedMsg("S2IP0001",nil) - ["MDEF",lhs,nil,nil,postTran rhs] - lhs:= postTran lhs + lhs := postTran lhs [form,targetType]:= lhs is [":",:.] => rest lhs [lhs,nil] @@ -308,10 +296,6 @@ postForm u == x is [.,["%Comma",:y]] => [first x,:y] x -postQuote: %ParseTree -> %ParseForm -postQuote [.,a] == - quote a - postIf: %ParseTree -> %ParseForm postIf t == t isnt ["if",:l] => t @@ -334,13 +318,6 @@ postMapping u == u isnt ["->",source,target] => u ["Mapping",postTran target,:unComma postTran source] -postOp: %ParseTree -> %ParseForm -postOp x == - x=":=" => "%LET" - x=":-" => "LETD" - x="%Attribute" => "ATTRIBUTE" - x - postRepeat: %ParseTree -> %ParseForm postRepeat t == t isnt ["REPEAT",:m,x] => systemErrorHere ["postRepeat",t] @@ -400,8 +377,6 @@ tuple2List l == u:= tuple2List l' a is ["SEGMENT",p,q] => null u => ["construct",postTranSegment(p,q)] - $InteractiveMode => - ["append",["construct",postTranSegment(p,q)],tuple2List l'] ["nconc",["construct",postTranSegment(p,q)],tuple2List l'] null u => ["construct",postTran a] ["cons",postTran a,tuple2List l'] @@ -414,7 +389,7 @@ SEGMENT(a,b) == postReduce: %ParseTree -> %ParseForm postReduce t == t isnt ["%Reduce",op,expr] => systemErrorHere ["postReduce",t] - $InteractiveMode or expr is ["COLLECT",:.] => + expr is ["COLLECT",:.] => ["REDUCE",op,0,postTran expr] postReduce ["%Reduce",op,["COLLECT",["IN",g:= gensym(),expr], ["construct", g]]] @@ -544,7 +519,6 @@ for x in [["with", :"postWith"],_ ["/", :"postSlash"],_ ["construct", :"postConstruct"],_ ["%Block", :"postBlock"],_ - ["QUOTE", :"postQUOTE"],_ ["COLLECT", :"postCollect"],_ [":BF:", :"postBigFloat"],_ ["in", :"postin"],_ diff --git a/src/interp/property.lisp b/src/interp/property.lisp index de9719a4..94163971 100644 --- a/src/interp/property.lisp +++ b/src/interp/property.lisp @@ -63,9 +63,12 @@ (MAKEPROP 'SEGMENT '|Led| '(|..| SEGMENT 401 699 (|P:Seg|))) (MAKEPROP 'SEGMENT '|isSuffix| 'T) (MAKEPROP 'EQUAL1 'CHRYBNAM 'EQ) +(MAKEPROP 'COND '|Nud| '(|if| |if| 130 0)) +(MAKEPROP 'CONS '|Led| '(CONS CONS 1000 1000)) +(MAKEPROP 'APPEND '|Led| '(APPEND APPEND 1000 1000)) (REPEAT (IN X '( - (%LET " := ") + (|:=| " := ") (= "=") (|/| "/") (+ "+") diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot index 894907b2..0eb18815 100644 --- a/src/interp/spad-parser.boot +++ b/src/interp/spad-parser.boot @@ -383,7 +383,7 @@ parseCategory() == pushReduction('parseCategory,["%Signature",popStack2(),popStack1()]) recordSignatureDocumentation(nthStack 1,g) true - pushReduction('parseCategory,["%Attribute",popStack1()]) + pushReduction('parseCategory,["ATTRIBUTE",popStack1()]) recordAttributeDocumentation(nthStack 1,g) true nil diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index fc517d67..2de5aaaa 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -340,15 +340,6 @@ (FLAG TEMPGENSYMLIST 'IS-GENSYM) -(MAKEPROP 'COND '|Nud| '(|if| |if| 130 0)) -(MAKEPROP 'CONS '|Led| '(CONS CONS 1000 1000)) -(MAKEPROP 'APPEND '|Led| '(APPEND APPEND 1000 1000)) -(MAKEPROP 'TAG '|Led| '(TAG TAG 122 121)) -(MAKEPROP 'EQUATNUM '|Nud| '(|dummy| |dummy| 0 0)) -(MAKEPROP 'EQUATNUM '|Led| '(|dummy| |dummy| 10000 0)) -(MAKEPROP '%LET '|Led| '(:= %LET 125 124)) -(MAKEPROP 'RARROW '|Led| '(== DEF 122 121)) -(MAKEPROP 'SEGMENT '|Led| '(\.\. SEGMENT 401 699 (|boot-Seg|))) ;; NAME: DECIMAL-LENGTH ;; PURPOSE: Computes number of decimal digits in print representation of x |