Commits

Anonymous committed 40eb43f

Implement some decoding routines: read-atom, read-small-int, read-int.

Comments (0)

Files changed (1)

src/scheme-bert.ss

              ((isbyte? num)
               (write-1 outpr SMALL_INT)
               (write-1 outpr num))
-             ((and (<= num MAX_INT) (>= num MIN_INT))
+             ((and (>= num MIN_INT) (<= num MAX_INT))
               (write-1 outpr INT)
               (write-4 outpr num))
              (else (write-bignum outpr num))))         
            (let-values (((a b) (hashtable-entries hash)))
              (write-any-raw 
               outpr
-              (vector 
-               'bert
-               'dict
-               (vector->list
-                (vector-map 
-                 (lambda (k v) (vector (convert k) (convert v)))
-                 a
-                 b))))))         
+              (vector 'bert 'dict
+                      (vector->list 
+                       (vector-map
+                        (lambda (k v) (vector (convert k) (convert v)))
+                        a b))))))
          
          (define (write-any-raw outpr obj)
            (cond
              (define (frac1 sign expon frac)
                (let ((b (make-bytevector 8)))
                  (bytevector-u64-native-set! b 0
-                  (bor (bsl (bor (bsl sign 11) FLOAT_BIAS) 52) frac))
+                                             (bor (bsl (bor (bsl sign 11) FLOAT_BIAS) 52) frac))
                  (bytevector-ieee-double-native-ref b 0)))
              (let-values (((sign expon frac) (funpack float)))
                (cond
          
          (define (insert-decimal-exp place s)
            (let* ((s0 (if (= (string-length s) 1) "0"
-                         (substring s 1)))
-                 (e  (if (< place 1) "e-" "e+"))
-                 (t (- 20 (string-length s0)))
-                 (s1 (if (not (zero? t))
-                     (string-append s0 (make-string t #\0))
-                     s0)))
+                          (substring s 1)))
+                  (e  (if (< place 1) "e-" "e+"))
+                  (t (- 20 (string-length s0)))
+                  (s1 (if (not (zero? t))
+                          (string-append s0 (make-string t #\0))
+                          s0)))
              (string-append (substring s 0 1) "." s1 e 
                             (number->string (abs (- place 1))))))
          
                       (fdig (flonum->digits float f1 e1))
                       (place (car fdig))
                       (digits (cdr fdig))
-                      (res (map (lambda(x)(integer->char (+ x #x30))) digits))
-                      (strdigits (list->string res)))
+                      (r (map (lambda(x)(integer->char (+ x #x30))) digits))
+                      (strdigits (list->string r)))
                  (string-append (if (< float 0) "-" "")                                
                                 (insert-decimal-exp place strdigits)))))
          
                            (scale (* f be 4) 4 (* be 2) be 0 round? round? v)))
                      (if (or (= e min-e) (not (= f bp-1)))
                          (scale (* f 2) (expt 2 (- 1 e)) 1 1 0 round? round? v)
-                         (scale (* f 4) (expt 2 (- 2 e)) 2 1 0 round? round? v)))))))
+                         (scale (* f 4) (expt 2 (- 2 e)) 2 1 0 
+                                round? round? v)))))))
          
          (define scale
            (lambda (r s m+ m- k low-ok? high-ok? v)
                          (list (+ d 1)))
                      (if (not tc2)
                          (list d)
-                         (if (< (* r 2) s)
-                             (list d)
-                             (list (+ d 1)))))))))
+                         (if (< (* r 2) s) (list d) (list (+ d 1)))))))))
          
          (define expt10
            (let ([table (make-vector 326)])
              (lambda (x)
                (* (log x) f))))
          
+         ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+         ;; Decoder part
          
-         ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-         ;; Test cases
+         (define (decode bytes)
+           (read-any (open-bytevector-input-port bytes)))
          
-         (define (test-1)
-           ; {foo,42,666,{12,[],{255,'Bar'},111222333444555666}}
-           (if (equal? (encode (vector 'foo 42 666 (vector 12 '() (vector 255 'bar) 111222333444555666))) (u8-list->bytevector '(131 104 4 100 0 3 102 111 111 97 42 98 0 0 2 154 104 4 97 12 106 104 2 97 255 100 0 3 98 97 114 110 8 0 146 131 13 124 31 36 139 1)))
-               #t
-               (display "test-1: failed\n")))
+         (define (read-any inp)
+           (if (eq? (read-1 inp) MAGIC)
+               (read-any-raw inp)
+               (error "read-any" "Bad Magic")))
          
-         (define (test-2)
-           ; {bert,dict,[{two,2},{one,1},{three,3}]}
-           (let ((h (make-eqv-hashtable)))
-             (hashtable-set! h 1 'one)
-             (hashtable-set! h 2 'two)
-             (hashtable-set! h 3 'three)
-             (if (equal? (encode h) (u8-list->bytevector '(131 104 3 100 0 4 98 101 114 116 100 0 4 100 105 99 116 108 0 0 0 3 104 2 97 2 100 0 3 116 119 111 104 2 97 1 100 0 3 111 110 101 104 2 97 3 100 0 5 116 104 114 101 101 106)))
-                 #t
-                 (display "test-2: failed\n"))))
+         (define (read-any-raw inp)
+           (let ((tag (read-1 inp)))
+             (cond
+               ((eq? tag ATOM) (read-atom inp))
+               ((eq? tag SMALL_INT) (read-small-int inp))
+               ((eq? tag INT) (read-int inp))
+               (else
+                (error "read-any-raw"
+                       (string-append 
+                        "Unknown term tag: "
+                        (number->string tag)))))))
          
-         (define (test-3)
-           ; {bert, time, erlang:now()}
-           (if (equal? (encode (make-time time-utc 234389000 1281880551))
-                       (u8-list->bytevector '(131 104 5 100 0 4 98 101 114 116 100 0 4 116 105 109 101 98 0 0 5 1 98 0 13 111 167 98 0 3 147 149)))
-               #t
-               (display "test-3: failed\n")))
+         (define (read-1 inp)
+           (get-u8 inp))
          
-         (define (test)
-           (if (and (test-1) (test-2) (test-3))
-               (display "test: OK. All tests passed successfully.")
-               (display "test: Error. Some tests failed."))
-           (newline)))
+         (define (read-2 inp)
+           (bor (bsl (get-u8 inp) 8)
+                (get-u8 inp)))
+         
+         (define (read-4 inp)
+           (bytevector-s32-ref (get-bytevector-n inp 4) 0 (endianness big)))
+         
+         (define (read-str inp length)
+           (bytevector->string (get-bytevector-n inp length) 
+                               (native-transcoder)))
+         
+         (define (read-atom inp)
+           (let ((len (read-2 inp)))
+             (string->symbol (read-str inp len))))
+         
+         (define (read-small-int inp)
+           (read-1 inp))
+         
+         (define (read-int inp)
+           (read-4 inp))         
+         )