-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

-- more white lies, since closure is actually predefined...
(--DOC
  <EXAMPLE>
    abstract representation closure;
  <ENDEXAMPLE>
  The `closure' representation is the parent of all closure
  expressions. Many control structures are defined on this object. But
  it's a regular object, so other user-defined objects can be
  descendants (e.g., see `eval.cecil' in the compiler directory tree).
--)

--DOC The `loop' method invokes its closure argument endlessly. It
--DOC never returns normally. To exit the loop, the closure must do a
--DOC non-local return or invoke some closure that does (e.g., using
--DOC the `exit' control structure).  All other looping constructs are
--DOC built upon this method.
method loop(c@closure:&():void):none (** inline **) {
  -- eval(c) over and over until a nlr in c exits the loop
  prim rtl: "
	label l;
          decl OOP t1 := send eval(c);
          goto l;
  "
}


--DOC `while' implements a standard while-do loop. E.g.:
--DOC <EXAMPLE>
--DOC   while({ i < last }, {
--DOC 	    ...
--DOC 	    i := i.succ;
--DOC   });
--DOC <ENDEXAMPLE>
method while(cond:&():bool, c:&():void):void (** inline **) {
    while_true(cond, c);
}


(--DOC
  Other while-do and do-until loops are implemented using the
  `{while,until}[_{true,false}]' methods.
  The one-argument `while_{true,false}' methods simply evaluate
  their argument test until it returns `true' or `false', respectively,
  presumably for its side effects.  The `until_' versions evaluate their
  body closure and then the test until the test returns `true' or
  `false', as appropriate.
--)
--DOCSHORT same as `while_true'
method while_true(cond:&():bool, c:&():void):void (** inline **) {
    loop({
	if_false(eval(cond), {^});
	eval(c);
    });
}
method while_false(cond:&():bool, c:&():void):void (** inline **) {
    while_true({ not(eval(cond)) }, c);
}

method while(cond:&():bool):void (** inline **) {
    while_true(cond, {});
}
method while_true(cond:&():bool):void (** inline **) {
    while_true(cond, {});
}
method while_false(cond:&():bool):void (** inline **) {
    while_false(cond, {});
}

method until(c:&():void, cond:&():bool):void (** inline **) {
    until_true(c, cond);
}
method until_true(c:&():void, cond:&():bool):void (** inline **) {
    loop({
	eval(c);
	if(eval(cond), {^});
    });
}
method until_false(c:&():void, cond:&():bool):void (** inline **) {
    until_true(c, { not(eval(cond)) });
}


(--DOC
  The `exit[_value][_continue]' constructs support evaluating a block
  of code (the `body' closure), breaking out of it if the `break' closure
  is evaluated inside `body'. The `_value' versions return a
  value.  The `_continue' versions allows `body' to be
  restarted from the beginning when the `continue' closure is evaluated.

  For example, to execute some code, but perhaps quit early:
  <EXAMPLE>
    exit(&(break:&():none){
	...
	if(..., { eval(break) }); -- skip the rest of the body of exit
	...
	-- fall off bottom
    });
  <ENDEXAMPLE>
  This idiom supports breaking out of any sort of looping or non-looping
  piece of code: just wrap the thing in an `exit' or `exit_value' control
  structure and invoke the `break' block where the control structure should be
  exited.
--)
method exit(c@closure:&(exit:&():none):void):void (** inline **) {
    eval(c, {^});
}

method exit_value(c:&(exit:&(`T):none):`T):T (** inline **) {
    eval(c, &(e:T){ ^e }) }

method exit_continue(c:&(exit:&():none,
			 continue:&():none):void):void (** inline **) {
    loop_exit_continue(&(exit:&():none, continue:&():none){
        eval(c, exit, continue);
	eval(exit); -- don't loop unless through continuing
    });
}

method exit_value_continue(c:&(exit:&(`T):none, continue:&():none):T):T
                                 (** inline **) {
    loop_exit_value_continue(&(exit:&(T):none, continue:&():none){
        eval(exit, eval(c, exit, continue));
    }) }


