#lang racket

; Compiles a propositional expression for short-circuit evaluation
; 0. Syntax (not checked) - an S-exp
;    a. x corresponds to referencing a boolean value.
;    b. (not exp), (and exp1 ... expn), and (or exp1 ... expn)
; 1. A boolean expression has its references counted.  These references
;    are implicitly numbered starting from 0.  References are indicated by x.
; 2. Compiled to a branching program like lab 3 fall 12 EXCEPT that compilation is
;    right-before-left for and/or.
; 3. The program is applied to a lat with T, F, and D (true, false, die) values to be matched up with the x's.  
;    Conceptually, these are numbered left-to-right starting with 0 - which also maps to the
;    instruction's addresses.
; 4. Exactly one of the entire expression's true and false destinations must be an address equal
;    to the number of references.  The convention is to make this address the true destination.

; Supports and/or with arbitrary number of subexpressions - must have at least one
; Supports if (?:, if-then-else, ite) by including binary branch instruction for interpreter

(struct instruction (addr op dest op-dest)) ; address op-code destination1 destination2

(define (operandCount exp) ; Just counts the references, i.e. x
  (cond
    ((null? exp) 0)
    ((pair? exp) (+ (operandCount (car exp)) (operandCount (cdr exp))))
    ((eq? exp 'x) 1)
    (else 0)))

(define (compile exp)
  (define current (operandCount exp)) ; For numbering each x, always has number of last processed x.
  (define (helper exp trueDest falseDest) ; If exp evaluates true then goto trueDest, else falseDest.
    (define (and explist)
      (cond
        ((null? (cdr explist))  ; last subexpression
         (helper (car explist) trueDest falseDest))
        (else
         (let ((right (and (cdr explist))))  ; get instructions for subexpressions to right
           (append (helper (car explist) current falseDest) ; prepend instructions this subexpression
                   right)))))
    (define (or explist)
      (cond
        ((null? (cdr explist))  ; last subexpression
         (helper (car explist) trueDest falseDest))
        (else
         (let ((right (or (cdr explist))))  ; get instructions for subexpressions to right
           (append (helper (car explist) trueDest current) ; prepend instructions this subexpression
                   right)))))
    (cond
      ((eq? exp 'x)
       (set! current (- current 1)) ; next x will be to the left - so decrement
       (cond ; compile appropriately for "fall through"
         ((= (+ 1 current) trueDest)
          (list (instruction current 'brF falseDest -1)))  ; trueDest is the next instruction
         ((= (+ 1 current) falseDest)
          (list (instruction current 'brT trueDest -1)))   ; falseDest is the next instruction
         (else
          (list (instruction current 'br2 trueDest falseDest)))))  ; fall-thru doesn't apply
      ((eq? (car exp) 'not) ; just swaps the false and true destinations
       (helper (cadr exp) falseDest trueDest))
      ((eq? (car exp) 'and) (and (cdr exp)))
      ((eq? (car exp) 'or) (or (cdr exp)))
      ((eq? (car exp) 'if)
       (let ((elsepart (helper (cadddr exp) trueDest falseDest))
             (elsestart current)
             (thenpart (helper (caddr exp) trueDest falseDest)))
         (append (helper (cadr exp) current elsestart)
                 thenpart
                 elsepart)))
      (else "syntax error")))
  (helper exp current (+ 1 current)))

(define (listing code)
  (cond
    ((null? code) '())
    (else
     (cons (list (instruction-addr (car code))
                 (instruction-op (car code))
                 (instruction-dest (car code))
                 (instruction-op-dest (car code)))
           (listing (cdr code))))))

(define (interpret program data)
  (define (helper program data pc)
    (cond
      ((null? program)
       (list "terminate at" pc))
      ((null? data) "out of data")
      ((> pc (instruction-addr (car program)))
       (helper (cdr program) (cdr data) pc))
      ((eq? (car data) 'D)
       (display "At state ")
       (displayln pc)
       "Die")
      (else
       (display "At state ")
       (displayln pc)
       (helper (cdr program)
               (cdr data)
               (cond
                 ((eq? (instruction-op (car program)) 'brT)
                  (if (eq? (car data) 'T)
                      (instruction-dest (car program))
                      (+ 1 pc)))
                 ((eq? (instruction-op (car program)) 'brF)
                  (if (eq? (car data) 'F)
                      (instruction-dest (car program))
                      (+ 1 pc)))
                 (else
                  (if (eq? (car data) 'T)
                      (instruction-dest (car program))
                      (instruction-op-dest (car program)))))))))
  (displayln data)
  (helper program data 0))

(define (sc exp data)
  (displayln exp)
  (let ((code (compile exp)))
    (displayln (listing code))
    (interpret code data)))

(sc '(and x x) '(F F))

(sc '(or x x) '(F F))

(sc '(not x) '(F))

(sc '(not (or (or x x) (and x x))) '(F D F D))

(sc '(and (and (and x x) (and x x)) (and (or x x) (or x x)))
    '(T T F F F T T F))

(sc '(not (or (or (not x) (not x)) (not (and x x))))
    '(T T T T))

(sc '(not (and (not (and x x)) (or (not x) (not x))))
    '(F D T D))

(sc '(not (and x x x x x)) '(F F F F F))

(sc '(or (not x) (not x) (not x) (not x) (not x)) '(F F F F F))

(sc '(not (or x x x x x)) '(F F F F F))

(sc '(and (not x) (not x) (not x) (not x) (not x)) '(F F F F F))

(sc '(and
      (or x (not x) x)
      (not (or x x x))
      (not (and x x x)))
    '(T T T T T T T T T))

(sc '(if x x x) '(T F T))

(sc '(if (if x x x) (if x x x) (if x x x)) '(T T T T T T T T T))

(sc '(if (not (if x x x)) (not (if x x x)) (not (if x x x))) '(F F F F F F F F F))

(sc '(if (and x x) (or x x) (and x x)) '(T T T T T T))

(sc '(if (not (or (not x) (not x))) (not (and (not x) (not x))) (not (or (not x) (not x)))) '(T T T T T T))