(load "tester.scm") ; logic expression evaluator ; The expected expressions E are: ; 0, 1, a variable (symbol) ; (not E), (and E ...), (or E ...), (xor E ...), (implies E E) ; ; Evaluate expression exp in environment env ; where the environment is an association list (define (myval exp env) (cond ((isOne exp) 1) ((isZero exp) 0) ((isVar exp) (get-binding exp env)) ((list? exp) (let ((operator (first exp)) (operands (myval-each (rest exp) env))) (cond ((equal? operator 'not) (mynot operands)) ((equal? operator 'and) (myand operands)) ((equal? operator 'or) (myor operands)) ((equal? operator 'xor) (myxor operands)) ((equal? operator 'implies) (myimplies operands)) (else (error "unrecognized expression " exp))))) (else (error "unrecognized expression " exp)))) ; Determine whether exp is a 1, 0, or variable (define (isOne exp) (equal? exp 1)) (define (isZero exp) (equal? exp 0)) (define (isVar exp) (symbol? exp)) ; Compute the 'not operator applied to one argument (define (mynot operands) (cond ((null? operands) (error "not has 0 arguments")) ((null? (rest operands)) (let ((operand (first operands))) (cond ((equal? operand 1) 0) ((equal? operand 0) 1) (else (error "invalid argument to not" operand))))) (else (error "not has more than 1 argument")))) ; Compute the 'and operator applied to any number of arguments (define (myand operands) (foldl (lambda(x y) (if (isZero x) 0 y)) 1 operands)) ; Compute the 'or operator applied to any number of arguments (define (myor operands) (foldl (lambda(x y) (if (isOne x) 1 y)) 0 operands)) ; Compute the 'xor operator applied to any number of arguments (define (myxor operands) (foldl (lambda(x y) (if (isOne x) (if (isOne y) 0 1) (if (isOne y) 1 0))) 0 operands)) ; Compute the 'implies operator, applied to two arguments (define (myimplies operands) (cond ((= 2 (length operands)) (if (isOne (first operands)) (if (isOne (second operands)) 1 0) 1)) (else (error "implies needs 2 arguments" operands)))) ; Evaluate each of a list of expressions in the same environment (define (myval-each exps env) (map (lambda (exp) (myval exp env)) exps)) ; Get the value of a variable in the environment env (define (get-binding var env) (let ( (found (assoc var env)) ) (if found (second found) (error "unbound variable" var)))) ; Bind a variable to a value in an environment, creating a new environment (define (bind var value env) (cons (list var value) env)) ; Bind each variable in a list to a corresponding value, creating a new environment (define (bind-all vars values env) (if (null? vars) env (bind (first vars) (first values) (bind-all (rest vars) (rest values) env)))) (test (myval '0 ()) 0) (test (myval '1 ()) 1) (test (myval '(not 0) ()) 1) (test (myval '(not 1) ()) 0) (test (myval '(not (not 0)) ()) 0) (test (myval '(and 0 0) ()) 0) (test (myval '(and 0 1) ()) 0) (test (myval '(and 1 0) ()) 0) (test (myval '(and 1 1) ()) 1) (test (myval '(or 0 0) ()) 0) (test (myval '(or 0 1) ()) 1) (test (myval '(or 1 0) ()) 1) (test (myval '(or 1 1) ()) 1) (test (myval '(implies 0 0) ()) 1) (test (myval '(implies 0 1) ()) 1) (test (myval '(implies 1 0) ()) 0) (test (myval '(implies 1 1) ()) 1) (test (myval '(xor 0 0) ()) 0) (test (myval '(xor 0 1) ()) 1) (test (myval '(xor 1 0) ()) 1) (test (myval '(xor 1 1) ()) 0) (test (myval '(xor 0 0 0) ()) 0) (test (myval '(xor 0 0 1) ()) 1) (test (myval '(xor 0 1 0) ()) 1) (test (myval '(xor 0 1 1) ()) 0) (test (myval '(xor 1 0 0) ()) 1) (test (myval '(xor 1 0 1) ()) 0) (test (myval '(xor 1 1 0) ()) 0) (test (myval '(xor 1 1 1) ()) 1) (test (myval 'x '((x 0) (y 1))) 0) (test (myval '1 '((x 0) (y 1))) 1) (test (myval '(not x) '((x 0) (y 1))) 1) (test (myval '(not y) '((x 0) (y 1))) 0) (test (myval '(not (not x)) '((x 0) (y 1))) 0) (test (myval '(and x x) '((x 0) (y 1))) 0) (test (myval '(and x y) '((x 0) (y 1))) 0) (test (myval '(and y x) '((x 0) (y 1))) 0) (test (myval '(and y y) '((x 0) (y 1))) 1) (test (myval '(or x x) '((x 0) (y 1))) 0) (test (myval '(or x y) '((x 0) (y 1))) 1) (test (myval '(or 1 0) '((x 0) (y 1))) 1) (test (myval '(or y x) '((x 0) (y 1))) 1) (test (myval '(implies x x) '((x 0) (y 1))) 1) (test (myval '(implies x y) '((x 0) (y 1))) 1) (test (myval '(implies y x) '((x 0) (y 1))) 0) (test (myval '(implies y y) '((x 0) (y 1))) 1) (test (myval '(xor x x) '((x 0) (y 1))) 0) (test (myval '(xor x y) '((x 0) (y 1))) 1) (test (myval '(xor y x) '((x 0) (y 1))) 1) (test (myval '(xor y y) '((x 0) (y 1))) 0) (test (myval '(xor x x x) '((x 0) (y 1))) 0) (test (myval '(xor x x y) '((x 0) (y 1))) 1) (test (myval '(xor x y x) '((x 0) (y 1))) 1) (test (myval '(xor x y y) '((x 0) (y 1))) 0) (test (myval '(xor y x x) '((x 0) (y 1))) 1) (test (myval '(xor y x y) '((x 0) (y 1))) 0) (test (myval '(xor y y x) '((x 0) (y 1))) 0) (test (myval '(xor y y y) '((x 0) (y 1))) 1) (test (myval '(implies x x) (bind 'x 0 (bind 'y 1 ()))) 1) (test (myval '(implies x y) (bind 'x 0 (bind 'y 1 ()))) 1) (test (myval '(implies y x) (bind 'x 0 (bind 'y 1 ()))) 0) (test (myval '(implies y y) (bind 'x 0 (bind 'y 1 ()))) 1) (test (myval '(xor x x x) (bind-all '(x y) '(0 1) ())) 0) (test (myval '(xor x x y) (bind-all '(x y) '(0 1) ())) 1) (test (myval '(xor x y x) (bind-all '(x y) '(0 1) ())) 1) (test (myval '(xor x y y) (bind-all '(x y) '(0 1) ())) 0) (tester 'show)