learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-7.scm (3073B)


      1 (define-library (sicp solutions chapter-4 exercise-7)
      2   (import (scheme base)
      3           (ice-9 match))
      4 
      5   (begin
      6     (define (eval exp env)
      7       (cond ((self-evaluating? exp) exp)
      8             ((variable? exp) (lookup-variable-value exp env))
      9             ((quoted? exp) (text-of-quotation exp))
     10             ((assignment? exp) (eval-assignment exp env))
     11             ((definition? exp) (eval-definition exp env))
     12             ((if? exp) (eval-if exp env))
     13             ((lambda? exp)
     14              (make-procedure (lambda-parameters exp)
     15                              (lambda-body exp)
     16                              env))
     17             ((begin? exp)
     18              (eval-sequence (begin-actions exp) env))
     19             ((cond? exp) (eval (cond->if exp) env))
     20             ((let? exp) (eval (let->combination exp) env))
     21             ((let*? exp) (eval (let*->nested-lets exp) env))
     22             ((application? exp)
     23              (apply (eval (operator exp) env)
     24                     (list-of-values (operands exp) env)))
     25             (else
     26              (error "Unknown expression type -- EVAL" exp))))
     27 
     28     (define (let*? exp) (eqv? (car exp) 'let*))
     29 
     30     (let*->combination '(let* () a b c))
     31     (let*->combination '(let* ((a (b)) (c (d))) 1))
     32 
     33     (define (let*->combination exp)
     34       (match exp
     35         (`(let* () ,first-code-expression . ,rest-of-code-expressions)
     36          `(begin ,first-code-expression
     37                  ,@rest-of-code-expressions))
     38         (`(let* ((,variable-name ,variable-expression))
     39             ,first-code-expression . ,rest-of-code-expressions)
     40          `((lambda (,variable-name)
     41              ,first-code-expression
     42              ,@rest-of-code-expressions)
     43            ,variable-expression))
     44         (`(let* ((,variable-name ,variable-expression) . ,rest-of-variables)
     45             ,first-code-expression . ,rest-of-code-expressions)
     46          (let ((inner
     47                 (let*->combination `(let* ,rest-of-variables
     48                                       ,first-code-expression
     49                                       ,@rest-of-code-expressions))))
     50            `((lambda (,variable-name)
     51                ,inner)
     52              ,variable-expression)))))
     53 
     54     (let*->nested-lets '(let* () a b c))
     55     (let*->nested-lets '(let* ((a (b)) (c (d))) 1 2 3))
     56 
     57     (define (let*->nested-lets exp)
     58       (match exp
     59         (`(let* () ,first-code-expression . ,rest-of-code-expressions)
     60          `(begin ,first-code-expression
     61                  ,@rest-of-code-expressions))
     62         (`(let* ((,variable-name ,variable-expression))
     63             ,first-code-expression . ,rest-of-code-expressions)
     64          `(let ((,variable-name ,variable-expression))
     65             ,first-code-expression
     66             ,@rest-of-code-expressions))
     67         (`(let* ((,variable-name ,variable-expression) . ,rest-of-variables)
     68             ,first-code-expression . ,rest-of-code-expressions)
     69          `(let ((,variable-name ,variable-expression))
     70             ,(let*->nested-lets
     71              `(let* ,rest-of-variables
     72                ,first-code-expression
     73                ,@rest-of-code-expressions))))))))