UNB/ CS/ David Bremner/ teaching/ cs4613/ lectures/ lecture10/ memcalc9.rkt
#lang plait
(require (typed-in racket/base
                   [char->integer : (Char -> Number)]
                   [integer->char : (Number -> Char)]
                   [number->string : (Number -> String)]
                   [vector->list : ((Vectorof Number) -> (Listof Number))])
         (typed-in racket/vector
                   [vector-copy : ((Vectorof Number) Number Number -> (Vectorof Number))]))

(define MEMORY (make-vector 100 -1))
(define next-addr 0)
(define (reset) (set! next-addr 0))
(define (write-and-bump v)
  (let ([n next-addr])
    (begin
      (vector-set! MEMORY n v)
      (set! next-addr (add1 next-addr))
      n)))

(define NUMBER-TAG 1337)
(define STRING-TAG 5712)

(define (store-str s)
  (let ([a0 (write-and-bump STRING-TAG)])
    (begin
      (write-and-bump (string-length s))
      (map write-and-bump
           (map char->integer (string->list s)))
      a0)))

(test (begin (reset) (store-str "hello")
             (vector-copy MEMORY 0 7))
      '#(5712 5 104 101 108 108 111))

(define (store-num n)
  (let ([a0 (write-and-bump NUMBER-TAG)])
    (begin
      (write-and-bump n)
      a0)))

(define (read-str a)
  (if (= (vector-ref MEMORY a) STRING-TAG)
      (let* ([len (vector-ref MEMORY (+ a 1))]
             [start (+ a 2)]
             [end (+ start len)]
             [slice (vector-copy MEMORY start end)]
             [lst (vector->list slice)])
        (list->string (map integer->char lst)))
      (error 'string (number->string a))))

(test (read-str (store-str "hello-world")) "hello-world")
(test/exn (read-str (store-num 42)) "string")