typed words

extra/bson/reader/reader.factor

@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs bson.constants calendar combinators
 combinators.short-circuit io io.binary kernel math
-namespaces sequences serialize strings vectors ;
+namespaces sequences serialize strings vectors byte-arrays ;
 
 FROM: io.encodings.binary => binary ;
 FROM: io.streams.byte-array => with-byte-reader ;
+FROM: typed => TYPED: ;
 
 IN: bson.reader
 
@@ -20,7 +21,7 @@ TUPLE: state
     { scope vector }
     { elements vector } ;
 
-: (prepare-elements) ( -- elements-vector )
+TYPED: (prepare-elements) ( -- elements-vector: vector )
     V{ } clone [ T_Object "" element boa swap push ] [ ] bi ; inline
 
 : <state> ( exemplar -- state )
@@ -32,37 +33,37 @@ TUPLE: state
     } cleave
     (prepare-elements) >>elements ;
 
-: get-state ( -- state )
+TYPED: get-state ( -- state: state )
     state get ; inline
 
-: read-int32 ( -- int32 )
+TYPED: read-int32 ( -- int32: integer )
     4 read signed-le> ; inline
 
-: read-longlong ( -- longlong )
+TYPED: read-longlong ( -- longlong: integer )
     8 read signed-le> ; inline
 
-: read-double ( -- double )
+TYPED: read-double ( -- double: float )
     8 read le> bits>double ; inline
 
-: read-byte-raw ( -- byte-raw )
+TYPED: read-byte-raw ( -- byte-raw: byte-array )
     1 read ; inline
 
-: read-byte ( -- byte )
+TYPED: read-byte ( -- byte: integer )
     read-byte-raw first ; inline
 
-: read-cstring ( -- string )
+TYPED: read-cstring ( -- string: string )
     "\0" read-until drop >string ; inline
 
-: read-sized-string ( length -- string )
+TYPED: read-sized-string ( length: integer -- string: string )
     read 1 head-slice* >string ; inline
 
-: push-element ( type name state -- )
+TYPED: push-element ( type: integer name: string state: state -- )
     [ element boa ] dip elements>> push ; inline
 
-: pop-element ( state -- element )
+TYPED: pop-element ( state: state -- element: element )
     elements>> pop ; inline
 
-: peek-scope ( state -- ht )
+TYPED: peek-scope ( state: state -- ht )
     scope>> last ; inline
 
 : bson-object-data-read ( -- object )
@@ -70,9 +71,6 @@ TUPLE: state
     [ exemplar>> clone ] [ scope>> ] bi
     [ push ] keep ; inline
 
-: bson-binary-bytes? ( subtype -- ? )
-    T_Binary_Bytes = ; inline
-
 : bson-binary-read ( -- binary )
    read-int32 read-byte 
    {
@@ -82,14 +80,14 @@ TUPLE: state
         [ drop read >string ]
    } case ; inline
 
-: bson-regexp-read ( -- mdbregexp )
+TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp )
    mdbregexp new
    read-cstring >>regexp read-cstring >>options ; inline
 
-: bson-oid-read ( -- oid )
+TYPED: bson-oid-read ( -- oid: oid )
     read-longlong read-int32 oid boa ; inline
 
-: element-data-read ( type -- object )
+TYPED: element-data-read ( type: integer -- object )
     {
         { T_OID [ bson-oid-read ] }
         { T_String [ read-int32 read-sized-string ] }
@@ -104,50 +102,50 @@ TUPLE: state
         { T_NULL [ f ] }
     } case ; inline
 
-: bson-array? ( type -- ? )
+TYPED: bson-array? ( type: integer -- ?: boolean )
     T_Array = ; inline
 
-: bson-object? ( type -- ? )
+TYPED: bson-object? ( type: integer -- ?: boolean )
     T_Object = ; inline
 
 : check-object ( assoc -- object )
     dup dbref-assoc? [ assoc>dbref ] when ; inline
 
-: fix-result ( assoc type -- result )
+TYPED: fix-result ( assoc type: integer -- result )
     {
         { T_Array [ values ] }
         { T_Object [ check-object ] }
     } case ; inline
 
-: end-element ( type -- )
+TYPED: end-element ( type: integer -- )
     { [ bson-object? ] [ bson-array? ] } 1||
     [ get-state pop-element drop ] unless ; inline
 
-: (>state<) ( -- state scope element )
+TYPED: (>state<) ( -- state: state scope: vector element: element )
     get-state [  ] [ scope>> ] [ pop-element ] tri ; inline
 
