Make PARSE3 RAISE errors on unsuccessful parse

The design choice to raise a definitional error on incomplete
parses worked so well for UPARSE that this goes ahead and
patches the behavior into PARSE3.

As a result of making this change, bugs were discovered and
unclear code was rewritten to make it obvious when accepting
incomplete states was intentional.

extensions/console/ext-console-init.reb

@@ -573,7 +573,10 @@ ext-console-impl: func [
     let directives: collect [
         let i
         if block? prior [
-            parse3 prior [some [set i: issue! (keep i)] end]
+            parse3 prior [
+                try some [set i: issue! (keep i)]
+                accept (true)
+            ]
         ]
     ]
 

extensions/locale/iso3166.r

@@ -59,7 +59,7 @@ parse3 init-code [
          #"[" thru #"]"
     ] iso-3166-table-count
     to <end>
-] else [
+] except [
     fail "Failed to update iso-3166-table"
 ]
 

extensions/locale/iso639.r

@@ -61,7 +61,7 @@ parse3 init-code [
          #"[" thru #"]"
     ] iso-639-table-count
     to <end>
-] else [
+] except [
     fail "Failed to update iso-639-table"
 ]
 

scripts/encap.reb

@@ -273,7 +273,7 @@ elf-format: context [
                 (mode: 'write) seek pos, program-header-rule
             ]
             to <end>
-        ] else [
+        ] except [
             fail "Error updating offsets in program headers"
         ]
 
@@ -287,7 +287,7 @@ elf-format: context [
                 (mode: 'write) seek pos, section-header-rule
             ]
             to <end>
-        ] else [
+        ] except [
             fail "Error updating offsets in section headers"
         ]
     ]
