#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))]))

(require (typed-in racket/base
                   [quotient : (Number Number -> Number)]))

(define NUMBER-TAG 2) ; 10 binary
(define STRING-TAG 1) ; 01 binary

(define (ref->tag ref)
  (modulo ref 4))

(define (ref->word loc)
  (quotient loc 4))

(define (tag-word word tag)
  (+ tag (* 4 word)))

(let ([str-ref (tag-word 0 STRING-TAG)]
      [num-ref (tag-word 7 NUMBER-TAG)])
  (begin
    (test (ref->tag str-ref) STRING-TAG)
    (test (ref->word str-ref) 0)
    (test (ref->tag num-ref) NUMBER-TAG)
    (test (ref->word num-ref) 7)))

(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 (store-str s)
  (let ([a0 (write-and-bump (string-length s))])
    (begin
      (map write-and-bump
           (map char->integer (string->list s)))
      (tag-word a0 STRING-TAG))))

(define (store-num n)
  (tag-word (write-and-bump n) NUMBER-TAG))

(let ([str-ref (store-str "hello")]
      [num-ref (store-num 42)])
  (begin
    (reset)
    (test (ref->tag str-ref) STRING-TAG)
    (test (ref->tag num-ref) NUMBER-TAG)
    (test (vector-copy MEMORY (ref->word str-ref) 7)
          '#(5 104 101 108 108 111 42))
  ))