(--DOC
  For loops, some additional methods are defined for convenience.

  The `loop_exit[_value][_continue]' methods evaluate the `body' closure
  again and again until the `break' closure is evaluated inside
  body. For the `_continue' version, execution of body can be restarted
  from the beginning by evaluating the `continue' closure. The `_value'
  version returns a value.

  To write a simple loop with a break statement:
  <EXAMPLE>
    loop_exit(&(break:&():none){
        ...
	if(..., { eval(break) }); -- exit loop conditionally
	...
	-- loop
    });
  <ENDEXAMPLE>
  To loop and compute a value:
  <EXAMPLE>
    let result:int := loop_exit_value(&(break:&(int):none){
	...
	if(..., { eval(break, theResult) }); -- exit loop, returning theResult
	...
    });
  <ENDEXAMPLE>
  If both `break' and `continue' are desired for an arbitrary iterating
  construct, such as `do', two `exit' methods should be used, as in the
  following example. The outer method encloses the iterator and
  provides breaking out of the loop, while the inner method encloses
  the loop body and provides continuing to the next iteration:
  <EXAMPLE>
  exit(&(break:&():none){
      10.do(&(i:int){                -- for i := 0 to 10-1 do
          exit(&(continue:&():none){
	      ...
	      if(..., break);        -- break out of loop
	      ...
	      if(..., continue);     -- continue the iteration by jumping
				     -- to the end of the loop body
	      ...
	  });
      });
  });
  <ENDEXAMPLE>
--)

method loop_exit(c:&(exit:&():none):void):void (** inline **) {
    loop({ eval(c, {^}); });
}

method loop_exit_value(c:&(exit:&(`T):none):void):T (** inline **) {
    loop({ eval(c, &(e:T){ ^e }); }) }

method loop_exit_continue(c:&(exit:&():none, continue:&():none):void):void
                                   (** inline **) {
    loop({
	exit(&(continue:&():none){
	    eval(c, {^}, continue);
	});
    });
}

method loop_exit_value_continue(c:&(exit:&(`T):none, continue:&():none):void):T
                                    (** inline **) {
    loop({
	exit(&(continue:&():none){
	    eval(c, &(x:T){^x}, continue);
	});
    });
}


(--DOC
  Case statements are supported through the `switch', `case', and `else'
  methods.  The elements of `switch''s argument collection (usually a
  vector literal expression) are evaluated in turn, until one of the
  test blocks evaluates to `true' or the `else' case is found. Then the
  corresponding `do' block is evaluated and its result returned as the
  result of the `switch' method. (Thus `switch' is very much like Lisp's
  `cond'.) The `switch' method dies with a run-time error if none of the
  cases match and there is no `else' case. To illustrate:
  <EXAMPLE>
    let result:string :=
      switch([case({ x < 0 }, { "negative" }),
	      case({ x = 0 }, { "zero" }),
	      else(           { "positive" })]);
  <ENDEXAMPLE>
  Unfortunately, unlike most Cecil control structures, the `switch' construct
  is not as efficient as the C version: a vector object is created and
  filled in with objects containing real closures, and a bunch of
  messages get sent. So you might wish to use chained `if' expressions
  instead of `switch' expressions in the most time-critical parts of
  your program. (Recently, some optimizations have been implemented
  that often transform `switch' statements of this form into an
  if-then-else chain, but only if you invoke `unrolled_switch' instead
  of `switch', and object creations still remain unless `debug_support' is
  disabled.)
--)
template object case_pair[T];
  extend type case_pair[`T] subtypes case_pair[`S >= T];

  field cond(@:case_pair[`T]):&():bool;
  field stmt(@:case_pair[`T]):&():T;

method case(c:&():bool, s:&():`T):case_pair[T] {
    concrete object isa case_pair[T] { cond := c, stmt := s } }

method else(s:&():`T):case_pair[T] {
    concrete object isa case_pair[T] { cond := &&(){ true }, stmt := s } }

method switch(t@:ordered_collection[case_pair[`T]]):T {
    t.do(&(cp:case_pair[T]){
	if(eval(cp.cond), { ^ eval(cp.stmt) });
    });
    error("No condition matched in switch statement") }

-- we can optimize switch([...]) by hand-unrolling it, if short enough,
-- and then CSE-ing away all the closure & vector creations.
-- this should only be used w/ vector literal arguments w/ closure literal
-- cases.
method unrolled_switch(t@:i_vector[case_pair[`T]]):T (** inline **) {
  if(t.length >= 9, {
      switch(t)
  }, {
      if(t.length >= 1, { if(eval((t!0).cond), { ^ eval((t!0).stmt) }); });
      if(t.length >= 2, { if(eval((t!1).cond), { ^ eval((t!1).stmt) }); });
      if(t.length >= 3, { if(eval((t!2).cond), { ^ eval((t!2).stmt) }); });
      if(t.length >= 4, { if(eval((t!3).cond), { ^ eval((t!3).stmt) }); });
      if(t.length >= 5, { if(eval((t!4).cond), { ^ eval((t!4).stmt) }); });
      if(t.length >= 6, { if(eval((t!5).cond), { ^ eval((t!5).stmt) }); });
      if(t.length >= 7, { if(eval((t!6).cond), { ^ eval((t!6).stmt) }); });
      if(t.length >= 8, { if(eval((t!7).cond), { ^ eval((t!7).stmt) }); });
      error("No condition matched in switch statement")
  }) }