@@ -325,7 +325,7 @@ elf-format: context [
 
         parse3 skip executable string-header-offset [
             (mode: 'read) section-header-rule to <end>
-        ] else [
+        ] except [
             fail "Error finding string section in ELF binary"
         ]
 
@@ -415,7 +415,7 @@ elf-format: context [
                 )
                 (mode: 'write) seek pos, section-header-rule
                 to <end>
-            ] else [
+            ] except [
                 fail "Error updating string table size in string header"
             ]
 
@@ -441,7 +441,7 @@ elf-format: context [
                 )
                 (mode: 'write) section-header-rule
                 to <end>
-            ] else [
+            ] except [
                 fail "Error creating new section for the embedded data"
             ]
 
@@ -483,7 +483,7 @@ elf-format: context [
 
         parse3 executable [
             (mode: 'write) header-rule to <end>
-        ] else [
+        ] except [
             fail "Error updating the ELF header"
         ]
     ]
@@ -494,7 +494,7 @@ elf-format: context [
     ][
         let header-data: read/part file 64  ; 64-bit size, 32-bit is smaller
 
-        parse3 header-data [(mode: 'read) header-rule to <end>] else [
+        parse3 header-data [(mode: 'read) header-rule to <end>] except [
             return null
         ]
 
@@ -506,7 +506,7 @@ elf-format: context [
         ;
         parse3 skip section-headers-data (e_shstrndx * e_shentsize) [
             (mode: 'read) section-header-rule to <end>
-        ] else [
+        ] except [
             fail "Error finding string section in ELF binary"
         ]
 
@@ -614,7 +614,7 @@ pe-format: context [
             | skip
         ]
 
-        parse3 rule [try some block-rule] else [fail]
+        parse3 rule [try some block-rule]
 
         set name make object! append def '~
         return bind rule get name
@@ -774,7 +774,7 @@ pe-format: context [
         repeat (COFF-header.number-of-sections) section-rule
         end-of-section-header: <here>
 
-        ; !!! stop here, no END ?
+        accept (true)  ; !!! stop here, no END ?
     ]
     size-of-section-header: 40  ; Size of one entry
 
@@ -823,7 +823,7 @@ pe-format: context [
         exe-data [binary!]
     ][
         reset
-        parse3 exe-data exe-rule
+        try parse3 exe-data exe-rule
         if err = 'missing-dos-signature [
             return false  ; soft failure (just wasn't an EXE, no "MZ")
         ]
@@ -1273,7 +1273,7 @@ encap: func [
     print ["Compressed resource is" length of compressed "bytes long."]
 
     case [
-        did parse3 executable [
+        try parse3 executable [
             (elf-format.mode: 'read) elf-format.header-rule to <end>
         ][
             print "ELF format found"

scripts/prot-http.r

@@ -485,7 +485,7 @@ read-body: function [
                 ; even have enough input data for the chunk *size*, much less
                 ; the chunk.  READ until we have at least a chunk size.
                 ;
-                while [didn't parse3 conn.data [
+                while [not try parse3 conn.data [
                     copy chunk-size: some hex-digits, thru crlfbin
                     mk1: <here>, to <end>
                 ]][
@@ -511,7 +511,7 @@ read-body: function [
                 ; Now we have the chunk size but may not have the chunk data.
                 ; Loop until enough data is gathered.
                 ;
-                while [didn't parse3 mk1 [
+                while [not try parse3 mk1 [
                     repeat (chunk-size) skip, mk2: <here>, crlfbin, to <end>
                 ]][
                     read conn
@@ -532,11 +532,11 @@ read-body: function [
             ;
             ; https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Trailer
             ;
-            parse3 mk1 [
+            if try parse3 mk1 [
                 crlfbin (trailer: "") to <end>
                     |
                 copy trailer to crlf2bin to <end>
-            ] then [
+            ][
                 trailer: scan-net-header as binary! trailer
                 append headers spread trailer
                 clear conn.data

src/boot/errors.r

@@ -226,6 +226,7 @@ Script: [
     parse-command:      [{PARSE - command cannot be used as variable:} :arg1]
     parse-series:       [{PARSE - input must be a series:} :arg1]
     parse-multiple-set: {PARSE - SET can capture at most one value}
+    parse-incomplete:   {PARSE rules did not reach end of input}
 
     bad-library:        {bad library (already closed?)}
     only-callback-ptr:  {Only callback functions may be passed by FFI pointer}

src/core/c-path.c

@@ -308,12 +308,11 @@ Bounce TO_Sequence(Frame(*) frame_, enum Reb_Kind kind, const REBVAL *arg) {
         // (Inefficient!  But just see how it feels before optimizing.)
         //
         return rebValue(
-            "as", Datatype_From_Kind(kind), "catch [",
+            "as", Datatype_From_Kind(kind),
                 "parse3 let v: load @", arg, "[",
-                    "[any-sequence! | any-array!] end (throw first v)",
-                    "| (throw v)",  // try to convert whatever other block
-                "]",
-            "]"
+                    "[any-sequence! | any-array!] <end> accept (first v)",
+                    "| accept (v)",  // try to convert whatever other block
+                "]"
         );
     }
 

src/core/n-data.c

@@ -2665,8 +2665,8 @@ DECLARE_NATIVE(concretize)
 //
 //  "Turn isotopes into their plain forms, pass thru other values"
 //
-//      return: [element?]
-//      value [<opt> any-value!]
+//      return: [<void> element?]
+//      value [<opt> <void> any-value!]
 //  ]
 //
 DECLARE_NATIVE(noisotope)

src/core/u-parse.c

@@ -1454,7 +1454,7 @@ DECLARE_NATIVE(subparse)
               case SYM_WHILE:
                 if (not (P_FLAGS & PF_REDBOL)) {
                     fail (
-                        "Please replace PARSE2's WHILE with TRY SOME -or-"
+                        "Please replace PARSE3's WHILE with TRY SOME -or-"
                         " TRY FURTHER SOME--it's being reclaimed as arity-2."
                         " https://forum.rebol.info/t/1540/12 (or use PARSE2)"
                     );
@@ -1779,7 +1779,7 @@ DECLARE_NATIVE(subparse)
                 //    (go-on?: either condition [[accept]][[reject]])
                 //    go-on?
                 //
-                // !!! Note: PARSE/REDBOL may be a modality it needs to
+                // !!! Note: PARSE3/REDBOL may be a modality it needs to
                 // support, and Red added IF.  It might be necessary to keep
                 // it (though Rebol2 did not have IF in PARSE...)
                 //
@@ -1822,7 +1822,7 @@ DECLARE_NATIVE(subparse)
 
                 DECLARE_LOCAL (thrown_arg);
                 if (IS_TAG(P_RULE)) {
-                    if (rebDid(P_RULE, "= <here>"))
+                    if (rebDid(rebR(rebUnrelativize(P_RULE)), "= <here>"))
                         Copy_Cell(thrown_arg, ARG(position));
                     else
                         fail ("PARSE3 ACCEPT TAG! only works with <here>");
@@ -2760,14 +2760,20 @@ DECLARE_NATIVE(parse3)
         return THROWN;
     }
 
-    if (Is_Nulled(OUT))
-        return nullptr;  // the match failed
+    if (Is_Nulled(OUT)) {  // a match failed (but may be at end of input)
+        if (REF(redbol))
+            return nullptr;
+        return RAISE(Error_Parse_Incomplete_Raw());
+    }
 
     REBLEN index = VAL_UINT32(OUT);
     assert(index <= VAL_LEN_HEAD(input));
 
-    if (index != VAL_LEN_HEAD(input))
-        return nullptr;  // the match failed
+    if (index != VAL_LEN_HEAD(input)) {  // didn't reach end of input
+        if (REF(redbol))
+            return nullptr;
+        return RAISE(Error_Parse_Incomplete_Raw());
+    }
 
     // !!! R3-Alpha parse design had no means to bubble up a "synthesized"
     // rule product.  But that's important in the new design.  Hack in support
@@ -2785,12 +2791,7 @@ DECLARE_NATIVE(parse3)
         return OUT;
     }
 
-    // !!! Give back a value that triggers a THEN clause and won't trigger an
-    // ELSE clause.  See UPARSE for the redesign that will be applied to more
-    // native code in the future.  But this is just to get people out of the
-    // habit of writing `IF PARSE ...`
-    //
-    return rebValue("~use-DID-PARSE-for-logic~");
+    return NONE;
 }
 
 

src/main/main-startup.reb

@@ -511,7 +511,7 @@ main-startup: func [
 
     while [not tail? argv] [
 
-        let is-option: did parse3/case argv.1 [
+        let is-option: did try parse3/case argv.1 [
 
             ["--" end] (
                 ; Double-dash means end of command line arguments, and the
@@ -673,11 +673,11 @@ main-startup: func [
         ; heuristic is to check for more than one letter.
         ;
         alphanum: charset [#"A" - #"Z" #"a" - #"z" #"0" #"9"]
-        o.script: parse3 o.script [alphanum some alphanum ":" to <end>] then [
-            to url! o.script
-        ]
-        else [
-            local-to-file o.script
+        parse3 o.script [
+            alphanum some alphanum ":" to <end>
+            (o.script: to url! o.script)
+        ] except [
+            o.script: local-to-file o.script
         ]
     ]
 

src/mezz/base-defs.r

@@ -343,10 +343,6 @@ reorder: enclose :reorder* lambda [f] [
     inherit-meta (do f) action
 ]
 
-; The PARSE name has been taken by what was UPARSE.
-
-parse2: :parse3/redbol
-
 
 ; REQUOTE is helpful when functions do not accept QUOTED! values.
 ;

src/mezz/base-files.r

@@ -206,7 +206,7 @@ split-path: func [
 ][
     parse3 as text! target [
         copy directory try some thru "/"
-        copy file thru end
+        copy file thru <end>
     ]
     if empty? directory [
         directory: null

src/mezz/base-funcs.r

@@ -430,7 +430,7 @@ redescribe: func [
             )]
         ]
         <end>
-    ] else [
+    ] except [
         fail [{REDESCRIBE specs should be STRING! and ANY-WORD! only:} spec]
     ]
 

src/mezz/base-series.r

@@ -357,13 +357,15 @@ trim: function [
     ;
     indent: null
     if auto [
-        parse3* series [
+        parse3 series [
             ; Don't count empty lines, (e.g. trim/auto {^/^/^/    asdf})
-            remove [try some LF]
+            try remove some LF
 
             (indent: 0)
-            s: <here>, some rule, e: <here>
+            s: <here>, try some rule, e: <here>
             (indent: (index of e) - (index of s))
+
+            accept (true)  ; don't need to reach end
         ]
     ]
 

src/mezz/mezz-series.r

@@ -191,8 +191,8 @@ reword: function [
         block? escape [
             parse3 escape [
                 set prefix delimiter-types
-                [end | set suffix delimiter-types]
-            ] else [
+                [<end> | set suffix delimiter-types]
+            ] except [
                 fail ["Invalid /ESCAPE delimiter block" escape]
             ]
         ]
@@ -301,7 +301,7 @@ reword: function [
         (append out a)  ; finalize output - transfer any remainder verbatim
     ]
 
-    apply :parse3 [source rule /case case_REWORD] else [fail]  ; should succeed
+    apply :parse3 [source rule /case case_REWORD]  ; should succeed
     return out
 ]
 
@@ -513,7 +513,7 @@ split: function [
         [block! integer! char! bitset! text! tag! word!]
     /into "If dlm is integer, split in n pieces (vs. pieces of length n)"
 ][
-    (parse3 (maybe match block! dlm) [some integer!]) then [
+    if try parse3 (maybe match block! dlm) [some integer!] [
         return map-each len dlm [
             if len <= 0 [
                 series: skip series negate len
@@ -538,7 +538,7 @@ split: function [
 
                 [
                     repeat (count) [
-                        copy series [repeat (piece-size) skip] (
+                        copy series try [repeat (piece-size) skip] (
                             keep series
                         )
                     ]

tests/control/match.test.reb

@@ -86,11 +86,8 @@
 [
     (match+: reframer func [f [frame!] <local> p] [
         p: f.(first parameters of action of f)  ; get the first parameter
-        if did do f [
-            return p
-        ] else [
-            return null
-        ] ; evaluate to parameter if operation succeeds
+        do f except [return null]
+        return p  ; evaluate to parameter if operation succeeds
     ]
     true)