-: (prepare-result) ( scope element -- result )
+TYPED: (prepare-result) ( scope: vector element: element -- result )
     [ pop ] [ type>> ] bi* fix-result ; inline
 
-: bson-eoo-element-read ( -- cont? )
+: bson-eoo-element-read ( -- cont?: boolean )
     (>state<)
     [ (prepare-result) ] [  ] [ drop empty? ] 2tri
     [ 2drop >>result drop f ]
     [ swap [ name>> ] [ last ] bi* set-at drop t ] if ; inline
 
-: (prepare-object) ( type -- object )
+TYPED: (prepare-object) ( type: integer -- object )
     [ element-data-read ] [ end-element ] bi ; inline
 
-: (read-object) ( type name state -- )
+TYPED: (read-object) ( type: integer name: string state: state -- )
     [ (prepare-object) ] 2dip
     peek-scope set-at ; inline
 
-: bson-not-eoo-element-read ( type -- cont? )
+TYPED: bson-not-eoo-element-read ( type: integer -- cont?: boolean )
     read-cstring get-state
     [ push-element ]
     [ (read-object) t ] 3bi ; inline
 
-: (element-read) ( type -- cont? )
+TYPED: (element-read) ( type: integer -- cont?: boolean )
     dup T_EOO > 
     [ bson-not-eoo-element-read ]
     [ drop bson-eoo-element-read ] if ; inline

extra/bson/writer/writer.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs bson.constants byte-arrays
 calendar combinators.short-circuit fry hashtables io io.binary
-kernel linked-assocs literals math math.parser namespaces
+kernel linked-assocs literals math math.parser namespaces byte-vectors
 quotations sequences serialize strings vectors dlists alien.accessors ;
 FROM: words => word? word ;
 FROM: typed => TYPED: ;
@@ -17,7 +17,7 @@ CONSTANT: INT64-SIZE 8
 
 PRIVATE>
 
-: with-length ( quot: ( -- ) -- bytes-written start-index )
+TYPED: with-length ( quot -- bytes-written: integer start-index: integer )
     [ output-stream get [ length ] [ ] bi ] dip
     call length swap [ - ] keep ; inline
 
@@ -33,26 +33,26 @@ PRIVATE>
     
 <PRIVATE
 
-: write-int32 ( int -- ) INT32-SIZE >le write ; inline
+TYPED: write-int32 ( int: integer -- ) INT32-SIZE >le write ; inline
 
-: write-double ( real -- ) double>bits INT64-SIZE >le write ; inline
+TYPED: write-double ( real: float -- ) double>bits INT64-SIZE >le write ; inline
 
-: write-cstring ( string -- ) B{ } like write 0 write1 ; inline
+TYPED: write-cstring ( string: string -- ) B{ } like write 0 write1 ; inline
 
 : write-longlong ( object -- ) INT64-SIZE >le write ; inline
 
 : write-eoo ( -- ) T_EOO write1 ; inline
 
-: write-header ( name object type -- object )
+TYPED: write-header ( name: string object type: integer -- object )
     write1 [ write-cstring ] dip ; inline
 
 DEFER: write-pair
 
-: write-byte-array ( binary -- )
+TYPED: write-byte-array ( binary: byte-array -- )
     [ length write-int32 ]
     [ T_Binary_Bytes write1 write ] bi ; inline
 
-: write-mdbregexp ( regexp -- )
+TYPED: write-mdbregexp ( regexp: mdbregexp -- )
    [ regexp>> write-cstring ]
    [ options>> write-cstring ] bi ; inline
 
@@ -94,7 +94,7 @@ TYPED: write-string ( string: string -- )
 TYPED: write-boolean ( bool: boolean -- )
     [ 1 write1 ] [ 0 write1 ] if ; inline
 
-: write-pair ( name obj -- )
+TYPED: write-pair ( name: string obj -- )
     {
         {
             [ dup { [ hashtable? ] [ linked-assoc? ] } 1|| ]
@@ -143,12 +143,12 @@ TYPED: write-boolean ( bool: boolean -- )
 
 PRIVATE>
 
-TYPED: assoc>bv ( assoc: hashtables -- byte-vector )
+TYPED: assoc>bv ( assoc: hashtables -- byte-vector: byte-vector )
     [ BV{ } clone dup ] dip '[ _ write-assoc ] with-output-stream* ; inline
 
 TYPED: assoc>stream ( assoc: hashtables -- )
     write-assoc ; inline
 
-: mdb-special-value? ( value -- ? )
+TYPED: mdb-special-value? ( value -- ?: boolean )
    { [ timestamp? ] [ quotation? ] [ mdbregexp? ]
      [ oid? ] [ byte-array? ] } 1|| ; inline