#lang plait
(define-type Exp
  [boolE (b : Boolean)]
  [numE (n : Number)]
  [equalE (l : Exp) (r : Exp)]
  [condE (clauses : (Listof (Exp * Exp))) (else-exp : Exp)])

(define-type Type
  [boolT]
  [numT])

(define (check-clauses clauses type) ....)

(define (typecheck exp)
  (type-case Exp exp
    [(boolE b) (boolT)]
    [(numE n) (numT)]
    [(equalE l r)
     (let ([l-t (typecheck l)]
           [r-t (typecheck r)])
       (cond
         [(equal? l-t r-t) (boolT)]
         [else (error 'typecheck "type mismatch")]))]
    [(condE clauses else-exp) (check-clauses clauses (typecheck else-exp))]
    ))

(module+ test
  (test/exn (typecheck (equalE (numE 1) (boolE #t))) "mismatch"))

(module+ test
  (test (typecheck (condE empty (numE 42))) (numT))
  (test (typecheck (condE (list (pair (equalE (numE 42) (numE 3)) (numE 1))
                                (pair (boolE #t) (numE 2))) (numE 3))) (numT))
  (test/exn
   (typecheck (condE (list (pair (numE 3) (numE 1))) (numE 3))) "boolean")
  (test/exn (typecheck
             (condE (list (pair (equalE (numE 42) (numE 3)) (numE 1))
                          (pair (boolE #t) (boolE #f))) (numE 3)))
            "mismatch"))

(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-type MExp
  [num (n : Number)]
  [str (s : String)]
  [plus (l : MExp) (r : MExp)])

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

(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-num n)
  (let ([a0 (write-and-bump NUMBER-TAG)])
    (begin
      (write-and-bump n)
      a0)))

(define (read-num a)
  (if (= (vector-ref MEMORY a) NUMBER-TAG)
      (vector-ref MEMORY (add1 a))
      (error 'number (number->string a))))

(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)))

(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))))

(define-type-alias Value Number)
(define numV store-num)
(define strV store-str)

(define (num+ la ra)
  (store-num (+ (read-num la) (read-num ra))))

(define (str++ la ra)
  (store-str (string-append (read-str la) (read-str ra))))

(define (calc e)
  (type-case MExp e
    [(num n) (numV n)]
    [(str s) (strV s)]
    [(plus l r) ....]))

(module+ test
  (test (read-num
         (calc (plus (num 1) (plus (num 2) (num 3))))) 6)
  (test (read-str
         (calc (plus (str "hello")
                     (plus (str " ") (str "world"))))) "hello world")
  (test/exn
   (calc (plus (str "hello") (num 2))) "mismatch")
  (test/exn
   (calc (plus (num 1) (str " world"))) "mismatch")
  )

(module+ test
  (test (begin (reset!) next-addr) 0)
  (test/exn (read-str (store-num 42)) "string")
  (test/exn (read-num (store-str "hello")) "number"))