merge

kernel/int.fs

@@ -40,16 +40,17 @@ require kernel/version.fs \ version-string
 
 \ parse                                           23feb93py
 
-: (parse)    ( char "ccc<char>" -- c-addr u ) \ core-ext
-\G Parse @i{ccc}, delimited by @i{char}, in the parse
-\G area. @i{c-addr u} specifies the parsed string within the
-\G parse area. If the parse area was empty, @i{u} is 0.
+: (parse)    ( char "ccc<char>" -- c-addr u )
     >r  source  >in @ over min /string ( c-addr1 u1 )
     over  swap r>  scan >r
     over - dup r@ IF 1+ THEN  >in +!
     2dup r> 0<> - input-lexeme! ;
 
-Defer parse  ' (parse) is parse
+Defer parse ( xchar "ccc<xchar>" -- c-addr u ) \ core-ext,xchar
+\G Parse @i{ccc}, delimited by @i{xchar}, in the parse
+\G area. @i{c-addr u} specifies the parsed string within the
+\G parse area. If the parse area was empty, @i{u} is 0.
+' (parse) is parse
 
 \ name                                                 13feb93py
 

peeprules.vmg

@@ -58,6 +58,8 @@ super31 = lit f@
 super32 = lit f!
 super33 = noop flit
 super34 = lit+ @
+super35 = f@ f*
+super36 = f@ f+
 
 \ compare-and-branch; comment them out if we take up work on gforth-native again
 cb1 = 0< ?branch

stuff.fs

@@ -622,3 +622,21 @@ end-struct buffer%
     \G representing the first character of @i{ccc}.  Interpretation
     \G semantics for this word are undefined.
     char postpone Literal ; immediate restrict
+
+\ xchar version of parse
+
+: (xparse)    ( xchar "ccc<char>" -- c-addr u ) \ core-ext
+\G Parse @i{ccc}, delimited by @i{xchar}, in the parse
+\G area. @i{c-addr u} specifies the parsed string within the
+\G parse area. If the parse area was empty, @i{u} is 0.
+    dup $80 < if (parse) exit then \ for -1, also possibly faster
+    {: | xc[ 8 ] :} xc[ 8 xc!+? 0= #-77 and throw drop xc[ - {: xcu :}
+    source  >in @ over min /string ( c-addr1 u1 )
+    over swap xc[ xcu search if
+	drop over - xcu
+    else
+	nip 0 then
+    over + >in +!
+    2dup input-lexeme! ;
+
+' (xparse) is parse

test/xchar.fs

@@ -32,4 +32,8 @@ base @ hex
 { 2060 xc-width -> 0 }
 { test-string x-width -> 9 }
 
+{ '√' parse abc√ "abc" str= -> true }
+{ '√' parse def
+"def" str= -> true }
+
 base !