* interp/parse.boot (parseTran): Don't set $op. Don't strip parse

	tree codes.
	(parseConstruct): Handle parse tree code.
	(parseUpArrow): Likewise.
	(parseLeftArrow): Likewise.
	(parseIs): Likewise.
	(parseIsnt): Likewise.
	(parseLET): Likewise.
	(parseLETD): Likewise.
	(parseColon): Likewise.
	(parseBigelt): Likewise.
	(parseCoerce): Likewise.
	(parseAtSign): Likewise.
	(parsePretend): Likewise.
	(parseHas): Likewise.
	(parseDEF): Likewise.
	(parseMDEF): Likewise.
	(parseCategory): Likewise.
	(parseGreaterThan): Likewise.
	(parseGreaterEqual): Likewise.
	(parseLessEqual): Likewise.
	(parseNotEqual): Likewise.
	(parseAnd): Likewise.
	(parseOr): Likewise.
	(parseEquivalence): Likewise.
	(parseImplies): Likewise.
	(parseExclusiveOr): Likewise.
	(parseExit): Likewise.
	(parseLeave): Likewise.
	(parseReturn): Likewise.
	(parseJoin): Likewise.
	(parseInBy): Likewise.
	(parseSegment): Likewise.
	(parseIn): Likewise.
	(parseIf): Likewise.
	(parseWhere): Likewise.
	(parseSeq): Likewise.
	(parseVCONS): Likewise.

2 files changed, 113 insertions, 63 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 053947ca..882b8c60 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,44 @@
+2008-07-06  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/parse.boot (parseTran): Don't set $op.  Don't strip parse
+	tree codes.
+	(parseConstruct): Handle parse tree code.
+	(parseUpArrow): Likewise.
+	(parseLeftArrow): Likewise.
+	(parseIs): Likewise.
+	(parseIsnt): Likewise.
+	(parseLET): Likewise.
+	(parseLETD): Likewise.
+	(parseColon): Likewise.
+	(parseBigelt): Likewise.
+	(parseCoerce): Likewise.
+	(parseAtSign): Likewise.
+	(parsePretend): Likewise.
+	(parseHas): Likewise.
+	(parseDEF): Likewise.
+	(parseMDEF): Likewise.
+	(parseCategory): Likewise.
+	(parseGreaterThan): Likewise.
+	(parseGreaterEqual): Likewise.
+	(parseLessEqual): Likewise.
+	(parseNotEqual): Likewise.
+	(parseAnd): Likewise.
+	(parseOr): Likewise.
+	(parseEquivalence): Likewise.
+	(parseImplies): Likewise.
+	(parseExclusiveOr): Likewise.
+	(parseExit): Likewise.
+	(parseLeave): Likewise.
+	(parseReturn): Likewise.
+	(parseJoin): Likewise.
+	(parseInBy): Likewise.
+	(parseSegment): Likewise.
+	(parseIn): Likewise.
+	(parseIf): Likewise.
+	(parseWhere): Likewise.
+	(parseSeq): Likewise.
+	(parseVCONS): Likewise.
+
 2008-07-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/nruncomp.boot (NRTassocIndex): Document.
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index ce48ef98..a706d174 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -48,22 +48,21 @@ parseTransform x ==
 
 parseTran: %ParseForm -> %Form
 parseTran x ==
-  $op: local := nil
   atom x => parseAtom x
-  [$op,:argl]:= x
-  u := g($op) where g op == (op is ["elt",op,x] => g x; op)
+  [op,:argl]:= x
+  u := g(op) where g op == (op is ["elt",op,x] => g x; op)
   u="construct" =>
-    r:= parseConstruct argl
-    $op is ["elt",:.] => [parseTran $op,:rest r]
+    r:= parseConstruct ["construct",:argl]
+    op is ["elt",:.] => [parseTran op,:rest r]
     r
