steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

YAML: parse anchors

db4
Jon Harper 2014-03-16 16:06:27 +01:00 committed by John Benediktsson
parent 11d6c820b0
commit b60d1c86f9
1 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
extra/yaml/yaml.factor
View File

@ -10,12 +10,23 @@ IN: yaml
: yaml-assert-ok ( ? -- ) [ "yaml error" throw ] unless ; : yaml-assert-ok ( ? -- ) [ "yaml error" throw ] unless ;
: event>scalar ( event -- obj ) SYMBOL: anchors
data>> scalar>> construct-scalar ; : ?register-anchor ( obj event -- obj )
dupd anchor>> [ anchors get set-at ] [ drop ] if* ;
: deref-anchor ( event -- obj )
data>> alias>> anchor>> anchors get at ;
: ?scalar-value ( event -- scalar/f f/type ) : event>scalar ( event -- obj )
dup type>> YAML_SCALAR_EVENT = data>> scalar>>
[ event>scalar f ] [ type>> clone f swap ] if ; [ construct-scalar ]
[ ?register-anchor ] bi ;
: ?scalar-value ( event -- scalar/event scalar? )
dup type>> {
{ YAML_SCALAR_EVENT [ event>scalar t ] }
{ YAML_ALIAS_EVENT [ deref-anchor t ] }
[ drop clone f ]
} case ;
! Must not reuse the event struct before with-destructors scope ends ! Must not reuse the event struct before with-destructors scope ends
: next-event ( parser event -- event ) : next-event ( parser event -- event )
@ -23,16 +34,21 @@ IN: yaml
DEFER: parse-sequence DEFER: parse-sequence
DEFER: parse-mapping DEFER: parse-mapping
: next-complex-value ( parser event type -- obj ) : (parse-sequence) ( parser event prev-event -- obj )
{ [ parse-sequence ] [ sequence_start>> ?register-anchor ] bi* ;
{ YAML_SEQUENCE_START_EVENT [ parse-sequence ] } : (parse-mapping) ( parser event prev-event -- obj )
{ YAML_MAPPING_START_EVENT [ parse-mapping ] } [ parse-mapping ] [ mapping_start>> ?register-anchor ] bi* ;
: next-complex-value ( parser event prev-event -- obj )
dup type>> {
{ YAML_SEQUENCE_START_EVENT [ data>> (parse-sequence) ] }
{ YAML_MAPPING_START_EVENT [ data>> (parse-mapping) ] }
{ YAML_ALIAS_EVENT [ 2nip deref-anchor ] }
[ throw ] [ throw ]
} case ; } case ;
:: next-value ( parser event -- obj ) :: next-value ( parser event -- obj )
parser event [ next-event ?scalar-value ] with-destructors parser event [ next-event ?scalar-value ] with-destructors
[ [ drop parser event ] dip next-complex-value ] when* ; [ [ parser event ] dip next-complex-value ] unless ;
:: parse-mapping ( parser event -- map ) :: parse-mapping ( parser event -- map )
[ [
@ -41,15 +57,15 @@ DEFER: parse-mapping
[ [
parser event next-event type>> parser event next-event type>>
YAML_MAPPING_END_EVENT = [ YAML_MAPPING_END_EVENT = [
t done! f f f t done! f f
] [ ] [
event ?scalar-value t event ?scalar-value
] if ] if
] with-destructors ] with-destructors
[ done [ 2drop ] [
[ nip [ parser event ] dip next-complex-value ] when* [ [ parser event ] dip next-complex-value ] unless
parser event next-value swap ,, parser event next-value swap ,,
] [ 2drop ] if ] if
] until ] until
] H{ } make ; ] H{ } make ;
@ -60,12 +76,14 @@ DEFER: parse-mapping
[ [
parser event next-event type>> parser event next-event type>>
YAML_SEQUENCE_END_EVENT = [ YAML_SEQUENCE_END_EVENT = [
t done! f t done! f f
] [ ] [
event ?scalar-value dup [ nip ] [ [ , ] dip ] if event ?scalar-value
] if ] if
] with-destructors ] with-destructors
[ [ parser event ] dip next-complex-value , ] when* done [ 2drop ] [
[ [ parser event ] dip next-complex-value ] unless ,
] if
] until ] until
] { } make ; ] { } make ;
@ -75,6 +93,11 @@ DEFER: parse-mapping
[ "wrong event" throw ] unless [ "wrong event" throw ] unless
] with-destructors ; ] with-destructors ;
:: parse-yaml-doc ( parser event -- obj )
H{ } clone anchors [
parser event next-value
] with-variable ;
:: ?parse-yaml-doc ( parser event -- obj/f ? ) :: ?parse-yaml-doc ( parser event -- obj/f ? )
[ [
parser event next-event type>> { parser event next-event type>> {
@ -84,7 +107,7 @@ DEFER: parse-mapping
} case } case
] with-destructors ] with-destructors
[ [
parser event next-value t parser event parse-yaml-doc t
parser event YAML_DOCUMENT_END_EVENT expect-event parser event YAML_DOCUMENT_END_EVENT expect-event
] [ f f ] if ; ] [ f f ] if ;