factor: more escapes/renames/blah
parent
b4eebf65a9
commit
087f09bfd1
|
@ -537,3 +537,14 @@ CONSTANT: factor-lexing-rules {
|
|||
! { char: \n [ read-token-or-whitespace ] }
|
||||
! { f [ f like dup [ make-tag-literal ] when ] }
|
||||
! } case ; inline
|
||||
|
||||
![[
|
||||
|
||||
vocab-roots get [ vocabs-from reject-some-paths ] map concat
|
||||
{
|
||||
"specialized-arrays" "specialized-vectors"
|
||||
"math.blas.matrices" "math.blas.vectors" "math.vectors.simd"
|
||||
"math.vectors.simd.cords"
|
||||
} diff
|
||||
[ modern-source-path dup <pathname> . path>literals ] map-zip
|
||||
]]
|
|
@ -110,7 +110,7 @@ CONSTANT: vm-error-exception-flag>bit
|
|||
{ +fp-underflow+ 0x04 }
|
||||
{ +fp-zero-divide+ 0x08 }
|
||||
{ +fp-inexact+ 0x10 }
|
||||
}
|
||||
} ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
@ -8,7 +8,7 @@ in: xml.elements
|
|||
|
||||
: take-interpolated ( quot -- interpolated )
|
||||
interpolating? get [
|
||||
drop get-char char: > eq?
|
||||
drop get-char char: \> eq?
|
||||
[ next f ]
|
||||
[ "->" take-string [ blank? ] trim ]
|
||||
if <interpolated>
|
||||
|
@ -29,7 +29,7 @@ in: xml.elements
|
|||
|
||||
: parse-attr ( -- array )
|
||||
parse-name pass-blank "=" expect pass-blank
|
||||
get-char char: < eq?
|
||||
get-char char: \< eq?
|
||||
[ "<-" expect interpolate-quote ]
|
||||
[ t parse-quote* ] if 2array ;
|
||||
|
||||
|
@ -109,9 +109,9 @@ defer: make-tag ! Is this unavoidable?
|
|||
|
||||
: dtd-loop ( -- )
|
||||
pass-blank get-char {
|
||||
{ char: ] [ next ] }
|
||||
{ char: % [ expand-pe ] }
|
||||
{ char: < [
|
||||
{ char: \] [ next ] }
|
||||
{ char: \% [ expand-pe ] }
|
||||
{ char: \< [
|
||||
next make-tag dup dtd-acceptable?
|
||||
[ bad-doctype ] unless , dtd-loop
|
||||
] }
|
||||
|
@ -151,7 +151,7 @@ defer: make-tag ! Is this unavoidable?
|
|||
|
||||
: direct ( -- object )
|
||||
get-char {
|
||||
{ char: - [ take-comment ] }
|
||||
{ char: \- [ take-comment ] }
|
||||
{ char: \[ [ take-cdata ] }
|
||||
[ drop take-directive ]
|
||||
} case ;
|
||||
|
@ -167,7 +167,7 @@ defer: make-tag ! Is this unavoidable?
|
|||
: make-tag ( -- tag )
|
||||
get-char {
|
||||
{ char: \! [ next direct ] }
|
||||
{ char: ? [ next instruct ] }
|
||||
{ char: - [ next interpolate-tag ] }
|
||||
{ char: \? [ next instruct ] }
|
||||
{ char: \- [ next interpolate-tag ] }
|
||||
[ drop normal-tag ]
|
||||
} case ;
|
||||
|
|
|
@ -124,11 +124,11 @@ M: unclosed-quote error.
|
|||
M: quoteless-attr error.
|
||||
call-next-method "Attribute lacks quotes around value" print ;
|
||||
|
||||
M: attr-w/< error.
|
||||
M: attr-w/lt error.
|
||||
call-next-method
|
||||
"Attribute value contains literal <" print ;
|
||||
|
||||
M: text-w/]]> error.
|
||||
M: text-w/terminator error.
|
||||
call-next-method
|
||||
"Text node contains ']]>'" print ;
|
||||
|
||||
|
|
|
@ -90,9 +90,9 @@ XML-ERROR: unclosed-quote ;
|
|||
|
||||
XML-ERROR: quoteless-attr ;
|
||||
|
||||
XML-ERROR: attr-w/< ;
|
||||
XML-ERROR: attr-w/lt ;
|
||||
|
||||
XML-ERROR: text-w/]]> ;
|
||||
XML-ERROR: text-w/terminator ;
|
||||
|
||||
XML-ERROR: duplicate-attr key values ;
|
||||
|
||||
|
|
|
@ -117,16 +117,16 @@ HINTS: next* { spot } ;
|
|||
[ swap push-all ] [ no-entity ] ?if
|
||||
] ?if ;
|
||||
|
||||
: take-; ( -- string )
|
||||
: take-semi ( -- string )
|
||||
next ";" take-to next ;
|
||||
|
||||
: parse-entity ( accum -- )
|
||||
take-; "#" ?head [
|
||||
take-semi "#" ?head [
|
||||
"x" ?head 16 10 ? base> swap push
|
||||
] [ parse-named-entity ] if ;
|
||||
|
||||
: parse-pe ( accum -- )
|
||||
take-; dup pe-table get at
|
||||
take-semi dup pe-table get at
|
||||
[ swap push-all ] [ no-entity ] ?if ;
|
||||
|
||||
:: (parse-char) ( quot: ( ch -- ? ) accum spot -- )
|
||||
|
@ -134,11 +134,11 @@ HINTS: next* { spot } ;
|
|||
{
|
||||
{ [ char not ] [ ] }
|
||||
{ [ char quot call ] [ spot next* ] }
|
||||
{ [ char char: & eq? ] [
|
||||
{ [ char char: \& eq? ] [
|
||||
accum parse-entity
|
||||
quot accum spot (parse-char)
|
||||
] }
|
||||
{ [ char char: % eq? [ in-dtd? get ] [ f ] if ] [
|
||||
{ [ char char: \% eq? [ in-dtd? get ] [ f ] if ] [
|
||||
accum parse-pe
|
||||
quot accum spot (parse-char)
|
||||
] }
|
||||
|
@ -152,20 +152,20 @@ HINTS: next* { spot } ;
|
|||
: parse-char ( quot: ( ch -- ? ) -- seq )
|
||||
512 <sbuf> [ spot get (parse-char) ] keep "" like ; inline
|
||||
|
||||
: assure-no-]]> ( pos char -- pos' )
|
||||
"]]>" next-matching dup 2 > [ text-w/]]> ] when ; inline
|
||||
: assure-no-terminator ( pos char -- pos' )
|
||||
"]]>" next-matching dup 2 > [ text-w/terminatorl ] when ; inline
|
||||
|
||||
:: parse-text ( -- string )
|
||||
depth get zero? :> no-text
|
||||
0 :> pos!
|
||||
|[ char |
|
||||
pos char assure-no-]]> pos!
|
||||
pos char assure-no-terminator pos!
|
||||
no-text [
|
||||
char blank? char char: < eq? or [
|
||||
char blank? char char: \< eq? or [
|
||||
char 1string t pre/post-content
|
||||
] unless
|
||||
] when
|
||||
char char: < eq?
|
||||
char char: \< eq?
|
||||
] parse-char ;
|
||||
|
||||
: close ( -- )
|
||||
|
@ -177,7 +177,7 @@ HINTS: next* { spot } ;
|
|||
: (parse-quote) ( <-disallowed? ch -- string )
|
||||
swap '[
|
||||
dup _ eq? [ drop t ]
|
||||
[ char: < eq? _ and [ attr-w/< ] [ f ] if ] if
|
||||
[ char: \< eq? _ and [ attr-w/lt ] [ f ] if ] if
|
||||
] parse-char normalize-quote get-char
|
||||
[ unclosed-quote ] unless ; inline
|
||||
|
||||
|
|
Loading…
Reference in New Issue