#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))
(define (read-num a)
(if (= (ref->tag a) NUMBER-TAG)
(vector-ref MEMORY (ref->word a))
(error 'number (number->string a))))
(define (read-str a)
(if (= (ref->tag a) STRING-TAG)
(let* ([word (ref->word a)]
[len (vector-ref MEMORY word)]
[start (+ word 1)]
[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")