LittleSchemerCh10 created by bkachinthay - https://repl.it/@bkachinthay/LittleSchemerCh10

LittleSchemerCh10.sc

;pair functions
(define first
  (lambda (pair)
    (car pair)))

(define second
  (lambda (pair)
    (car (cdr pair))))

(define build
  (lambda (x y)
    (cons x (cons y '()))))

;entry builder
(define new-entry build)

(new-entry '(a b c) '(1 1 1))

;entry look up function
; (define look-up-entry
;   (lambda (name entry)
;     (cond
;       ; ((null? (first entry)) entry)
;       ((eq? (car (first entry)) name)
;             (car (second entry)))
;       (else
;         (look-up-entry
;               name
;               (build (cdr (first entry)) (cdr (second entry))))))))
; (look-up-entry 'c '((a b c) (1 2 2)))

(define look-up-entry-help
  (lambda (name names values entry-f)
    (cond
      ((null? names) (entry-f name))
      ((eq? (car names) name) (car values))
      (else (look-up-entry-help
              name
              (cdr names)
              (cdr values)
              entry-f)))))

(define look-up-entry
  (lambda (name entry entry-f)
    (look-up-entry-help
      name
      (first entry)
      (second entry)
      entry-f)))

(look-up-entry 'entree '((appetizer entree beverage)
(food tastes good)) (lambda (x) (x)))

(look-up-entry 'dessert '((appetizer entree beverage)
(food tastes good)) (lambda (x) x))

; extend table
(define extend-table cons)

(define look-up-table
  (lambda (name table entry-f)
    (cond
      ((null? table) (entry-f name))
      (else (look-up-entry
              name
              (car table)
              (lambda (name)
                (look-up-table
                name
                (cdr table)
                entry-f
                )))))))

(look-up-table 'entree '(((tree dessert)
(spaghetti spumoni))
(( appetizer entree beverage)
(food tastes good))) (lambda (x) x))

(define atom?
  (lambda (x)
    (and (not (null? x)) (not (pair? x)))))

(define expression-to-action
  (lambda (e)
    (cond
      ((atom? e) (atom-to-action e))
      (else (list-to-action e)))))

(define atom-to-action
  (lambda (e)
    (cond
      ((number? e) *const)
      ((eq? e #t) *const)
      ((eq? e #f) *const)
      ((eq? e (quote cons)) *const)
      ((eq? e (quote car)) *const)
      ((eq? e (quote cdr)) *const)
      ((eq? e (quote null)) *const)
      ((eq? e (quote eq?)) *const)
      ((eq? e (quote atom?)) *const)
      ((eq? e (quote zero?)) *const)
      ((eq? e (quote add1)) *const)
      ((eq? e (quote sub1)) *const)
      ((eq? e (quote number?)) *const)
      (else *identifier))))

; ((atom-to-action 'cons) 'a '())

(define list-to-action
  (lambda (e)
    (cond
      ((atom? (car e))
      (cond
        ((eq? (car e) 'quote) *quote)
        ((eq? (car e) 'lambda) *lambda)
        ((eq? (car e) 'cond) *cond)
        (else *application)))
      (else *application))))

(define meaning
  (lambda (e table)
    ((expression-to-action e) e table)))

(define value
  (lambda (e)
    (meaning e '())))

(define const*
  (lambda (e table)
    (cond
      ((number? e) e)
      ((eq? e #t) #t)
      ((eq? e #f) #f)
      (else (build (quote primitive) e)))))

(define *quote
  (lambda (e table)
    (second e)))

(define *identifier
  (lambda (e table)
    (look-up-table e table (lambda (x) x))))

(define *lambda
  (lambda (e table)
    (build 'non-primitive
      (cons table (cdr e)))))

(meaning '(lambda (x) (cons x y)) '(((y z) ((8) 9))))

(define third
  (lambda (l)
    (car (cdr (cdr l)))))

(define table-of first)
(define formals-of second)
(define body-of third)

(define else?
  (lambda (q)
    (cond
      ((atom? q) (eq? 'else q))
      (else #f))))

(define question-of first)
(define answer-of second)

(define evcon
  (lambda (lines table)
    (cond
      ((else? (question-of (car lines)))
         (meaning (answer-of (car lines)) table))
      ((meaning (question-of (car lines)))
         (meaning (answer-of (cdr lines)) table))
      (else (evcon (cdr lines) table)))))

(define cond-lines-of cdr)

(define *cond
  (lambda (e table)
    (evcon (cond-lines-of e) table)))

(define evlis
  (lambda (args table)
    (cond
      ((null? args) '())
      (else (cons
              (meaning (car args) table)
              (evlis (cdr args) table))))))

(define function-of car)
(define arguments-of cdr)

(define *application
  (lambda (e table)
    (apply
      (meaning (function-of e) table)
      (meaning (arguments-of e) table))))
    
(define primitive?
  (lambda (l)
    (eq? (cdr l) 'primitive)))

(define non-primitive?
  (lambda (l)
    (eq? (cdr l) 'non-primitive)))

(define apply
  (lambda (fun vals)
    (cond
      ((primitive? fun)
         (apply-primitive (second fun) vals))
      ((non-primitive? fun)
         (apply-closure (second fun) vals)))))