#lang pl 04

;; Defining two new types
(define-type BIT = (U 0 1))
(define-type Bit-List = (Listof BIT))

;; The actual interpreter
#| BNF for the ROL language:

 <ROL> ::= { reg-len = <num> <RegE>}

 <RegE> ::= <Bits>
          | {and <RegE> <RegE>}
          | {or <RegE> <RegE>}
          | {shl <RegE>}
          | {with {<id> <RegE>} <RegE>}
          | {fun { <id> } <RegE>}
          | {call <RegE> <RegE>}
          | <id>

 <Bits> ::= 0
          | 1
          | {<Bits>}

 |#
(define-type RegE
  [Reg Bit-List]
  [And RegE RegE]
  [Or RegE RegE]
  [Shl RegE]
  [Id Symbol]
  [With Symbol RegE RegE]
  [Fun Symbol RegE]
  [Call RegE RegE] )
;; Next is a technical function that converts (casts)
;; (any) list into a bit-list. We use it in parse-sexpr.
(: list->bit-list : (Listof Any) -> Bit-List)
;; to cast a list of bits as a bit-list
(define (list->bit-list lst)
  (cond [(null? lst) null]
        [(eq? (first lst) 1)
         (cons 1 (list->bit-list (rest lst)))]
        [else (cons 0 (list->bit-list (rest lst)))]))

(: parse-sexpr : Sexpr -> RegE)
;; to convert the main s-expression into ROL
(define (parse-sexpr sexpr)
  (match sexpr
    []
    < --fill in-- > ;; remember to make sure specified register length is at least 1
    [else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
(: parse-sexpr-RegL : Sexpr Number -> RegE)
;; to convert s-expressions into RegEs
(define (parse-sexpr-RegL sexpr reg-len)
  (match sexpr
    [(list (and a (or 1 0)) ... ) (< --fill in-- >
                                     (error 'parse-sexpr "wrong number of bits in ~s" a))]
    [< --fill in-- >]
    [< --fill in-- >]
    …
    [< --fill in-- >]
    [else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
(: parse : String -> RegE)
;; parses a string containing a RegE expression to a RegE AST
(define (parse str)
  (parse-sexpr (string->sexpr str)))


;; tests
(test (run "{ reg-len = 4 {1 0 0 0}}") => '(1 0 0 0))
(test (run "{ reg-len = 4 {shl {1 0 0 0}}}") => '(0 0 0 1))
(test (run "{ reg-len = 4 {and {shl {1 0 1 0}}{shl {1 0 1 0}}}}") => '(0 1 0 1))
(test (run "{ reg-len = 4 { or {and {shl {1 0 1 0}} {shl {1 0 0 1}}} {1 0 1 0}}}") => '(1 0 1 1))
(test (run "{ reg-len = 2 { or {and {shl {1 0}} {1 0}} {1 0}}}") => '(1 0))
(test (run "{ reg-len = 4 {with {x {1 1 1 1}} {shl y}}}") =error> "free identifier")
(test (run "{ reg-len = 2 { with {x { or {and {shl {1 0}} {1 0}} {1 0}}} {shl x}}}") => '(0 1))
(test (run "{ reg-len = 4 {or {1 1 1 1} {0 1 1}}}") =error>"wrong number of bits in")
(test (run "{ reg-len = 0 {}}") =error> "Register length must be at least 1")
(test (run "{ reg-len = 3 {with {identity {fun {x} x}} {with {foo {fun {x} {or x {1 1 0}}}} {call {call identity foo} {0 1 0}}}}}"))