#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 exp2), and (or exp1 exp2)
; 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 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 the true destination.

(struct instruction (addr op dest))

; Tests for legal simple expression, from http://ranger.uta.edu/~weems/NOTES3302/LAB2SPR13/lab2spr13.symbol.rkt
(define (first x) (car x))

(define (second x) (car (cdr x)))

(define (exp? x)
  (cond
    ((eq? x 'x) #t)
    ((not (pair? x)) #f)
    ((eq? (first x) 'not) (and (pair? (cdr x))
                               (exp? (second x))
                               (null? (cdr (cdr x)))))
    ((eq? (first x) 'or) (and (expList? (cdr x))
                              (= (length (cdr x)) 2)))
    ((eq? (first x) 'and) (and (expList? (cdr x))
                               (= (length (cdr x)) 2)))
    (else #f)))

; Tests arguments to boolean operators or and and, from http://ranger.uta.edu/~weems/NOTES3302/LAB2SPR13/lab2spr13.symbol.rkt
(define (expList? x)
  (cond
    ((not (pair? x)) #f)
    ((exp? (car x)) (or (null? (cdr x))
                        (expList? (cdr x))))
    (else #f)))

(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.
    (cond
      ((eq? exp 'x)
       (set! current (- current 1)) ; next x will be to the left - so decrement
       (cond ; compile appropriately for "fall through" if branch is not taken
         ((= (+ 1 current) trueDest)
          (list (instruction current 'brF falseDest)))  ; trueDest is the next instruction
         (else
          (list (instruction current 'brT trueDest))))) ; falseDest is the next instruction
      ((eq? (car exp) 'not) ; just swaps the false and true destinations
       (helper (cadr exp) falseDest trueDest))
      ((eq? (car exp) 'and)
       (let 
           ((right (helper (caddr exp) trueDest falseDest))) ; first operand was true
         (append (helper (cadr exp) current falseDest)       ; still need second operand true
                 right)))
      ((eq? (car exp) 'or)
       (let 
           ((right (helper (caddr exp) trueDest falseDest))) ; first operand was false
         (append (helper (cadr exp) trueDest current)        ; second chance to get second operand true
                 right)))
      (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)))
           (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)
               (if (eq? (instruction-op (car program)) 'brT)
                   (if (eq? (car data) 'T)
                       (instruction-dest (car program))
                       (+ 1 pc))
                   (if (eq? (car data) 'F) ; must be a brF
                       (instruction-dest (car program))
                       (+ 1 pc)))))))
  (displayln data)
  (helper program data 0))

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

(define (scLuser exp data)
  (displayln exp)
  (cond
    ((not (exp? exp)) "Not an expression")
    ((not (= (operandCount exp) (length data))) "Bad T/F/D list")
    (else
     (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 '(and (or x x) (or x x)) '(F T F T))