* 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.

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|)