-  SYMBOLP u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,argl)
-  [parseTran $op,:parseTranList argl]
+  SYMBOLP u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,x)
+  [parseTran op,:parseTranList argl]
  
 
 parseAtom: %Atom -> %Form
 parseAtom x ==
  -- next line for compatibility with new compiler
-  x = "break" => parseLeave ["$NoValue"]
+  x = "break" => parseLeave ["leave","$NoValue"]
   x
  
 parseTranList: %List -> %List
@@ -74,27 +73,26 @@ parseTranList l ==
 parseConstruct: %ParseForm -> %Form
 parseConstruct u ==
   $insideConstructIfTrue: local:= true
-  l:= parseTranList u
-  ["construct",:l]
- 
+  [first u,:parseTranList rest u]
 
+-- ??? This parser is unused at the moment.
 parseUpArrow: %ParseForm -> %Form
 parseUpArrow u ==  
-  parseTran ["**",:u]
+  parseTran ["**",:rest u]
 
- 
+-- ??? This parser is unused at the moment.
 parseLeftArrow: %ParseForm -> %Form
 parseLeftArrow u == 
-  parseTran ["LET",:u]
+  parseTran ["LET",:rest u]
 
 parseIs: %ParseForm -> %Form 
 parseIs t == 
-  t isnt [a,b] => systemErrorHere "parseIs"
+  t isnt ["is",a,b] => systemErrorHere "parseIs"
   ["is",parseTran a,transIs parseTran b]
  
 parseIsnt: %ParseForm -> %Form
 parseIsnt t == 
-  t isnt [a,b] => systemErrorHere "parseIsnt"
+  t isnt ["isnt",a,b] => systemErrorHere "parseIsnt"
   ["isnt",parseTran a,transIs parseTran b]
  
 
@@ -126,7 +124,7 @@ transIs1 u ==
  
 parseLET: %ParseForm -> %Form
 parseLET t ==
-  t isnt [x,y] => systemErrorHere "parseLET"
+  t isnt ["LET",x,y] => systemErrorHere "parseLET"
   p := ["LET",parseTran x,parseTranCheckForRecord(y,opOf x)]
   opOf x = "cons" => ["LET",transIs p.1,p.2]
   p
@@ -134,22 +132,24 @@ parseLET t ==
 
 parseLETD: %ParseForm -> %Form
 parseLETD t == 
-  t isnt [x,y] => systemErrorHere "parseLETD"
+  t isnt ["LETD",x,y] => systemErrorHere "parseLETD"
   ["LETD",parseTran x,parseTran parseType y]
 
 parseColon: %ParseForm -> %Form 
 parseColon u ==
-  u is [x] => [":",parseTran x]
-  u is [x,typ] =>
+  u isnt [":",:.] => systemErrorHere "parseColon"
+  u is [":",x] => [":",parseTran x]
+  u is [":",x,typ] =>
     $InteractiveMode =>
       $insideConstructIfTrue=true => ["TAG",parseTran x,parseTran typ]
       [":",parseTran x,parseTran parseType typ]
     [":",parseTran x,parseTran typ]
  
 
+-- ??? This parser is unused at the moment.
 parseBigelt: %ParseForm -> %Form
 parseBigelt t ==
-  t isnt [typ,consForm] => systemErrorHere "parseBigelt"
+  t isnt [.,typ,consForm] => systemErrorHere "parseBigelt"
   [["elt",typ,"makeRecord"],:transUnCons consForm]
 
 transUnCons: %ParseForm -> %Form 
@@ -164,20 +164,20 @@ transUnCons u ==
 
 parseCoerce: %ParseForm -> %Form 
 parseCoerce t ==
-  t isnt [x,typ] => systemErrorHere "parseCoerce"
+  t isnt [.,x,typ] => systemErrorHere "parseCoerce"
   $InteractiveMode => ["::",parseTran x,parseTran parseType typ]
   ["::",parseTran x,parseTran typ]
 
 parseAtSign: %ParseForm -> %Form 
 parseAtSign t ==
