--- /dev/null
+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
--- /dev/null
+! 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 ;