factor: more escaping. add execute\ for words that simply have to be called.....
parent
69eab4cbba
commit
0c170345af
|
@ -107,6 +107,7 @@ in: bootstrap.syntax
|
|||
"read-only"
|
||||
"call("
|
||||
"execute("
|
||||
"execute\\"
|
||||
"\""
|
||||
"P\""
|
||||
"SBUF\""
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -59,8 +59,8 @@ defer: expression-parser
|
|||
[
|
||||
{
|
||||
[ blank? not ]
|
||||
[ char: ) = not ]
|
||||
[ char: - = not ]
|
||||
[ char: \) = not ]
|
||||
[ char: \- = not ]
|
||||
} 1&&
|
||||
] satisfy repeat1 [ >string ] action ;
|
||||
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue