]> gitweb.factorcode.org Git - factor.git/commitdiff
bare: initial support for Binary Application Record Encoding (BARE)
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 15 Jun 2022 17:51:56 +0000 (10:51 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 15 Jun 2022 17:52:25 +0000 (10:52 -0700)
extra/bare/authors.txt [new file with mode: 0644]
extra/bare/bare-tests.factor [new file with mode: 0644]
extra/bare/bare.factor [new file with mode: 0644]
extra/bare/summary.txt [new file with mode: 0644]

diff --git a/extra/bare/authors.txt b/extra/bare/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/bare/bare-tests.factor b/extra/bare/bare-tests.factor
new file mode 100644 (file)
index 0000000..2e3bded
--- /dev/null
@@ -0,0 +1,643 @@
+USING: bare tools.test ;
+
+! uint
+
+{ 0 } [ B{ 0x00 } uint bare> ] unit-test
+{ B{ 0x00 } } [ 0 uint >bare ] unit-test
+
+{ 1 } [ B{ 0x01 } uint bare> ] unit-test
+{ B{ 0x01 } } [ 1 uint >bare ] unit-test
+
+{ 126 } [ B{ 0x7e } uint bare> ] unit-test
+{ B{ 0x7e } } [ 126 uint >bare ] unit-test
+
+{ 127 } [ B{ 0x7f } uint bare> ] unit-test
+{ B{ 0x7f } } [ 127 uint >bare ] unit-test
+
+{ 128 } [ B{ 0x80 0x01 } uint bare> ] unit-test
+{ B{ 0x80 0x01 } } [ 128 uint >bare ] unit-test
+
+{ 129 } [ B{ 0x81 0x01 } uint bare> ] unit-test
+{ B{ 0x81 0x01 } } [ 129 uint >bare ] unit-test
+
+{ 255 } [ B{ 0xFF 0x01 } uint bare> ] unit-test
+{ B{ 0xFF 0x01 } } [ 255 uint >bare ] unit-test
+
+! int
+
+{ 0 } [ B{ 0x00 } int bare> ] unit-test
+{ B{ 0x00 } } [ 0 int >bare ] unit-test
+
+{ 1 } [ B{ 0x02 } int bare> ] unit-test
+{ B{ 0x02 } } [ 1 int >bare ] unit-test
+
+{ -1 } [ B{ 0x01 } int bare> ] unit-test
+{ B{ 0x01 } } [ -1 int >bare ] unit-test
+
+{ 63 } [ B{ 0x7e } int bare> ] unit-test
+{ B{ 0x7e } } [ 63 int >bare ] unit-test
+
+{ -63 } [ B{ 0x7d } int bare> ] unit-test
+{ B{ 0x7d } } [ -63 int >bare ] unit-test
+
+{ 64 } [ B{ 0x80 0x01 } int bare> ] unit-test
+{ B{ 0x80 0x01 } } [ 64 int >bare ] unit-test
+
+{ -64 } [ B{ 0x7f } int bare> ] unit-test
+{ B{ 0x7f } } [ -64 int >bare ] unit-test
+
+{ 65 } [ B{ 0x82 0x01 } int bare> ] unit-test
+{ B{ 0x82 0x01 } } [ 65 int >bare ] unit-test
+
+{ -65 } [ B{ 0x81 0x01 } int bare> ] unit-test
+{ B{ 0x81 0x01 } } [ -65 int >bare ] unit-test
+
+{ 255 } [ B{ 0xFE 0x03 } int bare> ] unit-test
+{ B{ 0xFE 0x03 } } [ 255 int >bare ] unit-test
+
+{ -255 } [ B{ 0xFD 0x03 } int bare> ] unit-test
+{ B{ 0xFD 0x03 } } [ -255 int >bare ] unit-test
+
+! u32
+
+{ 0 } [ B{ 0x00 0x00 0x00 0x00 } u32 bare> ] unit-test
+{ B{ 0x00 0x00 0x00 0x00 } } [ 0 u32 >bare ] unit-test
+
+{ 1 } [ B{ 0x01 0x00 0x00 0x00 } u32 bare> ] unit-test
+{ B{ 0x01 0x00 0x00 0x00 } } [ 1 u32 >bare ] unit-test
+
+{ 255 } [ B{ 0xFF 0x00 0x00 0x00 } u32 bare> ] unit-test
+{ B{ 0xFF 0x00 0x00 0x00 } } [ 255 u32 >bare ] unit-test
+
+! i16
+
+{ 0 } [ B{ 0x00 0x00 } i16 bare> ] unit-test
+{ B{ 0x00 0x00 } } [ 0 i16 >bare ] unit-test
+
+{ 1 } [ B{ 0x01 0x00 } i16 bare> ] unit-test
+{ B{ 0x01 0x00 } } [ 1 i16 >bare ] unit-test
+
+{ -1 } [ B{ 0xFF 0xFF } i16 bare> ] unit-test
+{ B{ 0xFF 0xFF } } [ -1 i16 >bare ] unit-test
+
+{ 255 } [ B{ 0xFF 0x00 } i16 bare> ] unit-test
+{ B{ 0xFF 0x00 } } [ 255 i16 >bare ] unit-test
+
+{ -255 } [ B{ 0x01 0xFF } i16 bare> ] unit-test
+{ B{ 0x01 0xFF } } [ -255 i16 >bare ] unit-test
+
+! f64
+
+{ 0.0 } [ B{ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 } f64 bare> ] unit-test
+{ B{ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 } } [ 0.0 f64 >bare ] unit-test
+
+{ 1.0 } [ B{ 0x00 0x00 0x00 0x00 0x00 0x00 0xF0 0x3F } f64 bare> ] unit-test
+{ B{ 0x00 0x00 0x00 0x00 0x00 0x00 0xF0 0x3F } } [ 1.0 f64 >bare ] unit-test
+
+{ 2.55 } [ B{ 0x66 0x66 0x66 0x66 0x66 0x66 0x04 0x40 } f64 bare> ] unit-test
+{ B{ 0x66 0x66 0x66 0x66 0x66 0x66 0x04 0x40 } } [ 2.55 f64 >bare ] unit-test
+
+{ -25.5 } [ B{ 0x00 0x00 0x00 0x00 0x00 0x80 0x39 0xC0 } f64 bare> ] unit-test
+{ B{ 0x00 0x00 0x00 0x00 0x00 0x80 0x39 0xC0 } } [ -25.5 f64 >bare ] unit-test
+
+! bool
+
+{ t } [ B{ 0x01 } bool bare> ] unit-test
+{ B{ 0x01 } } [ t bool >bare ] unit-test
+
+{ f } [ B{ 0x00 } bool bare> ] unit-test
+{ B{ 0x00 } } [ f bool >bare ] unit-test
+
+! str
+
+{ "BARE" } [ B{ 0x04 0x42 0x41 0x52 0x45 } str bare> ] unit-test
+{ B{ 0x04 0x42 0x41 0x52 0x45 } } [ "BARE" str >bare ] unit-test
+
+! data
+
+{ B{ 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb } } [
+    B{ 0x10 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb }
+    T{ data } bare>
+] unit-test
+
+{ B{ 0x10 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb } } [
+    B{ 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb }
+    T{ data } >bare
+] unit-test
+
+! data[length]
+
+{ B{ 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb } } [
+    B{ 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb }
+    T{ data f 16 } bare>
+] unit-test
+
+{ B{ 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb } } [
+    B{ 0xaa 0xee 0xff 0xee 0xdd 0xcc 0xbb 0xaa 0xee 0xdd 0xcc 0xbb 0xee 0xdd 0xcc 0xbb }
+    T{ data f 16 } >bare
+] unit-test
+
+! optional<u32>
+
+{ f } [ B{ 0x00 } T{ optional f u32 } bare> ] unit-test
+{ 0 } [ B{ 0x01 0x00 0x00 0x00 0x00 } T{ optional f u32 } bare> ] unit-test
+{ 1 } [ B{ 0x01 0x01 0x00 0x00 0x00 } T{ optional f u32 } bare> ] unit-test
+{ 255 } [ B{ 0x01 0xFF 0x00 0x00 0x00 } T{ optional f u32 } bare> ] unit-test
+
+! list<str>
+
+{ { "foo" "bar" "buzz" } } [
+    B{ 0x03 0x03 0x66 0x6f 0x6f 0x03 0x62 0x61 0x72 0x04 0x62 0x75 0x7A 0x7A }
+    T{ list f str f } bare>
+] unit-test
+
+{ B{ 0x03 0x03 0x66 0x6f 0x6f 0x03 0x62 0x61 0x72 0x04 0x62 0x75 0x7A 0x7A } } [
+    { "foo" "bar" "buzz" } T{ list f str f } >bare
+] unit-test
+
+! list<uint>[10]
+
+{ { 0 1 254 255 256 257 126 127 128 129 } } [
+    B{ 0x00 0x01 0xFE 0x01 0xFF 0x01 0x80 0x02 0x81 0x02 0x7E 0x7F 0x80 0x01 0x81 0x01 }
+    T{ list f uint 10 } bare>
+] unit-test
+
+{ B{ 0x00 0x01 0xFE 0x01 0xFF 0x01 0x80 0x02 0x81 0x02 0x7E 0x7F 0x80 0x01 0x81 0x01 } } [
+    { 0 1 254 255 256 257 126 127 128 129 } T{ list f uint 10 } >bare
+] unit-test
+
+! user types / schema
+
+{
+    [=[ T{ schema
+    { types
+        V{
+            T{ user
+                { name "PublicKey" }
+                { type T{ data { length 128 } } }
+            }
+            T{ user { name "Time" } { type str } }
+            T{ user
+                { name "Department" }
+                { type
+                    T{ enum
+                        { values
+                            V{
+                                { "ACCOUNTING" 0 }
+                                { "ADMINISTRATION" 1 }
+                                { "CUSTOMER_SERVICE" 2 }
+                                { "DEVELOPMENT" 3 }
+                                { "JSMITH" 99 }
+                            }
+                        }
+                    }
+                }
+            }
+            T{ user
+                { name "Address" }
+                { type T{ list { type str } { length 4 } } }
+            }
+            T{ user
+                { name "Customer" }
+                { type
+                    T{ struct
+                        { fields
+                            V{
+                                { "name" str }
+                                { "email" str }
+                                {
+                                    "address"
+                                    T{ user
+                                        { name "Address" }
+                                        { type
+                                            T{ list
+                                                { type str }
+                                                { length 4 }
+                                            }
+                                        }
+                                    }
+                                }
+                                {
+                                    "orders"
+                                    T{ list
+                                        { type
+                                            T{ struct
+                                                { fields
+                                                    V{
+                                                        {
+                                                            "orderId"
+                                                            i64
+                                                        }
+                                                        {
+                                                            "quantity"
+                                                            i32
+                                                        }
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                }
+                                {
+                                    "metadata"
+                                    T{ map
+                                        { from str }
+                                        { to T{ data } }
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+            T{ user
+                { name "Employee" }
+                { type
+                    T{ struct
+                        { fields
+                            V{
+                                { "name" str }
+                                { "email" str }
+                                {
+                                    "address"
+                                    T{ user
+                                        { name "Address" }
+                                        { type
+                                            T{ list
+                                                { type str }
+                                                { length 4 }
+                                            }
+                                        }
+                                    }
+                                }
+                                {
+                                    "department"
+                                    T{ user
+                                        { name "Department" }
+                                        { type
+                                            T{ enum
+                                                { values
+                                                    V{
+                                                        {
+                                                            "ACCOUNTING"
+                                                            0
+                                                        }
+                                                        {
+                                                            "ADMINISTRATION"
+                                                            1
+                                                        }
+                                                        {
+                                                            "CUSTOMER_SERVICE"
+                                                            2
+                                                        }
+                                                        {
+                                                            "DEVELOPMENT"
+                                                            3
+                                                        }
+                                                        {
+                                                            "JSMITH"
+                                                            99
+                                                        }
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                }
+                                {
+                                    "hireDate"
+                                    T{ user
+                                        { name "Time" }
+                                        { type str }
+                                    }
+                                }
+                                {
+                                    "publicKey"
+                                    T{ optional
+                                        { type
+                                            T{ user
+                                                { name
+                                                    "PublicKey"
+                                                }
+                                                { type
+                                                    T{ data
+                                                        { length
+                                                            128
+                                                        }
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                }
+                                {
+                                    "metadata"
+                                    T{ map
+                                        { from str }
+                                        { to T{ data } }
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+            T{ user
+                { name "TerminatedEmployee" }
+                { type void }
+            }
+            T{ user
+                { name "Person" }
+                { type
+                    T{ union
+                        { members
+                            V{
+                                {
+                                    T{ user
+                                        { name "Customer" }
+                                        { type
+                                            T{ struct
+                                                { fields
+                                                    V{
+                                                        {
+                                                            "name"
+                                                            str
+                                                        }
+                                                        {
+                                                            "email"
+                                                            str
+                                                        }
+                                                        {
+                                                            "address"
+                                                            T{
+                                                            user
+                                                                {
+                                                                name
+                                                                    "Address"
+                                                                }
+                                                                {
+                                                                type
+                                                                    T{
+                                                                    list
+                                                                        {
+                                                                        type
+                                                                            str
+                                                                        }
+                                                                        {
+                                                                        length
+                                                                            4
+                                                                        }
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                        {
+                                                            "orders"
+                                                            T{
+                                                            list
+                                                                {
+                                                                type
+                                                                    T{
+                                                                    struct
+                                                                        {
+                                                                        fields
+                                                                            V{
+                                                                                {
+                                                                                    "orderId"
+                                                                                    i64
+                                                                                }
+                                                                                {
+                                                                                    "quantity"
+                                                                                    i32
+                                                                                }
+                                                                            }
+                                                                        }
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                        {
+                                                            "metadata"
+                                                            T{
+                                                            map
+                                                                {
+                                                                from
+                                                                    str
+                                                                }
+                                                                {
+                                                                to
+                                                                    T{
+                                                                    data
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                    0
+                                }
+                                {
+                                    T{ user
+                                        { name "Employee" }
+                                        { type
+                                            T{ struct
+                                                { fields
+                                                    V{
+                                                        {
+                                                            "name"
+                                                            str
+                                                        }
+                                                        {
+                                                            "email"
+                                                            str
+                                                        }
+                                                        {
+                                                            "address"
+                                                            T{
+                                                            user
+                                                                {
+                                                                name
+                                                                    "Address"
+                                                                }
+                                                                {
+                                                                type
+                                                                    T{
+                                                                    list
+                                                                        {
+                                                                        type
+                                                                            str
+                                                                        }
+                                                                        {
+                                                                        length
+                                                                            4
+                                                                        }
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                        {
+                                                            "department"
+                                                            T{
+                                                            user
+                                                                {
+                                                                name
+                                                                    "Department"
+                                                                }
+                                                                {
+                                                                type
+                                                                    T{
+                                                                    enum
+                                                                        {
+                                                                        values
+                                                                            V{
+                                                                                {
+                                                                                    "ACCOUNTING"
+                                                                                    0
+                                                                                }
+                                                                                {
+                                                                                    "ADMINISTRATION"
+                                                                                    1
+                                                                                }
+                                                                                {
+                                                                                    "CUSTOMER_SERVICE"
+                                                                                    2
+                                                                                }
+                                                                                {
+                                                                                    "DEVELOPMENT"
+                                                                                    3
+                                                                                }
+                                                                                {
+                                                                                    "JSMITH"
+                                                                                    99
+                                                                                }
+                                                                            }
+                                                                        }
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                        {
+                                                            "hireDate"
+                                                            T{
+                                                            user
+                                                                {
+                                                                name
+                                                                    "Time"
+                                                                }
+                                                                {
+                                                                type
+                                                                    str
+                                                                }
+                                                            }
+                                                        }
+                                                        {
+                                                            "publicKey"
+                                                            T{
+                                                            optional
+                                                                {
+                                                                type
+                                                                    T{
+                                                                    user
+                                                                        {
+                                                                        name
+                                                                            "PublicKey"
+                                                                        }
+                                                                        {
+                                                                        type
+                                                                            T{
+                                                                            data
+                                                                                {
+                                                                                length
+                                                                                    128
+                                                                                }
+                                                                            }
+                                                                        }
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                        {
+                                                            "metadata"
+                                                            T{
+                                                            map
+                                                                {
+                                                                from
+                                                                    str
+                                                                }
+                                                                {
+                                                                to
+                                                                    T{
+                                                                    data
+                                                                    }
+                                                                }
+                                                            }
+                                                        }
+                                                    }
+                                                }
+                                            }
+                                        }
+                                    }
+                                    1
+                                }
+                                {
+                                    T{ user
+                                        { name
+                                            "TerminatedEmployee"
+                                        }
+                                        { type void }
+                                    }
+                                    2
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+}]=]
+} [
+    [=[ type PublicKey data[128]
+type Time str # ISO 8601
+
+type Department enum {
+  ACCOUNTING
+  ADMINISTRATION
+  CUSTOMER_SERVICE
+  DEVELOPMENT
+
+  # Reserved for the CEO
+  JSMITH = 99
+}
+
+type Address list<str>[4] # street, city, state, country
+
+type Customer struct {
+  name: str
+  email: str
+  address: Address
+  orders: list<struct {
+    orderId: i64
+    quantity: i32
+  }>
+  metadata: map<str><data>
+}
+
+type Employee struct {
+  name: str
+  email: str
+  address: Address
+  department: Department
+  hireDate: Time
+  publicKey: optional<PublicKey>
+  metadata: map<str><data>
+}
+
+type TerminatedEmployee void
+
+type Person union {Customer | Employee | TerminatedEmployee}
+]=] parse-schema [ unparse ] without-limits
+] unit-test
diff --git a/extra/bare/bare.factor b/extra/bare/bare.factor
new file mode 100644 (file)
index 0000000..e18d6cf
--- /dev/null
@@ -0,0 +1,225 @@
+! Copyright (C) 2022 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors arrays assocs bare combinators endian
+hashtables io io.encodings.binary io.encodings.string
+io.encodings.utf8 io.streams.byte-array kernel math math.parser
+multiline namespaces parser peg peg.ebnf sequences
+sequences.deep strings vectors words words.constant ;
+
+IN: bare
+
+SINGLETONS: uint ;
+SINGLETONS: int ;
+SINGLETONS: u8 u16 u32 u64 ;
+SINGLETONS: i8 i16 i32 i64 ;
+SINGLETONS: f32 f64 ;
+SINGLETONS: bool ;
+SINGLETONS: str ;
+TUPLE: data length ;
+SINGLETONS: void ;
+TUPLE: enum values ;
+TUPLE: optional type ;
+TUPLE: list type length ;
+TUPLE: map from to ;
+TUPLE: union members ;
+TUPLE: struct fields ;
+TUPLE: user name type ;
+TUPLE: schema types ;
+
+GENERIC: write-bare ( obj schema -- )
+
+M: uint write-bare
+    drop [ dup 0x80 >= ] [
+        [ 0x7f bitand 0x80 bitor write1 ] [ -7 shift ] bi
+    ] while write1 ;
+
+M: int write-bare
+    drop 2 * dup 0 < [ neg 1 - ] when uint write-bare ;
+
+M: u8 write-bare drop write1 ;
+M: u16 write-bare drop 2 >le write ;
+M: u32 write-bare drop 4 >le write ;
+M: u64 write-bare drop 8 >le write ;
+
+M: i8 write-bare drop 1 >le write ;
+M: i16 write-bare drop 2 >le write ;
+M: i32 write-bare drop 4 >le write ;
+M: i64 write-bare drop 8 >le write ;
+
+M: f32 write-bare drop float>bits u32 write-bare ;
+M: f64 write-bare drop double>bits u64 write-bare ;
+
+M: bool write-bare drop >boolean 1 0 ? u8 write-bare ;
+
+M: str write-bare drop utf8 encode T{ data f f } write-bare ;
+
+M: data write-bare
+    length>> [ dup length uint write-bare ] unless write ;
+
+M: void write-bare 2drop ;
+
+M: enum write-bare values>> at uint write-bare ;
+
+M: optional write-bare
+    over 1 0 ? u8 write-bare
+    '[ _ type>> write-bare ] when* ;
+
+M: list write-bare
+    [ length>> [ dup length uint write-bare ] unless ]
+    [ type>> '[ _ write-bare ] each ] bi ;
+
+GENERIC: read-bare ( schema -- obj )
+
+M: uint read-bare
+    drop 0 0 [
+        read1
+        [ 0x7f bitand rot [ 7 * shift bitor ] keep 1 + swap ]
+        [ 0x80 bitand zero? not ] bi
+    ] loop nip ;
+
+M: int read-bare
+    drop uint read-bare dup odd? [ 1 + neg ] when 2 /i ;
+
+M: u8 read-bare drop read1 ;
+M: u16 read-bare drop 2 read le> ;
+M: u32 read-bare drop 4 read le> ;
+M: u64 read-bare drop 8 read le> ;
+
+M: i8 read-bare drop 1 read signed-le> ;
+M: i16 read-bare drop 2 read signed-le> ;
+M: i32 read-bare drop 4 read signed-le> ;
+M: i64 read-bare drop 8 read signed-le> ;
+
+M: f32 read-bare drop 4 read le> bits>float ;
+M: f64 read-bare drop 8 read le> bits>double ;
+
+M: bool read-bare
+    drop read1 {
+        { 0 [ f ] }
+        { 1 [ t ] }
+        [ throw ]
+    } case ;
+
+M: str read-bare drop T{ data f f } read-bare utf8 decode ;
+
+M: data read-bare
+    length>> [ read ] [ uint read-bare read ] if* ;
+
+M: void read-bare drop f ; ! XXX: this isn't right
+
+M: enum read-bare [ uint read-bare ] dip value-at ;
+
+M: optional read-bare
+    u8 read-bare 1 = [ type>> read-bare ] [ drop f ] if ;
+
+M: list read-bare
+    [ length>> [ uint read-bare ] unless* ]
+    [ type>> '[ _ read-bare ] replicate ] bi ;
+
+M: union read-bare
+    [ uint read-bare ] dip members>> value-at read-bare ;
+
+: >bare ( obj schema -- encoded )
+    binary [ write-bare ] with-byte-writer ;
+
+: bare> ( encoded schema -- obj )
+    swap binary [ read-bare ] with-byte-reader ;
+
+ERROR: invalid-schema ;
+
+ERROR: unknown-type name ;
+
+<PRIVATE
+
+: assign-values ( alist -- alist' )
+    0 swap [
+        [ [ drop ] 2dip swap over ] [ over ] if* [ 1 + ] 2dip
+    ] assoc-map nip ;
+
+SYMBOL: user-types
+
+EBNF: (parse-schema) [=[
+
+space     = [ \t\n]
+comment   = "#" [^\n]* "\n"?
+ws        = ((space | comment)*)~
+upper     = [A-Z]
+alpha     = [A-Za-z]
+digit     = [0-9]
+number    = digit+                        => [[ string>number ]]
+
+length    =  ws "["~ ws number ws "]"~
+
+type      =  ws "<"~ ws any-type ws ">"~
+
+uint      = "uint"                        => [[ uint ]]
+u8        = "u8"                          => [[ u8 ]]
+u16       = "u16"                         => [[ u16 ]]
+u32       = "u32"                         => [[ u32 ]]
+u64       = "u64"                         => [[ u64 ]]
+
+int       = "int"                         => [[ int ]]
+i8        = "i8"                          => [[ i8 ]]
+i16       = "i16"                         => [[ i16 ]]
+i32       = "i32"                         => [[ i32 ]]
+i64       = "i64"                         => [[ i64 ]]
+
+f32       = "f32"                         => [[ f32 ]]
+f64       = "f64"                         => [[ f64 ]]
+
+bool      = "bool"                        => [[ bool ]]
+str       = "str"                         => [[ str ]]
+data      = "data"~ length?               => [[ data boa ]]
+void      = "void"                        => [[ void ]]
+
+enum-values = enum-value (ws enum-value)* => [[ first2 swap prefix ]]
+enum-value = enum-value-name (ws "="~ ws number)?
+enum-value-name = upper (upper|digit|[_])* => [[ first2 swap prefix >string ]]
+enum      = "enum"~ ws "{"~ ws enum-values ws "}"~
+          => [[ assign-values enum boa ]]
+
+uints     = uint|u8|u16|u32|u64
+ints      = int|i8|i16|i32|i64
+floats    = f32|f64
+primitive = uints|ints|floats|bool|str|data|void|enum
+
+optional  = "optional"~ type              => [[ optional boa ]]
+list      = "list"~ type length?          => [[ first2 list boa ]]
+map       = "map"~ type type              => [[ first2 bare:map boa ]]
+
+struct-field-name = alpha+                => [[ >string ]]
+struct-field = struct-field-name ws ":"~ ws any-type => [[ >array ]]
+struct-fields = struct-field (ws struct-field)* => [[ first2 swap prefix ]]
+struct    = "struct"~ ws "{"~ ws~ struct-fields ws "}"~
+          => [[ struct boa ]]
+
+union-members = union-member (ws "|"~ ws union-member)* => [[ first2 swap prefix ]]
+union-member  = any-type (ws "="~ ws number)? => [[ >array ]]
+union     = "union"~ ws "{"~ (ws|"|")~ ws union-members ws ("|"|ws)~ "}"~
+          => [[ assign-values union boa ]]
+
+aggregate = optional|list|map|struct|union
+
+defined   = user-type-name => [[ user-types get ?at [ unknown-type ] unless ]]
+
+any-type  = aggregate|primitive|defined
+
+user-type-name = (alpha|digit)+     => [[ >string ]]
+user-type = "type"~ ws user-type-name ws any-type
+          => [[ first2 [ user boa dup ] 2keep drop user-types [ ?set-at ] change ]]
+
+user-types = user-type (ws user-type)* => [[ first2 swap prefix ]]
+schema = ws user-types ws => [[ schema boa ]]
+
+]=]
+
+PRIVATE>
+
+: parse-schema ( string -- schema )
+    H{ } clone user-types [ (parse-schema) ] with-variable ;
+
+SYNTAX: SCHEMA:
+    scan-object parse-schema types>> [
+        [ create-word-in dup reset-generic ] dip define-constant
+    ] assoc-each ;
diff --git a/extra/bare/summary.txt b/extra/bare/summary.txt
new file mode 100644 (file)
index 0000000..6326f79
--- /dev/null
@@ -0,0 +1 @@
+BARE (https://baremessages.org) encoding/decoding.