factor: more escaping. add execute\ for words that simply have to be called.....

locals-and-roots
Doug Coleman 2016-06-20 15:27:59 -07:00
parent 69eab4cbba
commit 0c170345af
10 changed files with 26 additions and 23 deletions

View File

@ -107,6 +107,7 @@ in: bootstrap.syntax
"read-only"
"call("
"execute("
"execute\\"
"\""
"P\""
"SBUF\""

View File

@ -373,6 +373,8 @@ in: bootstrap.syntax
"execute(" [ \ execute-effect parse-call-paren ] define-core-syntax
"execute\\" [ scan-word suffix! ] define-core-syntax
"::" [ (::) define-declared ] define-core-syntax
"M::" [ (M::) define ] define-core-syntax
"MACRO:" [ (:) define-macro ] define-core-syntax

View File

@ -69,7 +69,7 @@ in: c.lexer
} case ;
: take-token ( sequence-parser -- string/f )
char: \ char: " take-token* ;
char: \ char: \" take-token* ;
: c-identifier-begin? ( ch -- ? )
char: a char: z [a,b]

View File

@ -73,8 +73,8 @@ ERROR: header-file-missing path ;
: handle-include ( preprocessor-state sequence-parser -- )
skip-whitespace/comments advance dup previous {
{ char: < [ char: > take-until-object read-standard-include ] }
{ char: " [ char: " take-until-object read-local-include ] }
{ char: \< [ char: \> take-until-object read-standard-include ] }
{ char: \" [ char: \" take-until-object read-local-include ] }
[ bad-include-line ]
} case ;
@ -165,7 +165,7 @@ ERROR: header-file-missing path ;
] if ;
: preprocess-line ( preprocessor-state sequence-parser -- )
skip-whitespace/comments dup current char: # =
skip-whitespace/comments dup current char: \# =
[ parse-directive-line ]
[ swap processing-disabled?>> [ drop ] [ write-full nl ] if ] if ;

View File

@ -59,8 +59,8 @@ defer: expression-parser
[
{
[ blank? not ]
[ char: ) = not ]
[ char: - = not ]
[ char: \) = not ]
[ char: \- = not ]
} 1&&
] satisfy repeat1 [ >string ] action ;

View File

@ -74,13 +74,13 @@ CONSTANT: CHARS H{
{ char: \" 0x201E }
{ char: \. 0x02D9 }
{ char: \; 0x061B }
{ char: \[ char: ] }
{ char: \( char: ) }
{ char: \{ char: } }
{ char: \[ char: \] }
{ char: \( char: \) }
{ char: \{ char: \} }
{ char: \? 0x00BF }
{ char: \! 0x00A1 }
{ char: \' char: , }
{ char: \< char: > }
{ char: \' char: \, }
{ char: \< char: \> }
{ char: \_ 0x203E }
{ 0x203F 0x2040 }
{ 0x2045 0x2046 }

View File

@ -39,7 +39,7 @@ GML: count ( -- n ) dup operand-stack>> length ;
GML: counttomark ( -- n ) dup [ operand-stack>> length ] [ find-marker ] bi - ;
! Arrays
GML: ] ( -- array )
GML: \ ] ( -- array )
dup
[ [ operand-stack>> ] [ find-marker ] bi pop-slice { } like ]
[ operand-stack>> pop* ]
@ -146,12 +146,12 @@ GML:: map ( array proc -- )
:> gml
marker gml push-operand
gml array proc proc>quot1 each
gml-] ;
execute\ gml-] ;
GML:: twomap ( array1 array2 proc -- )
:> gml
marker gml push-operand
gml array1 array2 proc proc>quot2 2each
gml-] ;
execute\ gml-] ;
! Extensions to real GML
GML: print ( obj -- ) print-gml ;

View File

@ -180,7 +180,7 @@ global-dictionary [ H{ } clone ] initialize
primitive-effect define-declared ;
: scan-gml-name ( -- word name )
scan-token [ "gml-" prepend create-word-in ] keep ;
scan-escaped-word-string [ "gml-" prepend create-word-in ] keep ;
: (GML:) ( -- word name effect def )
scan-gml-name scan-effect parse-definition ;

View File

@ -25,11 +25,11 @@ in: simple-flat-file
: flat-file>biassoc ( filename -- biassoc )
utf8 file-lines process-codetable-lines >biassoc ;
: split-; ( line -- array )
: split-semi ( line -- array )
";" split [ [ blank? ] trim ] map! ;
: data ( filename -- data )
utf8 file-lines drop-comments [ split-; ] map! ;
utf8 file-lines drop-comments [ split-semi ] map! ;
symbol: interned
@ -40,7 +40,7 @@ symbol: interned
: expand-ranges ( assoc -- interval-map )
[
[
swap char: . over member? [
swap char: \. over member? [
".." split1 [ hex> ] bi@ 2array
] [ hex> ] if range,
] assoc-each

View File

@ -43,13 +43,13 @@ defer: parse-tnetstring
: parse-tnetstring ( data -- remain value )
parse-payload {
{ char: # [ string>number ] }
{ char: \# [ string>number ] }
{ char: \" [ ] }
{ char: } [ parse-dict ] }
{ char: ] [ parse-list ] }
{ char: \} [ parse-dict ] }
{ char: \] [ parse-list ] }
{ char: \! [ parse-bool ] }
{ char: ~ [ parse-null ] }
{ char: , [ ] }
{ char: \~ [ parse-null ] }
{ char: \, [ ] }
[ "Invalid payload type: %c" sprintf throw ]
} case ;