From eb1987924e8be202e221385fed1fd529ef8bba6e Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Sat, 15 Feb 2014 18:28:15 +0100
Subject: [PATCH] YAML: support non-scalar keys

---
 extra/yaml/yaml-tests.factor | 10 ++++++++++
 extra/yaml/yaml.factor       |  7 +++++--
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/extra/yaml/yaml-tests.factor b/extra/yaml/yaml-tests.factor
index b203c86b1f..3b6411fa32 100644
--- 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 67e51e4601..75fe9ffbcd 100644
--- 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!