YAML: support non-scalar keys

diff --git a/extra/yaml/yaml-tests.factor b/extra/yaml/yaml-tests.factor
index b203c86b1faeebf9c36969aca801b0437bd58936..3b6411fa32b23b33cb5f4deadacfba9873e3461f 100644 (file)
--- a/extra/yaml/yaml-tests.factor
+++ b/extra/yaml/yaml-tests.factor
@@ -35,3 +35,13 @@ CONSTANT: test-represented-string """--- !!seq
 ${ test-obj } [ $ test-string yaml> ] unit-test
 ${ test-represented-string } [ $ test-obj >yaml ] unit-test
 ${ test-represented-string } [ $ test-represented-string yaml> >yaml ] unit-test
+
+CONSTANT: complex-key H{ { { "4" } "3" } }
+CONSTANT: complex-key-represented """--- !!map
+? !!seq
+- !!str 4
+: !!str 3
+...
+"""
+
+${ complex-key } [ $ complex-key-represented yaml> ] unit-test

diff --git a/extra/yaml/yaml.factor b/extra/yaml/yaml.factor
index 67e51e4601a7e39e29564badb55fd504807820b2..75fe9ffbcd8fdf5ddcc318f2c221388523b5388e 100644 (file)
--- a/extra/yaml/yaml.factor
+++ b/extra/yaml/yaml.factor
@@ -34,9 +34,12 @@ DEFER: parse-mapping
     YAML_MAPPING_END_EVENT = [
       t done! f f
     ] [
-      event event>scalar t
+      event ?scalar-value
     ] if
-  ] with-destructors [ parser event next-value swap ,, ] [ drop ] if ] until
+  ] with-destructors 2dup or [
+    [ nip [ parser event ] dip next-complex-value ] when*
+    parser event next-value swap ,,
+  ] [ 2drop ] if ] until
 ] H{ } make ;
 :: parse-sequence ( parser event -- seq ) [
   f :> done!