Commit initial notes on compilation from Scheme-like source code.

doc/compiler.txt

@@ -0,0 +1,96 @@
+(let ...)
+(let* ...)
+(letrec ...)
+
+; (if cond-expr true-expr false-expr)
+;    => (let ([cond-val cond-expr])
+;         (let ([next-fn (%if cond-val
+;                             (lambda () true-expr)
+;                             (lambda () false-expr))])
+;           (next-fn)))
+
+(define (transform-if form)
+   (define cond-val (gensym))
+   (define next-fn (gensym))
+   (define-values (cond-expr true-expr false-expr)
+                  (apply values (cdr form)))
+   `(let ([,cond-val ,cond-expr])
+      (let ([,next-fn (%if ,cond-val
+                           (lambda () ,true-expr)
+                           (lambda () ,false-expr))])
+        (,next-fn))))
+
+; (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 (transform-lambda-arglist 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 opt rst)) 
+             (values nil arglist)))
+      (if (eq? arglist nil)
+          (values nil nil #f)
+          (if (pair? (car arglist))
+            (let-values ([(opt rst) (split-optional arglist)])
+               (values nil opt rst))
+            (let-values ([(req opt rst) (split-arglist (cdr arglist))])
+               (values (cons (car arglist) req) opt rst)))))
+
+   (define-values (requireds optionals rest) (split-arglist arglist))
+   (define argv-temp (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 (eq? ,argv-temp nil)
+                                           (set! ,(car opt-list) ,(cdr opt-list))
+                                           (set! ,(car opt-list) (car ,argv-temp)))
+                                       ,inner))
+   (define rest+bodyexprs (if rest `(let ([,rest ,argv-temp]) ,@bodyexprs)
+                                   `(begin ,@bodyexprs)))
+   `(lambda ,argv-temp
+      ,(foldr add-req (foldr add-opt rest+bodyexprs optionals) requireds)))
+
+; (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 (transform-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))
+   `(let ([,fn-var ,fn-expr] ,@arg-vars ,argv)
+      ,@(map (lambda (x y) `(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)))