From 4612bb13a8885c781b56a619f7efc940dd3cf0c5 Mon Sep 17 00:00:00 2001 From: David Kerkeslager Date: Mon, 30 May 2016 16:36:25 -0400 Subject: [PATCH] Adding in my work on LiSP --- LiSP/README.md | 14 +++++ LiSP/chapter1.scm | 143 ++++++++++++++++++++++++++++++++++++++++++++++ LiSP/run.sh | 1 + 3 files changed, 158 insertions(+) create mode 100644 LiSP/README.md create mode 100644 LiSP/chapter1.scm create mode 100755 LiSP/run.sh diff --git a/LiSP/README.md b/LiSP/README.md new file mode 100644 index 0000000..9c5b940 --- /dev/null +++ b/LiSP/README.md @@ -0,0 +1,14 @@ +# LiSP + +This is my attempt to turn each of the chapters of Christian Queinnec's excellent book *Lisp in Small Pieces* into +a working (albeit very limited) interpreter. It's mostly for my own education but perhaps someone will find it +useful. + +For the uninitiated, *LiSP* is split into 11 Chapters. Each chapter implements a interpreter/compiler for a +Scheme-like language. As such, this repo will hopefully contain 11 working interpreter/compilers. *LiSP* also +contains exercises which suggest modifications to the interpreters/compilers, which I will implement, so there may +actually be more than 11 interpreters/compilers. + +A lot of the code here will be directly out of *LiSP*. I believe this to be fair use, as I am never going to make any +money off it and Christian Queinnic himself has made the code freely available on [this +page](http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html). diff --git a/LiSP/chapter1.scm b/LiSP/chapter1.scm new file mode 100644 index 0000000..3667f2d --- /dev/null +++ b/LiSP/chapter1.scm @@ -0,0 +1,143 @@ +; this allows (begin), which is almost certainly undesirable behavior +(define (eprogn exps env trace) + (if (pair? exps) + (if (pair? (cdr exps)) + (begin (evaluate (car exps) env trace) + (eprogn (cdr exps) env trace)) + (evaluate (car exps env trace))) + '())) + +; Complication is to avoid excess recursion (exercise 1.2) +(define (evlis exps env trace) + (define (evlis-internal exps env trace) + (let ((current-result (evaluate (car exps) env trace))) + (cons current-result (if (pair? (cdr exps)) + (evlis (cdr exps) env trace) + '())))) + (if (pair? exps) + (evlis-internal exps env trace) + '())) + +(define (lookup id env) + (if (pair? env) + (if (eq? (caar env) id) + (cdar env) + (lookup id (cdr env))) + (wrong "No such binding" id))) + +(define (update! id env value) + (if (pair? env) + (if (eq? (caar env) id) + (begin (set-cdr! (car env) value) + value) + (update! id (cdr env) value)) + (wrong "No such binding" id))) + +(define (extend env variables values) + (cond ((pair? variables) (if (pair? values) + (cons (cons (car variables) (car values)) + (extend env (cdr variables) (cdr values))) + (wrong "Too many variables"))) + ((null? variables) (if (null? values) + env + (wrong "Too many values"))) + ; I'm not sure I like this, it creates an inconsistent + ; interface for extend + ((symbol? variables?) (cons (cons variables values) env)))) + +(define (invoke fn args) + (if (procedure? fn) + (fn args) + (wrong "Not a function" fn))) + +; variables are lexically scoped +(define (make-function variables body env trace) + (lambda (values) (eprogn body (extend env variables values) trace))) + +(define env.init '()) + +(define env.global env.init) + +(define-syntax def-initial + (syntax-rules () + ((def-initial name) (begin (set! env.global (cons (cons 'name 'void) env.global)) + 'name)) + ((def-initial name value) (begin (set! env.global (cons (cons 'name value) env.global)) + 'name)))) + +(define-syntax def-primitive + (syntax-rules () + ((def-primitive name value arity) (def-initial name (lambda (values) (if (= arity (length values)) + (apply value values) ; the real apply of Scheme + (wrong "Incorrect arity" (list 'name values)))))))) + + +; Implementing the exercise suggested in section 1.8 +(define exit-sentinel (gensym 'exit-sentinel-)) +(define (exit) exit-sentinel) + +(def-initial true #t) +(def-initial false #f) +(def-initial nil '()) + +(def-primitive cons cons 2) +(def-primitive car car 1) +(def-primitive cdr cdr 1) +(def-primitive set-car! set-car! 2) +(def-primitive set-cdr! set-cdr! 2) +(def-primitive + + 2) +(def-primitive - - 2) +(def-primitive * * 2) +(def-primitive / / 2) +(def-primitive eq? eq? 2) +(def-primitive < < 2) +(def-primitive > > 2) +(def-primitive <= <= 2) +(def-primitive >= >= 2) +(def-primitive exit exit 0) + +(define (atom? e) + (not (pair? e))) + +(define (display-args args) + (if (pair? args) + (begin (display " ") + (display (car args)) + (display-args (cdr args))))) + +; `trace` is there to implement exercise 1.1 +; Pass #t to output trace information +(define (evaluate e env trace) + (if (atom? e) + (cond ((symbol? e) (lookup e env)) + ((or (number? e) (string? e) (char? e) (boolean? e) (vector? e)) e) + (else (wrong "Cannot evaluate" e))) + (case (car e) + ((quote) (cadr e)) + ((if) (if (evaluate (cadr e) env trace) + (evaluate (caddr e) env trace) + (evaluate (cadddr e) env trace))) + ((begin) (eprogn (cdr e) env trace)) + ((set!) (update! (cadr e) env (evaluate (caddr e) env trace))) + ((lambda) (make-function (cadr e) (cddr e) env trace)) + (else + (let ((fn (evaluate (car e) env trace)) + (args (evlis (cdr e) env trace))) + (begin (if trace + (begin (display "(") + (display (car e)) + (display-args args) + (display ")\n"))) + (let ((result (invoke fn args))) + (begin (display result) + (display "\n") + result)))))))) + +(define (chapter1-scheme trace) + (define (toplevel) + (let ((result (evaluate (read) env.global trace))) + (if (not (and (symbol? result) (equal? result exit-sentinel))) + (begin (display result) + (display "\n") + (toplevel))))) + (toplevel)) diff --git a/LiSP/run.sh b/LiSP/run.sh new file mode 100755 index 0000000..8b7d3e3 --- /dev/null +++ b/LiSP/run.sh @@ -0,0 +1 @@ +gsi -:s $@ -- 2.20.1