-  t isnt [x,typ] => systemErrorHere "parseAtSign"
+  t isnt [.,x,typ] => systemErrorHere "parseAtSign"
   $InteractiveMode => ["@",parseTran x,parseTran parseType typ]
   ["@",parseTran x,parseTran typ]
  
 
 parsePretend: %ParseForm -> %Form
 parsePretend t ==
-  t isnt [x,typ] => systemErrorHere "parsePretend"
+  t isnt ["pretend",x,typ] => systemErrorHere "parsePretend"
   $InteractiveMode => ["pretend",parseTran x,parseTran parseType typ]
   ["pretend",parseTran x,parseTran typ]
  
@@ -190,7 +190,7 @@ parseType x ==
  
 parseHas: %ParseForm -> %Form 
 parseHas t ==
-  t isnt [x,y] => systemErrorHere "parseHas"
+  t isnt ["has",x,y] => systemErrorHere "parseHas"
   if $InteractiveMode then
     x:=
       get(x,'value,$CategoryFrame) is [D,m,.]
@@ -226,7 +226,7 @@ parseHasRhs u ==   --$InteractiveMode = true
 
 parseDEF: %ParseForm -> %Form
 parseDEF t ==
-  t isnt [$lhs,tList,specialList,body] => systemErrorHere "parseDEF"
+  t isnt ["DEF",$lhs,tList,specialList,body] => systemErrorHere "parseDEF"
   setDefOp $lhs
   ["DEF",parseLhs $lhs,parseTranList tList,parseTranList specialList,
     parseTranCheckForRecord(body,opOf $lhs)]
@@ -240,7 +240,7 @@ parseLhs x ==
 
 parseMDEF: %ParseForm -> %Form
 parseMDEF t ==
-  t isnt [$lhs,tList,specialList,body] => systemErrorHere "parseMDEF"
+  t isnt ["MDEF",$lhs,tList,specialList,body] => systemErrorHere "parseMDEF"
   ["MDEF",parseTran $lhs,parseTranList tList,parseTranList specialList,
     parseTranCheckForRecord(body,opOf $lhs)]
  
@@ -252,6 +252,7 @@ parseTranCheckForRecord(x,op) ==
     x
   x
  
+-- ??? This parser is unused at the moment.
 parseCases: %ParseForm -> %Form
 parseCases t ==
   t isnt [expr,ifClause] => systemErrorHere "parseCases"
@@ -263,7 +264,8 @@ parseCases t ==
  
 
 parseCategory: %ParseForm -> %Form
-parseCategory x ==
+parseCategory t ==
+  t isnt ["CATEGORY",:x] => systemErrorHere "parseCategory"
   l:= parseTranList parseDropAssertions x
   key:=
     CONTAINED("$",l) => "domain"
@@ -281,67 +283,70 @@ parseDropAssertions x ==
  
 parseGreaterThan: %ParseForm -> %Form
 parseGreaterThan t ==
-  t isnt [x,y] => systemErrorHere "parseGreaterThan"
-  [substitute("<",">",$op),parseTran y,parseTran x]
+  t isnt [op,x,y] => systemErrorHere "parseGreaterThan"
+  [substitute("<",">",op),parseTran y,parseTran x]
  
 
 parseGreaterEqual: %ParseForm -> %Form
 parseGreaterEqual u == 
-  parseTran ["not",[substitute("<",">=",$op),:u]]
+  parseTran ["not",[substitute("<",">=",first u),:rest u]]
  
 
 parseLessEqual: %ParseForm -> %Form
 parseLessEqual u == 
-  parseTran ["not",[substitute(">","<=",$op),:u]]
+  parseTran ["not",[substitute(">","<=",first u),:rest u]]
 
 parseNotEqual: %ParseForm -> %Form 
 parseNotEqual u == 
-  parseTran ["not",[substitute("=","^=",$op),:u]]
+  parseTran ["not",[substitute("=","^=",first u),:rest u]]
 
 parseAnd: %ParseForm -> %Form 
-parseAnd u ==
+parseAnd t ==
+  t isnt ["and",:u] => systemErrorHere "parseAnd"
   $InteractiveMode => ["and",:parseTranList u]
   null u => "true"
   null rest u => first u
-  parseIf [parseTran first u,parseAnd rest u,"false"]
+  parseIf ["IF",parseTran first u,parseAnd ["and",:rest u],"false"]
  
 
 parseOr: %ParseForm -> %Form
-parseOr u ==
+parseOr t ==
+  t isnt ["or",:u] => systemErrorHere "parseOr"
   $InteractiveMode => ["or",:parseTranList u]
   null u => "false"
   null rest u => first u
-  (x:= parseTran first u) is ["not",y] => parseIf [y,parseOr rest u,"true"]
-  true => parseIf [x,"true",parseOr rest u]
+  (x:= parseTran first u) is ["not",y] => 
+    parseIf ["IF",y,parseOr ["or",:rest u],"true"]
+  true => parseIf ["IF",x,"true",parseOr ["or",:rest u]]
  
 
 parseEquivalence: %ParseForm -> %Form
 parseEquivalence t == 
-  t isnt [a,b] => systemErrorHere "parseEquivalence"
-  parseIf [a,b,parseIf [b,:'(false true)]]
+  t isnt ["eqv",a,b] => systemErrorHere "parseEquivalence"
+  parseIf ["IF",a,b,parseIf ["IF",b,:'(false true)]]
  
 
 parseImplies: %ParseForm -> %Form
 parseImplies t == 
-  t isnt [a,b] => systemErrorHere "parseImplies"
-  parseIf [a,b,"true"]
+  t isnt ["implies",a,b] => systemErrorHere "parseImplies"
+  parseIf ["IF",a,b,"true"]
  
 parseExclusiveOr: %ParseForm -> %Form
 parseExclusiveOr t == 
-  t isnt [a,b] => systemErrorHere "parseExclusiveOr"
-  parseIf [a,parseIf [b,:'(false true)],b]
+  t isnt ["xor",a,b] => systemErrorHere "parseExclusiveOr"
+  parseIf ["IF",a,parseIf ["IF",b,:'(false true)],b]
  
 
 parseExit: %ParseForm -> %Form
 parseExit t ==
-  t isnt [a,:b] => systemErrorHere "parseExit"
+  t isnt ["exit",a,:b] => systemErrorHere "parseExit"
   --  note: I wanted to convert 1s to 0s here to facilitate indexing in
   --   comp code; unfortunately, parseTran-ning is sometimes done more
   --   than once so that the count can be decremented more than once
   a:= parseTran a
   b:= parseTran b
   b =>
-    null INTEGERP a =>
+    not INTEGERP a =>
       (MOAN('"first arg ",a,'" for exit must be integer"); ["exit",1,a])
     ["exit",a,:b]
   ["exit",1,a]
@@ -349,11 +354,11 @@ parseExit t ==
 
 parseLeave: %ParseForm -> %Form
 parseLeave t ==
-  t isnt [a,:b] => systemErrorHere "parseLeave"
+  t isnt ["leave",a,:b] => systemErrorHere "parseLeave"
   a:= parseTran a
   b:= parseTran b
   b =>
-    null INTEGERP a =>
+    not INTEGERP a =>
       (MOAN('"first arg ",a,'" for 'leave' must be integer"); ["leave",1,a])
     ["leave",a,:b]
   ["leave",1,a]
@@ -361,15 +366,16 @@ parseLeave t ==
 
 parseReturn: %ParseForm -> %Form
 parseReturn t ==
-  t isnt [a,:b] => systemErrorHere "parseReturn"
+  t isnt ["return",a,:b] => systemErrorHere "parseReturn"
   a:= parseTran a
   b:= parseTran b
   b =>
     (if a^=1 then MOAN '"multiple-level 'return' not allowed"; ["return",1,:b])
   ["return",1,a]
  
-parseJoin: %List -> %Form
-parseJoin l ==
+parseJoin: %ParseForm -> %Form
+parseJoin t ==
+  t isnt ["Join",:l] => systemErrorHere "parseJoin"
   ["Join",:fn parseTranList l] where
     fn l ==
       null l => nil
@@ -379,8 +385,8 @@ parseJoin l ==
 
 parseInBy: %ParseForm -> %Form
 parseInBy t ==
-  t isnt [i,n,inc] => systemErrorHere "parseInBy"
-  (u:= parseIn [i,n]) isnt ["STEP",i,a,j,:r] =>
+  t isnt ["INBY",i,n,inc] => systemErrorHere "parseInBy"
+  (u:= parseIn ["IN",i,n]) isnt ["STEP",i,a,j,:r] =>
     postError ["   You cannot use",:bright '"by",
       '"except for an explicitly indexed sequence."]
   inc:= parseTran inc
@@ -388,14 +394,15 @@ parseInBy t ==
 
 parseSegment: %ParseForm -> %Form 
 parseSegment p ==
-  p is [a,b] =>
+  p is ["SEGMENT",a,b] =>
     b => ["SEGMENT",parseTran a, parseTran b]
     ["SEGMENT",parseTran a]
-  ["SEGMENT",:p]
+  -- SEGMENT is being elted from a domain
+  ["SEGMENT",:rest p]
  
 parseIn: %ParseForm -> %Form
 parseIn t ==
-  t isnt [i,n] => systemErrorHere "parseIn"
+  t isnt ["IN",i,n] => systemErrorHere "parseIn"
   i:= parseTran i
   n:= parseTran n
   n is ["SEGMENT",a] => ["STEP",i,a,1]
@@ -410,7 +417,7 @@ parseIn t ==
  
 parseIf: %ParseForm -> %Form
 parseIf t ==
-  t isnt [p,a,b] => t
+  t isnt ["IF",p,a,b] => t
   ifTran(parseTran p,parseTran a,parseTran b) where
     ifTran(p,a,b) ==
       null($InteractiveMode) and p="true"  => a
@@ -434,13 +441,15 @@ makeSimplePredicateOrNil p ==
  
 
 parseWhere: %List -> %Form
-parseWhere l == 
+parseWhere t == 
+  t isnt ["where",:l] => systemErrorHere "parseWhere"
   ["where",:mapInto(l, function parseTran)]
  
  
 parseSeq: %List -> %Form
-parseSeq l ==
-  not l is [:.,["exit",:.]] =>
+parseSeq t ==
+  t isnt ["SEQ",:l] => systemErrorHere "parseSeq"
+  l isnt [:.,["exit",:.]] =>
     postError ['"   Invalid ending to block: ",last l]
   transSeq mapInto(l,function parseTran)
  
@@ -508,7 +517,7 @@ scriptTranRow1 x ==
  
 parseVCONS: %List -> %Form
 parseVCONS l == 
-  ["VECTOR",:parseTranList l]
+  ["VECTOR",:parseTranList rest l]
 
 --% Register special parsers.
 
@@ -516,8 +525,8 @@ for x in [["<=", :"parseLessEqual"],_
 	  [">", :"parseGreaterThan"],_
 	  [">=", :"parseGreaterEqual"],_
 	  ["^=", :"parseNotEqual"],_
-	  ["_:", :"parseColon"],_
-	  ["_:_:", :"parseCoerce"],_
+	  [":", :"parseColon"],_
+	  ["::", :"parseCoerce"],_
 	  ["@", :"parseAtSign"],_
 	  ["and", :"parseAnd"],_
 	  ["CATEGORY", :"parseCategory"],_