diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/ChangeLog | 17 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 4 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 4 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 50 | ||||
| -rw-r--r-- | src/interp/iterator.boot | 110 | ||||
| -rw-r--r-- | src/interp/parse.boot | 41 | ||||
| -rw-r--r-- | src/interp/postpar.boot | 35 | ||||
| -rw-r--r-- | src/interp/property.lisp | 128 |
8 files changed, 201 insertions, 188 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 36577d81..bc8ec9da 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,20 @@ +2007-11-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (compiler.$(FASLEXT)): Update requirement. + * compiler.boot: Import "define" and "iterator". + Move setting of special compiler functions from property.lisp to + here. + * iterator.boot (compCollectV): Uncomment. + (compIteratorV): Likewise. + (computeMaxIndex): Likewise. + (exprDifference): Likewise. + * parse.boot: Move setting of special parsing functions from + property.lisp to here. + * postpar.boot: Move setting of special parsing transformers from + property.lisp to here. + * property.lisp: Move setting of special compiler functions and + parsers to appropriate files. + 2007-11-27 Gabriel Dos Reis <gdr@cs.tamu.edu> * vmlisp.lisp (create-sbc): Remove. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 29a708b9..4f933fb5 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -481,8 +481,8 @@ wi1.$(FASLEXT): wi1.boot macros.$(FASLEXT) apply.$(FASLEXT): apply.boot compiler.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< -compiler.$(FASLEXT): compiler.boot category.$(FASLEXT) c-util.$(FASLEXT) \ - modemap.$(FASLEXT) pathname.$(FASLEXT) +compiler.$(FASLEXT): compiler.boot c-util.$(FASLEXT) modemap.$(FASLEXT) \ + pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< nrunopt.$(FASLEXT): nrunopt.boot c-util.$(FASLEXT) diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 3783b9b1..3281a59a 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -816,8 +816,8 @@ wi1.$(FASLEXT): wi1.boot macros.$(FASLEXT) apply.$(FASLEXT): apply.boot compiler.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< -compiler.$(FASLEXT): compiler.boot category.$(FASLEXT) c-util.$(FASLEXT) \ - modemap.$(FASLEXT) pathname.$(FASLEXT) +compiler.$(FASLEXT): compiler.boot c-util.$(FASLEXT) modemap.$(FASLEXT) \ + pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< nrunopt.$(FASLEXT): nrunopt.boot c-util.$(FASLEXT) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index cd912ee4..f5bcab8f 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -34,8 +34,9 @@ import '"c-util" import '"pathname" -import '"category" import '"modemap" +import '"define" +import '"iterator" )package "BOOT" ++ A list of routines for diagnostic reports. These functions, in an @@ -1427,3 +1428,50 @@ compilerDoitWithScreenedLisplib(constructor, fun) == SEQ(UNEMBED 'RWRITE)) +--% Register compilers for special forms. +-- Those compilers are on the `SPECIAL' property of the corresponding +-- special form operator symbol. +for x in [["_|", :function compSuchthat],_ + ["_@", :function compAtSign],_ + ["_:", :function compColon],_ + ["_:_:", :function compCoerce],_ + ["QUOTE", :function compQuote],_ + ["add", :function compAdd],_ + ["CAPSULE", :function compCapsule],_ + ["case", :function compCase],_ + ["CATEGORY", :function compCategory],_ + ["COLLECT", :function compRepeatOrCollect],_ + ["COLLECTV", :function compCollectV],_ + ["CONS", :function compCons],_ + ["construct", :function compConstruct],_ + ["DEF", :function compDefine],_ + ["elt", :function compElt],_ + ["exit", :function compExit],_ + ["has", :function compHas],_ + ["IF", :function compIf],_ + ["import", :function compImport],_ + ["is", :function compIs],_ + ["Join", :function compJoin],_ + ["leave", :function compLeave],_ + ["LET", :function compSetq],_ + ["ListCategory", :function compConstructorCategory],_ + ["MDEF", :function compMacro],_ + ["not", :function compileNot],_ + ["pretend", :function compPretend],_ + ["Record", :function compCat],_ + ["RecordCategory", :function compConstructorCategory],_ + ["REDUCE", :function compReduce],_ + ["REPEAT", :function compRepeatOrCollect],_ + ["return", :function compReturn],_ + ["SEQ", :function compSeq],_ + ["SETQ", :function compSetq],_ + ["String", :function compString],_ + ["SubDomain", :function compSubDomain],_ + ["SubsetCategory", :function compSubsetCategory],_ + ["Union", :function compCat],_ + ["Mapping", :function compCat],_ + ["UnionCategory", :function compConstructorCategory],_ + ["VECTOR", :function compVector],_ + ["VectorCategory", :function compConstructorCategory],_ + ["where", :function compWhere]] repeat + MAKEPROP(car x, 'SPECIAL, cdr x) diff --git a/src/interp/iterator.boot b/src/interp/iterator.boot index af6d6c37..5431b3d9 100644 --- a/src/interp/iterator.boot +++ b/src/interp/iterator.boot @@ -240,59 +240,59 @@ modeIsAggregateOf(ListOrVector,m,e) == --the following 4 functions are not currently used ---compCollectV(form,m,e) == --- fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],e) where --- fn(form,$exitModeStack,$leaveLevelStack,e) == --- [repeatOrCollect,it,body]:= form --- [it',e]:= compIteratorV(it,e) or return nil --- m:= first $exitModeStack --- [mOver,mUnder]:= modeIsAggregateOf("Vector",m,e) or $EmptyMode --- [body',m',e']:= compOrCroak(body,mUnder,e) or return nil --- form':= ["COLLECTV",it',body'] --- {n:= --- it' is ("STEP",.,s,i,f) or it' is ("ISTEP",.,s,i,f) => --- computeMaxIndex(s,f,i); --- return nil} --- coerce([form',mOver,e'],m) --- ---compIteratorV(it,e) == --- it is ["STEP",index,start,inc,final] => --- (start':= comp(start,$Integer,e)) and --- (inc':= comp(inc,$NonNegativeInteger,start'.env)) and --- (final':= comp(final,$Integer,inc'.env)) => --- indexmode:= --- comp(start,$NonNegativeInteger,e) => $NonNegativeInteger --- $Integer --- if null get(index,"mode",e) then [.,.,e]:= --- compMakeDeclaration([":",index,indexmode],$EmptyMode,final'.env) or --- return nil --- e:= put(index,"value",[genSomeVariable(),indexmode,e],e) --- [["ISTEP",index,start'.expr,inc'.expr,final'.expr],e] --- [start,.,e]:= --- comp(start,$Integer,e) or return --- stackMessage ["start value of index: ",start," is not an integer"] --- [inc,.,e]:= --- comp(inc,$NonNegativeInteger,e) or return --- stackMessage ["index increment: ",inc," must be a non-negative integer"] --- [final,.,e]:= --- comp(final,$Integer,e) or return --- stackMessage ["final value of index: ",final," is not an integer"] --- indexmode:= --- comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger --- $Integer --- if null get(index,"mode",e) then [.,.,e]:= --- compMakeDeclaration([":",index,indexmode],$EmptyMode,e) or return nil --- e:= put(index,"value",[genSomeVariable(),indexmode,e],e) --- [["STEP",index,start,inc,final],e] --- nil --- ---computeMaxIndex(s,f,i) == --- i^=1 => cannotDo() --- s=1 => f --- exprDifference(f,exprDifference(s,1)) --- ---exprDifference(x,y) == --- y=0 => x --- FIXP x and FIXP y => DIFFERENCE(x,y) --- ["DIFFERENCE",x,y] +compCollectV(form,m,e) == + fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],e) where + fn(form,$exitModeStack,$leaveLevelStack,e) == + [repeatOrCollect,it,body]:= form + [it',e]:= compIteratorV(it,e) or return nil + m:= first $exitModeStack + [mOver,mUnder]:= modeIsAggregateOf("Vector",m,e) or $EmptyMode + [body',m',e']:= compOrCroak(body,mUnder,e) or return nil + form':= ["COLLECTV",it',body'] + n:= + it' is ["STEP",.,s,i,f] or it' is ["ISTEP",.,s,i,f] => + computeMaxIndex(s,f,i); + return nil + coerce([form',mOver,e'],m) + +compIteratorV(it,e) == + it is ["STEP",index,start,inc,final] => + (start':= comp(start,$Integer,e)) and + (inc':= comp(inc,$NonNegativeInteger,start'.env)) and + (final':= comp(final,$Integer,inc'.env)) => + indexmode:= + comp(start,$NonNegativeInteger,e) => $NonNegativeInteger + $Integer + if null get(index,"mode",e) then [.,.,e]:= + compMakeDeclaration([":",index,indexmode],$EmptyMode,final'.env) or + return nil + e:= put(index,"value",[genSomeVariable(),indexmode,e],e) + [["ISTEP",index,start'.expr,inc'.expr,final'.expr],e] + [start,.,e]:= + comp(start,$Integer,e) or return + stackMessage ["start value of index: ",start," is not an integer"] + [inc,.,e]:= + comp(inc,$NonNegativeInteger,e) or return + stackMessage ["index increment: ",inc," must be a non-negative integer"] + [final,.,e]:= + comp(final,$Integer,e) or return + stackMessage ["final value of index: ",final," is not an integer"] + indexmode:= + comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger + $Integer + if null get(index,"mode",e) then [.,.,e]:= + compMakeDeclaration([":",index,indexmode],$EmptyMode,e) or return nil + e:= put(index,"value",[genSomeVariable(),indexmode,e],e) + [["STEP",index,start,inc,final],e] + nil + +computeMaxIndex(s,f,i) == + i^=1 => cannotDo() + s=1 => f + exprDifference(f,exprDifference(s,1)) + +exprDifference(x,y) == + y=0 => x + FIXP x and FIXP y => DIFFERENCE(x,y) + ["DIFFERENCE",x,y] diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 3c0237e5..d5f07a25 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -485,3 +485,44 @@ scriptTranRow1 x == STRCONC(",",$quadSymbol,scriptTranRow1 rest x) parseVCONS l == ["VECTOR",:parseTranList l] + + +--% Register special parsers. + +for x in [["<=", :function parseLessEqual],_ + [">", :function parseGreaterThan],_ + [">=", :function parseGreaterEqual],_ + ["$<=", :function parseDollarLessEqual],_ + ["$>", :function parseDollarGreaterThan],_ + ["$>=", :function parseDollarGreaterEqual],_ + ["$^=", :function parseDollarNotEqual],_ + ["^=", :function parseNotEqual],_ + ["_:", :function parseColon],_ + ["_:_:", :function parseCoerce],_ + ["@", :function parseAtSign],_ + ["and", :function parseAnd],_ + ["CATEGORY", :function parseCategory],_ + ["construct", :function parseConstruct],_ + ["DEF", :function parseDEF],_ + ["eqv", :function parseEquivalence],_ + ["exit", :function parseExit],_ + ["has", :function parseHas],_ + ["IF", :function parseIf],_ + ["implies", :function parseImplies],_ + ["IN", :function parseIn],_ + ["INBY", :function parseInBy],_ + ["is", :function parseIs],_ + ["isnt", :function parseIsnt],_ + ["Join", :function parseJoin],_ + ["leave", :function parseLeave],_ + ["LET", :function parseLET],_ + ["LETD", :function parseLETD],_ + ["MDEF", :function parseMDEF],_ + ["or", :function parseOr],_ + ["pretend", :function parsePretend],_ + ["return", :function parseReturn],_ + ["SEGMENT", :function parseSegment],_ + ["SEQ", :function parseSeq],_ + ["VCONS", :function parseVCONS],_ + ["where", :function parseWhere]] repeat + MAKEPROP(car x, "parseTran", cdr x) diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index aa34f176..8cd67c35 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -529,3 +529,38 @@ hasAplExtension argl == deepestExpression x == x is ["_!",y] => deepestExpression y x + +--% Register special parse tree tranformers. + +for x in [["with", :function postWith],_ + ["Scripts", :function postScripts],_ + ["/", :function postSlash],_ + ["construct", :function postConstruct],_ + ["Block", :function postBlock],_ + ["QUOTE", :function postQUOTE],_ + ["COLLECT", :function postCollect],_ + ["_:BF_:", :function postBigFloat],_ + ["in", :function postin],_ + ["IN", :function postIn],_ + ["REPEAT", :function postRepeat],_ + ["TupleCollect", :function postTupleCollect],_ + ["add", :function postAdd],_ + ["Reduce", :function postReduce],_ + ["_,", :function postComma],_ + ["_;", :function postSemiColon],_ + ["where", :function postWhere],_ + ["_:_:", :function postColonColon],_ + ["_:", :function postColon],_ + ["@", :function postAtSign],_ + ["pretend", :function postPretend],_ + ["if", :function postIf],_ + ["Join", :function postJoin],_ + ["Signature", :function postSignature],_ + ["CATEGORY", :function postCategory],_ + ["==", :function postDef],_ + ["==>", :function postMDef],_ + ["->", :function postMapping],_ + ["=>", :function postExit],_ + ["Tuple", :function postTuple]] repeat + MAKEPROP(car x, "postTran", cdr x) + diff --git a/src/interp/property.lisp b/src/interp/property.lisp index 00c1cd70..6eef2a01 100644 --- a/src/interp/property.lisp +++ b/src/interp/property.lisp @@ -350,86 +350,6 @@ (|Enumeration| |mkEnumerationFunList|) )) (MAKEPROP (CAR X) '|makeFunctionList| (CADR X))) -(REPEAT (IN X '( - (|<=| |parseLessEqual|) - (|>| |parseGreaterThan|) - (|>=| |parseGreaterEqual|) - (|$<=| |parseDollarLessEqual|) - (|$>| |parseDollarGreaterThan|) - (|$>=| |parseDollarGreaterEqual|) - ($^= |parseDollarNotEqual|) - (^= |parseNotEqual|) - (\: |parseColon|) - (|::| |parseCoerce|) - (@ |parseAtSign|) -;; These two lines were commented out in the original sources. -;; However both of these lines involved control characters that -;; latex cannot handle. control-V and control-H should be the -;; actual control characters, not the text replacement shown here. -;; ;;(control-V |parseUpArrow|) -;; ;;(|control-H| |parseLeftArrow|) - (|and| |parseAnd|) - (CATEGORY |parseCategory|) - (|construct| |parseConstruct|) - (DEF |parseDEF|) - (|eqv| |parseEquivalence|) - (|exit| |parseExit|) - (|has| |parseHas|) - (IF |parseIf|) - (|implies| |parseImplies|) - (IN |parseIn|) - (INBY |parseInBy|) - (|is| |parseIs|) - (|isnt| |parseIsnt|) - (|Join| |parseJoin|) - (|leave| |parseLeave|) - (LET |parseLET|) - (LETD |parseLETD|) - (MDEF |parseMDEF|) - (|or| |parseOr|) - (|pretend| |parsePretend|) - (|return| |parseReturn|) - (SEGMENT |parseSegment|) - (SEQ |parseSeq|) - (VCONS |parseVCONS|) - (|where| |parseWhere|) -;; (|xor| |parseExclusiveOr|) -)) (MAKEPROP (CAR X) '|parseTran| (CADR X))) - -(REPEAT (IN X '( - (|with| |postWith|) - (|Scripts| |postScripts|) - (/ |postSlash|) - (|construct| |postConstruct|) - (|Block| |postBlock|) - (QUOTE |postQUOTE|) - (COLLECT |postCollect|) - (|:BF:| |postBigFloat|) - (|in| |postin|) ;" the infix operator version of in" - (IN |postIn|) ;" the iterator form of in" - (REPEAT |postRepeat|) - (|TupleCollect| |postTupleCollect|) - (|add| |postAdd|) - (|Reduce| |postReduce|) - (\, |postComma|) - (\; |postSemiColon|) - (|where| |postWhere|) - (|::| |postColonColon|) - (\: |postColon|) - (@ |postAtSign|) - (|pretend| |postPretend|) - (|if| |postIf|) - (|Join| |postJoin|) - (|Signature| |postSignature|) - (CATEGORY |postCategory|) -;;( |postDef|) - (== |postDef|) - (|==>| |postMDef|) - (|->| |postMapping|) - (|=>| |postExit|) - (|Tuple| |postTuple|) -)) (MAKEPROP (CAR X) '|postTran| (CADR X))) - (MAKEPROP 'INTEGER 'ISFUNCTION 'FIXP) (MAKEPROP '|Integer| '|isFunction| '|IsInteger|) (MAKEPROP '|Boolean| '|isFunction| '|isBoolean|) @@ -544,54 +464,6 @@ (|target| CAR) )) (MAKEPROP (CAR X) '|SEL,FUNCTION| (CADR X))) -(REPEAT (IN X '( - (\| |compSuchthat|) - (\@ |compAtSign|) - (|:| |compColon|) - (\:\: |compCoerce|) - (QUOTE |compQuote|) -;; We have a similar problem with the control-G character. -;; ;; (control-G |compContained|) - - (|add| |compAdd|) - (CAPSULE |compCapsule|) - (|case| |compCase|) - (CATEGORY |compCategory|) - (COLLECT |compRepeatOrCollect|) - (COLLECTV |compCollectV|) - (CONS |compCons|) - (|construct| |compConstruct|) - (DEF |compDefine|) - (|elt| |compElt|) - (|exit| |compExit|) - (|has| |compHas|) - (IF |compIf|) - (|import| |compImport|) - (|is| |compIs|) - (|Join| |compJoin|) - (|leave| |compLeave|) - (LET |compSetq|) - (|ListCategory| |compConstructorCategory|) - (MDEF |compMacro|) - (|pretend| |compPretend|) - (|Record| |compCat|) - (|RecordCategory| |compConstructorCategory|) - (REDUCE |compReduce|) - (REPEAT |compRepeatOrCollect|) - (|return| |compReturn|) - (SEQ |compSeq|) - (SETQ |compSetq|) - (|String| |compString|) - (|SubDomain| |compSubDomain|) - (|SubsetCategory| |compSubsetCategory|) - (|Union| |compCat|) - (|Mapping| |compCat|) - (|UnionCategory| |compConstructorCategory|) - (VECTOR |compVector|) - (|VectorCategory| |compConstructorCategory|) - (|where| |compWhere|) - (|not| |compileNot|) -)) (MAKEPROP (CAR X) 'SPECIAL (CADR X))) (REPEAT (IN X '( (\: |compColonInteractive|) |