* interp/compiler.boot (compResolveCall): Update description.

	(compRetractGuard): Tidy.
	(compRecoverDomain): Likewise.
	(compRecoverGuard): Likewise.
	(compAlternativeGuard): Likewise.
	(compMatchAlternative): Likewise.
	(compMatch): Likewise.

2 files changed, 73 insertions, 47 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 6f538c3e..dcbf4bc6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-12-06  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/compiler.boot (compResolveCall): Update description.
+	(compRetractGuard): Tidy.
+	(compRecoverDomain): Likewise.
+	(compRecoverGuard): Likewise.
+	(compAlternativeGuard): Likewise.
+	(compMatchAlternative): Likewise.
+	(compMatch): Likewise.
+
 2011-12-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/g-util.boot (splitAssignments): Rework.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index b9788096..d2dfd84b 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2115,11 +2115,12 @@ compResolveCall(op,argTs,m,$e) ==
 ++      x@t => stmt
 ++ in environment `e'.  Here `sn' is the temporary holding the
 ++ value of the scrutinee, and `sm' is its type.
-++ Return a quadruple [guard,init,envTrue,envFalse], where
+++ Return a quadruple [init,guard,init',envTrue,envFalse], where
+++   `init' is code that intializes the retract intermediate entity.
 ++   `guard' is code that gates the body of the alternative
-++   `init' is list of possible initializations 
+++   `init'' is list of possible initializations local to the branch
 ++   `envTrue' is an environment after the guard evaluates to true
-++   `envFalse' is an environment after the guard environment to false.
+++   `envFalse' is an environment after the guard evaluates to false.
 compRetractGuard(x,t,sn,sm,e) ==
   -- The retract pattern is compiled by transforming
   --     x@t => stmt
@@ -2127,10 +2128,11 @@ compRetractGuard(x,t,sn,sm,e) ==
   --   sn case t => (x := <expr>; stmt)
   -- where <expr> is code that computes appropriate initialization
   -- for `x' under the condition that either `sn' may be implicitly
