Commits

Anonymous committed 4a2b7dd

Vectors are mapped to tuples during encoding.

Comments (0)

Files changed (4)

encode.ss

-(module encode scheme 
-  ;(require scheme/tcp)
-  ;(require scheme/mpair)
-  (require rnrs/bytevectors-6)
-  (require rnrs/io/ports-6)
-  
-  (require "types.ss")
-  
-  (define (write-1 outpr byte)
-    (put-u8 outpr byte))
-  
-  (define (write-2 outpr short)
-    (put-bytevector outpr (integer->integer-bytes short 2 #t #t)))
-  
-  (define (write-4 outpr long)
-    (put-bytevector outpr (integer->integer-bytes long 4 #t #t)))
-  
-  (define (write-list outpr data)
-    (cond
-      [(empty? data)
-       (write-1 outpr NIL)]
-      [(andmap (lambda (x) (byte? x)) data)
-       (write-1 outpr STRING)
-       (write-2 outpr (length data))
-       (for-each (lambda (x) (write-1 outpr x)) data)]
-      [else (write-1 outpr LIST)
-            (write-4 outpr (length data))
-            (for-each (lambda (x) (write-any-raw outpr x)) data)
-            (write-1 outpr NIL)]))
-  
-  (define (write-fixnum outpr num)
-    (cond
-      [(byte? num)
-       (write-1 outpr SMALL_INT)
-       (write-1 outpr num)]
-      [(and (<= num MAX_INT) (>= num MIN_INT))
-       (write-1 outpr INT)
-       (write-4 outpr num)]
-      [else (write-bignum outpr num)]))
-  
-  (define (write-bignum outpr num)
-    (let ([n (ceiling (/ (integer-length num) 8))])
-      (if (< n 256)
-          (begin
-            (write-1 outpr SMALL_BIGNUM)
-            (write-1 outpr n))
-          (begin
-            (write-1 outpr LARGE_BIGNUM)
-            (write-4 n)))
-      (write-bignum-guts outpr num)))
-  
-  (define (write-bignum-guts outpr num)
-    (define (wr-b num)
-      (if (zero? num)
-          'ok
-          (begin
-            (write-1 outpr (modulo num 256))
-            (wr-bn (arithmetic-shift num -8)))))   
-    (if (num . < . 0)
-        (write-1 outpr 1)
-        (write-1 outpr 0))
-    (wr-b (abs num))
-    )
-  
-  (define (write-any-raw outpr obj)
-    (cond
-      [(list? obj)
-       (write-list outpr obj)]
-      [(integer? obj)
-       (write-fixnum outpr obj)]
-      [else (error "write-any-raw: Not implemented.\n")]))
-  
-  (define (write-any obj)
-    (let-values ([(outpr extr-proc) (open-bytevector-output-port)])
-      (write-1 outpr MAGIC)
-      (write-any-raw outpr obj)
-      (bytevector->u8-list (extr-proc)))))
+(module encode scheme 
+  ;(require scheme/tcp)
+  ;(require scheme/mpair)
+  (require rnrs/bytevectors-6)
+  (require rnrs/io/ports-6)
+  
+  (require "types.ss")
+  
+  (define (write-1 outpr byte)
+    (put-u8 outpr byte))
+  
+  (define (write-2 outpr short)
+    (put-bytevector outpr (integer->integer-bytes short 2 #t #t)))
+  
+  (define (write-4 outpr long)
+    (put-bytevector outpr (integer->integer-bytes long 4 #t #t)))
+  
+  (define (write-list outpr data)
+    (cond
+      [(empty? data)
+       (write-1 outpr NIL)]
+      [(andmap (lambda (x) (byte? x)) data)
+       (write-1 outpr STRING)
+       (write-2 outpr (length data))
+       (for-each (lambda (x) (write-1 outpr x)) data)]
+      [else (write-1 outpr LIST)
+            (write-4 outpr (length data))
+            (for-each (lambda (x) (write-any-raw outpr x)) data)
+            (write-1 outpr NIL)]))
+  
+  (define (write-tuple outpr data)
+    (let ([len (vector-length data)])
+      (if (< len 256)
+          (begin
+            (write-1 outpr SMALL_TUPLE)
+            (write-1 outpr len))
+          (begin
+            (write-1 outpr LARGE_TUPLE)
+            (write-4 outpr len)))
+      (let vector-for-each ([position 0])
+        (if (= position len)
+            'ok
+            (begin
+              (write-1 outpr (vector-ref data position))
+              (vector-for-each (+ position 1)))))))
+  
+  (define (write-fixnum outpr num)
+    (cond
+      [(byte? num)
+       (write-1 outpr SMALL_INT)
+       (write-1 outpr num)]
+      [(and (<= num MAX_INT) (>= num MIN_INT))
+       (write-1 outpr INT)
+       (write-4 outpr num)]
+      [else (write-bignum outpr num)]))
+  
+  (define (write-bignum outpr num)
+    (let ([n (ceiling (/ (integer-length num) 8))])
+      (if (< n 256)
+          (begin
+            (write-1 outpr SMALL_BIGNUM)
+            (write-1 outpr n))
+          (begin
+            (write-1 outpr LARGE_BIGNUM)
+            (write-4 n)))
+      (write-bignum-guts outpr num)))
+  
+  (define (write-bignum-guts outpr num)
+    (define (wr-b num)
+      (if (zero? num)
+          'ok
+          (begin
+            (write-1 outpr (modulo num 256))
+            (wr-b (arithmetic-shift num -8)))))   
+    (if (num . < . 0)
+        (write-1 outpr 1)
+        (write-1 outpr 0))
+    (wr-b (abs num))
+    )
+  
+  (define (write-any-raw outpr obj)
+    (cond
+      [(list? obj)
+       (write-list outpr obj)]
+      [(integer? obj)
+       (write-fixnum outpr obj)]
+      [(vector? obj)
+       (write-tuple outpr obj)]
+      [else (error "write-any-raw: Not implemented.")]))
+  
+  (define (write-any obj)
+    (let-values ([(outpr extr-proc) (open-bytevector-output-port)])
+      (write-1 outpr MAGIC)
+      (write-any-raw outpr obj)
+      (bytevector->u8-list (extr-proc)))))
+(module types scheme
+        (provide SMALL_INT
+                 INT
+                 SMALL_BIGNUM
+                 LARGE_BIGNUM
+                 FLOAT
+                 ATOM
+                 SMALL_TUPLE
+                 LARGE_TUPLE
+                 NIL
+                 STRING
+                 LIST
+                 BIN
+                 FUN
+                 NEW_FUN
+                 MAGIC
+                 MAX_INT
+                 MIN_INT
+                 )
+        (define SMALL_INT 97)
+        (define INT 98)
+        (define SMALL_BIGNUM 110)
+        (define LARGE_BIGNUM 111)
+        (define FLOAT 99)
+        (define ATOM 100)
+        (define SMALL_TUPLE 104)
+        (define LARGE_TUPLE 105)
+        (define NIL 106)
+        (define STRING 107)
+        (define LIST 108)
+        (define BIN 109)
+        (define FUN 117)
+        (define NEW_FUN 112)
+        (define MAGIC 131)
+        (define MAX_INT (- (arithmetic-shift 1 27) 1))
+        (define MIN_INT (- (arithmetic-shift 1 27)))
+        )
+

types.ss

-(module types scheme
-        (provide SMALL_INT
-                 INT
-                 SMALL_BIGNUM
-                 LARGE_BIGNUM
-                 FLOAT
-                 ATOM
-                 SMALL_TUPLE
-                 LARGE_TUPLE
-                 NIL
-                 STRING
-                 LIST
-                 BIN
-                 FUN
-                 NEW_FUN
-                 MAGIC
-                 MAX_INT
-                 MIN_INT
-                 )
-        (define SMALL_INT 97)
-        (define INT 98)
-        (define SMALL_BIGNUM 110)
-        (define LARGE_BIGNUM 111)
-        (define FLOAT 99)
-        (define ATOM 100)
-        (define SMALL_TUPLE 104)
-        (define LARGE_TUPLE 105)
-        (define NIL 106)
-        (define STRING 107)
-        (define LIST 108)
-        (define BIN 109)
-        (define FUN 117)
-        (define NEW_FUN 112)
-        (define MAGIC 131)
-        (define MAX_INT (- (arithmetic-shift 1 27) 1))
-        (define MIN_INT (- (arithmetic-shift 1 27)))
-        )
-