Temp commit

module/Makefile.am

@@ -76,6 +76,8 @@ SOURCES =					\
   $(ECMASCRIPT_LANG_SOURCES)			\
   $(ELISP_LANG_SOURCES)				\
   $(BRAINFUCK_LANG_SOURCES)			\
+  $(JS_IL_LANG_SOURCES)				\
+  $(JS_LANG_SOURCES)				\
   $(LIB_SOURCES)				\
   $(WEB_SOURCES)
 
@@ -204,6 +206,15 @@ BRAINFUCK_LANG_SOURCES =			\
   language/brainfuck/compile-tree-il.scm	\
   language/brainfuck/spec.scm
 
+JS_IL_LANG_SOURCES =				\
+  language/js-il.scm				\
+  language/js-il/compile-javascript.scm		\
+  language/js-il/spec.scm
+
+JS_LANG_SOURCES =				\
+  language/javascript.scm			\
+  language/js-il/spec.scm
+
 SCRIPTS_SOURCES =				\
   scripts/compile.scm				\
   scripts/disassemble.scm			\

module/language/cps/compile-js.scm

@@ -0,0 +1,125 @@
+(define-module (language cps compile-js)
+  #:use-module ((guile) #:select ((values . mv:values))) ;; FIXME:
+  #:use-module (language cps)
+  #:use-module (language js-il)
+  #:use-module (ice-9 match)
+  #:export (compile-js))
+
+(define optimize (@@ (language cps compile-bytecode) optimize))
+(define convert-closures (@@ (language cps compile-bytecode) convert-closures))
+(define reify-primitives (@@ (language cps compile-bytecode) reify-primitives))
+(define renumber (@@ (language cps compile-bytecode) renumber))
+
+(define (compile-js exp env opts)
+  ;; See comment in `optimize' about the use of set!.
+  (set! exp (optimize exp opts))
+  (set! exp (convert-closures exp))
+  ;; first-order optimization should go here
+  (set! exp (reify-primitives exp))
+  (set! exp (renumber exp))
+  ;; (values exp env env)
+  (match exp
+    (($ $program funs)
+     ;; TODO: I should special case the compilation for the initial fun,
+     ;; as this is the entry point for the program, and shouldn't get a
+     ;; "self" argument, for now, I add "undefined" as the first
+     ;; argument in the call to it.
+     ;; see compile-exp in (language js-il compile-javascript)
+     (mv:values (make-program (compile-fun (car funs))
+                           (map compile-fun (cdr funs)))
+             env
+             env)))
+  )
+
+(define (compile-fun fun)
+  ;; meta
+  (match fun
+    (($ $cont k ($ $kfun src meta self ($ $cont tail ($ $ktail)) clause))
+     (make-var k (compile-clause clause self tail)))
+    (_
+     `(fun:todo: ,fun))))
+
+(define (compile-clause clause self tail)
+  (match clause
+    (($ $cont k ($ $kclause ($ $arity req opt rest kw allow-other-keys?)
+         body alternate))
+     ;; add function argument prelude
+     (unless (null? opt)
+       (not-supported "optional arguments are not supported" clause))
+     (when rest
+       (not-supported "rest arguments are not supported" clause))
+     (unless (or (null? kw) allow-other-keys?)
+       (not-supported "keyword arguments are not supported" clause))
+     (when alternate
+       (not-supported "alternate continuations are not supported" clause))
+     (make-function self ;; didn't think this js pattern would come in handy
+                    (cons tail req)
+                    (match body
+                      (($ $cont k ($ $kargs () () exp))
+                       (compile-term exp))
+                      (($ $cont k _)
+                       (make-local (list (compile-cont body))
+                                   (make-jscall k req))))))
+    (_
+     `(clause:todo: ,clause))))
+
+(define (not-supported msg clause)
+  (error 'not-supported msg clause))
+
+(define (compile-term term)
+  (match term
+    (($ $letk conts body)
+     (make-local (map compile-cont conts) (compile-term body)))
+    (($ $continue k src exp)
+     (compile-exp exp k))))
+
+(define (compile-cont cont)
+  (match cont
+    (($ $cont k ($ $kargs names syms body))
+     ;; use the name part?
+     (make-var k (make-function syms (compile-term body))))
+    (($ $cont k ($ $kreceive ($ $arity (arg) _ (? symbol? rest) _ _) k2))
+     ;; still not 100% on passing values as args vs a values object.
+     ;; using the former means I can merge make-jscall and make-continue
+     (make-var k (make-function (list arg rest) (make-jscall k2 (list arg rest)))))
+    (($ $cont k ($ $kreceive ($ $arity (arg) _ #f _ _) k2))
+     (make-var k (make-function (list arg) (make-jscall k2 (list arg)))))
+    (_
+     `(cont:todo: ,cont))
+    ))
+
+(define (compile-exp exp k)
+ (match exp
+    (($ $branch kt exp)
+     (compile-test exp kt k))
+    (($ $primcall 'return (arg))
+     (make-continue k (make-id arg)))
+    (($ $call name args)
+     (make-call name (cons k args)))
+    (($ $callk label proc args)
+     ;; eh?
+     ;; (pk 'callk label proc args k)
+     (make-jscall label (cons k args)))
+    (_
+     (make-continue k (compile-exp* exp)))))
+
+(define (compile-exp* exp)
+  (match exp
+    (($ $const val)
+     (make-const val))
+    (($ $primcall name args)
+     (make-primcall name args))
+    (($ $closure label nfree)
+     (make-closure label nfree))
+    (($ $values values)
+     (make-values values))
+    (_
+     `(exp:todo: ,exp))))
+
+(define (compile-test exp kt kf)
+  ;; TODO: find out if the expression is always simple enough that I
+  ;; don't need to create a new continuation (which will require extra
+  ;; arguments being passed through)
+  (make-branch (compile-exp* exp)
+               (make-continue kt (make-values '()))
+               (make-continue kf (make-values '()))))

module/language/cps/spec.scm

@@ -22,6 +22,7 @@
   #:use-module (system base language)
   #:use-module (language cps)
   #:use-module (language cps compile-bytecode)
+  #:use-module (language cps compile-js)
   #:export (cps))
 
 (define* (write-cps exp #:optional (port (current-output-port)))
@@ -32,6 +33,7 @@
   #:reader	(lambda (port env) (read port))
   #:printer	write-cps
   #:parser      parse-cps
-  #:compilers   `((bytecode . ,compile-bytecode))
+  #:compilers   `((bytecode . ,compile-bytecode)
+                  (js-il . ,compile-js))
   #:for-humans? #f
   )

module/language/javascript.scm

@@ -0,0 +1,190 @@
+;; Only has enough of the ecmascript language for compilation from cps
+(define-module (language javascript)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:export (
+            make-const const
+            make-function function
+            make-return return
+            make-call call
+            make-block block
+            make-new new
+            make-id id
+            make-refine refine
+            make-conditional conditional
+            make-var var
+
+            print-statement))
+
+;; Copied from (language cps)
+;; Should put in a srfi 99 module
+(define-syntax define-record-type*
+  (lambda (x)
+    (define (id-append ctx . syms)
+      (datum->syntax ctx (apply symbol-append (map syntax->datum syms))))
+    (syntax-case x ()
+      ((_ name field ...)
+       (and (identifier? #'name) (and-map identifier? #'(field ...)))
+       (with-syntax ((cons (id-append #'name #'make- #'name))
+                     (pred (id-append #'name #'name #'?))
+                     ((getter ...) (map (lambda (f)
+                                          (id-append f #'name #'- f))
+                                        #'(field ...))))
+         #'(define-record-type name
+             (cons field ...)
+             pred
+             (field getter)
+             ...))))))
+
+;; TODO: add type predicates to fields so I can only construct valid
+;; objects
+(define-syntax-rule (define-js-type name field ...)
+  (begin
+    (define-record-type* name field ...)
+    (set-record-type-printer! name print-js)))
+
+(define (print-js exp port)
+  (format port "#<js ~S>" (unparse-js exp)))
+
+(define-js-type const c)
+(define-js-type function args body)
+(define-js-type return exp)
+(define-js-type call function args)
+(define-js-type block statements)
+(define-js-type new expr)
+(define-js-type id name)
+(define-js-type refine id field)
+(define-js-type conditional test then else)
+(define-js-type var id exp)
+
+(define (unparse-js exp)
+  (match exp
+    (($ const c)
+     `(const ,c))
+    (($ function args body)
+     `(function ,args ,@(map unparse-js body)))
+    (($ return exp)
+     `(return ,(unparse-js exp)))
+    (($ call function args)
+     `(call ,(unparse-js function) ,@(map unparse-js args)))
+    (($ block statements)
+     `(block ,@(map unparse-js statements)))
+    (($ new expr)
+     `(new ,(unparse-js expr)))
+    (($ id name)
+     `(id ,name))
+    (($ refine id field)
+     `(refine ,(unparse-js id) ,(unparse-js field)))
+    (($ conditional test then else)
+     `(if ,(unparse-js test)
+          (block ,@(map unparse-js then))
+          (block ,@(map unparse-js else))))
+    (($ var id exp)
+     `(var ,id ,(unparse-js exp)))))
+
+(define (print-exp exp port)
+  (match exp
+
+    (($ const c)
+     (print-const c port))
+
+    (($ id name)
+     (print-id name port))
+
+    (($ call (and ($ function _ _) fun) args)
+     (format port "(")
+     (print-exp fun port)
+     (format port ")(")
+     (print-separated args print-exp "," port)
+     (format port ")"))
+
+    (($ call fun args)
+     (print-exp fun port)
+     (format port "(")
+     (print-separated args print-exp "," port)
+     (format port ")"))
+
+
+    (($ refine expr field)
+     (print-exp expr port)
+     (format port "[")
+     (print-exp field port)
+     (format port "]"))
+
+    (($ function params body)
+     (format port "function (")
+     (print-separated params print-id "," port)
+     (format port ")")
+     (print-block body port))
+
+    (($ block stmts)
+     (print-block stmts port))
+
+    (($ new expr)
+     (format port "new ")
+     (print-exp expr port))))
+
+(define (print-statement stmt port)
+  (match stmt
+    (($ var id exp)
+     (format port "var ")
+     (print-id id port)
+     (format port " = ")
+     (print-exp exp port)
+     (format port ";"))
+
+    (($ conditional test then else)
+     (format port "if (")
+     (print-exp test port)
+     (format port ") {")
+     (print-block then port)
+     (format port "} else {")
+     (print-block else port)
+     (format port "}"))
+
+    (($ return expr)
+     (format port "return ")
+     (print-exp expr port)
+     (format port ";"))
+
+    (expr
+     (print-exp expr port)
+     (format port ";"))))
+
+(define (print-id id port)
+  (display id port))
+
+(define (print-block stmts port)
+  (format port "{")
+  (print-statements stmts port)
+  (format port "}"))
+
+(define (print-statements stmts port)
+  (for-each (lambda (stmt)
+              (print-statement stmt port))
+            stmts))
+
+(define (print-const c port)
+  (cond ((string? c)
+         (write c port))
+        ((number? c)
+         (write c port))
+        (else
+         (throw 'unprintable-const c))))
+
+(define (print-separated args printer separator port)
+  (unless (null? args)
+    (let ((first (car args))
+          (rest  (cdr args)))
+      (printer first port)
+      (for-each (lambda (x)
+                  (display separator port)
+                  (printer x port))
+                rest))))
+
+(define (print-terminated args printer terminator port)
+  (for-each (lambda (x)
+              (printer x port)
+              (display terminator port))
+            args))

module/language/javascript/spec.scm

@@ -0,0 +1,13 @@
+;; in future, this should be merged with ecmacript
+
+(define-module (language javascript spec)
+  #:use-module (system base language)
+  #:use-module (language javascript)
+  #:export (javascript))
+
+(define-language javascript
+  #:title	"Javascript"
+  #:reader      #f
+  #:printer	print-statement
+  #:for-humans? #f
+  )

module/language/js-il.scm

@@ -0,0 +1,223 @@
+(define-module (language js-il)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (ice-9 match)
+  #:export (make-program program
+            (make-function* . make-function) function
+            make-local local
+            make-var var
+            make-continue continue ; differ from conts
+            make-const const
+            make-primcall primcall
+            make-call call
+            make-jscall jscall
+            make-closure closure
+            make-branch branch
+            make-values values
+            ; print-js
+            make-return return
+            make-id id
+            ))
+
+;; Copied from (language cps)
+;; Should put in a srfi 99 module
+(define-syntax define-record-type*
+  (lambda (x)
+    (define (id-append ctx . syms)
+      (datum->syntax ctx (apply symbol-append (map syntax->datum syms))))
+    (syntax-case x ()
+      ((_ name field ...)
+       (and (identifier? #'name) (and-map identifier? #'(field ...)))
+       (with-syntax ((cons (id-append #'name #'make- #'name))
+                     (pred (id-append #'name #'name #'?))
+                     ((getter ...) (map (lambda (f)
+                                          (id-append f #'name #'- f))
+                                        #'(field ...))))
+         #'(define-record-type name
+             (cons field ...)
+             pred
+             (field getter)
+             ...))))))
+
+;; TODO: add type predicates to fields so I can only construct valid
+;; objects
+(define-syntax-rule (define-js-type name field ...)
+  (begin
+    (define-record-type* name field ...)
+    (set-record-type-printer! name print-js)))
+
+(define (print-js exp port)
+  (format port "#<js-il ~S>" (unparse-js exp)))
+
+(define-js-type program entry body)
+(define-js-type function name params body)
+
+(define make-function*
+  (case-lambda
+    ((name params body)
+     (make-function name params body))
+    ((params body)
+     (make-function #f params body))))
+
+(define-js-type local bindings body) ; local scope
+(define-js-type var id exp)
+(define-js-type continue cont exp)
+(define-js-type const value)
+(define-js-type primcall name args)
+(define-js-type call name args)
+(define-js-type jscall name args) ;; TODO: shouldn't need this hack
+(define-js-type closure label num-free)
+(define-js-type values vals)
+(define-js-type branch test consequence alternate)
+(define-js-type id name)
+(define-js-type return val)
+
+(define (unparse-js exp)
+  (match exp
+    (($ program entry body)
+     `(program ,(unparse-js entry) . ,(map unparse-js body)))
+    (($ function name params body)
+     `(function ,name ,params ,(unparse-js body)))
+    (($ local bindings body)
+     `(local ,(map unparse-js bindings) ,(unparse-js body)))
+    (($ var id exp)
+     `(var ,id ,(unparse-js exp)))
+    (($ continue k exp)
+     `(continue ,k ,(unparse-js exp)))
+    (($ branch test then else)
+     `(if ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
+    ;; values
+    (($ const c)
+     `(const ,c))
+    (($ primcall name args)
+     `(primcall ,name , args))
+    (($ call name args)
+     `(call ,name , args))
+    (($ jscall name args)
+     `(jscall ,name , args))
+    (($ closure label nfree)
+     `(closure ,label ,nfree))
+    (($ values vals)
+     `(values . ,vals))
+    (($ return val)
+     `(return . ,(unparse-js val)))
+    (($ id name)
+     `(id . ,name))
+    (_
+     ;(error "unexpected js" exp)
+     (pk 'unexpected exp)
+     exp)))
+#|
+(define (print-js exp port)
+  ;; could be much nicer with foof's fmt
+  (match exp
+    (($ program (and entry ($ var name _)) body)
+     ;; TODO: I should probably put call to entry in js-il
+     (format port "(function(){\n")
+     (print-js entry port) (display ";\n" port)
+     (print-terminated body print-js ";\n" port)
+     ;; call to entry point
+     (format port "return ~a(scheme.initial_cont);" (lookup-cont name))
+     (format port "})();\n"))
+    (($ function #f params body)
+     (format port "function(")
+     (print-separated params print-var "," port)
+     (format port "){\n")
+     (print-js body port)(display ";" port)
+     (format port "}"))
+    ;; TODO: clean this code up
+    (($ function name params body)
+     (format port "function (~a," (lookup-cont name))
+     (print-separated params print-var "," port)
+     (format port "){\n")
+     (print-js body port)(display ";" port)
+     (format port "}"))
+    (($ local bindings body)
+     (display "{" port)
+     (print-terminated bindings print-js ";\n" port)
+     (print-js body port)
+     (display ";\n")
+     (display "}" port))
+    (($ var id exp)
+     (format port "var ~a = " (lookup-cont id))
+     (print-js exp port))
+    (($ continue k exp)
+     (format port "return ~a(" (lookup-cont k))
+     (print-js exp port)
+     (display ")" port))
+    (($ branch test then else)
+     (display "if (scheme.is_true(" port)
+     (print-js test port)
+     (display ")) {\n" port)
+     (print-js then port)
+     (display ";} else {\n" port)
+     (print-js else port)
+     (display ";}" port))
+    ;; values
+    (($ const c)
+     (print-const c port))
+    (($ primcall name args)
+     (format port "scheme.primitives[\"~s\"](" name)
+     (print-separated args print-var "," port)
+     (format port ")"))
+    (($ call name args)
+     ;; TODO: need to also add closure env
+     (format port "return ~a.fun(~a," (lookup-cont name) (lookup-cont name))
+     (print-separated args print-var "," port)
+     (format port ")"))
+    (($ jscall name args)
+     (format port "return ~a(" (lookup-cont name))
+     (print-separated args print-var "," port)
+     (format port ")"))
+    (($ closure label nfree)
+     (format port "new scheme.Closure(~a,~a)" (lookup-cont label) nfree))
+    (($ values vals)
+     (display "new scheme.Values(" port)
+     (print-separated vals print-var "," port)
+     (display ")" port))
+    ;; (($ return val)
+    ;;  (display "return " port)
+    ;;  (print-js val port))
+    (($ id name)
+     (print-var name port))
+    (_
+     (error "print: unexpected js" exp))))
+
+(define (print-var var port)
+  (if (number? var)
+      (display (lookup-cont var) port)
+      (display var port)))
+
+(define (lookup-cont k)
+  (format #f "kont_~s" k))
+
+(define (print-separated args printer separator port)
+  (unless (null? args)
+    (let ((first (car args))
+          (rest  (cdr args)))
+      (printer first port)
+      (for-each (lambda (x)
+                  (display separator port)
+                  (printer x port))
+                rest))))
+
+(define (print-terminated args printer terminator port)
+  (for-each (lambda (x)
+              (printer x port)
+              (display terminator port))
+            args))
+
+(define (print-const c port)
+  (cond ((number? c) (display c port))
+        ((eqv? c #t) (display "scheme.TRUE" port))
+        ((eqv? c #f) (display "scheme.FALSE" port))
+        ((eqv? c '()) (display "scheme.EMPTY" port))
+        ((unspecified? c) (display "scheme.UNSPECIFIED" port))
+        ((symbol? c) (format port "new scheme.Symbol(\"~s\")" c))
+        ((list? c)
+         (display "scheme.list(" port)
+         (print-separated c print-const "," port)
+         (display ")" port))
+        (else
+         (throw 'not-implemented))))
+|#

module/language/js-il/compile-javascript.scm

@@ -0,0 +1,104 @@
+(define-module (language js-il compile-javascript)
+  #:use-module (ice-9 match)
+  #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
+  #:use-module (language javascript)
+  #:export (compile-javascript))
+
+(define (compile-javascript exp env opts)
+  (values (compile-exp exp) env env))
+
+(define *scheme* (make-id "scheme"))
+
+(define (name->id name)
+  (make-id (rename name)))
+
+(define (rename name)
+  (format #f "kont_~a" name))
+
+(define (compile-exp exp)
+  ;; TODO: handle ids for js
+  (match exp
+    (($ il:program (and entry ($ il:var name _)) body)
+     (let ((entry-call
+            (make-return
+             (make-call (name->id name)
+                        (list
+                         (make-id "undefined")
+                         (make-refine *scheme* (make-const "initial_cont")))))))
+       (make-call (make-function '() (append (map compile-exp body)
+                                           (list (compile-exp entry) entry-call)))
+                  '())))
+
+    (($ il:function #f params body)
+     (make-function (map rename params) (list (compile-exp body))))
+
+    (($ il:function name params body)
+     ;; TODO: split il:function into closure (with self) and cont types
+     (make-function (map rename (cons name params)) (list (compile-exp body))))
+
+    (($ il:local bindings body)
+     (make-block (append (map compile-exp bindings) (list (compile-exp body)))))
+
+    (($ il:var id exp)
+     (make-var (rename id) (compile-exp exp)))
+
+    (($ il:continue k exp)
+     (make-return (make-call (name->id k) (list (compile-exp exp)))))
+
+    (($ il:branch test then else)
+     (make-conditional (make-call (make-refine *scheme* (make-const "is_true"))
+                                  (list (compile-exp test)))
+                       (list (compile-exp then))
+                       (list (compile-exp else))))
+
+    (($ il:const c)
+     (compile-const c))
+
+    (($ il:primcall name args)
+     (make-call (make-refine (make-refine *scheme* (make-const "primitives"))
+                             (make-const (symbol->string name)))
+                (map name->id args)))
+
+    (($ il:call name args)
+     (make-return
+      (make-call (make-refine (name->id name) (make-const "fun"))
+                 (map name->id (cons name args)))))
+
+    (($ il:jscall name args)
+     (make-return (make-call (name->id name) (map name->id args))))
+
+    (($ il:closure label nfree)
+     (make-new
+      (make-call (make-refine *scheme* (make-const "Closure"))
+                 (list (name->id label) (make-const nfree)))))
+
+    (($ il:values vals)
+     (make-new
+      (make-call (make-refine *scheme* (make-const "Values"))
+                 (map name->id vals))))
+
+    (($ il:id name)
+     (name->id name))))
+
+(define (compile-const c)
+  (cond ((number? c)
+         (make-const c))
+        ((eqv? c #t)
+         (make-refine *scheme* (make-const "TRUE")))
+        ((eqv? c #f)
+         (make-refine *scheme* (make-const "FALSE")))
+        ((eqv? c '())
+         (make-refine *scheme* (make-const "EMPTY")))
+        ((unspecified? c)
+         (make-refine *scheme* (make-const "UNSPECIFIED")))
+        ((symbol? c)
+         (make-new
+          (make-call
+           (make-refine *scheme* (make-const "Symbol"))
+           (list (make-const (symbol->string c))))))
+        ((list? c)
+         (make-call
+           (make-refine *scheme* (make-const "list"))
+           (map compile-const c)))
+        (else
+         (throw 'uncompilable-const c))))

module/language/js-il/runtime.js

@@ -0,0 +1,191 @@
+var scheme = {
+    obarray : {},
+    primitives : {},
+    env : {},
+    cache: [],
+    builtins: [],
+    // TODO: placeholders
+    FALSE : false,
+    TRUE : true,
+    NIL  : false,
+    EMPTY : [],
+    UNSPECIFIED : []
+};
+
+function not_implemented_yet() {
+    throw "not implemented yet";
+};
+
+// Numbers
+scheme.primitives.add = function (x, y) {
+    return x + y;
+};
+
+scheme.primitives.add1 = function (x) {
+    return x + 1;
+};
+
+scheme.primitives.sub = function (x, y) {
+    return x - y;
+};
+
+scheme.primitives.sub1 = function (x) {
+    return x - 1;
+};
+
+scheme.primitives.mul = function (x, y) {
+    return x * y;
+};
+
+scheme.primitives.div = function (x, y) {
+    return x / y;
+};
+
+scheme.primitives["="] = function (x, y) {
+    return x == y;
+};
+
+scheme.primitives["<"] = function (x, y) {
+    return x < y;
+};
+
+scheme.primitives.quo = not_implemented_yet;
+scheme.primitives.rem = not_implemented_yet;
+scheme.primitives.mod = not_implemented_yet;
+
+// Boxes
+scheme.Box = function (x) {
+    this.x = x;
+    return this;
+};
+
+scheme.primitives["box-ref"] = function (box) {
+    return box.x;
+};
+
+scheme.primitives["box-set!"] = function (box, val) {
+    box.x = val;
+};
+
+// Lists
+scheme.Pair = function (car, cdr) {
+    this.car = car;
+    this.cdr = cdr;
+    return this;
+};
+
+scheme.primitives.cons = function (car, cdr) {
+    return new scheme.Pair(car,cdr);
+};
+
+scheme.primitives.car = function (obj) {
+    return obj.car;
+};
+
+scheme.primitives.cdr = function (obj) {
+    return obj.cdr;
+};
+
+scheme.list = function () {
+    var l = scheme.EMPTY;
+    for (var i = arguments.length - 1; i >= 0; i--){
+        l = scheme.primitives.cons(arguments[i],l);
+    };
+    return l;
+};
+
+scheme.primitives["null?"] = function(obj) {
+    return scheme.EMPTY == obj;
+};
+
+// Symbols
+scheme.Symbol = function(s) {
+    if (scheme.obarray[s]) {
+        return scheme.obarray[s];
+    } else {
+        this.name = s;
+        scheme.obarray[s] = this;
+        return this;
+    };
+};
+
+// Vectors
+
+// Bytevectors
+
+// Booleans
+
+// Chars
+
+// Strings
+
+// Closures
+scheme.Closure = function(f, size) {
+    this.fun = f;
+    this.freevars = new Array(size);
+    return this;
+};
+
+scheme.primitives["free-set!"] = function (closure, idx, obj) {
+    closure.freevars[idx] = obj;
+};
+
+scheme.primitives["free-ref"] = function (closure, idx) {
+    return closure.freevars[idx];
+};
+
+scheme.primitives["builtin-ref"] = function (idx) {
+    return scheme.builtins[idx];
+};
+
+// Modules
+scheme.primitives["define!"] = function(sym, obj) {
+    scheme.env[sym.name] = new scheme.Box(obj);
+};
+
+scheme.primitives["cache-current-module!"] = function (module, scope) {
+    scheme.cache[scope] = module;
+};
+
+scheme.primitives["cached-toplevel-box"] = function (scope, sym, is_bound) {
+    return scheme.cache[scope][sym.name];
+};
+
+scheme.primitives["current-module"] = function () {
+    return scheme.env;
+};
+
+scheme.primitives["resolve"] = function (sym, is_bound) {
+    return scheme.env[sym.name];
+};
+
+// values
+scheme.Values = function () {
+    this.values = arguments;
+    return this;
+};
+
+// bleh
+scheme.initial_cont = function (x) { return x; };
+scheme.primitives.return = function (x) { return x; };
+scheme.is_true = function (obj) {
+    return !(obj == scheme.FALSE || obj == scheme.NIL);
+};
+
+var callcc = function (k,vals) {
+    var closure = vals.values[0];
+    var f = function (k2, val) {
+        // TODO: multivalue continuations
+        return k(val);
+    };
+    return closure.fun(k, new scheme.Closure(f, 0));
+};
+scheme.builtins[4] = new scheme.Closure(callcc, 0);
+// #define FOR_EACH_VM_BUILTIN(M) \
+//   M(apply, APPLY, 2, 0, 1) \
+//   M(values, VALUES, 0, 0, 1) \
+//   M(abort_to_prompt, ABORT_TO_PROMPT, 1, 0, 1) \
+//   M(call_with_values, CALL_WITH_VALUES, 2, 0, 0) \
+//   M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION, 1, 0, 0)
+
+// ---

module/language/js-il/spec.scm

@@ -0,0 +1,12 @@
+(define-module (language js-il spec)
+  #:use-module (system base language)
+  ; #:use-module (language js-il)
+  #:use-module (language js-il compile-javascript)
+  #:export (js-il))
+
+(define-language js-il
+  #:title	"Javascript Intermediate Language"
+  #:reader      #f
+  #:compilers   `((javascript . ,compile-javascript))
+  #:printer	#f ; print-js
+  #:for-humans? #f)