Mark UNTIL reserved for future use

Internally to Ren-C, the LOOP-UNTIL/LOOP-WHILE proposal has been
implemented:

https://trello.com/c/988j1mjS

This goes ahead and deploys the new meaning of UNTIL for use in the
Mezzanine, and then bumps it to reserved in user space.  Compatibility
code for bootstrap renames R3-Alpha's UNTIL out of the way to
LOOP-UNTIL, and also leaves UNTIL undefined.

src/mezz/base-defs.r

@@ -23,14 +23,6 @@ REBOL [
 ]
 
 
-; !!! The long term goal for Ren-C is that UNTIL and WHILE both be arity-2 and
-; inversions of each other, with LOOP-UNTIL and LOOP-WHILE being arity-1.
-; To avoid rocking the boat in the default distribution, this is changed here.
-;
-until-2: :until
-until: :loop-until
-
-
 ; Words for BLANK! and BAR!, for those who don't like symbols
 
 blank: _

src/mezz/base-funcs.r

@@ -733,7 +733,7 @@ left-bar: func [
     right [<opt> any-value! <...>]
         {Any number of expressions on the right.}
 ][
-    while [not tail? right] [take right]
+    loop-until [void? take right]
     :left
 ]
 
@@ -746,7 +746,7 @@ right-bar: func [
     right [<opt> any-value! <...>]
         {Any number of expressions on the right.}
 ][
-    also take right (while [not tail? right] [take right])
+    also take right (loop-until [void? take right])
 ]
 
 

src/mezz/mezz-debug.r

@@ -120,7 +120,7 @@ assert-debug: function [
     ][
         ; Otherwise it's a block!
         active: true
-        while [not tail? conditions] [
+        until [tail? conditions] [
             if option: maybe [issue! tag!] :conditions/1 [
                 unless any-value? (active: select live-asserts-map option) [
                     ;

src/mezz/mezz-legacy.r

@@ -433,7 +433,7 @@ r3-alpha-apply: function [
     params: words-of :action
     using-args: true
 
-    while [not tail? block] [
+    until [tail? block] [
         arg: either only [
             also block/1 (block: next block)
         ][
@@ -809,7 +809,7 @@ set 'r3-legacy* func [<local> if-flags] [
             either function? :source [
                 code: reduce [:source]
                 params: words-of :source
-                while [not tail? params] [
+                for-next params [
                     append code switch type-of params/1 [
                         :word! [take normals]
                         :lit-word! [take softs]
@@ -818,7 +818,6 @@ set 'r3-legacy* func [<local> if-flags] [
                         :refinement! [break]
                         (fail ["bad param type" params/1])
                     ]
-                    params: next params
                 ]
                 lib/do code
             ][
@@ -941,7 +940,7 @@ set 'r3-legacy* func [<local> if-flags] [
             ;
             use :vars [
                 position: data
-                while [not tail? position] compose [
+                until [tail? position] compose [
                     (collect [
                         every item vars [
                             case [

src/mezz/mezz-series.r

@@ -260,7 +260,7 @@ reword: function [
             vals: make map! length values  ; Make a new map internally
             not only block? values  ; Should we evaluate value expressions?
         ] [
-            while [not tail? values] [
+            until [tail? values] [
                 w: first+ values  ; Keywords are not evaluated
                 v: do/next values 'values
                 if any [set-word? :w lit-word? :w] [w: to word! :w]

src/mezz/prot-http.r

@@ -55,7 +55,7 @@ sync-op: func [port body /local state] [
     ;NOTE: We'll wait in a WHILE loop so the timeout cannot occur during 'reading-data state.
     ;The timeout should be triggered only when the response from other side exceeds the timeout value.
     ;--Richard
-    while [not find [ready close] state/state][
+    until [find [ready close] state/state][
         unless port? wait [state/connection port/spec/timeout] [
             fail make-http-error "Timeout"
         ]

src/mezz/sys-ports.r

@@ -225,7 +225,7 @@ init-schemes: func [
             ; Process all events (even if no awake ports).
             n-event: 0
             event-list: sport/state
-            while [not empty? event-list][
+            until [empty? event-list][
                 if n-event > 8 [break] ; Do only 8 events at a time (to prevent polling lockout).
                 event: first event-list
                 port: event/port

src/mezz/sys-start.r

@@ -62,6 +62,17 @@ finish-init-core: procedure [
                 {If in <r3-legacy> mode, old JOIN meaning is available.}
             ] 'dummy1
         ])
+
+        'while-not (get 'until)
+        'until (func [dummy] [
+            fail/where [
+                {UNTIL is reserved in Ren-C for future use}
+                {(It will be arity-2 and act like WHILE [NOT ...] [...])}
+                {Use LOOP-UNTIL for the single arity form, and see also}
+                {LOOP-WHILE for the arity-1 form of WHILE.}
+                {If in <r3-legacy> mode, old UNTIL meaning is available.}
+            ] 'dummy
+        ])
     ]
     system/contexts/user: tmp
 

src/tools/common-parsers.r

@@ -342,12 +342,11 @@ proto-parser: context [
     ] c.lexical/grammar
 ]
 
-rewrite-if-directives: func [
-    {Bottom up rewrite of conditional directives to remove unnecessary sections.}
+rewrite-if-directives: function [
+    {Bottom up rewrite conditional directives to remove unnecessary sections.}
     position
-    /local rewritten
 ][
-    until [
+    loop-until [
         parse position [
             (rewritten: false)
             some [

src/tools/r2r3-future.r

@@ -362,6 +362,16 @@ join: does [
 adjoin: get 'repend
 
 
+; It's not possible to write loop wrappers that work correctly with RETURN,
+; and so a good forward-compatible version of UNTIL as WHILE-NOT isn't really
+; feasible.  So just don't use it.
+;
+loop-until: get 'until
+until: does [
+    fail "UNTIL in Ren-C will be arity 2 (WHILE-NOT), can't mimic in R3-Alpha"
+]
+
+
 ; Note: any-context! and any-context? supplied at top of file
 
 ; *all* typesets now ANY-XXX to help distinguish them from concrete types

tests/bench.r3

@@ -148,7 +148,7 @@ merge: func [
 a la b lb /local c
 ] [
 c: copy/part a la
-until [
+loop-until [
 either (compare first b first c) [
 change/only a first b
 b: next b

tests/control/until.test.reb

@@ -1,35 +1,35 @@
 ; functions/control/until.r
 [
     num: 0
-    until [num: num + 1 num > 9]
+    loop-until [num: num + 1 num > 9]
     num = 10
 ]
 ; Test body-block return values
-[1 = until [1]]
+[1 = loop-until [1]]
 ; Test break and break/return
-[void? until [break true]]
-[1 = until [break/return 1 true]]
+[void? loop-until [break true]]
+[1 = loop-until [break/return 1 true]]
 ; Test continue
 [
     success: true
     cycle?: true
-    until [if cycle? [cycle?: false continue success: false] true]
+    loop-until [if cycle? [cycle?: false continue success: false] true]
     success
 ]
 ; Test that return stops the loop
 [
-    f1: does [until [return 1]]
+    f1: does [loop-until [return 1]]
     1 = f1
 ]
 ; Test that errors do not stop the loop
-[1 = until [try [1 / 0] 1]]
+[1 = loop-until [try [1 / 0] 1]]
 ; Recursion check
 [
     num1: 0
     num3: 0
-    until [
+    loop-until [
         num2: 0
-        until [
+        loop-until [
             num3: num3 + 1
             1 < (num2: num2 + 1)
         ]