* interp/metalex.lisp: "break" is now a keyword.

	* interp/fnewmeta.lisp (PARSE-Jump): New.
	* interp/compiler.boot (compAtom): Dipatch compilation of "break"
	and "iterate" to...
	(compBreak): ... here
	(compIterate): and here.
	(jumpFromLoop): New.
	(compRepeatOrCollect): Initialize $lookKind, $iterateCount, and
	$breakCount.  Set exit point for loop bodies with 'iterate'
	expressions. 
	* interp/parse.boot (parseAtom): Remove.
	(parseTran): Adjust.
	* algebra/outform.spad.pamphlet: Tidy.
	* interp/c-util.boot ($loopKind): Declare.
	($repeatBodyLabel): Likewise.
	($iterateCount): Likewise.
	($breakCount): Likewise.

9 files changed, 82 insertions, 13 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index cac7aa68..37e87fe7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,23 @@
+2009-07-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/metalex.lisp: "break" is now a keyword.
+	* interp/fnewmeta.lisp (PARSE-Jump): New.
+	* interp/compiler.boot (compAtom): Dipatch compilation of "break"
+	and "iterate" to...
+	(compBreak): ... here
+	(compIterate): and here.
+	(jumpFromLoop): New.
+	(compRepeatOrCollect): Initialize $lookKind, $iterateCount, and
+	$breakCount.  Set exit point for loop bodies with 'iterate'
+	expressions. 
+	* interp/parse.boot (parseAtom): Remove.
+	(parseTran): Adjust.
+	* algebra/outform.spad.pamphlet: Tidy.
+	* interp/c-util.boot ($loopKind): Declare.
+	($repeatBodyLabel): Likewise.
+	($iterateCount): Likewise.
+	($breakCount): Likewise.
+
 2009-07-12  Gabriel Dos Reis  <gdr@cse.tamu.edu>
 
 	* algebra/mkfunc.spad.pamphlet
diff --git a/src/algebra/outform.spad.pamphlet b/src/algebra/outform.spad.pamphlet
index be457105..0ac9ba49 100644
--- a/src/algebra/outform.spad.pamphlet
+++ b/src/algebra/outform.spad.pamphlet
@@ -153,7 +153,7 @@ NumberFormats(): NFexports == NFimplementation where
                 -- Coefficient of 10**(i+2)
                 d := n rem 10
                 n := n quo 10
-                zero? d => "iterate"
+                zero? d => iterate
                 m0:String := concat(new(i,plen),concat("I",new(i,pren)))
                 mm := concat([m0 for j in 1..d]$List(String))
                 -- strictly speaking the blank is gratuitous
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 3d050c51..34c1ce25 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -49,6 +49,19 @@ module c_-util where
 $scanIfTrue := false
 
 
+++ If within a loop, which kind? (list comprehension or plain old loop)
+$loopKind := nil
+
+++ If within a loop, the program point for the start of the body.
+$repeatBodyLabel := nil
+
+++ The number of occurrance of `iterate' in a (plain old) loop.
+$iterateCount := nil
+
+++ The number of occurrance of `break' in a (plain old) loop.
+$breakCount := 0
+
+
 +++ If non nil, holds compiled value of 'Rep' of the current domain.
 $Representation := nil
 
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 2eb63a11..13cb5951 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -397,6 +397,8 @@ transImplementation(op,map,fn) ==
   ["call",fn]
 
 compAtom(x,m,e) ==
+  x = "break" => compBreak(x,m,e)
+  x = "iterate" => compIterate(x,m,e)
   T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T
   x="nil" =>
     T:=
