# Scheme0 Source Code

From the book Compiling Lambda Calculus

Provided under the Creative Commons Zero (CC0) licence

```; Scheme_0 compiler/interpreter, classic model
; By Nils M Holm, 2016, 2018
;
; Provided under the Creative Common Zero (CC0) license
; (https://creativecommons.org/publicdomain/zero/1.0/)
;
; From the book COMPILING LAMBDA CALCULUS, http://t3x.org/clc/

; Examples: (comp '(((lambda (x) (lambda (y) (cons x y))) 'x) 'y))
;           (evcomp '(((lambda (x) (lambda (y) (cons x y))) 'x) 'y))

(define version 0)```

## Compiler

```(define (comp x)

(define (comp-expr x t)
(cond ((not (pair? x))
x)
((eq? 'quote (car x))
((eq? 'lambda (car x))
((eq? 'if (car x))
(else
`(,(if t '%tail-apply '%apply)
,@(map (lambda (x)
(comp-expr x #f))
x)))))

(comp-expr x #f))
```

## Interpreter / Abstract Machine

```(define (eval x)

(define E
'((cons  . %cons)
(car   . %car)
(cdr   . %cdr)
(pair? . %pair?)
(null? . %null?)))

(define S '())

(define (bind v a e)
(cons (cons v a) e))

(define (make-fun x)

(define (push x)
(set! S (cons x S)))

(define (cleanup)
(set! S (cddr S)))

(define *primitives*
'(%cons
%car
%cdr
%pair?
%null?))

(define (primitive? x)
(and (memq x *primitives*) #t))

(define (ev-apply-prim fn a)
(cond ((eq? '%cons fn)
(cons (ev (car a)) (ev (cadr a))))
((eq? '%car fn)
(car (ev (car a))))
((eq? '%cdr fn)
(cdr (ev (car a))))
((eq? '%pair? fn)
(if (pair? (ev (car a))) 't '()))
(else ; %null?
(if (null? (ev (car a))) 't '()))))

(define (ev-apply x)
(let ((fn (ev (fun x))))
(if (primitive? fn)
(ev-apply-prim fn (cddr x))
(let ((a (ev (arg x))))
(push E)
(push 'C)
(set! E (bind (fun-var fn) a (fun-env fn)))
(let ((n (ev (fun-term fn))))
(cleanup)
n)))))

(define (ev-tail-apply x)
(let ((fn (ev (fun x))))
(if (primitive? fn)
(ev-apply-prim fn (cddr x))
(let ((a (ev (arg x))))
(cleanup)
(push E)
(push 'C)
(set! E (bind (fun-var fn) a (fun-env fn)))
(ev (fun-term fn))))))

(define (ev x)
(if (symbol? x)
(cdr (assq x E))
(let ((f (car x)))
(cond ((eq? '%lambda f)
(make-fun x))
((eq? '%apply f)
(ev-apply x))
((eq? '%tail-apply f)
(ev-tail-apply x))
((eq? '%quote f)