-  -- convertible to t (using only courtesy coerciions) or that
+  -- convertible to t (using only courtesy coercions) or that
   -- `sn' is retractable to t.
   --
   -- 1.  Evaluate the retract condition, and retract.
+  initCode := nil
   caseCode := nil
   restrictCode := nil
   envFalse := e
@@ -2146,12 +2148,12 @@ compRetractGuard(x,t,sn,sm,e) ==
   -- 1.2. Otherwise try retractIfCan, for those `% has RetractableTo t'.
   else if retractT := comp(["retractIfCan",sn],["Union",t,'"failed"],e) then
     [retractCode,.,e] := retractT
-    -- Assign this value to a temporary.  From the backend point of
-    -- view, that temporary needs to have a lifetime that covers both
-    -- the condition and the body of the alternative, so just use 
-    -- assignment here and let the rest of the compiler deal with it.
+    -- Assign this value to a temporary.  That temporary needs to
+    -- have a lifetime that covers both the condition and the body
+    -- of the alternative
     z := gensym()
-    caseCode := ['%seq,["%LET",z,retractCode],['%ieq,['%head,z],0]]
+    initCode := [[z,retractCode]]
+    caseCode := ['%ieq,['%head,z],0]
     restrictCode := ["%tail",z]
   -- 1.3. Everything else failed; nice try.
   else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t])
@@ -2159,7 +2161,7 @@ compRetractGuard(x,t,sn,sm,e) ==
   [.,.,e] := compMakeDeclaration(x,t,e) or return nil
   e := giveVariableSomeValue(x,t,e)
   -- 3.  Assemble result.
-  [caseCode, [[x,restrictCode]],e,envFalse]
+  [initCode,caseCode,[[x,restrictCode]],e,envFalse]
 
 
 ++ Subroutine of compRecoverGuard.  The parameters and the result
@@ -2170,13 +2172,13 @@ compRecoverDomain(x,t,sn,e) ==
   -- 1. We recover domains only.
   not isDomainForm(t,e) =>
     stackAndThrow('"Form %1b does not designate a domain",[t])
-  caseCode := ["EQUAL",["devaluate",t],["CAR",sn]]
+  caseCode := ["%equal",["devaluate",t],["%head",sn]]
   -- 2. Declare `x'.
   originalEnv := e
   [.,.,e] := compMakeDeclaration(x,t,e) or return nil
   e := giveVariableSomeValue(x,t,e)
   -- 3.  Assemble the result
-  [caseCode,[[x,['%tail,sn]]],e,originalEnv]
+  [nil,caseCode,[[x,['%tail,sn]]],e,originalEnv]
 
 ++ Subroutine of compAlternativeGuardItem, responsible for 
 ++ compiling a guad item of the form
@@ -2198,8 +2200,8 @@ compRecoverGuard(x,t,sn,sm,e) ==
   -- underlying type is t.
   --
   -- 0. Type recovery is for expressions of type 'Any'.
-  (sm = "$" => $functorForm; sm) ~= $Any  =>
-    stackAndThrow('"Scrutinee must be of type %b Any %d in type recovery alternative of case pattern",nil)
+  (sm is "$" => get('$,'%dc,e); sm) ~= $Any  =>
+    stackAndThrow('"Scrutinee must be of type %1pb in type recovery alternative of case pattern",[$Any])
   -- 1. Do some preprocessing if this is existential type recovery.
   t is ["%Exist",var,t'] =>
     var isnt [":",var',cat'] =>
@@ -2213,17 +2215,14 @@ compRecoverGuard(x,t,sn,sm,e) ==
       stackAndThrow('"Expression %1b does not designate a category",[cat'])
     getmode(var',e) =>
       stackAndThrow('"You cannot redeclare identifier %1b",[var'])
-    -- Extract the type component.  Here note that we use a wider
-    -- assignment scope (e.g. "%LET") as opposed to local assignment
-    -- because the recovered type may be needed in the body of
-    -- the alternative.
+    -- Extract the type component. 
     varDef := [":=",[":",var',$Type],
                 [["elt",["Foreign","Builtin"],"evalDomain"],
-                  [["elt",["Foreign","Builtin"],"CAR"], sn]]]
+                  [["elt",["Foreign","Builtin"],"%head"], sn]]]
     [def,.,e] := compOrCroak(varDef,$EmptyMode,e)
     [hasTest,.,e] := compOrCroak(["has",var',cat'],$EmptyMode,e)
-    [guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e)
-    [['%seq,def,hasTest],inits,e,envFalse]
+    [defs',guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e)
+    [[def.args,:defs'],hasTest,inits,e,envFalse]
   -- 2. Hand it to whoever is in charge.
   compRecoverDomain(x,t,sn,e)
 
@@ -2233,7 +2232,6 @@ warnUnreachableAlternative pat ==
 warnTooManyOtherwise() ==
   stackWarning('"One too many `otherwise' alternative",nil)
 
-
 ++ Subroutine of compMatch.  Perform semantics analysis of the scrutinee
 ++ in a case-pattern.  Return a triple if everything is OK, otherwise nil.
 compMatchScrutinee(form,e) ==
@@ -2262,30 +2260,33 @@ defineMatchScrutinee(m,e) ==
 ++ `sn' is the name of the temporary holding the scrutinee value,
 ++ `sn' is its mode,
 ++ `pat' is the simple pattern being compiled.
-++ On success, return a quadruple of the form [guard,init,eT,eF] where
-++   `guard' is the code for guard alternative
-++   `init' is collateral initialization
-++   `eT' is the environment for successful guard
-++   `eF' is the environment for unsuccessful guard 
+++ On success, return a quintuple of the form [inits,guard,inits',eT,eF] where
+++   inits is initialization to perform before the guard test.  This
+++     iniialization extends to the corresponding branch of the pattern clause.
+++   guard is the code for guard alternative
+++   inits' is initialization to perform after the pattrn test.
+++   eT is the environment for successful guard
+++   eF is the environment for unsuccessful guard 
 compAlternativeGuardItem(sn,sm,pat,e) ==
   pat is [op,x,t] and op in '(_: _@) =>
     not ident? x => 
       stackAndThrow('"pattern %1b must declare a variable",[pat])
     if $catchAllCount > 0 then
       warnUnreachableAlternative pat
-    op = ":" => compRecoverGuard(x,t,sn,sm,e)
+    op is ":" => compRecoverGuard(x,t,sn,sm,e)
     compRetractGuard(x,t,sn,sm,e) or
        stackAndThrow('"cannot compile %1b",[pat])
-  return stackAndThrow('"invalid pattern %1b",[pat])
+  stackAndThrow('"invalid pattern %1b",[pat])
 
 ++ Subroutine of compMatchAlternative.  The parameters
 ++ have the same meaning.
+++ Return value has same structure and semantics as compAlternativeGuardItem.
 compAlternativeGuard(sn,sm,pat,e) ==
   pat = "otherwise" =>
     if $catchAllCount > 0 then
       warnTooManyOtherwise()
     $catchAllCount := $catchAllCount + 1
-    ['%otherwise,nil,e,e]
+    [nil,'%otherwise,nil,e,e]
   cons? sn =>
     pat isnt ["%Comma",:.] =>
       stackAndThrow('"Pattern must be a tuple for a tuple scrutinee",nil)
@@ -2293,14 +2294,19 @@ compAlternativeGuard(sn,sm,pat,e) ==
       stackAndThrow('"Tuple pattern must match tuple scrutinee in length",nil)
     inits := nil
     guards := nil
+    inits' := nil
     ok := true
     originalEnv := e
     for n in sn for m in rest sm for p in rest pat while ok repeat
-      [guard,init,e,.] := compAlternativeGuardItem(n,m,p,e) => 
-        guards := [guard,:guards]
+      [init,guard,init',e,.] := compAlternativeGuardItem(n,m,p,e) => 
         inits := [init,:inits]
+        guards := [guard,:guards]
+        inits' := [init',:inits']
       ok := false
-    ok => [['%and,:reverse! guards],append/reverse! inits,e,originalEnv]
+    ok => [append/reverse! inits,
+            ['%and,:reverse! guards],
+              append/reverse! inits',
+                e,originalEnv]
     nil
   compAlternativeGuardItem(sn,sm,pat,e)
 
@@ -2312,17 +2318,23 @@ compAlternativeGuard(sn,sm,pat,e) ==
 ++ `stmt' is the body of the alternative we are compiling
 ++ `m' is the desired mode for the return value.
 ++ `e' is the environment in effect at the start of the environment.
+++ Return a doublet with the first part being a 3-uple with components
+++ as follows:
+++    0. initialization code (if any) to run before performing the test
+++    1. code for the guard
+++    2. code to execute when the guard test succeeds.
+++ and the second part being an environment to consider when
+++ the guard test fails.
 compMatchAlternative(sn,sm,pat,stmt,m,e) ==
-  [guard,inits,e,eF] := compAlternativeGuard(sn,sm,pat,e) or return nil
-  stmtT := comp(stmt,m,e) or
-            stackAndThrow('"could not compile %1b under mode %2pb",[stmt,m])
+  [inits,guard,inits',e,eF] := compAlternativeGuard(sn,sm,pat,e) or return nil
+  stmtT := compOrCroak(stmt,m,e)
   body :=
-    null inits => stmtT.expr
-    ['%bind,inits,stmtT.expr]
-  [[guard,body],stmtT.mode,stmtT.env,eF]
+    inits' = nil => stmtT.expr
+    ['%bind,inits',stmtT.expr]
+  [[inits,guard,body],eF]
 
-++ Analyze and generate code for `is case'-pattern where the
-++ scrutineeis `subject' and the alternatives are `altBlock'.
+++ Analyze and generate code for `case is'-pattern where the
+++ scrutinee is `subject' and the alternatives are `altBlock'.
 -- FIXME: Make sure nobody asks for creating matter out of void.
 compMatch(["%Match",subject,altBlock],m,env) ==
   altBlock isnt ["%Block",:alts] => 
@@ -2336,17 +2348,21 @@ compMatch(["%Match",subject,altBlock],m,env) ==
   altsCode := nil
   for alt in alts repeat
      alt is ["=>",pat,stmt] => 
-       [block,mode,.,env] := compMatchAlternative(sn,sm,pat,stmt,m,env) or
+       [block,env] := compMatchAlternative(sn,sm,pat,stmt,m,env) or
              return stackAndThrow('"cannot compile pattern %1b",[pat])
        altsCode := [block,:altsCode]
      return stackAndThrow('"invalid alternative %1b",[alt])
+  body := '%noBranch
+  for [inits,guard,stmt] in altsCode repeat
+     body := ['IF,guard,stmt,body]
+     inits = nil => nil
+     body := ['%bind,inits,body]
   $catchAllCount = 0 => 
     stackAndThrow('"missing %b otherwise %d alternative in case pattern",nil)
-  code := 
-    ident? sn => ['%bind,[[sn,se]],['%when,:reverse! altsCode]]
-    ["%bind",[[n,e] for n in sn for e in rest se], 
-       ['%when,:reverse! altsCode]]
-  [code,m,savedEnv]
+  inits := 
+    ident? sn => [[sn,se]]
+    [[n,e] for n in sn for e in rest se]
+  [['%bind,inits,body],m,savedEnv]
 
 ++ Compile the form scheme `x'.
 compScheme(x,m,e) ==