@@ -1085,6 +1087,31 @@ compLeave(["leave",level,x],m,e) ==
   modifyModeStack(m',index)
   [["TAGGEDexit",index,u],m,e]
 
+jumpFromLoop(kind,key) ==
+  null $exitModeStack or kind ^= $loopKind =>
+    stackAndThrow('"You can use %1b only in %2b loop",[key,kind])
+    false
+  true
+
+compBreak: (%Symbol,%Mode,%Env) -> %Maybe %Triple
+compBreak(x,m,e) ==
+  x ^= "break" or not jumpFromLoop("REPEAT",x) => nil
+  index:= #$exitModeStack-1-$leaveLevelStack.0
+  $breakCount := $breakCount + 1
+  u := coerce(["$NoValue",$Void,e],$exitModeStack.index) or return nil
+  u := coerce(u,m) or return nil
+  modifyModeStack(u.mode,index)
+  [["TAGGEDexit",index,u],m,e]
+
+compIterate: (%Symbol,%Mode,%Env) -> %Maybe %Triple
+compIterate(x,m,e) ==
+  x ^= "iterate" or not jumpFromLoop("REPEAT",x) => nil
+  $iterateCount := $iterateCount + 1
+  -- We don't really produce a value; but we cannot adequately convey
+  -- that to the current 'EXIT' structure.  So, pretend we have an 
+  -- undefined value, which is a good enough approximation.
+  [["THROW","$loopBodyTag",nil],m,e]
+
 --% return
 
 compReturn: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -2272,6 +2299,9 @@ compRepeatOrCollect(form,m,e) ==
     ,e) where
       fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
         $until: local := nil
+        $loopKind: local := nil
+        $iterateCount: local := 0
+        $breakCount: local := 0
         oldEnv := e
         aggr := nil
         [repeatOrCollect,:itl,body]:= form
@@ -2293,9 +2323,15 @@ compRepeatOrCollect(form,m,e) ==
             return nil
             -- If we're doing a collect, and the type isn't conformable
             -- then we've boobed. JHD 26.July.1990
+          -- ??? we hve a plain old loop; the return type should be Void
+          $loopKind := repeatOrCollect
           $NoValueMode
         [body',m',e']:=
             compOrCroak(body,bodyMode,e) or return nil
+        -- Massage the loop body if we have a structured jump.
+        if $iterateCount > 0 then
+           bodyTag := quoteForm GENSYM()
+           body' := ["CATCH",bodyTag,NSUBST(bodyTag,"$loopBodyTag",body')]
         if $until then
           [untilCode,.,e']:= comp($until,$Boolean,e')
           itl':= substitute(["UNTIL",untilCode],'$until,itl')
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index 0e248f83..7df80102 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -113,7 +113,7 @@
 
 ;; Return:         'return' Expression +(return #1) ;
 
-;; Exit:           'exit' (Expression / +\$NoValue) +(exit #1) ;
+;; Exit:           'exit' Expression +(exit #1) ;
 
 ;; Leave:          'leave' ( Expression / +\$NoValue )
 ;;                 ('from' Label +(leaveFrom #1 #1) / +(leave #1)) ;
@@ -571,13 +571,19 @@
        (PUSH-REDUCTION '|PARSE-Return|
            (CONS '|return| (CONS (POP-STACK-1) NIL))))) 
 
+(DEFUN |PARSE-Jump| ()
+  (LET ((S (CURRENT-SYMBOL)))
+       (AND S 
+	    (ACTION (ADVANCE-TOKEN))
+	    (PUSH-REDUCTION '|PARSE-Jump| S))))
+
 
 (DEFUN |PARSE-Exit| ()
   (AND (MATCH-ADVANCE-STRING "exit")
        (MUST (OR (|PARSE-Expression|)
                  (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|)))
        (PUSH-REDUCTION '|PARSE-Exit|
-           (CONS '|exit| (CONS (POP-STACK-1) NIL))))) 
+           (CONS '|exit| (CONS (POP-STACK-1) NIL)))))
 
 
 (DEFUN |PARSE-Leave| ()
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 2ef75f07..20c43c79 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -45,7 +45,6 @@ $specialOps := '(
      _[_|_|_] %Macro %MLambda %Import %Export %Inline %With %Add %Match)
 
 $repeatLabel := NIL
-$breakCount := 0
 $anonymousMapCounter := 0
 
 ++ List of free variables in the current function
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index 27b82522..0aaf9d70 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -573,7 +573,7 @@ empty (if File-Closed (return nil))
   '(|or| |and| |isnt| |is| |when| |where| |forall| |exist|
     |has| |with| |add| |case| |in| |by| |pretend| |mod|
     |exquo| |div| |quo| |else| |rem| |then| |suchthat|
-    |if| |yield| |iterate| |from| |exit| |leave| |return|
+    |if| |yield| |iterate| |break| |from| |exit| |leave| |return|
     |not| |unless| |repeat| |until| |while| |for| |import| |inline|)
 
 "Alphabetic literal strings occurring in the New Meta code constitute
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index db00f018..60475d2e 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -156,8 +156,9 @@
           (|return| 202 201 (|PARSE-Return|))
           (|leave| 202 201 (|PARSE-Leave|))
           (|exit| 202 201 (|PARSE-Exit|))
+	  (|break| 202 201 (|PARSE-Jump|))
+	  (|iterate| 202 201 (|PARSE-Jump|))
           (|from|)
-          (|iterate|)
           (|yield|)
           (|if| 130 0 (|PARSE-Conditional|))    ; was 130
           (|case| 130 190 (|PARSE-Match|))
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 2a93222d..e656c023 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -70,7 +70,7 @@ parseTransform x ==
 
 parseTran: %ParseForm -> %Form
 parseTran x ==
-  atom x => parseAtom x
+  atom x => x
   [op,:argl]:= x
   u := g(op) where g op == (op is ["elt",op,x] => g x; op)
   u="construct" =>
@@ -87,12 +87,6 @@ parseType t ==
 parseTypeList l ==
   mapInto(l, function parseType) 
 
-parseAtom: %Atom -> %Form
-parseAtom x ==
- -- next line for compatibility with new compiler
-  x = "break" => parseLeave ["leave","$NoValue"]
-  x
- 
 parseTranList: %List -> %List
 parseTranList l ==
   atom l => parseTran l