]> gitweb.factorcode.org Git - factor.git/commitdiff
feature: canonical s-expressions
authorRudi Grinberg <me@rgrinberg.com>
Sun, 2 Jul 2023 15:59:18 +0000 (17:59 +0200)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 2 Jul 2023 16:07:48 +0000 (08:07 -0800)
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
extra/csexp/authors.txt [new file with mode: 0644]
extra/csexp/csexp-tests.factor [new file with mode: 0644]
extra/csexp/csexp.factor [new file with mode: 0644]
extra/csexp/summary.txt [new file with mode: 0644]

diff --git a/extra/csexp/authors.txt b/extra/csexp/authors.txt
new file mode 100644 (file)
index 0000000..295c6f9
--- /dev/null
@@ -0,0 +1 @@
+Rudi Grinberg
diff --git a/extra/csexp/csexp-tests.factor b/extra/csexp/csexp-tests.factor
new file mode 100644 (file)
index 0000000..d0c155c
--- /dev/null
@@ -0,0 +1,11 @@
+USING: tools.test csexp ;
+IN: csexp.tests
+{ "6:foobar" } [ "foobar" >csexp ] unit-test
+{ "()" } [ V{ } >csexp ] unit-test
+{ "(3:foo(1:a1:b))" } [ V{ "foo" V{ "a" "b" } } >csexp ] unit-test
+
+{ "foobar" } [ "6:foobar" csexp> ] unit-test
+{ "" } [ "0:" csexp> ] unit-test
+{ V{ } } [ "()" csexp> ] unit-test
+{ V{ "foo" } } [ "(3:foo)" csexp> ] unit-test
+{ V{ "foo" V{ V{ } } "bar" V{ "a" "bb" "" } } } [ "(3:foo(())3:bar(1:a2:bb0:))" csexp> ] unit-test
diff --git a/extra/csexp/csexp.factor b/extra/csexp/csexp.factor
new file mode 100644 (file)
index 0000000..587608b
--- /dev/null
@@ -0,0 +1,54 @@
+USING: kernel namespaces sequences math math.parser strings io io.streams.string ascii combinators ;
+
+IN: csexp
+
+GENERIC: write-csexp ( obj -- )
+
+SINGLETON: end-of-list
+
+ERROR: csexp-error ;
+
+M: string write-csexp
+    dup length number>string write
+    CHAR: : write1
+    write ;
+
+M: sequence write-csexp
+    CHAR: ( write1
+    [ write-csexp ] each
+    CHAR: ) write1 ;
+
+: >csexp ( obj -- string )
+    [ write-csexp ] with-string-writer ;
+
+: digit>num ( digit -- num )
+    CHAR: 0 - ;
+
+: add-digit-to-num ( num digit -- num )
+    [ 10 * ] [ digit>num ] bi* + ;
+
+: read-string ( size -- string )
+    read1 {
+        { [ dup CHAR: : = ] [ drop dup 0 = [ drop "" ] [ read ] if ] }
+        { [ dup digit? ] [ add-digit-to-num read-string ] }
+        [ drop csexp-error ]
+    } cond ;
+
+DEFER: read-csexp-with-eol
+
+: read-list ( acc -- obj )
+    read-csexp-with-eol dup end-of-list? [ drop ] [ over push read-list ] if ;
+
+: read-csexp-with-eol ( -- obj )
+    read1 {
+        { [ dup CHAR: ( = ] [ drop V{ } clone read-list ] }
+        { [ dup CHAR: ) = ] [ drop end-of-list ] }
+        { [ dup digit? ] [ digit>num read-string ] }
+        [ drop csexp-error ]
+    } cond ;
+
+: read-csexp ( -- obj )
+    read-csexp-with-eol dup end-of-list? [ csexp-error ] when ;
+
+: csexp> ( string -- obj )
+    [ read-csexp ] with-string-reader ;
diff --git a/extra/csexp/summary.txt b/extra/csexp/summary.txt
new file mode 100644 (file)
index 0000000..dd8ac2b
--- /dev/null
@@ -0,0 +1 @@
+Csexp (https://www.wikiwand.com/en/Canonical_S-expressions) reader and writer