From a98ecda079ad8abcc968a7a48763d96d8398c435 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Wed, 14 Apr 2010 13:44:28 -0500
Subject: [PATCH] Commit other half of doc/compiler.txt -> compiler.ss move.

---
 doc/compiler.txt | 260 -----------------------------------------------
 1 file changed, 260 deletions(-)
 delete mode 100644 doc/compiler.txt

diff --git a/doc/compiler.txt b/doc/compiler.txt
deleted file mode 100644
index 4fc0c0f..0000000
--- a/doc/compiler.txt
+++ /dev/null
@@ -1,260 +0,0 @@
-(define (simplify-form form)
-  (if (pair? form)
-    (case (car form)
-      [(let) (simplify-let form)]
-      [(let*) (simplify-let* form)]
-      [(letrec) (simplify-letrec form)]
-      [(if) (simplify-if form)]
-      [(lambda) (simplify-lambda form)]
-      [(begin) `(%bind () ,@(map simplify-form (cdr form)))]
-      [(set!) (simplify-set! form)]
-      [(car cdr)
-       (if (pair? (second form))
-           (let ([x (gensym)])
-             `(%bind (,x)
-                ,(simplify-form `(set! ,x ,(second form)))
-                (,(if (eq? (first form) 'car) '%car '%cdr) ,x)))
-           `(,(if (eq? (first form) 'car) '%car '%cdr) ,(second form)))]
-      [(%bind %if %tail-call %apply %lambda %set! %cons %car %cdr) form]
-      [else (simplify-funcall form)])
-    form))
-
-(define (simplify-set! form)
-  (let ([value-form (simplify-form (third form))])
-    (if (and (pair? value-form) (eq? (first value-form) '%bind))
-        `(%bind ,(second value-form)
-           ,@(foldr (lambda (x s)
-                      (if (pair? s)
-                          (cons x s)
-                          (list (simplify-set! `(set! ,(second form) ,x)))))
-                    '()
-                    (cddr value-form)))
-        `(%set! ,(second form) ,value-form))))
-
-; (let ([var expr]...) bodyexpr...)  ; first eval exprs, then assign bindings in parallel
-;    => (%bind (tmp...)
-;         (%set! tmp ,(simplify-form expr))...
-;         (%bind (var...)
-;           (%set! var tmp)...
-;           bodyexpr...))
-
-(define (simplify-let form)
-   (define bindings (second form))
-   (define bodyexprs (cdr (cdr form)))
-   (define vars (map (lambda (x) (if (pair? x) (first x) x)) bindings))
-   (define temp-bindings
-     (append-map
-       (lambda (x) (if (pair? x)
-                       (let ([tmp (gensym)])
-                         `((,tmp
-                            ,(simplify-form `(set! ,tmp ,(second x)))
-                            (%set! ,(first x) ,tmp))))
-                         '()))
-       bindings))
-   (if (pair? bindings)
-       (if (pair? (cdr bindings))
-           `(%bind ,(map first temp-bindings)
-              ,@(map second temp-bindings)
-              (%bind ,vars
-                ,@(map third temp-bindings)
-                ,@(map simplify-form bodyexprs)))
-           `(%bind (,(first vars))
-              ,@(if (pair? (first bindings))
-                  `(,(simplify-form `(set! ,(first vars) ,(second (first bindings)))))
-                  '())
-              ,@(map simplify-form bodyexprs)))
-       `(%bind () ,@bodyexprs)))
-
-; (let* ...)   ; eval exprs & bind variables serially
-;    => (let ([var-0 expr-0])
-;         (let ([var-1 expr-1])
-;           (...
-;             bodyexprs...)))
-
-(define (simplify-let* form)
-   (define bindings (second form))
-   (define bodyexprs (cdr (cdr form)))
-   (define (add-binding bind bodyexpr)
-      `(let (,bind) ,bodyexpr))
-   (simplify-form (foldr add-binding `(begin ,@bodyexprs) bindings)))
-
-; (letrec ...) ; init bindings to undefined, then assign values in series
-;    => (let (var...)
-;         (set! var expr)...
-;         bodyexprs)
-
-(define (simplify-letrec form)
-  (define bindings (second form))
-  (define bodyexprs (cdr (cdr form)))
-  (simplify-form
-  `(%bind (,@(map (lambda (x) (if (pair? x) (first x) x)) bindings))
-     ,@(append-map
-         (lambda (x)
-           (if (pair? x)
-               `((set! ,(first x) ,(simplify-form (second x))))
-               '()))
-         bindings)
-     ,@(map simplify-form bodyexprs))))
-
-(define (simplify-if form)
-  (define cond-val (gensym))
-  (define next-fn (gensym))
-  (define true-fn (gensym))
-  (define false-fn (gensym))
-  (define-values (cond-expr true-expr false-expr)
-                 (apply values (cdr form)))
-  (simplify-form
-    `(let ([,cond-val ,cond-expr]
-           [,true-fn  (%lambda ,(simplify-form true-expr))]
-           [,false-fn (%lambda ,(simplify-form false-expr))])
-       (let ([,next-fn (%if ,cond-val ,true-fn ,false-fn)])
-         (%apply ,next-fn %nil)))))
-
-; (lambda (required... [optional default-expr]... . rest) bodyexpr...)
-;    => (lambda argv
-;         (let ([argv-temp argv])
-;           (let ([required-0 (car argv-temp)])
-;             (set! argv-temp (cdr argv-temp)))
-;             (let ([required-1 (car argv-temp)])
-;               (set! argv-temp (cdr argv-temp)))
-;               (...
-;                 (let (optional-0)
-;                   (if (eq? argv-temp %nil)
-;                       (set! optional-0 default-expr-0)
-;                       (set! optional-0 (car argv-temp)))
-;                   (set! argv-temp (cdr argv-temp))
-;                   (let (optional-1)
-;                     (if (eq? argv-temp %nil)
-;                         (set! optional-1 default-expr-1)
-;                         (set! optional-1 (car argv-temp)))
-;                     (set! argv-temp (cdr argv-temp))
-;                     (...
-;                       (let ([rest argv-temp])
-;                         bodyexpr...)...)))...)))
-
-(define (simplify-lambda form)
-   (define arglist (car (cdr form)))
-   (define bodyexprs (cdr (cdr form)))
-   (define (split-arglist arglist)
-      (define (split-optional arglist)
-         (if (pair? arglist)
-             (let-values ([(opt rst) (split-optional (cdr arglist))])
-               (values (cons (car arglist) opt) rst)) 
-             (values '() arglist)))
-      (if (pair? arglist)
-          (if (pair? (car arglist))
-            (let-values ([(opt rst) (split-optional arglist)])
-               (values '() opt rst))
-            (let-values ([(req opt rst) (split-arglist (cdr arglist))])
-               (values (cons (car arglist) req) opt rst)))
-          (values '() '() #f)))
-
-   (define-values (requireds optionals rest) (split-arglist arglist))
-   (define argv-temp (gensym))
-   (define k (gensym))
-   (define rval (gensym))
-
-   (define (add-req req inner) `(let ([,req (car ,argv-temp)])
-                                  (set! ,argv-temp (cdr ,argv-temp))
-                                  ,inner))
-   (define (add-opt opt-list inner) `(let (,(car opt-list))
-                                       (if (pair? ,argv-temp)
-                                           (begin
-                                             (set! ,(first opt-list) (car ,argv-temp))
-                                             (set! ,argv-temp (cdr ,argv-temp)))
-                                           (set! ,(first opt-list) ,(second opt-list)))
-                                       ,inner))
-   (define rest+bodyexprs (if rest `(let ([,rest ,argv-temp]) ,@bodyexprs)
-                                   `(begin ,@bodyexprs)))
-   `(%lambda 
-      (%bind (,rval ,k)
-        (%set! ,k %k)
-        ,(simplify-form
-           `(set! ,rval (let ([,argv-temp %argv])
-                          ,(foldr add-req (foldr add-opt rest+bodyexprs optionals) requireds))))
-        (%set! ,rval (%cons ,rval %nil))
-        (%tail-call ,k ,rval))))
-
-; (fn-expr arg-expr...)
-;    => (let ([fn-var fn-expr] arg-var... argv)
-;         (set! fn-var fn-expr)
-;         (set! arg-var arg-expr)...
-;         (set! argv %nil)
-;         (set! argv (cons arg-var argv))... [reversed]
-;         (%apply fn-var argv))
-
-(define (simplify-funcall form)
-  (define fn-expr (car form))
-  (define arg-exprs (cdr form))
-  (define fn-var (gensym))
-  (define arg-vars (map (lambda (x) (gensym)) arg-exprs))
-  (define argv (gensym))
-  (simplify-form
-    `(%bind (,fn-var ,@arg-vars ,argv)
-       ,(simplify-form `(set! ,fn-var ,fn-expr))
-       ,@(map (lambda (x y) (simplify-form `(set! ,x ,y))) arg-vars arg-exprs)
-       (%set! ,argv %nil)
-       ,@(reverse (map (lambda (x) `(%set! ,argv (%cons ,x ,argv))) arg-vars))
-       (%apply ,fn-var ,argv))))
-
-(define (subst-var old-var new-var form)
-  (define (recurse form)
-    (subst-var old-var new-var form))
-  (if (pair? form)
-    (case (car form)
-      [(%bind)
-       (if (memq old-var (second form))
-           form
-           `(%bind ,(second form) ,@(map recurse (cddr form))))]
-      [(%if %tail-call %apply %lambda %set! %cons %car %cdr)
-       `(,(first form) ,@(map recurse (cdr form)))]
-      [else (error "Unsimplified form:" form)])
-    (if (eq? form old-var)
-        new-var
-        form)))
-
-(define (make-bindings-unique form)
-  (if (pair? form)
-    (case (car form)
-      [(%bind)
-       (let ([new-vars (map (lambda _ (gensym)) (second form))])
-         `(%bind ,new-vars
-            ,@(map (lambda (frm)
-                     (foldl (lambda (pair s)
-                              (subst-var (car pair)
-                                         (cdr pair)
-                                         s))
-                            (make-bindings-unique frm)
-                            (map cons (second form) new-vars)))
-                   (cddr form))))]
-      [(%if %tail-call %apply %lambda %set! %cons %car %cdr)
-       `(,(first form) ,@(map make-bindings-unique (cdr form)))]
-      [else (error "Unsimplified form:" form)])
-    form))
-
-(define (flatten-binds form)
-  ;(pretty-print form) (write-char #\Newline)
-  (if (pair? form)
-    (case (car form)
-      [(%bind)
-       (let* ([bound-vars (second form)]
-              [subforms (append-map (lambda (form)
-                                      (let ([new-form (flatten-binds form)])
-                                        (if (and (pair? new-form) (eq? (car new-form) '%bind))
-                                          (begin
-                                            (set! bound-vars (append bound-vars (second new-form)))
-                                            (cddr new-form))
-                                          (list new-form))))
-                                    (cddr form))])
-         `(%bind ,bound-vars ,@subforms))]
-      [(%if %tail-call %apply %lambda %set! %cons %car %cdr)
-       `(,(first form) ,@(map flatten-binds (cdr form)))]
-      [else (error "Unsimplified form:" form)])
-    form))
-
-(define (compile form)
-  (flatten-binds
-      (make-bindings-unique
-        (simplify-form `(lambda () ,form)))))
-
-; vim:set sw=2 expandtab: