the-little-schemer/chapter-10/code.scm

;; ============
;; INTRODUCTION
;; ============

;; This chapter deals with the writing of a simple interpreter for
;; S-expressions.

;; =============
;; PREREQUISITES
;; =============

(define first car)
(define second cadr)
(define third caddr)
(define build list)


;; ===============
;; CODE OF CHAPTER
;; ===============

(define new-entry build)

(define lookup-in-entry
  (lambda (name entry lookup-fallback-proc)
    (lookup-in-entry-helper name
                            (first entry)
                            (second entry)
                            lookup-fallback-proc)))

(define lookup-in-entry-helper
  (lambda (name keys values lookup-fallback-proc)
    (cond
     [(null? keys) (lookup-fallback-proc name)]
     [(eq? name (car keys)) (car values)]
     [else
      (lookup-in-entry-helper name
                              (cdr keys)
                              (cdr values)
                              lookup-fallback-proc)])))

(define extend-table cons)

(define new-table
  (lambda (entry)
    (extend-table entry '())))

(define lookup-in-table
  (lambda (name table lookup-failure-proc)
    (cond
     [(null? table) (lookup-failure-proc name)]
     [else
      (lookup-in-entry name
                       (car table)
                       ;; fallback will be to look up the name in the rest of
                       ;; the table
                       (lambda (name)
                         (lookup-in-table name
                                          (cdr table)
                                          ;; the failure proc is retained, to be
                                          ;; called when there are no more
                                          ;; entries to continue the lookup in
                                          lookup-failure-proc)))])))

;; 6 types:

;; const
;; quote
;; identifier
;; lambda
;; cond
;; application

;; An action is a representation of a type (???).
;; An S-expression is either an atom or a list.
;; -> There are 2 cases to distinguish, when transforming an S-expression to an action.

;; Given code:

(define expression-to-action
  (lambda (expr)
    (cond
     [(atom? expr)
      (atom-to-action expr)]
     [else
      (list-to-action expr)])))

;; =====
;; Task: Define `atom-to-action`.
;; =====
(define atom-to-action
  (lambda (#|atom|# a)
    (cond
     [(number? a) *const]
     [(eq? a #t) *const]
     [(eq? a #f) *const]
     [(eq? a 'cons) *const]
     [(eq? a 'car) *const]
     [(eq? a 'cdr) *const]
     [(eq? a 'null?) *const]
     [(eq? a 'eq?) *const]
     [(eq? a 'atom?) *const]
     [(eq? a 'zero?) *const]
     [(eq? a 'add1) *const]
     [(eq? a 'sub1) *const]
     [(eq? a 'number?) *const]
     [else *identifier])))

;; =====
;; Task: Define `list-to-action`.
;; =====
(define list-to-action
  (lambda (#|list|# l)
    (cond
     [(atom? (car l))
      (cond
       [(eq? (car l) 'quote) *quote]
       [(eq? (car l) 'lambda) *lambda]
       [(eq? (car l) 'cond) *cond]
       [else *application])]
     [else *application])))

;; Given code:
(define value
  (lambda (expr)
    ;; Q: Why is there an empty list as an argument here?
    ;; A: This is an empty table! This means that the meaning of something is
    ;; the meaning it has in some table.
    (meaning expr '())))

;; The procedure `meaning` is only a tool for figuring out what action to take
;; next.

(define meaning
  (lambda (expr table)
    ;; Apply the result of `expression-to-action` to the expression and a table.
    ;; Actions seem to be what calculates a result of an expression.
    ;; Those actions are not yet defined.

    ;; For example this could be:
    ;; ((expression-to-action '(cdr '(1 2 3))) '(cdr (x y z))
    ;;                                         '(((x y z)
    ;;                                            (1 2 3))))
    ;; ≡
    ;; (*application '(cdr (x y z))
    ;;               '(((x y z)
    ;;                  (1 2 3))))
    ((expression-to-action expr) expr table)))

;; Thought: It is weird to name `meaning` `meaning`, if it calculates the result
;; of some expression, as "meaning" is not necessarily something itself.

;; Some "actions" do not really need the given table.
(define *const
  (lambda (expr table)
    (cond
     [(number? expr) expr]
     [(eq? expr #t) #t]
     [(eq? expr #f) #f]
     [else
      (build 'primitive expr)])))

(define *quote
  (lambda (expr table)
    (text-of expr)))

;; =====
;; Task: Define `text-of`.
;; =====
(define text-of second)

;; Explanation: Something quoted has the form `(quote something)`, so the second
;; part is the quoted thing. But why name it its "text"?

(define *identifier
  (lambda (expr table)
    ;; An identifier's meaning depends on the environment or table it is defined
    ;; in.
    (lookup-in-table expr
                     table
                     ;; Not sure why the lambda is named `initial-table`.
                     ;; I was not sure what to put here.
                     initial-table)))

;; The book gives a definition of `initial-table` then:
;; Given code:
(define initial-table
  (lambda (name)
    (car '())))
;; Which will result in an error.

;; Given code:
(define *lambda
  (lambda (the-lambda table)
    (build 'non-primitive
           (cons table
                 ;; The cdr of a lambda expression is its argument list and a
                 ;; body.
                 (cdr the-lambda)))))

#|
(meaning (lambda (x) (cons x y))
         (((y z) ((8) 9))))

is

(*lambda (lambda (x) (cons x y))
         (((y z) ((8) 9))))

is

(build 'non-primitive
       ((((y z) ((8) 9)))
        (x)
        (cons x y)))

|#

;; =====
;; Task: Write table-of, formals-of and body-of.
;; =====
(define table-of first)
(define formals-of second)
(define body-of third)

;; Writing a function for evaluating a cond expression. This can be done,
;; because we now have code that evaluates code and thus is one level above the
;; evaluated code. This is why we do only need a normal function to evaluate a
;; cond expression. A macro is basically the same thing as such one level above
;; code, because it processes the code before it is run.

;; Also note, that cond is not an *application. As the book continues to
;; explain, in an *application expression, all the arguments must be evaluated,
;; before the application can be done.

(define evaluate-cond-q-and-a-lines
  (lambda (q-and-a-lines table)
    ;; When evaluating a cond expression, we in turn rely on cond in our
    ;; one-level-above language. This cond is not necessarily the same as the
    ;; cond in the code we are processing.
    (cond
     ;; Check for an else-branch. In this case evaluate the answer part.
     [(else? (question-of (car q-and-a-lines)))
      (meaning (answer-of (car q-and-a-lines)))]
     ;; If there is a normal question, then it needs to be evaluated, to get its
     ;; boolean return value.
     [(meaning (question-of (car q-and-a-lines)))
      (meaning (answer-of (car q-and-a-lines)))]
     ;; Otherwise consider the next question answer pair.
     [else
      (evaluate-cond-q-and-a-lines (cdr q-and-a-lines) table)])))

;; =====
;; Task: Write `else?`, `question-of` and `answer-of`.
;; =====
(define else?
  (lambda (something)
    ;; The book includes a check for `atom?`. I am not sure why this is
    ;; necessary, if we already check whether `something` is equal to the symbol
    ;; `else`.
    (eq? something 'else)))
(define question-of first)
(define answer-of second)

;; =====
;; Task: Write the *cond action.
;; =====
(define *cond
  (lambda (cond-expr table)
    (evaluate-cond-q-and-a-lines (cond-q-and-a-lines-of cond-expr) table)))

;; not only `second`, as there is possibly a list of cond-q-and-a-lines.
(define cond-q-and-a-lines-of cdr)

;; =====
;; Task: Write a function evaluate-list.
;; =====

(define evaluate-list
  (lambda (list-expression table)
    (cond
     ;; If the list is empty, then the result is also empty.
     [(null? list-expression) '()]
     [else
      (cons (meaning (car list-expression) table)
            (evaluate-list (cdr list-expression) table))])))

;; This will "reduce" the list elements (arguments), so that they are ready to
;; have the function applied to them.

(define *application
  (lambda (expr table)
    (apply
     ;; get the identifier or lambda-expression of the application
     (meaning (function-of expr) table)
     ;; get the arguments of the application
     (meaning (arguments-of expr) table))))

;; An input to *application could be:

;; (*application '(cdr (x y z))
;;               '(((x y z)
;;                  (1 2 3))))

;; Which would be calculated as follows:

;; (*application '(cdr (x y z))
;;               '(((x y z)
;;                  (1 2 3))))
;; ≡
;; (*application '(cdr (x y z))
;;               '(((x y z)
;;                  (1 2 3))))

;; =====
;; Task: Write `function-of` and `arguments-of`.
;; =====

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

;; The book distinguishes between primitives and non-primitives as types of
;; functions, where primitives are the ones, which need to already be defined in
;; our language to construct non-primitives from them. The functions are marked
;; as primitives or non-primitives by putting a tag (a symbol) in an expression,
;; which represents a primitive or a non-primitive. It is tagged data.

;; We can see this being put in our implementation of *lambda and *const. In the
;; predicates `primitive?` and `non-primitive?` we look for those markers.

(define primitive?
  (lambda (sth)
    (eq? (first sth) 'primitive)))

(define non-primitive?
  (lambda (sth)
    (eq? (first sth) 'non-primitive)))

;; Now we define `apply` as follows:

(define apply
  (lambda (func args)
    ;; Depending on whether a procedure is a primitive or a non-primitive, the
    ;; application happens in different ways.
    (cond
     [(primitive? func)
      ;; first of func is the tag for primitive or non-primitive.
      ;; '(primitive func-name args)
      (apply-primitive (second func) args)]
     [(non-primitive? func)
      (apply-closure (second func) args)])))

;; Q: But now how do we implement `apply-primitive` and `apply-closure`?!

;; A: The book gives the following definition with gaps to fill in:

;; =====
;; Task: Fill the gaps.
;; =====

;; Explanation: The whole time we were writing procedures to evaluate lists, which represent
;; programs. This `apply-primitive` procedure is all about understanding, what kind of expression we
;; have to evaluate and then do the transformation, which leads to the evaluation result on our
;; one-level-above language. For example, if we find a `car`, then we need to get the first element
;; of the list that is in `vals`. This is what we do in our one-level-above language. The result is
;; returned as a value, which is reinserted into the evaluated language's context.

(define apply-primitive
  (lambda (name vals)
    (cond
     [(eq? name #| here was a gap |# cons)
      (cons (first vals) (second vals))]

     [(eq? name 'car)
      (car (first vals))]

     [(eq? name 'cdr)
      (#| here was a gap |# ... (first vals))]

     [(eq? name 'null?)
      (null? (first vals))]

     [(eq? name 'eq?)
      (#| here was a gap |# ... (first vals) #| here was a gap |# ...)]

     [(eq? name 'atom?)
      (#| here was a gap |# ... (first vals))]

     [(eq? name 'zero?)
      (zero? (first vals))]

     [(eq? name 'add1)
      (+ (first vals) 1)]

     [(eq? name 'sub1)
      (- (first vals) 1)]

     [(eq? name 'number?)
      (number? (first vals))])))