aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/ChangeLog17
-rw-r--r--src/interp/Makefile.in4
-rw-r--r--src/interp/Makefile.pamphlet4
-rw-r--r--src/interp/compiler.boot50
-rw-r--r--src/interp/iterator.boot110
-rw-r--r--src/interp/parse.boot41
-rw-r--r--src/interp/postpar.boot35
-rw-r--r--src/interp/property.lisp128
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|)