From ce1cc2706c62e2e497a44d88465ae31e1f289aa4 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Fri, 5 Jun 2015 22:46:44 +0100
Subject: [PATCH 01/90] Temp commit

---
 module/Makefile.am                           |  11 +
 module/language/cps/compile-js.scm           | 125 +++++++++++
 module/language/cps/spec.scm                 |   4 +-
 module/language/javascript.scm               | 190 ++++++++++++++++
 module/language/javascript/spec.scm          |  13 ++
 module/language/js-il.scm                    | 223 +++++++++++++++++++
 module/language/js-il/compile-javascript.scm | 104 +++++++++
 module/language/js-il/runtime.js             | 191 ++++++++++++++++
 module/language/js-il/spec.scm               |  12 +
 9 files changed, 872 insertions(+), 1 deletion(-)
 create mode 100644 module/language/cps/compile-js.scm
 create mode 100644 module/language/javascript.scm
 create mode 100644 module/language/javascript/spec.scm
 create mode 100644 module/language/js-il.scm
 create mode 100644 module/language/js-il/compile-javascript.scm
 create mode 100644 module/language/js-il/runtime.js
 create mode 100644 module/language/js-il/spec.scm

diff --git a/module/Makefile.am b/module/Makefile.am
index 88b84a1a3..584039bf0 100644
--- a/module/Makefile.am
+++ b/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			\
diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
new file mode 100644
index 000000000..ed75db0a2
--- /dev/null
+++ b/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 '()))))
diff --git a/module/language/cps/spec.scm b/module/language/cps/spec.scm
index f1255afeb..ec73528ad 100644
--- a/module/language/cps/spec.scm
+++ b/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
   )
diff --git a/module/language/javascript.scm b/module/language/javascript.scm
new file mode 100644
index 000000000..0a0b20e56
--- /dev/null
+++ b/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))
diff --git a/module/language/javascript/spec.scm b/module/language/javascript/spec.scm
new file mode 100644
index 000000000..f04341f42
--- /dev/null
+++ b/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
+  )
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
new file mode 100644
index 000000000..b62c3bad4
--- /dev/null
+++ b/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))))
+|#
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
new file mode 100644
index 000000000..21b6fc9c6
--- /dev/null
+++ b/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))))
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
new file mode 100644
index 000000000..823ba9706
--- /dev/null
+++ b/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)
+
+// ---
diff --git a/module/language/js-il/spec.scm b/module/language/js-il/spec.scm
new file mode 100644
index 000000000..81ca5da1c
--- /dev/null
+++ b/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)

From d57dc85fa84a380c3deefff098069fcab90d7f2d Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 6 Jun 2015 10:14:36 +0100
Subject: [PATCH 02/90] Replace values object with values passed as
 continuation arguments

---
 module/language/cps/compile-js.scm           | 19 ++++++++-----------
 module/language/js-il.scm                    | 12 ++++--------
 module/language/js-il/compile-javascript.scm |  9 ++-------
 module/language/js-il/runtime.js             | 14 +++-----------
 4 files changed, 17 insertions(+), 37 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index ed75db0a2..0e0aa4ecd 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -1,5 +1,4 @@
 (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)
@@ -25,7 +24,7 @@
      ;; "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))
+     (values (make-program (compile-fun (car funs))
                            (map compile-fun (cdr funs)))
              env
              env)))
@@ -79,8 +78,6 @@
      ;; 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)))))
@@ -93,15 +90,17 @@
     (($ $branch kt exp)
      (compile-test exp kt k))
     (($ $primcall 'return (arg))
-     (make-continue k (make-id arg)))
+     (make-continue k (list (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-jscall label (cons* proc k args)))
+    (($ $values values)
+     (make-continue k (map make-id values)))
     (_
-     (make-continue k (compile-exp* exp)))))
+     (make-continue k (list (compile-exp* exp))))))
 
 (define (compile-exp* exp)
   (match exp
@@ -111,8 +110,6 @@
      (make-primcall name args))
     (($ $closure label nfree)
      (make-closure label nfree))
-    (($ $values values)
-     (make-values values))
     (_
      `(exp:todo: ,exp))))
 
@@ -121,5 +118,5 @@
   ;; 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 '()))))
+               (make-continue kt '())
+               (make-continue kf '())))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index b62c3bad4..7dceb6061 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -13,7 +13,6 @@
             make-jscall jscall
             make-closure closure
             make-branch branch
-            make-values values
             ; print-js
             make-return return
             make-id id
@@ -61,13 +60,12 @@
 
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
-(define-js-type continue cont exp)
+(define-js-type continue cont args)
 (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)
@@ -82,8 +80,8 @@
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
      `(var ,id ,(unparse-js exp)))
-    (($ continue k exp)
-     `(continue ,k ,(unparse-js exp)))
+    (($ continue k args)
+     `(continue ,k ,(map unparse-js args)))
     (($ branch test then else)
      `(if ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
     ;; values
@@ -97,8 +95,6 @@
      `(jscall ,name , args))
     (($ closure label nfree)
      `(closure ,label ,nfree))
-    (($ values vals)
-     `(values . ,vals))
     (($ return val)
      `(return . ,(unparse-js val)))
     (($ id name)
@@ -141,7 +137,7 @@
     (($ var id exp)
      (format port "var ~a = " (lookup-cont id))
      (print-js exp port))
-    (($ continue k exp)
+    (($ continue k args)
      (format port "return ~a(" (lookup-cont k))
      (print-js exp port)
      (display ")" port))
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 21b6fc9c6..6fde3bae0 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -42,8 +42,8 @@
     (($ 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:continue k exps)
+     (make-return (make-call (name->id k) (map compile-exp exps))))
 
     (($ il:branch test then else)
      (make-conditional (make-call (make-refine *scheme* (make-const "is_true"))
@@ -72,11 +72,6 @@
       (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))))
 
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 823ba9706..502c61b57 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -159,12 +159,6 @@ 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; };
@@ -172,13 +166,11 @@ 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
+var callcc = function (self, k, closure) {
+    var f = function (self, k2, val) {
         return k(val);
     };
-    return closure.fun(k, new scheme.Closure(f, 0));
+    return closure.fun(closure, k, new scheme.Closure(f, 0));
 };
 scheme.builtins[4] = new scheme.Closure(callcc, 0);
 // #define FOR_EACH_VM_BUILTIN(M) \

From b70b39e4783e15861c3a02dbb609e2558bc05506 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 6 Jun 2015 10:26:51 +0100
Subject: [PATCH 03/90] Remove jscall type

---
 module/language/cps/compile-js.scm           | 10 ++++------
 module/language/js-il.scm                    |  4 ----
 module/language/js-il/compile-javascript.scm |  3 ---
 3 files changed, 4 insertions(+), 13 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 0e0aa4ecd..6d1edb87d 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -58,7 +58,7 @@
                        (compile-term exp))
                       (($ $cont k _)
                        (make-local (list (compile-cont body))
-                                   (make-jscall k req))))))
+                                   (make-continue k (map make-id req)))))))
     (_
      `(clause:todo: ,clause))))
 
@@ -78,9 +78,9 @@
      ;; use the name part?
      (make-var k (make-function syms (compile-term body))))
     (($ $cont k ($ $kreceive ($ $arity (arg) _ (? symbol? rest) _ _) k2))
-     (make-var k (make-function (list arg rest) (make-jscall k2 (list arg rest)))))
+     (make-var k (make-function (list arg rest) (make-continue k2 (list (make-id arg) (make-id rest))))))
     (($ $cont k ($ $kreceive ($ $arity (arg) _ #f _ _) k2))
-     (make-var k (make-function (list arg) (make-jscall k2 (list arg)))))
+     (make-var k (make-function (list arg) (make-continue k2 (list (make-id arg))))))
     (_
      `(cont:todo: ,cont))
     ))
@@ -94,9 +94,7 @@
     (($ $call name args)
      (make-call name (cons k args)))
     (($ $callk label proc args)
-     ;; eh?
-     ;; (pk 'callk label proc args k)
-     (make-jscall label (cons* proc k args)))
+     (make-continue label (map make-id (cons* proc k args))))
     (($ $values values)
      (make-continue k (map make-id values)))
     (_
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 7dceb6061..946a1c02e 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -10,7 +10,6 @@
             make-const const
             make-primcall primcall
             make-call call
-            make-jscall jscall
             make-closure closure
             make-branch branch
             ; print-js
@@ -64,7 +63,6 @@
 (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 branch test consequence alternate)
 (define-js-type id name)
@@ -91,8 +89,6 @@
      `(primcall ,name , args))
     (($ call name args)
      `(call ,name , args))
-    (($ jscall name args)
-     `(jscall ,name , args))
     (($ closure label nfree)
      `(closure ,label ,nfree))
     (($ return val)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 6fde3bae0..790ac7c10 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -64,9 +64,6 @@
       (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"))

From 9e498f2430891cabc71aa891c9a1470dbf2d6eea Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 6 Jun 2015 20:10:23 +0100
Subject: [PATCH 04/90] fix makefile

---
 module/Makefile.am | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/Makefile.am b/module/Makefile.am
index 584039bf0..c9fddd62f 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -127,6 +127,7 @@ CPS_LANG_SOURCES =						\
   language/cps.scm						\
   language/cps/closure-conversion.scm				\
   language/cps/compile-bytecode.scm				\
+  language/cps/compile-js.scm				\
   language/cps/constructors.scm					\
   language/cps/contification.scm				\
   language/cps/cse.scm						\
@@ -213,7 +214,7 @@ JS_IL_LANG_SOURCES =				\
 
 JS_LANG_SOURCES =				\
   language/javascript.scm			\
-  language/js-il/spec.scm
+  language/javascript/spec.scm
 
 SCRIPTS_SOURCES =				\
   scripts/compile.scm				\

From 54ce470cf870dd0c8bacd7d9b5bda2e0d24c36ea Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 6 Jun 2015 20:10:57 +0100
Subject: [PATCH 05/90] separate js-il functions into actual functions and
 those for continuations

---
 module/language/cps/compile-js.scm           |  20 ++-
 module/language/js-il.scm                    | 128 +------------------
 module/language/js-il/compile-javascript.scm |   3 +-
 3 files changed, 20 insertions(+), 131 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 6d1edb87d..1d50c89cb 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -51,7 +51,7 @@
        (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
+     (make-function self
                     (cons tail req)
                     (match body
                       (($ $cont k ($ $kargs () () exp))
@@ -76,11 +76,14 @@
   (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))
-     (make-var k (make-function (list arg rest) (make-continue k2 (list (make-id arg) (make-id rest))))))
-    (($ $cont k ($ $kreceive ($ $arity (arg) _ #f _ _) k2))
-     (make-var k (make-function (list arg) (make-continue k2 (list (make-id arg))))))
+     (make-var k (make-continuation syms (compile-term body))))
+    (($ $cont k ($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2))
+     (make-var k
+       (make-continuation (append req (list rest))
+                          (make-continue k2
+                                         (append (map make-id req) (list (make-id rest)))))))
+    (($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2))
+     (make-var k (make-continuation req (make-continue k2 (map make-id req)))))
     (_
      `(cont:todo: ,cont))
     ))
@@ -108,6 +111,11 @@
      (make-primcall name args))
     (($ $closure label nfree)
      (make-closure label nfree))
+    (($ $values (val))
+     ;; FIXME:
+     ;; may happen if a test branch of a conditional compiles to values
+     ;; placeholder till I learn if multiple values could be returned.
+     (make-id val))
     (_
      `(exp:todo: ,exp))))
 
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 946a1c02e..02a99d510 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -3,7 +3,8 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (ice-9 match)
   #:export (make-program program
-            (make-function* . make-function) function
+            make-function function
+            make-continuation continuation
             make-local local
             make-var var
             make-continue continue ; differ from conts
@@ -49,14 +50,7 @@
 
 (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 continuation params body)
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
 (define-js-type continue cont args)
@@ -72,6 +66,8 @@
   (match exp
     (($ program entry body)
      `(program ,(unparse-js entry) . ,(map unparse-js body)))
+    (($ continuation params body)
+     `(continuation ,params ,(unparse-js body)))
     (($ function name params body)
      `(function ,name ,params ,(unparse-js body)))
     (($ local bindings body)
@@ -99,117 +95,3 @@
      ;(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 args)
-     (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))))
-|#
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 790ac7c10..fb5ed5eb3 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -29,11 +29,10 @@
                                            (list (compile-exp entry) entry-call)))
                   '())))
 
-    (($ il:function #f params body)
+    (($ il:continuation 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)

From d1a663baec8a631b3d1e72fd53c4056c1b73cea7 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 6 Jun 2015 20:15:25 +0100
Subject: [PATCH 06/90] Get rid of comments and dead branches

---
 module/language/cps/compile-js.scm | 17 ++++-------------
 module/language/javascript.scm     |  6 ------
 module/language/js-il.scm          | 10 ++--------
 module/language/js-il/spec.scm     |  3 +--
 4 files changed, 7 insertions(+), 29 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 1d50c89cb..3b5e35e12 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -16,7 +16,6 @@
   ;; 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,
@@ -27,16 +26,12 @@
      (values (make-program (compile-fun (car funs))
                            (map compile-fun (cdr funs)))
              env
-             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))))
+     (make-var k (compile-clause clause self tail)))))
 
 (define (compile-clause clause self tail)
   (match clause
@@ -58,9 +53,7 @@
                        (compile-term exp))
                       (($ $cont k _)
                        (make-local (list (compile-cont body))
-                                   (make-continue k (map make-id req)))))))
-    (_
-     `(clause:todo: ,clause))))
+                                   (make-continue k (map make-id req)))))))))
 
 (define (not-supported msg clause)
   (error 'not-supported msg clause))
@@ -115,9 +108,7 @@
      ;; FIXME:
      ;; may happen if a test branch of a conditional compiles to values
      ;; placeholder till I learn if multiple values could be returned.
-     (make-id val))
-    (_
-     `(exp:todo: ,exp))))
+     (make-id val))))
 
 (define (compile-test exp kt kf)
   ;; TODO: find out if the expression is always simple enough that I
diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 0a0b20e56..18ce0f0d5 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -182,9 +182,3 @@
                   (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))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 02a99d510..921bac63a 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -7,13 +7,12 @@
             make-continuation continuation
             make-local local
             make-var var
-            make-continue continue ; differ from conts
+            make-continue continue
             make-const const
             make-primcall primcall
             make-call call
             make-closure closure
             make-branch branch
-            ; print-js
             make-return return
             make-id id
             ))
@@ -78,7 +77,6 @@
      `(continue ,k ,(map unparse-js args)))
     (($ branch test then else)
      `(if ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
-    ;; values
     (($ const c)
      `(const ,c))
     (($ primcall name args)
@@ -90,8 +88,4 @@
     (($ return val)
      `(return . ,(unparse-js val)))
     (($ id name)
-     `(id . ,name))
-    (_
-     ;(error "unexpected js" exp)
-     (pk 'unexpected exp)
-     exp)))
+     `(id . ,name))))
diff --git a/module/language/js-il/spec.scm b/module/language/js-il/spec.scm
index 81ca5da1c..fa4dc8eca 100644
--- a/module/language/js-il/spec.scm
+++ b/module/language/js-il/spec.scm
@@ -1,6 +1,5 @@
 (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))
 
@@ -8,5 +7,5 @@
   #:title	"Javascript Intermediate Language"
   #:reader      #f
   #:compilers   `((javascript . ,compile-javascript))
-  #:printer	#f ; print-js
+  #:printer	#f
   #:for-humans? #f)

From 3b32d180b16c08bfd861879efbc90a7e9d323884 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 7 Jun 2015 16:58:41 +0100
Subject: [PATCH 07/90] Simple inlining of immediate calls

---
 module/language/js-il/compile-javascript.scm |  2 ++
 module/language/js-il/direct.scm             | 36 ++++++++++++++++++++
 2 files changed, 38 insertions(+)
 create mode 100644 module/language/js-il/direct.scm

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index fb5ed5eb3..a0427cc73 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -2,9 +2,11 @@
   #:use-module (ice-9 match)
   #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
   #:use-module (language javascript)
+  #:use-module (language js-il direct)
   #:export (compile-javascript))
 
 (define (compile-javascript exp env opts)
+  (set! exp (remove-immediate-calls exp))
   (values (compile-exp exp) env env))
 
 (define *scheme* (make-id "scheme"))
diff --git a/module/language/js-il/direct.scm b/module/language/js-il/direct.scm
new file mode 100644
index 000000000..6e97e3e9a
--- /dev/null
+++ b/module/language/js-il/direct.scm
@@ -0,0 +1,36 @@
+(define-module (language js-il direct)
+  #:use-module (ice-9 match)
+  #:use-module (language js-il)
+  #:export (remove-immediate-calls))
+
+(define (remove-immediate-calls exp)
+  (match exp
+    (($ program entry body)
+     (make-program (remove-immediate-calls entry)
+                   (map remove-immediate-calls body)))
+
+    (($ continuation params body)
+     (make-continuation params (remove-immediate-calls body)))
+
+    (($ function name params body)
+     (make-function name params (remove-immediate-calls body)))
+
+    (($ local
+        (($ var id ($ continuation () body)))
+        ($ continue id ()))
+     (remove-immediate-calls body))
+
+    (($ local
+        (($ var id ($ continuation (arg) body)))
+        ($ continue id (val)))
+     (make-local (list (make-var arg val))
+                 (remove-immediate-calls body)))
+
+    (($ local bindings body)
+     (make-local (map remove-immediate-calls bindings)
+                 (remove-immediate-calls body)))
+
+    (($ var id exp)
+     (make-var id (remove-immediate-calls exp)))
+
+    (exp exp)))

From f8618a522fbaa732144548f4da556bbf8b2636e1 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 7 Jun 2015 17:00:48 +0100
Subject: [PATCH 08/90] conditional->branch

---
 module/language/javascript.scm               | 8 ++++----
 module/language/js-il/compile-javascript.scm | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 18ce0f0d5..0a30db35b 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -12,7 +12,7 @@
             make-new new
             make-id id
             make-refine refine
-            make-conditional conditional
+            make-branch branch
             make-var var
 
             print-statement))
@@ -55,7 +55,7 @@
 (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 branch test then else)
 (define-js-type var id exp)
 
 (define (unparse-js exp)
@@ -76,7 +76,7 @@
      `(id ,name))
     (($ refine id field)
      `(refine ,(unparse-js id) ,(unparse-js field)))
-    (($ conditional test then else)
+    (($ branch test then else)
      `(if ,(unparse-js test)
           (block ,@(map unparse-js then))
           (block ,@(map unparse-js else))))
@@ -134,7 +134,7 @@
      (print-exp exp port)
      (format port ";"))
 
-    (($ conditional test then else)
+    (($ branch test then else)
      (format port "if (")
      (print-exp test port)
      (format port ") {")
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index a0427cc73..373d5a9d3 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -47,10 +47,10 @@
      (make-return (make-call (name->id k) (map compile-exp exps))))
 
     (($ 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))))
+     (make-branch (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))

From a3ddf537dc2ef03adad7487f2513108d3fa65c5e Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 7 Jun 2015 17:11:22 +0100
Subject: [PATCH 09/90] get rid of unused match case

---
 module/language/cps/compile-js.scm | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 3b5e35e12..250b7a17b 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -76,10 +76,7 @@
                           (make-continue k2
                                          (append (map make-id req) (list (make-id rest)))))))
     (($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2))
-     (make-var k (make-continuation req (make-continue k2 (map make-id req)))))
-    (_
-     `(cont:todo: ,cont))
-    ))
+     (make-var k (make-continuation req (make-continue k2 (map make-id req)))))))
 
 (define (compile-exp exp k)
  (match exp

From 1bed3f047e8ec4b6e0c7c4e48245d863a340158b Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 7 Jun 2015 18:36:53 +0100
Subject: [PATCH 10/90] fix makefile

---
 module/Makefile.am | 1 +
 1 file changed, 1 insertion(+)

diff --git a/module/Makefile.am b/module/Makefile.am
index c9fddd62f..7a9e7157a 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -209,6 +209,7 @@ BRAINFUCK_LANG_SOURCES =			\
 
 JS_IL_LANG_SOURCES =				\
   language/js-il.scm				\
+  language/js-il/direct.scm			\
   language/js-il/compile-javascript.scm		\
   language/js-il/spec.scm
 

From 86fabef4ca8c73ea6aa293d3685b52df0f442eb2 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 7 Jun 2015 21:47:08 +0100
Subject: [PATCH 11/90] Compile rest args

---
 module/language/cps/compile-js.scm           |  9 ++++----
 module/language/js-il.scm                    |  8 ++++---
 module/language/js-il/compile-javascript.scm | 23 ++++++++++++++++++--
 module/language/js-il/direct.scm             |  4 ++--
 4 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 250b7a17b..826f646a2 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -40,20 +40,19 @@
      ;; 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
-                    (cons tail req)
+     (make-function (make-params self (cons tail req) rest)
                     (match body
                       (($ $cont k ($ $kargs () () exp))
                        (compile-term exp))
                       (($ $cont k _)
                        (make-local (list (compile-cont body))
-                                   (make-continue k (map make-id req)))))))))
+                                   (make-continue
+                                    k
+                                    (map make-id (append req (if rest (list rest) '())))))))))))
 
 (define (not-supported msg clause)
   (error 'not-supported msg clause))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 921bac63a..4c6c34691 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -4,6 +4,7 @@
   #:use-module (ice-9 match)
   #:export (make-program program
             make-function function
+            make-params params
             make-continuation continuation
             make-local local
             make-var var
@@ -48,7 +49,8 @@
   (format port "#<js-il ~S>" (unparse-js exp)))
 
 (define-js-type program entry body)
-(define-js-type function name params body)
+(define-js-type function params body)
+(define-js-type params self req rest)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
@@ -67,8 +69,8 @@
      `(program ,(unparse-js entry) . ,(map unparse-js body)))
     (($ continuation params body)
      `(continuation ,params ,(unparse-js body)))
-    (($ function name params body)
-     `(function ,name ,params ,(unparse-js body)))
+    (($ function ($ params self req opt) body)
+     `(function ,(append (list self) req (if opt (list opt) '())) ,(unparse-js body)))
     (($ local bindings body)
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 373d5a9d3..676d4480f 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -17,6 +17,20 @@
 (define (rename name)
   (format #f "kont_~a" name))
 
+(define (bind-rest-args rest num-drop)
+  (define (ref i l)
+    (if (null? l)
+        i
+        (ref (make-refine i (make-const (car l)))
+             (cdr l))))
+  (define this (rename rest))
+  (make-var this
+            (make-call (ref *scheme* (list "list" "apply"))
+                       (list
+                        (ref *scheme* (list "list"))
+                        (make-call (ref (make-id "Array") (list "prototype" "slice" "call"))
+                                   (list (make-id "arguments") (make-const num-drop)))))))
+
 (define (compile-exp exp)
   ;; TODO: handle ids for js
   (match exp
@@ -34,8 +48,13 @@
     (($ il:continuation params body)
      (make-function (map rename params) (list (compile-exp body))))
 
-    (($ il:function name params body)
-     (make-function (map rename (cons name params)) (list (compile-exp body))))
+    (($ il:function ($ il:params self req #f) body)
+     (make-function (map rename (cons self req)) (list (compile-exp body))))
+
+    (($ il:function ($ il:params self req rest) body)
+     (make-function (map rename (cons self req))
+                    (list (bind-rest-args rest (length (cons self req)))
+                          (compile-exp body))))
 
     (($ il:local bindings body)
      (make-block (append (map compile-exp bindings) (list (compile-exp body)))))
diff --git a/module/language/js-il/direct.scm b/module/language/js-il/direct.scm
index 6e97e3e9a..e43164963 100644
--- a/module/language/js-il/direct.scm
+++ b/module/language/js-il/direct.scm
@@ -12,8 +12,8 @@
     (($ continuation params body)
      (make-continuation params (remove-immediate-calls body)))
 
-    (($ function name params body)
-     (make-function name params (remove-immediate-calls body)))
+    (($ function params body)
+     (make-function params (remove-immediate-calls body)))
 
     (($ local
         (($ var id ($ continuation () body)))

From a4003003e2766805b28c8187b6939d4206b2fe0b Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 7 Jun 2015 21:48:02 +0100
Subject: [PATCH 12/90] Compile string constants

---
 module/language/javascript.scm               | 3 +++
 module/language/js-il/compile-javascript.scm | 5 +++++
 module/language/js-il/runtime.js             | 4 ++++
 3 files changed, 12 insertions(+)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 0a30db35b..37b7b28da 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -167,6 +167,9 @@
 
 (define (print-const c port)
   (cond ((string? c)
+         ;; FIXME:
+         ;; Scheme strings and JS Strings are different, and not just in
+         ;; terms of mutability
          (write c port))
         ((number? c)
          (write c port))
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 676d4480f..3d50bcc7b 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -112,5 +112,10 @@
          (make-call
            (make-refine *scheme* (make-const "list"))
            (map compile-const c)))
+        ((string? c)
+         (make-new
+          (make-call
+           (make-refine *scheme* (make-const "String"))
+           (list (make-const c)))))
         (else
          (throw 'uncompilable-const c))))
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 502c61b57..ac2d4e380 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -118,6 +118,10 @@ scheme.Symbol = function(s) {
 // Chars
 
 // Strings
+scheme.String = function(s) {
+    this.s = s;
+    return this;
+};
 
 // Closures
 scheme.Closure = function(f, size) {

From 41023d5b4cd322d51319ba8e9bbd1a7f3cfb7091 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 8 Jun 2015 00:17:22 +0100
Subject: [PATCH 13/90] Mangle js identifiers

---
 module/language/js-il/compile-javascript.scm | 37 ++++++++++++++++++--
 1 file changed, 35 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 3d50bcc7b..19e8eb72a 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -14,8 +14,41 @@
 (define (name->id name)
   (make-id (rename name)))
 
-(define (rename name)
-  (format #f "kont_~a" name))
+(define (rename id)
+  (cond ((and (integer? id) (>= id 0))
+         (format #f "k_~a " id))
+        ((symbol? id)
+         (js-id (symbol->string id)))
+        ((string? id)
+         (js-id id))
+        (else
+         (throw 'bad-id id))))
+
+(define (js-id name)
+  (call-with-output-string
+   (lambda (port)
+     (display "k_" port)
+     (string-for-each
+      (lambda (c)
+        (if (or (and (char<=? #\a c) (char<=? c #\z))
+                (and (char<=? #\A c) (char<=? c #\Z))
+                (and (char<=? #\0 c) (char<=? c #\9)))
+            (display c port)
+            (case c
+              ((#\-) (display "_h" port))
+              ((#\_) (display "_u" port))
+              ((#\?) (display "_p" port))
+              ((#\!) (display "_x" port))
+              ((#\<) (display "_l" port))
+              ((#\>) (display "_g" port))
+              ((#\=) (display "_e" port))
+              ((#\*) (display "_s" port))
+              ((#\+) (display "_a" port))
+              ((#\\) (display "_b" port))
+              ((#\/) (display "_f" port))
+              (else
+               (throw 'bad-id-char  c)))))
+      name))))
 
 (define (bind-rest-args rest num-drop)
   (define (ref i l)

From 30afdcd97678e7aceb9bea187752f307a936f5ca Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 8 Jun 2015 18:02:01 +0100
Subject: [PATCH 14/90] Add binop type

---
 module/language/javascript.scm | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 37b7b28da..748621355 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -14,6 +14,7 @@
             make-refine refine
             make-branch branch
             make-var var
+            make-binop binop
 
             print-statement))
 
@@ -57,6 +58,7 @@
 (define-js-type refine id field)
 (define-js-type branch test then else)
 (define-js-type var id exp)
+(define-js-type binop op arg1 arg2)
 
 (define (unparse-js exp)
   (match exp
@@ -81,7 +83,9 @@
           (block ,@(map unparse-js then))
           (block ,@(map unparse-js else))))
     (($ var id exp)
-     `(var ,id ,(unparse-js exp)))))
+     `(var ,id ,(unparse-js exp)))
+    (($ binop op arg1 arg2)
+     `(binop ,op ,arg1 ,arg2))))
 
 (define (print-exp exp port)
   (match exp
@@ -123,7 +127,25 @@
 
     (($ new expr)
      (format port "new ")
-     (print-exp expr port))))
+     (print-exp expr port))
+
+    (($ binop op arg1 arg2)
+     (display "(" port)
+     (print-exp arg1 port)
+     (display ")" port)
+     (print-binop op port)
+     (display "(" port)
+     (print-exp arg2 port)
+     (display ")" port))))
+
+(define (print-binop op port)
+  (case op
+    ((or) (display "||" port))
+    ((and) (display "&&" port))
+    ((=) (display "==" port))
+    ((+ - < <= > >=) (format port "~a" op))
+    (else
+     (throw 'unprintable-binop op))))
 
 (define (print-statement stmt port)
   (match stmt

From 44e04eae0a193a63cf6057df6980056879f6622d Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 9 Jun 2015 17:08:09 +0100
Subject: [PATCH 15/90] Handle case-lambda via a jump table

---
 module/language/cps/compile-js.scm           | 58 +++++++++++++-------
 module/language/js-il.scm                    | 12 +++-
 module/language/js-il/compile-javascript.scm | 55 +++++++++++++++++--
 3 files changed, 97 insertions(+), 28 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 826f646a2..dd7241d3d 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -30,29 +30,47 @@
 
 (define (compile-fun fun)
   (match fun
-    (($ $cont k ($ $kfun src meta self ($ $cont tail ($ $ktail)) clause))
-     (make-var k (compile-clause clause self tail)))))
+    (($ $cont k ($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause))
+     (call-with-values
+         (lambda ()
+           (extract-clauses self clause))
+       (lambda (jump-table clauses)
+         (make-var
+          k
+          (make-function
+           (list self tail)
+           (make-local (map (lambda (clause)
+                              (compile-clause clause self tail))
+                            clauses)
+                       (make-jump-table jump-table)))))))))
+
+(define (extract-clauses self clause)
+  (let loop ((clause clause) (specs '()) (clauses '()))
+    (match clause
+      (($ $cont k ($ $kclause ($ $arity req _ rest _ _) _ #f))
+       (values (reverse (cons (cons (make-params self req rest) k) specs))
+               (reverse (cons clause clauses))))
+      (($ $cont k ($ $kclause ($ $arity req _ rest _ _) _ alternate))
+       (loop alternate
+             (cons (cons (make-params self req rest) k) specs)
+             (cons clause clauses))))))
 
 (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))
-     (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 (make-params self (cons tail req) rest)
-                    (match body
-                      (($ $cont k ($ $kargs () () exp))
-                       (compile-term exp))
-                      (($ $cont k _)
-                       (make-local (list (compile-cont body))
-                                   (make-continue
-                                    k
-                                    (map make-id (append req (if rest (list rest) '())))))))))))
+    (($ $cont k ($ $kclause ($ $arity req _ rest _) body _))
+     (make-var
+      k
+      (make-continuation
+       (append (list self)
+               req (if rest (list rest) '()))
+       (match body
+         (($ $cont k ($ $kargs () () exp))
+          (compile-term exp))
+         (($ $cont k _)
+          (make-local (list (compile-cont body))
+                      (make-continue
+                       k
+                       (map make-id (append req (if rest (list rest) '()))))))))))))
 
 (define (not-supported msg clause)
   (error 'not-supported msg clause))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 4c6c34691..943590efc 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -4,6 +4,7 @@
   #:use-module (ice-9 match)
   #:export (make-program program
             make-function function
+            make-jump-table jump-table
             make-params params
             make-continuation continuation
             make-local local
@@ -50,6 +51,7 @@
 
 (define-js-type program entry body)
 (define-js-type function params body)
+(define-js-type jump-table spec)
 (define-js-type params self req rest)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
@@ -69,8 +71,14 @@
      `(program ,(unparse-js entry) . ,(map unparse-js body)))
     (($ continuation params body)
      `(continuation ,params ,(unparse-js body)))
-    (($ function ($ params self req opt) body)
-     `(function ,(append (list self) req (if opt (list opt) '())) ,(unparse-js body)))
+    (($ function args body)
+     `(function ,args ,(unparse-js body)))
+    (($ jump-table body)
+     `(jump-table ,@(map (lambda (p)
+                           `(,(unparse-js (car p)) . ,(cdr p)))
+                         body)))
+    (($ params self req rest)
+     `(params ,self ,req ,rest))
     (($ local bindings body)
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 19e8eb72a..3c9385bed 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -1,4 +1,5 @@
 (define-module (language js-il compile-javascript)
+  #:use-module ((srfi srfi-1) #:select (fold-right))
   #:use-module (ice-9 match)
   #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
   #:use-module (language javascript)
@@ -81,13 +82,11 @@
     (($ il:continuation params body)
      (make-function (map rename params) (list (compile-exp body))))
 
-    (($ il:function ($ il:params self req #f) body)
-     (make-function (map rename (cons self req)) (list (compile-exp body))))
+    (($ il:function params body)
+     (make-function (map rename params) (list (compile-exp body))))
 
-    (($ il:function ($ il:params self req rest) body)
-     (make-function (map rename (cons self req))
-                    (list (bind-rest-args rest (length (cons self req)))
-                          (compile-exp body))))
+    (($ il:jump-table specs)
+     (compile-jump-table specs))
 
     (($ il:local bindings body)
      (make-block (append (map compile-exp bindings) (list (compile-exp body)))))
@@ -125,6 +124,50 @@
     (($ il:id name)
      (name->id name))))
 
+(define (compile-jump-table specs)
+  (define offset 2) ; closure & continuation
+  (define (compile-test params)
+    (match params
+      (($ il:params self req #f)
+       (make-binop '=
+                   (make-refine (make-id "arguments")
+                                (make-const "length"))
+                   (make-const (+ offset (length req)))))
+      (($ il:params self req rest)
+       (make-binop '>=
+                   (make-refine (make-id "arguments")
+                                (make-const "length"))
+                   (make-const (+ offset (length req)))))))
+  (define (compile-jump params k)
+    (match params
+      (($ il:params self req #f)
+       (list
+        (make-return
+         (make-call (name->id k)
+                    (cons (name->id self)
+                          (map (lambda (idx)
+                                 (make-refine (make-id "arguments")
+                                              (make-const (+ offset idx))))
+                               (iota (length req))))))))
+      (($ il:params self req rest)
+       (list
+        (bind-rest-args rest (+ offset (length req)))
+        (make-return
+         (make-call (name->id k)
+                    (append (list (name->id self))
+                            (map (lambda (idx)
+                                   (make-refine (make-id "arguments")
+                                                (make-const (+ offset idx))))
+                                 (iota (length req)))
+                            (list (name->id rest)))))))))
+  (fold-right (lambda (a d)
+                (make-branch (compile-test (car a))
+                             (compile-jump (car a) (cdr a))
+                             (list d)))
+              ;; FIXME: should throw an error
+              (make-return (make-id "undefined"))
+              specs))
+
 (define (compile-const c)
   (cond ((number? c)
          (make-const c))

From f83c651f462c7c6c091fda1e6b4b3b39fc57b2f1 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 9 Jun 2015 17:08:59 +0100
Subject: [PATCH 16/90] Remove superfluous space

---
 module/language/js-il/compile-javascript.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 3c9385bed..0952a8679 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -17,7 +17,7 @@
 
 (define (rename id)
   (cond ((and (integer? id) (>= id 0))
-         (format #f "k_~a " id))
+         (format #f "k_~a" id))
         ((symbol? id)
          (js-id (symbol->string id)))
         ((string? id)

From 941f8fac015702221aa5245fc5d7f91ac27267ef Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Fri, 12 Jun 2015 18:27:14 +0100
Subject: [PATCH 17/90] Implement Optional arguments

---
 module/language/cps/compile-js.scm           | 15 +++---
 module/language/js-il.scm                    |  6 +--
 module/language/js-il/compile-javascript.scm | 54 +++++++++++++++++---
 module/language/js-il/runtime.js             |  4 +-
 4 files changed, 61 insertions(+), 18 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index dd7241d3d..1e36aec49 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -47,22 +47,21 @@
 (define (extract-clauses self clause)
   (let loop ((clause clause) (specs '()) (clauses '()))
     (match clause
-      (($ $cont k ($ $kclause ($ $arity req _ rest _ _) _ #f))
-       (values (reverse (cons (cons (make-params self req rest) k) specs))
+      (($ $cont k ($ $kclause ($ $arity req opts rest _ _) _ #f))
+       (values (reverse (cons (cons (make-params self req opts rest) k) specs))
                (reverse (cons clause clauses))))
-      (($ $cont k ($ $kclause ($ $arity req _ rest _ _) _ alternate))
+      (($ $cont k ($ $kclause ($ $arity req opts rest _ _) _ alternate))
        (loop alternate
-             (cons (cons (make-params self req rest) k) specs)
+             (cons (cons (make-params self req opts rest) k) specs)
              (cons clause clauses))))))
 
 (define (compile-clause clause self tail)
   (match clause
-    (($ $cont k ($ $kclause ($ $arity req _ rest _) body _))
+    (($ $cont k ($ $kclause ($ $arity req opt rest _) body _))
      (make-var
       k
       (make-continuation
-       (append (list self)
-               req (if rest (list rest) '()))
+       (append (list self) req opt (if rest (list rest) '()))
        (match body
          (($ $cont k ($ $kargs () () exp))
           (compile-term exp))
@@ -70,7 +69,7 @@
           (make-local (list (compile-cont body))
                       (make-continue
                        k
-                       (map make-id (append req (if rest (list rest) '()))))))))))))
+                       (map make-id (append req opt (if rest (list rest) '()))))))))))))
 
 (define (not-supported msg clause)
   (error 'not-supported msg clause))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 943590efc..acaeb5a78 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -52,7 +52,7 @@
 (define-js-type program entry body)
 (define-js-type function params body)
 (define-js-type jump-table spec)
-(define-js-type params self req rest)
+(define-js-type params self req opt rest)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
@@ -77,8 +77,8 @@
      `(jump-table ,@(map (lambda (p)
                            `(,(unparse-js (car p)) . ,(cdr p)))
                          body)))
-    (($ params self req rest)
-     `(params ,self ,req ,rest))
+    (($ params self req opt rest)
+     `(params ,self ,req ,opt ,rest))
     (($ local bindings body)
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 0952a8679..7f814fff9 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -4,8 +4,15 @@
   #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
   #:use-module (language javascript)
   #:use-module (language js-il direct)
+  #:use-module (system foreign)
   #:export (compile-javascript))
 
+(define (undefined? obj)
+  (define tc8-iflag 4)
+  (define unbound-val 9)
+  (define unbound-bits (logior (ash unbound-val 8) tc8-iflag))
+  (eqv? obj (pointer->scm (make-pointer unbound-bits))))
+
 (define (compile-javascript exp env opts)
   (set! exp (remove-immediate-calls exp))
   (values (compile-exp exp) env env))
@@ -65,6 +72,17 @@
                         (make-call (ref (make-id "Array") (list "prototype" "slice" "call"))
                                    (list (make-id "arguments") (make-const num-drop)))))))
 
+(define (bind-opt-args opts num-drop)
+  (map (lambda (opt idx)
+         (make-var (rename opt)
+                   (make-binop 'or
+                               (make-refine (make-id "arguments")
+                                            (make-const (+ num-drop idx)))
+                               (make-refine *scheme* (make-const "UNDEFINED")))))
+       opts
+       (iota (length opts))))
+
+
 (define (compile-exp exp)
   ;; TODO: handle ids for js
   (match exp
@@ -128,19 +146,30 @@
   (define offset 2) ; closure & continuation
   (define (compile-test params)
     (match params
-      (($ il:params self req #f)
+      (($ il:params self req '() #f)
        (make-binop '=
                    (make-refine (make-id "arguments")
                                 (make-const "length"))
                    (make-const (+ offset (length req)))))
-      (($ il:params self req rest)
+      (($ il:params self req '() rest)
        (make-binop '>=
                    (make-refine (make-id "arguments")
                                 (make-const "length"))
-                   (make-const (+ offset (length req)))))))
+                   (make-const (+ offset (length req)))))
+      (($ il:params self req opts #f)
+       (make-binop 'and
+                   (make-binop '<=
+                               (make-const (+ offset (length req)))
+                               (make-refine (make-id "arguments")
+                                            (make-const "length")))
+                   (make-binop '<=
+                               (make-refine (make-id "arguments")
+                                            (make-const "length"))
+                               (make-const (+ offset (length req) (length opts))))))
+      ))
   (define (compile-jump params k)
     (match params
-      (($ il:params self req #f)
+      (($ il:params self req '() #f)
        (list
         (make-return
          (make-call (name->id k)
@@ -149,7 +178,7 @@
                                  (make-refine (make-id "arguments")
                                               (make-const (+ offset idx))))
                                (iota (length req))))))))
-      (($ il:params self req rest)
+      (($ il:params self req '() rest)
        (list
         (bind-rest-args rest (+ offset (length req)))
         (make-return
@@ -159,7 +188,20 @@
                                    (make-refine (make-id "arguments")
                                                 (make-const (+ offset idx))))
                                  (iota (length req)))
-                            (list (name->id rest)))))))))
+                            (list (name->id rest)))))))
+      (($ il:params self req opts #f)
+       (append
+        (bind-opt-args opts (+ offset (length req)))
+        (list
+         (make-return
+          (make-call (name->id k)
+                     (append (list (name->id self))
+                             (map (lambda (idx)
+                                    (make-refine (make-id "arguments")
+                                                 (make-const (+ offset idx))))
+                                  (iota (length req)))
+                             (map name->id opts)))))))
+      ))
   (fold-right (lambda (a d)
                 (make-branch (compile-test (car a))
                              (compile-jump (car a) (cdr a))
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index ac2d4e380..1e51c6bc5 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -9,7 +9,9 @@ var scheme = {
     TRUE : true,
     NIL  : false,
     EMPTY : [],
-    UNSPECIFIED : []
+    UNSPECIFIED : [],
+    // FIXME: wingo says not to leak undefined to users
+    UNDEFINED: undefined
 };
 
 function not_implemented_yet() {

From e9d0f97410d3549caab95acea1b706e544e44f8b Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Fri, 12 Jun 2015 18:30:39 +0100
Subject: [PATCH 18/90] Add more types of constants

---
 module/language/js-il/compile-javascript.scm | 23 +++++++++++++++++
 module/language/js-il/runtime.js             | 26 ++++++++++++++++++++
 2 files changed, 49 insertions(+)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 7f814fff9..3b13e0844 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -235,5 +235,28 @@
           (make-call
            (make-refine *scheme* (make-const "String"))
            (list (make-const c)))))
+        ((pair? c)
+         (make-new
+          (make-call
+           (make-refine *scheme* (make-const "Pair"))
+           (list (compile-const (car c))
+                 (compile-const (cdr c))))))
+        ((vector? c)
+         (make-new
+          (make-call
+           (make-refine *scheme* (make-const "Vector"))
+           (map compile-const (vector->list c)))))
+        ((char? c)
+         (make-new
+          (make-call
+           (make-refine *scheme* (make-const "Char"))
+           (list (make-const (string c))))))
+        ((keyword? c)
+         (make-new
+          (make-call
+           (make-refine *scheme* (make-const "Keyword"))
+           (list (make-const (symbol->string (keyword->symbol c)))))))
+        ((undefined? c)
+         (make-refine *scheme* (make-const "UNDEFINED")))
         (else
          (throw 'uncompilable-const c))))
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 1e51c6bc5..6569cbe29 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -111,13 +111,39 @@ scheme.Symbol = function(s) {
     };
 };
 
+// Keywords
+scheme.Keyword = function(s) {
+    this.name = s;
+    return this;
+};
+
 // Vectors
+scheme.Vector = function () {
+    this.array = Array.prototype.slice.call(arguments);
+    return this;
+};
+
+scheme.primitives["vector-ref"] = function (vec, idx) {
+    return vec.array[idx];
+};
+
+scheme.primitives["vector-set!"] = function (vec, idx, obj) {
+    return vec.array[idx] = obj;
+};
+
+scheme.primitives["vector-length"] = function (vec) {
+    return vec.array.length;
+};
 
 // Bytevectors
 
 // Booleans
 
 // Chars
+scheme.Char = function(c) {
+    this.c = c;
+    return this;
+};
 
 // Strings
 scheme.String = function(s) {

From 46905ec32223938e7ac4380ec9bdea791fce75d1 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 13 Jun 2015 15:29:13 +0100
Subject: [PATCH 19/90] Simplify output Javascript

---
 module/language/javascript/simplify.scm      | 48 ++++++++++++++++++++
 module/language/js-il/compile-javascript.scm |  5 +-
 2 files changed, 52 insertions(+), 1 deletion(-)
 create mode 100644 module/language/javascript/simplify.scm

diff --git a/module/language/javascript/simplify.scm b/module/language/javascript/simplify.scm
new file mode 100644
index 000000000..b3360aa40
--- /dev/null
+++ b/module/language/javascript/simplify.scm
@@ -0,0 +1,48 @@
+(define-module (language javascript simplify)
+  #:use-module (language javascript)
+  #:use-module (ice-9 match)
+  #:use-module ((srfi srfi-1) #:select (fold-right))
+  #:export (flatten-blocks))
+
+(define (flatten-blocks exp)
+  (define (flatten exp rest)
+    (match exp
+      (($ block statements)
+       (fold-right flatten rest statements))
+      (else
+       (cons (flatten-exp exp) rest))))
+  (define (flatten-block stmts)
+    (fold-right flatten '() stmts))
+  (define (flatten-exp exp)
+    (match exp
+      (($ const c) exp)
+      (($ new exp)
+       (make-new (flatten-exp exp)))
+      (($ return exp)
+       (make-return (flatten-exp exp)))
+      (($ id name) exp)
+      (($ var id exp)
+       (make-var id (flatten-exp exp)))
+      (($ refine id field)
+       (make-refine (flatten-exp id)
+                    (flatten-exp field)))
+      (($ binop op arg1 arg2)
+       (make-binop op
+                   (flatten-exp arg1)
+                   (flatten-exp arg2)))
+      (($ function args body)
+       (make-function args (flatten-block body)))
+      (($ block statements)
+       (maybe-make-block (flatten-block statements)))
+      (($ branch test then else)
+       (make-branch (flatten-exp test)
+                    (flatten-block then)
+                    (flatten-block else)))
+      (($ call function args)
+       (make-call (flatten-exp function)
+                  (map flatten-exp args)))))
+  (define (maybe-make-block exp)
+    (match exp
+      ((exp) exp)
+      (exps (make-block exps))))
+  (maybe-make-block (flatten exp '())))
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 3b13e0844..ca7cca552 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -3,6 +3,7 @@
   #:use-module (ice-9 match)
   #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
   #:use-module (language javascript)
+  #:use-module (language javascript simplify)
   #:use-module (language js-il direct)
   #:use-module (system foreign)
   #:export (compile-javascript))
@@ -15,7 +16,9 @@
 
 (define (compile-javascript exp env opts)
   (set! exp (remove-immediate-calls exp))
-  (values (compile-exp exp) env env))
+  (set! exp (compile-exp exp))
+  (set! exp (flatten-blocks exp))
+  (values exp env env))
 
 (define *scheme* (make-id "scheme"))
 

From e84f8394633339284953d7e54fe3cd5018d2e160 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 13 Jun 2015 22:41:37 +0100
Subject: [PATCH 20/90] Implement keyword argument parsing

---
 module/language/cps/compile-js.scm           | 14 +++---
 module/language/js-il.scm                    |  6 +--
 module/language/js-il/compile-javascript.scm | 45 +++++++++++++++++---
 module/language/js-il/runtime.js             | 20 +++++++++
 4 files changed, 69 insertions(+), 16 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 1e36aec49..8bffa9772 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -47,21 +47,21 @@
 (define (extract-clauses self clause)
   (let loop ((clause clause) (specs '()) (clauses '()))
     (match clause
-      (($ $cont k ($ $kclause ($ $arity req opts rest _ _) _ #f))
-       (values (reverse (cons (cons (make-params self req opts rest) k) specs))
+      (($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ #f))
+       (values (reverse (cons (cons (make-params self req opts rest kw allow-other-keys?) k) specs))
                (reverse (cons clause clauses))))
-      (($ $cont k ($ $kclause ($ $arity req opts rest _ _) _ alternate))
+      (($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ alternate))
        (loop alternate
-             (cons (cons (make-params self req opts rest) k) specs)
+             (cons (cons (make-params self req opts rest kw allow-other-keys?) k) specs)
              (cons clause clauses))))))
 
 (define (compile-clause clause self tail)
   (match clause
-    (($ $cont k ($ $kclause ($ $arity req opt rest _) body _))
+    (($ $cont k ($ $kclause ($ $arity req opt rest ((_ _ kw-syms) ...) _) body _))
      (make-var
       k
       (make-continuation
-       (append (list self) req opt (if rest (list rest) '()))
+       (append (list self) req opt kw-syms (if rest (list rest) '()))
        (match body
          (($ $cont k ($ $kargs () () exp))
           (compile-term exp))
@@ -69,7 +69,7 @@
           (make-local (list (compile-cont body))
                       (make-continue
                        k
-                       (map make-id (append req opt (if rest (list rest) '()))))))))))))
+                       (map make-id (append req opt kw-syms (if rest (list rest) '()))))))))))))
 
 (define (not-supported msg clause)
   (error 'not-supported msg clause))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index acaeb5a78..3415cd9b4 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -52,7 +52,7 @@
 (define-js-type program entry body)
 (define-js-type function params body)
 (define-js-type jump-table spec)
-(define-js-type params self req opt rest)
+(define-js-type params self req opt rest kw allow-other-keys?)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
@@ -77,8 +77,8 @@
      `(jump-table ,@(map (lambda (p)
                            `(,(unparse-js (car p)) . ,(cdr p)))
                          body)))
-    (($ params self req opt rest)
-     `(params ,self ,req ,opt ,rest))
+    (($ params self req opt rest kw allow-other-keys?)
+     `(params ,self ,req ,opt ,rest ,kw ,allow-other-keys?))
     (($ local bindings body)
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index ca7cca552..27f91ad18 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -21,6 +21,7 @@
   (values exp env env))
 
 (define *scheme* (make-id "scheme"))
+(define *utils*  (make-refine *scheme* (make-const "utils")))
 
 (define (name->id name)
   (make-id (rename name)))
@@ -85,6 +86,18 @@
        opts
        (iota (length opts))))
 
+(define (bind-kw-args kws ids num-drop)
+  (define lookup (make-refine *utils* (make-const "keyword_ref")))
+  (map (lambda (kw id)
+         (make-var (rename id)
+                   (make-call lookup
+                              (list (compile-const kw)
+                                    (make-id "arguments")
+                                    (compile-const num-drop)
+                                    (make-refine *scheme* (make-const "UNDEFINED"))))))
+       kws
+       ids))
+
 
 (define (compile-exp exp)
   ;; TODO: handle ids for js
@@ -149,17 +162,17 @@
   (define offset 2) ; closure & continuation
   (define (compile-test params)
     (match params
-      (($ il:params self req '() #f)
+      (($ il:params self req '() #f '() #f)
        (make-binop '=
                    (make-refine (make-id "arguments")
                                 (make-const "length"))
                    (make-const (+ offset (length req)))))
-      (($ il:params self req '() rest)
+      (($ il:params self req '() rest '() #f)
        (make-binop '>=
                    (make-refine (make-id "arguments")
                                 (make-const "length"))
                    (make-const (+ offset (length req)))))
-      (($ il:params self req opts #f)
+      (($ il:params self req opts #f '() #f)
        (make-binop 'and
                    (make-binop '<=
                                (make-const (+ offset (length req)))
@@ -169,10 +182,16 @@
                                (make-refine (make-id "arguments")
                                             (make-const "length"))
                                (make-const (+ offset (length req) (length opts))))))
+      ;; FIXME: need to handle allow-other-keys? and testing for actual keywords
+      (($ il:params self req opts #f kwargs _)
+       (make-binop '<=
+                   (make-const (+ offset (length req)))
+                   (make-refine (make-id "arguments")
+                                (make-const "length"))))
       ))
   (define (compile-jump params k)
     (match params
-      (($ il:params self req '() #f)
+      (($ il:params self req '() #f '() #f)
        (list
         (make-return
          (make-call (name->id k)
@@ -181,7 +200,7 @@
                                  (make-refine (make-id "arguments")
                                               (make-const (+ offset idx))))
                                (iota (length req))))))))
-      (($ il:params self req '() rest)
+      (($ il:params self req '() rest '() #f)
        (list
         (bind-rest-args rest (+ offset (length req)))
         (make-return
@@ -192,7 +211,7 @@
                                                 (make-const (+ offset idx))))
                                  (iota (length req)))
                             (list (name->id rest)))))))
-      (($ il:params self req opts #f)
+      (($ il:params self req opts #f '() #f)
        (append
         (bind-opt-args opts (+ offset (length req)))
         (list
@@ -204,6 +223,20 @@
                                                  (make-const (+ offset idx))))
                                   (iota (length req)))
                              (map name->id opts)))))))
+      (($ il:params self req opts #f ((kws names ids) ...) _)
+       (append
+        (bind-opt-args opts (+ offset (length req)))
+        (bind-kw-args kws names (+ offset (length req)))
+        (list
+         (make-return
+          (make-call (name->id k)
+                     (append (list (name->id self))
+                             (map (lambda (idx)
+                                    (make-refine (make-id "arguments")
+                                                 (make-const (+ offset idx))))
+                                  (iota (length req)))
+                             (map name->id opts)
+                             (map name->id names)))))))
       ))
   (fold-right (lambda (a d)
                 (make-branch (compile-test (car a))
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 6569cbe29..688974e2e 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1,6 +1,7 @@
 var scheme = {
     obarray : {},
     primitives : {},
+    utils : {},
     env : {},
     cache: [],
     builtins: [],
@@ -117,6 +118,25 @@ scheme.Keyword = function(s) {
     return this;
 };
 
+scheme.utils.keyword_ref = function(kw, args, start, dflt) {
+    var l = args.length;
+
+    if ((l - start) % 2 == 1) {
+        // FIXME: should error
+        return undefined;
+    }
+    // Need to loop in reverse because last matching keyword wins
+    for (var i = l - 2; i >= start; i -= 2) {
+        if (!(args[i] instanceof scheme.Keyword)) {
+            return undefined;
+        }
+        if (args[i].name === kw.name) {
+            return args[i + 1];
+        }
+    }
+    return dflt;
+};
+
 // Vectors
 scheme.Vector = function () {
     this.array = Array.prototype.slice.call(arguments);

From 4622269e684ad5918aff1b7fa29a47ad2c17b0a4 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 15 Jun 2015 16:34:42 +0100
Subject: [PATCH 21/90] Primitives should return Scheme Booleans

---
 module/language/js-il/runtime.js | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 688974e2e..271e50837 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -19,6 +19,10 @@ function not_implemented_yet() {
     throw "not implemented yet";
 };
 
+function coerce_bool(obj) {
+    return obj ? scheme.TRUE : scheme.FALSE;
+};
+
 // Numbers
 scheme.primitives.add = function (x, y) {
     return x + y;
@@ -45,11 +49,12 @@ scheme.primitives.div = function (x, y) {
 };
 
 scheme.primitives["="] = function (x, y) {
-    return x == y;
+    return coerce_bool(x == y);
 };
 
 scheme.primitives["<"] = function (x, y) {
-    return x < y;
+    return coerce_bool(x < y);
+};
 };
 
 scheme.primitives.quo = not_implemented_yet;
@@ -98,7 +103,7 @@ scheme.list = function () {
 };
 
 scheme.primitives["null?"] = function(obj) {
-    return scheme.EMPTY == obj;
+    return coerce_bool(scheme.EMPTY == obj);
 };
 
 // Symbols

From 48e84c5a2c170e8b1d868705400821cff486e079 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 15 Jun 2015 16:37:22 +0100
Subject: [PATCH 22/90] Add more Scheme Primitives to runtime.js

---
 module/language/js-il/runtime.js | 95 +++++++++++++++++++++++++++++++-
 1 file changed, 94 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 271e50837..d0aff57fb 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -55,6 +55,17 @@ scheme.primitives["="] = function (x, y) {
 scheme.primitives["<"] = function (x, y) {
     return coerce_bool(x < y);
 };
+
+scheme.primitives["<="] = function (x, y) {
+    return coerce_bool(x <= y);
+};
+
+scheme.primitives[">"] = function (x, y) {
+    return coerce_bool(x > y);
+};
+
+scheme.primitives[">="] = function (x, y) {
+    return coerce_bool(x >= y);
 };
 
 scheme.primitives.quo = not_implemented_yet;
@@ -67,6 +78,10 @@ scheme.Box = function (x) {
     return this;
 };
 
+scheme.primitives["box"] = function(x) {
+    return new scheme.Box(x);
+};
+
 scheme.primitives["box-ref"] = function (box) {
     return box.x;
 };
@@ -82,6 +97,10 @@ scheme.Pair = function (car, cdr) {
     return this;
 };
 
+scheme.primitives["pair?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.Pair);
+};
+
 scheme.primitives.cons = function (car, cdr) {
     return new scheme.Pair(car,cdr);
 };
@@ -94,6 +113,14 @@ scheme.primitives.cdr = function (obj) {
     return obj.cdr;
 };
 
+scheme.primitives["set-car!"] = function (pair, obj) {
+    obj.car = obj;
+};
+
+scheme.primitives["set-cdr!"] = function (pair, obj) {
+    obj.cdr = obj;
+};
+
 scheme.list = function () {
     var l = scheme.EMPTY;
     for (var i = arguments.length - 1; i >= 0; i--){
@@ -117,12 +144,20 @@ scheme.Symbol = function(s) {
     };
 };
 
+scheme.primitives["symbol?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.Symbol);
+};
+
 // Keywords
 scheme.Keyword = function(s) {
     this.name = s;
     return this;
 };
 
+scheme.primitives["keyword?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.Keyword);
+};
+
 scheme.utils.keyword_ref = function(kw, args, start, dflt) {
     var l = args.length;
 
@@ -160,22 +195,48 @@ scheme.primitives["vector-length"] = function (vec) {
     return vec.array.length;
 };
 
+scheme.primitives["vector?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.Vector);
+};
+
+scheme.primitives["make-vector/immediate"] = not_implemented_yet;
+scheme.primitives["vector-set!/immediate"] = not_implemented_yet;
+scheme.primitives["vector-ref/immediate"] = not_implemented_yet;
+
 // Bytevectors
 
 // Booleans
 
+scheme.primitives["boolean?"] = not_implemented_yet;
+
 // Chars
 scheme.Char = function(c) {
     this.c = c;
     return this;
 };
 
+scheme.primitives["char?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.Char);
+};
+
 // Strings
 scheme.String = function(s) {
     this.s = s;
     return this;
 };
 
+scheme.primitives["string?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.String);
+};
+
+scheme.primitives["string-length"] = function (str) {
+    return str.s.length;
+};
+
+scheme.primitives["string-ref"] = function (str, idx) {
+    return new scheme.Char(str.s[idx]);
+};
+
 // Closures
 scheme.Closure = function(f, size) {
     this.fun = f;
@@ -208,6 +269,8 @@ scheme.primitives["cached-toplevel-box"] = function (scope, sym, is_bound) {
     return scheme.cache[scope][sym.name];
 };
 
+scheme.primitives["cached-module-box"] = not_implemented_yet;
+
 scheme.primitives["current-module"] = function () {
     return scheme.env;
 };
@@ -237,4 +300,34 @@ scheme.builtins[4] = new scheme.Closure(callcc, 0);
 //   M(call_with_values, CALL_WITH_VALUES, 2, 0, 0) \
 //   M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION, 1, 0, 0)
 
-// ---
+// Structs
+scheme.primitives["struct?"] = not_implemented_yet;
+scheme.primitives["struct-set!/immediate"] = not_implemented_yet;
+scheme.primitives["struct-vtable"] = not_implemented_yet;
+scheme.primitives["struct-ref/immediate"] = not_implemented_yet;
+scheme.primitives["struct-ref"] = not_implemented_yet;
+scheme.primitives["struct-set!"] = not_implemented_yet;
+scheme.primitives["allocate-struct/immediate"] = not_implemented_yet;
+
+// Equality
+scheme.primitives["eq?"] = function(x, y) {
+    return coerce_bool(x === y);
+};
+
+scheme.primitives["eqv?"] = function(x, y) {
+    return coerce_bool(x === y);
+};
+
+scheme.primitives["equal?"] = not_implemented_yet;
+
+// Fluids
+scheme.primitives["pop-fluid"] = not_implemented_yet;
+scheme.primitives["push-fluid"] = not_implemented_yet;
+scheme.primitives["fluid-ref"] = not_implemented_yet;
+
+// Variables
+scheme.primitives["variable?"] = not_implemented_yet;
+
+// Dynamic Wind
+scheme.primitives["wind"] = not_implemented_yet;
+scheme.primitives["unwind"] = not_implemented_yet;

From 5827ad4f035bba20756373e1ce1292d8cb18f98e Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 15 Jun 2015 23:18:16 +0100
Subject: [PATCH 23/90] Compile cps $prompt form to javascript

---
 module/language/cps/compile-js.scm           |  8 ++-
 module/language/js-il.scm                    |  4 ++
 module/language/js-il/compile-javascript.scm |  9 +++
 module/language/js-il/runtime.js             | 72 ++++++++++++++++++--
 4 files changed, 85 insertions(+), 8 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 8bffa9772..e990d1ff9 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -1,6 +1,7 @@
 (define-module (language cps compile-js)
   #:use-module (language cps)
-  #:use-module (language js-il)
+  #:use-module ((language js-il)
+                #:renamer (lambda (x) (if (eqv? x 'make-prompt) 'make-prompt* x)))
   #:use-module (ice-9 match)
   #:export (compile-js))
 
@@ -106,6 +107,11 @@
      (make-continue label (map make-id (cons* proc k args))))
     (($ $values values)
      (make-continue k (map make-id values)))
+    (($ $prompt escape? tag handler)
+     (make-seq
+      (list
+       (make-prompt* escape? tag handler)
+       (make-continue k '()))))
     (_
      (make-continue k (list (compile-exp* exp))))))
 
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 3415cd9b4..ae5932ce6 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -17,6 +17,8 @@
             make-branch branch
             make-return return
             make-id id
+            make-seq seq
+            make-prompt prompt
             ))
 
 ;; Copied from (language cps)
@@ -64,6 +66,8 @@
 (define-js-type branch test consequence alternate)
 (define-js-type id name)
 (define-js-type return val)
+(define-js-type seq body)
+(define-js-type prompt escape? tag handler)
 
 (define (unparse-js exp)
   (match exp
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 27f91ad18..05327c74a 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -155,6 +155,15 @@
       (make-call (make-refine *scheme* (make-const "Closure"))
                  (list (name->id label) (make-const nfree)))))
 
+    (($ il:prompt escape? tag handler)
+     ;; never a tailcall
+     (make-call (make-refine (make-refine *scheme* (make-const "primitives"))
+                             (make-const "prompt"))
+                (list (compile-const escape?) (name->id tag) (name->id handler))))
+
+    (($ il:seq body)
+     (make-block (map compile-exp body)))
+
     (($ il:id name)
      (name->id name))))
 
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index d0aff57fb..319c432ea 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -5,6 +5,7 @@ var scheme = {
     env : {},
     cache: [],
     builtins: [],
+    dynstack : [],
     // TODO: placeholders
     FALSE : false,
     TRUE : true,
@@ -283,22 +284,55 @@ scheme.primitives["resolve"] = function (sym, is_bound) {
 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);
+    return !(obj === scheme.FALSE || obj === scheme.NIL);
 };
 
+// Builtins
+var apply = function(self, k, f, arg) {
+    return f.fun(f.freevars, k, arg);
+};
+
+var values = function(self, k, arg) {
+
+    return k(arg);
+};
+
+var abort_to_prompt = function(self, k, prompt, arg) {
+
+    var idx = find_prompt(prompt);
+    var spec = scheme.dynstack[idx];
+
+    var kont = undefined; // actual value doesn't matter
+
+    if (!scheme.is_true(spec[1])) {
+        // TODO: handle multivalue continations
+        // compare with callcc
+        var f = function (self, k2, val) {
+            return k(val);
+        };
+        kont = new scheme.Closure(f, 0);
+    };
+
+    unwind(idx);
+
+    var handler = spec[2];
+
+    return handler(kont, arg);
+};
+
+var call_with_values = not_implemented_yet;
+
 var callcc = function (self, k, closure) {
     var f = function (self, k2, val) {
         return k(val);
     };
     return closure.fun(closure, k, new scheme.Closure(f, 0));
 };
+scheme.builtins[0] = new scheme.Closure(apply, 0);
+scheme.builtins[1] = new scheme.Closure(values, 0);
+scheme.builtins[2] = new scheme.Closure(abort_to_prompt, 0);
+scheme.builtins[3] = new scheme.Closure(call_with_values, 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)
 
 // Structs
 scheme.primitives["struct?"] = not_implemented_yet;
@@ -331,3 +365,27 @@ scheme.primitives["variable?"] = not_implemented_yet;
 // Dynamic Wind
 scheme.primitives["wind"] = not_implemented_yet;
 scheme.primitives["unwind"] = not_implemented_yet;
+
+// Misc
+scheme.primitives["prompt"] = function(escape_only, tag, handler){
+    scheme.dynstack.unshift([tag, escape_only, handler]);
+};
+
+var unwind = function (idx) {
+    // TODO: call winders
+    scheme.dynstack = scheme.dynstack.slice(idx+1);
+};
+
+var find_prompt = function(prompt) {
+    var eq = scheme.primitives["eq?"];
+    function test(x){
+        return scheme.is_true(eq(x,prompt)) || scheme.is_true(eq(x,scheme.TRUE));
+    };
+    for (idx in scheme.dynstack) {
+        if (test(scheme.dynstack[idx][0])) {
+            return idx;
+        };
+    };
+    // FIXME: should error
+    return undefined;
+};

From 56e6c33264e848592b74b936bdf89fdfd8c874a4 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 16 Jun 2015 23:06:47 +0100
Subject: [PATCH 24/90] Primitives create multiple argument continuations.

---
 module/language/js-il/runtime.js | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 319c432ea..5b4089e8b 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -305,10 +305,9 @@ var abort_to_prompt = function(self, k, prompt, arg) {
     var kont = undefined; // actual value doesn't matter
 
     if (!scheme.is_true(spec[1])) {
-        // TODO: handle multivalue continations
-        // compare with callcc
-        var f = function (self, k2, val) {
-            return k(val);
+        var f = function (self, k2) {
+            var args = Array.prototype.slice.call(arguments, 2);
+            return k.apply(k,args);
         };
         kont = new scheme.Closure(f, 0);
     };
@@ -323,8 +322,9 @@ var abort_to_prompt = function(self, k, prompt, arg) {
 var call_with_values = not_implemented_yet;
 
 var callcc = function (self, k, closure) {
-    var f = function (self, k2, val) {
-        return k(val);
+    var f = function (self, k2) {
+        var args = Array.prototype.slice.call(arguments, 2);
+        return k.apply(k,args);
     };
     return closure.fun(closure, k, new scheme.Closure(f, 0));
 };

From cf905a700435f7f0a57ef94db10be1db33011373 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 16 Jun 2015 23:07:13 +0100
Subject: [PATCH 25/90] Implement call-with-values

---
 module/language/js-il/runtime.js | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5b4089e8b..232e9fa04 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -319,7 +319,13 @@ var abort_to_prompt = function(self, k, prompt, arg) {
     return handler(kont, arg);
 };
 
-var call_with_values = not_implemented_yet;
+var call_with_values = function (self, k, producer, consumer) {
+    var k2 = function () {
+        var args = Array.prototype.slice.call(arguments);
+        return consumer.fun.apply(consumer.fun, [consumer, k].concat(args));
+    };
+    return producer.fun(producer, k2);
+};
 
 var callcc = function (self, k, closure) {
     var f = function (self, k2) {

From ee42731b574745ea6c21ae572b30a160a4a80407 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 16 Jun 2015 23:17:09 +0100
Subject: [PATCH 26/90] abort-to-prompt takes multiple arguments

---
 module/language/js-il/runtime.js | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 232e9fa04..d5b7c9ba5 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -297,8 +297,9 @@ var values = function(self, k, arg) {
     return k(arg);
 };
 
-var abort_to_prompt = function(self, k, prompt, arg) {
+var abort_to_prompt = function(self, k, prompt) {
 
+    var args = Array.prototype.slice.call(arguments, 3);
     var idx = find_prompt(prompt);
     var spec = scheme.dynstack[idx];
 
@@ -315,8 +316,8 @@ var abort_to_prompt = function(self, k, prompt, arg) {
     unwind(idx);
 
     var handler = spec[2];
-
-    return handler(kont, arg);
+    args.unshift(kont);
+    return handler.apply(handler, args);
 };
 
 var call_with_values = function (self, k, producer, consumer) {

From b939d51f8a8965f43a95bea9a7a3224ce99a891f Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 16 Jun 2015 23:17:50 +0100
Subject: [PATCH 27/90] values takes multiple arguments

---
 module/language/js-il/runtime.js | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index d5b7c9ba5..c9bf8eea0 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -292,9 +292,9 @@ var apply = function(self, k, f, arg) {
     return f.fun(f.freevars, k, arg);
 };
 
-var values = function(self, k, arg) {
-
-    return k(arg);
+var values = function(self, k) {
+    var args = Array.prototype.slice.call(arguments, 2);
+    return k.apply(k,args);
 };
 
 var abort_to_prompt = function(self, k, prompt) {

From 6f777154571480be2c01de3a7ad56e44611f4166 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 16 Jun 2015 23:19:11 +0100
Subject: [PATCH 28/90] Implement apply correctly

---
 module/language/js-il/runtime.js | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index c9bf8eea0..c14fbe476 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -288,8 +288,16 @@ scheme.is_true = function (obj) {
 };
 
 // Builtins
-var apply = function(self, k, f, arg) {
-    return f.fun(f.freevars, k, arg);
+var apply = function(self, k, f) {
+    var args = Array.prototype.slice.call(arguments, 3);
+    var tail = args.pop();
+
+    while (scheme.is_true(scheme.primitives["pair?"](tail))) {
+        args.push(tail.car);
+        tail = tail.cdr;
+    };
+
+    return f.fun.apply(f.fun, [f,k].concat(args));
 };
 
 var values = function(self, k) {

From 46597b49dcc5a3f6dfcf753c0faef1b432575bdb Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 17 Jun 2015 20:31:04 +0100
Subject: [PATCH 29/90] Use scheme.frame.Prompt objects for prompts on dynstack

---
 module/language/js-il/runtime.js | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index c14fbe476..ad83fa146 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -309,11 +309,11 @@ var abort_to_prompt = function(self, k, prompt) {
 
     var args = Array.prototype.slice.call(arguments, 3);
     var idx = find_prompt(prompt);
-    var spec = scheme.dynstack[idx];
+    var frame = scheme.dynstack[idx];
 
     var kont = undefined; // actual value doesn't matter
 
-    if (!scheme.is_true(spec[1])) {
+    if (!scheme.is_true(frame.escape_only)) {
         var f = function (self, k2) {
             var args = Array.prototype.slice.call(arguments, 2);
             return k.apply(k,args);
@@ -323,7 +323,7 @@ var abort_to_prompt = function(self, k, prompt) {
 
     unwind(idx);
 
-    var handler = spec[2];
+    var handler = frame.handler;
     args.unshift(kont);
     return handler.apply(handler, args);
 };
@@ -383,7 +383,8 @@ scheme.primitives["unwind"] = not_implemented_yet;
 
 // Misc
 scheme.primitives["prompt"] = function(escape_only, tag, handler){
-    scheme.dynstack.unshift([tag, escape_only, handler]);
+    var frame = new scheme.frame.Prompt(tag, escape_only, handler);
+    scheme.dynstack.unshift(frame);
 };
 
 var unwind = function (idx) {
@@ -397,10 +398,20 @@ var find_prompt = function(prompt) {
         return scheme.is_true(eq(x,prompt)) || scheme.is_true(eq(x,scheme.TRUE));
     };
     for (idx in scheme.dynstack) {
-        if (test(scheme.dynstack[idx][0])) {
+        var frame = scheme.dynstack[idx];
+        if (frame instanceof scheme.frame.Prompt && test(frame.tag)) {
             return idx;
         };
     };
     // FIXME: should error
     return undefined;
 };
+// Dynstack frames
+scheme.frame = {};
+
+scheme.frame.Prompt = function(tag, escape_only, handler){
+    this.tag = tag;
+    this.escape_only = escape_only;
+    this.handler = handler;
+};
+

From 78cacbe450e2f46da62c5b95d725292acdbf71b3 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 17 Jun 2015 20:32:10 +0100
Subject: [PATCH 30/90] Implement fluid primitives

---
 module/language/js-il/runtime.js | 34 +++++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index ad83fa146..4a4c5421c 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -370,9 +370,33 @@ scheme.primitives["eqv?"] = function(x, y) {
 scheme.primitives["equal?"] = not_implemented_yet;
 
 // Fluids
-scheme.primitives["pop-fluid"] = not_implemented_yet;
-scheme.primitives["push-fluid"] = not_implemented_yet;
-scheme.primitives["fluid-ref"] = not_implemented_yet;
+scheme.Fluid = function (x) {
+    this.value = x;
+    return this;
+};
+
+scheme.primitives["pop-fluid"] = function () {
+    var frame = scheme.dynstack.shift();
+    if (frame instanceof scheme.frame.Fluid) {
+        frame.fluid.value = frame.fluid.old_value;
+        return;
+    } else {
+        throw "not a frame";
+    };
+};
+
+scheme.primitives["push-fluid"] = function (fluid, new_value) {
+    var old_value = fluid.value;
+    fluid.value = new_value;
+    var frame = new scheme.frame.Fluid(fluid, old_value);
+    scheme.dynstack.unshift(frame);
+    return;
+};
+
+scheme.primitives["fluid-ref"] = function (fluid) {
+    // TODO: check fluid type
+    return fluid.value;
+};
 
 // Variables
 scheme.primitives["variable?"] = not_implemented_yet;
@@ -415,3 +439,7 @@ scheme.frame.Prompt = function(tag, escape_only, handler){
     this.handler = handler;
 };
 
+scheme.frame.Fluid = function(fluid, old_value) {
+    this.fluid = fluid;
+    this.old_value = old_value;
+};

From 2e10f55426ded4ab89693cd9c206afbefe9dde50 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 18 Jun 2015 11:02:05 +0100
Subject: [PATCH 31/90] Different types for Continuation and Variable
 identifiers

---
 module/language/cps/compile-js.scm           | 71 +++++++++++------
 module/language/js-il.scm                    | 42 ++++++----
 module/language/js-il/compile-javascript.scm | 82 +++++++++++++-------
 module/language/js-il/direct.scm             |  4 +-
 4 files changed, 127 insertions(+), 72 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index e990d1ff9..69cb91c03 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -37,39 +37,54 @@
            (extract-clauses self clause))
        (lambda (jump-table clauses)
          (make-var
-          k
+          (make-kid k)
           (make-function
-           (list self tail)
+           (make-id self) (make-kid tail)
            (make-local (map (lambda (clause)
                               (compile-clause clause self tail))
                             clauses)
                        (make-jump-table jump-table)))))))))
 
 (define (extract-clauses self clause)
+  (define (make-params* self req opts rest kw allow-other-keys?)
+    (make-params (make-id self)
+                  (map make-id req)
+                  (map make-id opts)
+                  (and rest (make-id rest))
+                  (map make-id kw)
+                  allow-other-keys?))
   (let loop ((clause clause) (specs '()) (clauses '()))
     (match clause
       (($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ #f))
-       (values (reverse (cons (cons (make-params self req opts rest kw allow-other-keys?) k) specs))
+       (values (reverse (acons (make-params* self req opts rest kw allow-other-keys?)
+                               (make-kid k)
+                               specs))
                (reverse (cons clause clauses))))
       (($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ alternate))
        (loop alternate
-             (cons (cons (make-params self req opts rest kw allow-other-keys?) k) specs)
+             (acons (make-params* self req opts rest kw allow-other-keys?)
+                    (make-kid k)
+                    specs)
              (cons clause clauses))))))
 
 (define (compile-clause clause self tail)
   (match clause
     (($ $cont k ($ $kclause ($ $arity req opt rest ((_ _ kw-syms) ...) _) body _))
      (make-var
-      k
+      (make-kid k)
       (make-continuation
-       (append (list self) req opt kw-syms (if rest (list rest) '()))
+       (append (list (make-id self))
+               (map make-id req)
+               (map make-id opt)
+               (map make-id kw-syms)
+               (if rest (list (make-id rest)) '()))
        (match body
          (($ $cont k ($ $kargs () () exp))
           (compile-term exp))
          (($ $cont k _)
           (make-local (list (compile-cont body))
                       (make-continue
-                       k
+                       (make-kid k)
                        (map make-id (append req opt kw-syms (if rest (list rest) '()))))))))))))
 
 (define (not-supported msg clause)
@@ -86,43 +101,53 @@
   (match cont
     (($ $cont k ($ $kargs names syms body))
      ;; use the name part?
-     (make-var k (make-continuation syms (compile-term body))))
+     (make-var (make-kid k)
+               (make-continuation (map make-id syms)
+                                  (compile-term body))))
     (($ $cont k ($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2))
-     (make-var k
-       (make-continuation (append req (list rest))
-                          (make-continue k2
-                                         (append (map make-id req) (list (make-id rest)))))))
+     (make-var
+      (make-kid k)
+      (make-continuation (append (map make-id req) (list (make-id rest)))
+                         (make-continue (make-kid k2)
+                                        (append (map make-id req)
+                                                (list (make-id rest)))))))
     (($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2))
-     (make-var k (make-continuation req (make-continue k2 (map make-id req)))))))
+     (make-var (make-kid k)
+               (make-continuation (map make-id req)
+                                  (make-continue (make-kid k2)
+                                                 (map make-id req)))))))
 
 (define (compile-exp exp k)
  (match exp
     (($ $branch kt exp)
-     (compile-test exp kt k))
+     (compile-test exp (make-kid kt) (make-kid k)))
     (($ $primcall 'return (arg))
-     (make-continue k (list (make-id arg))))
+     (make-continue (make-kid k) (list (make-id arg))))
     (($ $call name args)
-     (make-call name (cons k args)))
+     (make-call (make-id name) (make-kid k) (map make-id args)))
     (($ $callk label proc args)
-     (make-continue label (map make-id (cons* proc k args))))
+     (make-continue (make-kid label)
+                    (cons* (make-id proc)
+                           (make-kid k)
+                           (map make-id args))))
     (($ $values values)
-     (make-continue k (map make-id values)))
+     (make-continue (make-kid k) (map make-id values)))
     (($ $prompt escape? tag handler)
      (make-seq
       (list
-       (make-prompt* escape? tag handler)
-       (make-continue k '()))))
+       (make-prompt* escape? (make-id tag) (make-kid handler))
+       (make-continue (make-kid k) '()))))
     (_
-     (make-continue k (list (compile-exp* exp))))))
+     (make-continue (make-kid k) (list (compile-exp* exp))))))
 
 (define (compile-exp* exp)
   (match exp
     (($ $const val)
      (make-const val))
     (($ $primcall name args)
-     (make-primcall name args))
+     (make-primcall name (map make-id args)))
     (($ $closure label nfree)
-     (make-closure label nfree))
+     (make-closure (make-kid label) nfree))
     (($ $values (val))
      ;; FIXME:
      ;; may happen if a test branch of a conditional compiles to values
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index ae5932ce6..31b47497e 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -15,8 +15,8 @@
             make-call call
             make-closure closure
             make-branch branch
-            make-return return
             make-id id
+            make-kid kid
             make-seq seq
             make-prompt prompt
             ))
@@ -52,7 +52,7 @@
   (format port "#<js-il ~S>" (unparse-js exp)))
 
 (define-js-type program entry body)
-(define-js-type function params body)
+(define-js-type function self tail body)
 (define-js-type jump-table spec)
 (define-js-type params self req opt rest kw allow-other-keys?)
 (define-js-type continuation params body)
@@ -61,11 +61,11 @@
 (define-js-type continue cont args)
 (define-js-type const value)
 (define-js-type primcall name args)
-(define-js-type call name args)
+(define-js-type call name k args)
 (define-js-type closure label num-free)
 (define-js-type branch test consequence alternate)
 (define-js-type id name)
-(define-js-type return val)
+(define-js-type kid name)
 (define-js-type seq body)
 (define-js-type prompt escape? tag handler)
 
@@ -74,32 +74,40 @@
     (($ program entry body)
      `(program ,(unparse-js entry) . ,(map unparse-js body)))
     (($ continuation params body)
-     `(continuation ,params ,(unparse-js body)))
-    (($ function args body)
-     `(function ,args ,(unparse-js body)))
+     `(continuation ,(map unparse-js params) ,(unparse-js body)))
+    (($ function self tail body)
+     `(function ,self ,tail ,(unparse-js body)))
     (($ jump-table body)
      `(jump-table ,@(map (lambda (p)
                            `(,(unparse-js (car p)) . ,(cdr p)))
                          body)))
-    (($ params self req opt rest kw allow-other-keys?)
-     `(params ,self ,req ,opt ,rest ,kw ,allow-other-keys?))
+    (($ params ($ id self) req opt rest kws allow-other-keys?)
+     `(params ,self
+              ,(map unparse-js req)
+              ,(map unparse-js opt)
+              ,(and rest (unparse-js rest))
+              ,(map (match-lambda
+                     ((kw ($ id name) ($ id sym))
+                      (list kw name sym)))
+                    kws)
+              ,allow-other-keys?))
     (($ local bindings body)
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
      `(var ,id ,(unparse-js exp)))
-    (($ continue k args)
+    (($ continue ($ kid k) args)
      `(continue ,k ,(map unparse-js args)))
     (($ branch test then else)
      `(if ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
     (($ const c)
      `(const ,c))
     (($ primcall name args)
-     `(primcall ,name , args))
-    (($ call name args)
-     `(call ,name , args))
-    (($ closure label nfree)
+     `(primcall ,name ,(map unparse-js args)))
+    (($ call ($ id name) ($ kid k) args)
+     `(call ,name ,k ,(map unparse-js args)))
+    (($ closure ($ kid label) nfree)
      `(closure ,label ,nfree))
-    (($ return val)
-     `(return . ,(unparse-js val)))
     (($ id name)
-     `(id . ,name))))
+     `(id . ,name))
+    (($ kid name)
+     `(kid . ,name))))
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 05327c74a..d269ab6b0 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -23,12 +23,28 @@
 (define *scheme* (make-id "scheme"))
 (define *utils*  (make-refine *scheme* (make-const "utils")))
 
+(define (rename-id i)
+  (match i
+    (($ il:id i)
+     (rename i))
+    (($ il:kid i)
+     (rename-kont i))))
+
+(define (compile-id i)
+  (make-id (rename-id i)))
+
+(define (kont->id name)
+  (make-id (rename-kont name)))
+
+(define (rename-kont name)
+  (format #f "k_~a" name))
+
 (define (name->id name)
   (make-id (rename name)))
 
 (define (rename id)
   (cond ((and (integer? id) (>= id 0))
-         (format #f "k_~a" id))
+         (format #f "v_~a" id))
         ((symbol? id)
          (js-id (symbol->string id)))
         ((string? id)
@@ -39,7 +55,7 @@
 (define (js-id name)
   (call-with-output-string
    (lambda (port)
-     (display "k_" port)
+     (display "v_" port)
      (string-for-each
       (lambda (c)
         (if (or (and (char<=? #\a c) (char<=? c #\z))
@@ -68,7 +84,7 @@
         i
         (ref (make-refine i (make-const (car l)))
              (cdr l))))
-  (define this (rename rest))
+  (define this (rename-id rest))
   (make-var this
             (make-call (ref *scheme* (list "list" "apply"))
                        (list
@@ -78,7 +94,7 @@
 
 (define (bind-opt-args opts num-drop)
   (map (lambda (opt idx)
-         (make-var (rename opt)
+         (make-var (rename-id opt)
                    (make-binop 'or
                                (make-refine (make-id "arguments")
                                             (make-const (+ num-drop idx)))
@@ -89,7 +105,7 @@
 (define (bind-kw-args kws ids num-drop)
   (define lookup (make-refine *utils* (make-const "keyword_ref")))
   (map (lambda (kw id)
-         (make-var (rename id)
+         (make-var (rename-id id)
                    (make-call lookup
                               (list (compile-const kw)
                                     (make-id "arguments")
@@ -105,7 +121,7 @@
     (($ il:program (and entry ($ il:var name _)) body)
      (let ((entry-call
             (make-return
-             (make-call (name->id name)
+             (make-call (compile-id name)
                         (list
                          (make-id "undefined")
                          (make-refine *scheme* (make-const "initial_cont")))))))
@@ -114,10 +130,11 @@
                   '())))
 
     (($ il:continuation params body)
-     (make-function (map rename params) (list (compile-exp body))))
+     (make-function (map rename-id params) (list (compile-exp body))))
 
-    (($ il:function params body)
-     (make-function (map rename params) (list (compile-exp body))))
+    (($ il:function self tail body)
+     (make-function (list (rename-id self) (rename-id tail))
+                    (list (compile-exp body))))
 
     (($ il:jump-table specs)
      (compile-jump-table specs))
@@ -126,10 +143,10 @@
      (make-block (append (map compile-exp bindings) (list (compile-exp body)))))
 
     (($ il:var id exp)
-     (make-var (rename id) (compile-exp exp)))
+     (make-var (rename-id id) (compile-exp exp)))
 
     (($ il:continue k exps)
-     (make-return (make-call (name->id k) (map compile-exp exps))))
+     (make-return (make-call (compile-id k) (map compile-exp exps))))
 
     (($ il:branch test then else)
      (make-branch (make-call (make-refine *scheme* (make-const "is_true"))
@@ -143,29 +160,34 @@
     (($ il:primcall name args)
      (make-call (make-refine (make-refine *scheme* (make-const "primitives"))
                              (make-const (symbol->string name)))
-                (map name->id args)))
+                (map compile-id args)))
 
-    (($ il:call name args)
+    (($ il:call name k args)
      (make-return
-      (make-call (make-refine (name->id name) (make-const "fun"))
-                 (map name->id (cons name args)))))
+      (make-call (make-refine (compile-id name) (make-const "fun"))
+                 (cons* (compile-id name)
+                        (compile-id k)
+                        (map compile-id args)))))
 
     (($ il:closure label nfree)
      (make-new
       (make-call (make-refine *scheme* (make-const "Closure"))
-                 (list (name->id label) (make-const nfree)))))
+                 (list (compile-id label) (make-const nfree)))))
 
     (($ il:prompt escape? tag handler)
      ;; never a tailcall
      (make-call (make-refine (make-refine *scheme* (make-const "primitives"))
                              (make-const "prompt"))
-                (list (compile-const escape?) (name->id tag) (name->id handler))))
+                (list (compile-const escape?) (compile-id tag) (compile-id handler))))
 
     (($ il:seq body)
      (make-block (map compile-exp body)))
 
     (($ il:id name)
-     (name->id name))))
+     (name->id name))
+
+    (($ il:kid name)
+     (kont->id name))))
 
 (define (compile-jump-table specs)
   (define offset 2) ; closure & continuation
@@ -203,8 +225,8 @@
       (($ il:params self req '() #f '() #f)
        (list
         (make-return
-         (make-call (name->id k)
-                    (cons (name->id self)
+         (make-call (compile-id k)
+                    (cons (compile-id self)
                           (map (lambda (idx)
                                  (make-refine (make-id "arguments")
                                               (make-const (+ offset idx))))
@@ -213,39 +235,39 @@
        (list
         (bind-rest-args rest (+ offset (length req)))
         (make-return
-         (make-call (name->id k)
-                    (append (list (name->id self))
+         (make-call (compile-id k)
+                    (append (list (compile-id self))
                             (map (lambda (idx)
                                    (make-refine (make-id "arguments")
                                                 (make-const (+ offset idx))))
                                  (iota (length req)))
-                            (list (name->id rest)))))))
+                            (list (compile-id rest)))))))
       (($ il:params self req opts #f '() #f)
        (append
         (bind-opt-args opts (+ offset (length req)))
         (list
          (make-return
-          (make-call (name->id k)
-                     (append (list (name->id self))
+          (make-call (compile-id k)
+                     (append (list (compile-id self))
                              (map (lambda (idx)
                                     (make-refine (make-id "arguments")
                                                  (make-const (+ offset idx))))
                                   (iota (length req)))
-                             (map name->id opts)))))))
+                             (map compile-id opts)))))))
       (($ il:params self req opts #f ((kws names ids) ...) _)
        (append
         (bind-opt-args opts (+ offset (length req)))
         (bind-kw-args kws names (+ offset (length req)))
         (list
          (make-return
-          (make-call (name->id k)
-                     (append (list (name->id self))
+          (make-call (compile-id k)
+                     (append (list (compile-id self))
                              (map (lambda (idx)
                                     (make-refine (make-id "arguments")
                                                  (make-const (+ offset idx))))
                                   (iota (length req)))
-                             (map name->id opts)
-                             (map name->id names)))))))
+                             (map compile-id opts)
+                             (map compile-id names)))))))
       ))
   (fold-right (lambda (a d)
                 (make-branch (compile-test (car a))
diff --git a/module/language/js-il/direct.scm b/module/language/js-il/direct.scm
index e43164963..589e76506 100644
--- a/module/language/js-il/direct.scm
+++ b/module/language/js-il/direct.scm
@@ -12,8 +12,8 @@
     (($ continuation params body)
      (make-continuation params (remove-immediate-calls body)))
 
-    (($ function params body)
-     (make-function params (remove-immediate-calls body)))
+    (($ function self tail body)
+     (make-function self tail (remove-immediate-calls body)))
 
     (($ local
         (($ var id ($ continuation () body)))

From f0537e39ee9b1f96eb073ee11f4dac2c0c66e67e Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 20 Jun 2015 20:58:29 +0100
Subject: [PATCH 32/90] Rewrite js-il inliner

---
 module/Makefile.am                           |   2 +-
 module/language/js-il/compile-javascript.scm |   4 +-
 module/language/js-il/direct.scm             |  36 ----
 module/language/js-il/inlining.scm           | 205 +++++++++++++++++++
 4 files changed, 208 insertions(+), 39 deletions(-)
 delete mode 100644 module/language/js-il/direct.scm
 create mode 100644 module/language/js-il/inlining.scm

diff --git a/module/Makefile.am b/module/Makefile.am
index 7a9e7157a..f16d6b41b 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -209,7 +209,7 @@ BRAINFUCK_LANG_SOURCES =			\
 
 JS_IL_LANG_SOURCES =				\
   language/js-il.scm				\
-  language/js-il/direct.scm			\
+  language/js-il/inlining.scm			\
   language/js-il/compile-javascript.scm		\
   language/js-il/spec.scm
 
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index d269ab6b0..44384c62b 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -4,7 +4,7 @@
   #:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
   #:use-module (language javascript)
   #:use-module (language javascript simplify)
-  #:use-module (language js-il direct)
+  #:use-module (language js-il inlining)
   #:use-module (system foreign)
   #:export (compile-javascript))
 
@@ -15,7 +15,7 @@
   (eqv? obj (pointer->scm (make-pointer unbound-bits))))
 
 (define (compile-javascript exp env opts)
-  (set! exp (remove-immediate-calls exp))
+  (set! exp (inline-single-calls exp))
   (set! exp (compile-exp exp))
   (set! exp (flatten-blocks exp))
   (values exp env env))
diff --git a/module/language/js-il/direct.scm b/module/language/js-il/direct.scm
deleted file mode 100644
index 589e76506..000000000
--- a/module/language/js-il/direct.scm
+++ /dev/null
@@ -1,36 +0,0 @@
-(define-module (language js-il direct)
-  #:use-module (ice-9 match)
-  #:use-module (language js-il)
-  #:export (remove-immediate-calls))
-
-(define (remove-immediate-calls exp)
-  (match exp
-    (($ program entry body)
-     (make-program (remove-immediate-calls entry)
-                   (map remove-immediate-calls body)))
-
-    (($ continuation params body)
-     (make-continuation params (remove-immediate-calls body)))
-
-    (($ function self tail body)
-     (make-function self tail (remove-immediate-calls body)))
-
-    (($ local
-        (($ var id ($ continuation () body)))
-        ($ continue id ()))
-     (remove-immediate-calls body))
-
-    (($ local
-        (($ var id ($ continuation (arg) body)))
-        ($ continue id (val)))
-     (make-local (list (make-var arg val))
-                 (remove-immediate-calls body)))
-
-    (($ local bindings body)
-     (make-local (map remove-immediate-calls bindings)
-                 (remove-immediate-calls body)))
-
-    (($ var id exp)
-     (make-var id (remove-immediate-calls exp)))
-
-    (exp exp)))
diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
new file mode 100644
index 000000000..f042966c1
--- /dev/null
+++ b/module/language/js-il/inlining.scm
@@ -0,0 +1,205 @@
+(define-module (language js-il inlining)
+  #:use-module ((srfi srfi-1) #:select (partition))
+  #:use-module (ice-9 match)
+  #:use-module (language js-il)
+  #:export (count-calls
+            inline-single-calls
+            ))
+
+(define (count-calls exp)
+  (define counts (make-hash-table))
+  (define (count-inc! key)
+    (hashv-set! counts key (+ 1 (hashv-ref counts key 0))))
+  (define (count-inf! key)
+    (hashv-set! counts key +inf.0))
+  (define (analyse-args arg-list)
+    (for-each (match-lambda
+               (($ kid name)
+                (count-inf! name))
+               (($ id name) #f))
+              arg-list))
+  (define (analyse exp)
+    (match exp
+      (($ program entry body)
+       (analyse entry)
+       (for-each analyse body))
+
+      (($ function self tail body)
+       (analyse body))
+
+      (($ jump-table spec)
+       (for-each (lambda (p) (analyse (cdr p)))
+                 spec))
+
+      (($ continuation params body)
+       (analyse body))
+
+      (($ local bindings body)
+       (for-each analyse bindings)
+       (analyse body))
+
+      (($ var id exp)
+       (analyse exp))
+
+      (($ continue ($ kid cont) args)
+       (count-inc! cont)
+       (for-each analyse args))
+
+      (($ primcall name args)
+       (analyse-args args))
+
+      (($ call name ($ kid k) args)
+       (count-inf! k)
+       (analyse-args args))
+
+      (($ closure ($ kid label) num-free)
+       (count-inf! label))
+
+      (($ branch test consequence alternate)
+       (analyse test)
+       (analyse consequence)
+       (analyse alternate))
+
+      (($ kid name)
+       (count-inf! name))
+
+      (($ seq body)
+       (for-each analyse body))
+
+      (($ prompt escape? tag ($ kid handler))
+       (count-inf! handler))
+
+      (else #f)))
+  (analyse exp)
+  counts)
+
+(define no-values-primitives
+  '(define!
+    cache-current-module!
+    set-cdr!
+    set-car!
+    vector-set!
+    free-set!
+    vector-set!/immediate
+    box-set!
+    struct-set!
+    struct-set!/immediate
+    wind
+    unwind
+    push-fluid
+    pop-fluid
+    ))
+
+(define no-values-primitive?
+  (let ((h (make-hash-table)))
+    (for-each (lambda (prim)
+                (hashv-set! h prim #t))
+              no-values-primitives)
+    (lambda (prim)
+      (hashv-ref h prim))))
+
+(define (inline-single-calls exp)
+
+  (define calls (count-calls exp))
+
+  (define (inlinable? k)
+    (eqv? 1 (hashv-ref calls k)))
+
+  (define (split-inlinable bindings)
+    (partition (match-lambda
+                (($ var ($ kid id) _) (inlinable? id)))
+               bindings))
+
+  (define (lookup kont substs)
+    (match substs
+      ((($ var ($ kid id) exp) . rest)
+       (if (= id kont)
+           exp
+           (lookup kont rest)))
+      (() kont)
+      (else
+       (throw 'lookup-failed kont))))
+
+  (define (inline exp substs)
+    (match exp
+
+      ;; FIXME: This hacks around the fact that define doesn't return
+      ;; arguments to the continuation. This should be handled when
+      ;; converting to js-il, not here.
+      (($ continue
+          ($ kid (? inlinable? cont))
+          (($ primcall (? no-values-primitive? prim) args)))
+       (match (lookup cont substs)
+         (($ continuation () body)
+          (make-seq
+           (list
+            (make-primcall prim args)
+            (inline body substs))))
+         (else
+          ;; inlinable but not locally bound
+          exp)))
+
+      (($ continue ($ kid (? inlinable? cont)) args)
+       (match (lookup cont substs)
+         (($ continuation kargs body)
+          (if (not (= (length args) (length kargs)))
+              (throw 'args-dont-match cont args kargs)
+              (make-local (map make-var kargs args)
+                          ;; gah, this doesn't work
+                          ;; identifiers need to be separated earlier
+                          ;; not just as part of compilation
+                          (inline body substs))))
+         (else
+          ;; inlinable but not locally bound
+          ;; FIXME: This handles tail continuations, but only by accident
+          exp)))
+
+      (($ continue cont args)
+       exp)
+
+      (($ continuation params body)
+       (make-continuation params (inline body substs)))
+
+      (($ local bindings body)
+       (call-with-values
+           (lambda ()
+             (split-inlinable bindings))
+         (lambda (new-substs uninlinable-bindings)
+           (define substs* (append new-substs substs))
+           (make-local (map (lambda (x) (inline x substs*))
+                            uninlinable-bindings)
+                       (inline body substs*)))))
+
+      (($ var id exp)
+       (make-var id (inline exp substs)))
+
+      (($ seq body)
+       (make-seq (map (lambda (x) (inline x substs))
+                      body)))
+
+      (($ branch test consequence alternate)
+       (make-branch test
+                    (inline consequence substs)
+                    (inline alternate substs)))
+
+      (exp exp)))
+
+  (define (handle-function fun)
+    (define (handle-bindings bindings)
+      (map (lambda (binding)
+             (match binding
+               (($ var id ($ continuation params body))
+                (make-var id (make-continuation params (inline body '()))))))
+           bindings))
+    (match fun
+      (($ var id ($ function self tail ($ local bindings ($ jump-table spec))))
+       (make-var id
+                 (make-function self
+                                tail
+                                (make-local (handle-bindings bindings)
+                                            (make-jump-table spec)))))))
+
+  (match exp
+    (($ program entry body)
+     (make-program (handle-function entry)
+                   (map handle-function body)))))

From a7b2dfa5810a8e027dfc149c1c173b3023dcc0ec Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sat, 20 Jun 2015 22:41:24 +0100
Subject: [PATCH 33/90] Change program type representation

---
 module/language/cps/compile-js.scm           | 25 ++++++++++----------
 module/language/js-il.scm                    |  9 ++++---
 module/language/js-il/compile-javascript.scm | 14 ++++++++---
 module/language/js-il/inlining.scm           | 24 +++++++++----------
 4 files changed, 42 insertions(+), 30 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 69cb91c03..c1de2bc6e 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -18,32 +18,33 @@
   (set! exp (reify-primitives exp))
   (set! exp (renumber exp))
   (match exp
-    (($ $program funs)
+    (($ $program (($ $cont ks 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)
-     (values (make-program (compile-fun (car funs))
-                           (map compile-fun (cdr funs)))
+     (values (make-program
+              (map (lambda (k fun)
+                     (cons (make-kid k) (compile-fun fun)))
+                   ks
+                   funs))
              env
              env))))
 
 (define (compile-fun fun)
   (match fun
-    (($ $cont k ($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause))
+    (($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause)
      (call-with-values
          (lambda ()
            (extract-clauses self clause))
        (lambda (jump-table clauses)
-         (make-var
-          (make-kid k)
-          (make-function
-           (make-id self) (make-kid tail)
-           (make-local (map (lambda (clause)
-                              (compile-clause clause self tail))
-                            clauses)
-                       (make-jump-table jump-table)))))))))
+         (make-function
+          (make-id self) (make-kid tail)
+          (make-local (map (lambda (clause)
+                             (compile-clause clause self tail))
+                           clauses)
+                      (make-jump-table jump-table))))))))
 
 (define (extract-clauses self clause)
   (define (make-params* self req opts rest kw allow-other-keys?)
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 31b47497e..8eb26a326 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -51,7 +51,7 @@
 (define (print-js exp port)
   (format port "#<js-il ~S>" (unparse-js exp)))
 
-(define-js-type program entry body)
+(define-js-type program body)
 (define-js-type function self tail body)
 (define-js-type jump-table spec)
 (define-js-type params self req opt rest kw allow-other-keys?)
@@ -71,8 +71,11 @@
 
 (define (unparse-js exp)
   (match exp
-    (($ program entry body)
-     `(program ,(unparse-js entry) . ,(map unparse-js body)))
+    (($ program body)
+     `(program . ,(map (match-lambda
+                        ((($ kid k) . fun)
+                         (cons k (unparse-js fun))))
+                       body)))
     (($ continuation params body)
      `(continuation ,(map unparse-js params) ,(unparse-js body)))
     (($ function self tail body)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 44384c62b..7d9140d08 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -118,15 +118,23 @@
 (define (compile-exp exp)
   ;; TODO: handle ids for js
   (match exp
-    (($ il:program (and entry ($ il:var name _)) body)
+    (($ il:program ((name . fun) (names . funs) ...))
      (let ((entry-call
             (make-return
              (make-call (compile-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)))
+       (make-call (make-function
+                   '()
+                   (append
+                    (map (lambda (id f)
+                           (make-var (rename-id id)
+                                     (compile-exp f)))
+                         (cons name names)
+                         (cons fun funs))
+
+                    (list entry-call)))
                   '())))
 
     (($ il:continuation params body)
diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index f042966c1..14e25bde4 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -20,9 +20,8 @@
               arg-list))
   (define (analyse exp)
     (match exp
-      (($ program entry body)
-       (analyse entry)
-       (for-each analyse body))
+      (($ program ((ids . funs) ...))
+       (for-each analyse funs))
 
       (($ function self tail body)
        (analyse body))
@@ -192,14 +191,15 @@
                 (make-var id (make-continuation params (inline body '()))))))
            bindings))
     (match fun
-      (($ var id ($ function self tail ($ local bindings ($ jump-table spec))))
-       (make-var id
-                 (make-function self
-                                tail
-                                (make-local (handle-bindings bindings)
-                                            (make-jump-table spec)))))))
+      (($ function self tail ($ local bindings ($ jump-table spec)))
+       (make-function self
+                      tail
+                      (make-local (handle-bindings bindings)
+                                  (make-jump-table spec))))))
 
   (match exp
-    (($ program entry body)
-     (make-program (handle-function entry)
-                   (map handle-function body)))))
+    (($ program ((ids . funs) ...))
+     (make-program (map (lambda (id fun)
+                          (cons id (handle-function fun)))
+                        ids
+                        funs)))))

From e9f37e6a311c0b9fa1ef78b24cbe901e160db2b5 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 21 Jun 2015 00:45:09 +0100
Subject: [PATCH 34/90] Change function type representation

---
 module/language/cps/compile-js.scm           | 87 +++++++++-----------
 module/language/js-il.scm                    | 19 +++--
 module/language/js-il/compile-javascript.scm | 20 +++--
 module/language/js-il/inlining.scm           | 24 ++----
 4 files changed, 68 insertions(+), 82 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index c1de2bc6e..e67652eed 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -35,61 +35,48 @@
 (define (compile-fun fun)
   (match fun
     (($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause)
-     (call-with-values
-         (lambda ()
-           (extract-clauses self clause))
-       (lambda (jump-table clauses)
-         (make-function
-          (make-id self) (make-kid tail)
-          (make-local (map (lambda (clause)
-                             (compile-clause clause self tail))
-                           clauses)
-                      (make-jump-table jump-table))))))))
+     (make-function
+      (make-id self)
+      (make-kid tail)
+      (compile-clauses clause self)))))
 
-(define (extract-clauses self clause)
-  (define (make-params* self req opts rest kw allow-other-keys?)
-    (make-params (make-id self)
+(define (compile-clauses clause self)
+  (match clause
+    (($ $cont k ($ $kclause arity body #f))
+     `((,(make-kid k)
+        ,(arity->params arity self)
+        ,(compile-clause arity body self))))
+    (($ $cont k ($ $kclause arity body next))
+     `((,(make-kid k)
+        ,(arity->params arity self)
+        ,(compile-clause arity body self))
+       . ,(compile-clauses next self)))))
+
+(define (arity->params arity self)
+  (match arity
+    (($ $arity req opts rest ((kws names kw-syms) ...) allow-other-keys?)
+     (make-params (make-id self)
                   (map make-id req)
                   (map make-id opts)
                   (and rest (make-id rest))
-                  (map make-id kw)
-                  allow-other-keys?))
-  (let loop ((clause clause) (specs '()) (clauses '()))
-    (match clause
-      (($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ #f))
-       (values (reverse (acons (make-params* self req opts rest kw allow-other-keys?)
-                               (make-kid k)
-                               specs))
-               (reverse (cons clause clauses))))
-      (($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ alternate))
-       (loop alternate
-             (acons (make-params* self req opts rest kw allow-other-keys?)
-                    (make-kid k)
-                    specs)
-             (cons clause clauses))))))
+                  (map (lambda (kw name kw-sym)
+                         (list kw (make-id name) (make-id kw-sym)))
+                       kws
+                       names
+                       kw-syms)
+                  allow-other-keys?))))
 
-(define (compile-clause clause self tail)
-  (match clause
-    (($ $cont k ($ $kclause ($ $arity req opt rest ((_ _ kw-syms) ...) _) body _))
-     (make-var
-      (make-kid k)
-      (make-continuation
-       (append (list (make-id self))
-               (map make-id req)
-               (map make-id opt)
-               (map make-id kw-syms)
-               (if rest (list (make-id rest)) '()))
-       (match body
-         (($ $cont k ($ $kargs () () exp))
-          (compile-term exp))
-         (($ $cont k _)
-          (make-local (list (compile-cont body))
-                      (make-continue
-                       (make-kid k)
-                       (map make-id (append req opt kw-syms (if rest (list rest) '()))))))))))))
-
-(define (not-supported msg clause)
-  (error 'not-supported msg clause))
+(define (compile-clause arity body self)
+  (match arity
+    (($ $arity req opt rest ((_ _ kw-syms) ...) _)
+     (let ((ids (map make-id
+                     (append req opt kw-syms (if rest (list rest) '())))))
+       (make-continuation
+        (cons (make-id self) ids)
+        (match body
+          (($ $cont k _)
+           (make-local (list (compile-cont body))
+                       (make-continue (make-kid k) ids)))))))))
 
 (define (compile-term term)
   (match term
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 8eb26a326..d83faf5cc 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -4,7 +4,6 @@
   #:use-module (ice-9 match)
   #:export (make-program program
             make-function function
-            make-jump-table jump-table
             make-params params
             make-continuation continuation
             make-local local
@@ -52,8 +51,7 @@
   (format port "#<js-il ~S>" (unparse-js exp)))
 
 (define-js-type program body)
-(define-js-type function self tail body)
-(define-js-type jump-table spec)
+(define-js-type function self tail clauses)
 (define-js-type params self req opt rest kw allow-other-keys?)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
@@ -78,12 +76,15 @@
                        body)))
     (($ continuation params body)
      `(continuation ,(map unparse-js params) ,(unparse-js body)))
-    (($ function self tail body)
-     `(function ,self ,tail ,(unparse-js body)))
-    (($ jump-table body)
-     `(jump-table ,@(map (lambda (p)
-                           `(,(unparse-js (car p)) . ,(cdr p)))
-                         body)))
+    (($ function ($ id self) ($ kid tail) clauses)
+     `(function ,self
+                ,tail
+                ,@(map (match-lambda
+                        ((($ kid id) params kont)
+                         (list id
+                               (unparse-js params)
+                               (unparse-js kont))))
+                       clauses)))
     (($ params ($ id self) req opt rest kws allow-other-keys?)
      `(params ,self
               ,(map unparse-js req)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 7d9140d08..3aa2e5b74 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -140,12 +140,14 @@
     (($ il:continuation params body)
      (make-function (map rename-id params) (list (compile-exp body))))
 
-    (($ il:function self tail body)
+    (($ il:function self tail clauses)
      (make-function (list (rename-id self) (rename-id tail))
-                    (list (compile-exp body))))
-
-    (($ il:jump-table specs)
-     (compile-jump-table specs))
+                    (append
+                     (map (match-lambda
+                           ((id _ body)
+                            (make-var (rename-id id) (compile-exp body))))
+                          clauses)
+                     (list (compile-jump-table clauses)))))
 
     (($ il:local bindings body)
      (make-block (append (map compile-exp bindings) (list (compile-exp body)))))
@@ -278,9 +280,11 @@
                              (map compile-id names)))))))
       ))
   (fold-right (lambda (a d)
-                (make-branch (compile-test (car a))
-                             (compile-jump (car a) (cdr a))
-                             (list d)))
+                (match a
+                  ((id params _)
+                   (make-branch (compile-test params)
+                                (compile-jump params id)
+                                (list d)))))
               ;; FIXME: should throw an error
               (make-return (make-id "undefined"))
               specs))
diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index 14e25bde4..c2a33db9f 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -23,12 +23,9 @@
       (($ program ((ids . funs) ...))
        (for-each analyse funs))
 
-      (($ function self tail body)
-       (analyse body))
-
-      (($ jump-table spec)
-       (for-each (lambda (p) (analyse (cdr p)))
-                 spec))
+      (($ function self tail ((($ kid ids) _ bodies) ...))
+       (for-each count-inc! ids) ;; count-inf! ?
+       (for-each analyse bodies))
 
       (($ continuation params body)
        (analyse body))
@@ -184,18 +181,15 @@
       (exp exp)))
 
   (define (handle-function fun)
-    (define (handle-bindings bindings)
-      (map (lambda (binding)
-             (match binding
-               (($ var id ($ continuation params body))
-                (make-var id (make-continuation params (inline body '()))))))
-           bindings))
     (match fun
-      (($ function self tail ($ local bindings ($ jump-table spec)))
+      (($ function self tail ((ids params bodies) ...))
        (make-function self
                       tail
-                      (make-local (handle-bindings bindings)
-                                  (make-jump-table spec))))))
+                      (map (lambda (id param body)
+                             (list id param (inline body '())))
+                           ids
+                           params
+                           bodies)))))
 
   (match exp
     (($ program ((ids . funs) ...))

From a680a4cb9d14c705a9248b1281614d1caded5881 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 21 Jun 2015 01:56:01 +0100
Subject: [PATCH 35/90] Change local type representation and remove var type

---
 module/language/cps/compile-js.scm           | 38 +++++++++-----------
 module/language/js-il.scm                    | 11 +++---
 module/language/js-il/compile-javascript.scm | 12 ++++---
 module/language/js-il/inlining.scm           | 20 +++++------
 4 files changed, 39 insertions(+), 42 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index e67652eed..34b1ffe56 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -74,36 +74,32 @@
        (make-continuation
         (cons (make-id self) ids)
         (match body
-          (($ $cont k _)
-           (make-local (list (compile-cont body))
+          (($ $cont k cont)
+           (make-local `((,(make-kid k) . ,(compile-cont cont)))
                        (make-continue (make-kid k) ids)))))))))
 
 (define (compile-term term)
   (match term
-    (($ $letk conts body)
-     (make-local (map compile-cont conts) (compile-term body)))
+    (($ $letk (($ $cont ks conts) ...) body)
+     (make-local (map (lambda (k cont)
+                        (cons (make-kid k)
+                              (compile-cont cont)))
+                      ks
+                      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 (make-kid k)
-               (make-continuation (map make-id syms)
-                                  (compile-term body))))
-    (($ $cont k ($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2))
-     (make-var
-      (make-kid k)
-      (make-continuation (append (map make-id req) (list (make-id rest)))
-                         (make-continue (make-kid k2)
-                                        (append (map make-id req)
-                                                (list (make-id rest)))))))
-    (($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2))
-     (make-var (make-kid k)
-               (make-continuation (map make-id req)
-                                  (make-continue (make-kid k2)
-                                                 (map make-id req)))))))
+    (($ $kargs names syms body)
+     (make-continuation (map make-id syms) (compile-term body)))
+    (($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
+     (let ((ids (map make-id (append req (list rest)))))
+       (make-continuation ids (make-continue (make-kid k2) ids))))
+    (($ $kreceive ($ $arity req _ #f _ _) k2)
+     (let ((ids (map make-id req)))
+       (make-continuation ids (make-continue (make-kid k2) ids))))))
 
 (define (compile-exp exp k)
  (match exp
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index d83faf5cc..e5fe19683 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -7,7 +7,6 @@
             make-params params
             make-continuation continuation
             make-local local
-            make-var var
             make-continue continue
             make-const const
             make-primcall primcall
@@ -55,7 +54,6 @@
 (define-js-type params self req opt rest kw allow-other-keys?)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
-(define-js-type var id exp)
 (define-js-type continue cont args)
 (define-js-type const value)
 (define-js-type primcall name args)
@@ -96,9 +94,12 @@
                     kws)
               ,allow-other-keys?))
     (($ local bindings body)
-     `(local ,(map unparse-js bindings) ,(unparse-js body)))
-    (($ var id exp)
-     `(var ,id ,(unparse-js exp)))
+     `(local ,(map (match-lambda
+                    ((a . d)
+                     (cons (unparse-js a)
+                           (unparse-js d))))
+                   bindings)
+             ,(unparse-js body)))
     (($ continue ($ kid k) args)
      `(continue ,k ,(map unparse-js args)))
     (($ branch test then else)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 3aa2e5b74..3ef9a950e 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -149,11 +149,13 @@
                           clauses)
                      (list (compile-jump-table clauses)))))
 
-    (($ il:local bindings body)
-     (make-block (append (map compile-exp bindings) (list (compile-exp body)))))
-
-    (($ il:var id exp)
-     (make-var (rename-id id) (compile-exp exp)))
+    (($ il:local ((ids . bindings) ...) body)
+     (make-block
+      (append (map (lambda (id binding)
+                     (make-var (rename-id id) (compile-exp binding)))
+                   ids
+                   bindings)
+              (list (compile-exp body)))))
 
     (($ il:continue k exps)
      (make-return (make-call (compile-id k) (map compile-exp exps))))
diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index c2a33db9f..72df2226b 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -31,12 +31,11 @@
        (analyse body))
 
       (($ local bindings body)
-       (for-each analyse bindings)
+       (for-each (match-lambda
+                  ((i . b) (analyse b)))
+                 bindings)
        (analyse body))
 
-      (($ var id exp)
-       (analyse exp))
-
       (($ continue ($ kid cont) args)
        (count-inc! cont)
        (for-each analyse args))
@@ -103,12 +102,12 @@
 
   (define (split-inlinable bindings)
     (partition (match-lambda
-                (($ var ($ kid id) _) (inlinable? id)))
+                ((($ kid id) . _) (inlinable? id)))
                bindings))
 
   (define (lookup kont substs)
     (match substs
-      ((($ var ($ kid id) exp) . rest)
+      (((($ kid id) . exp) . rest)
        (if (= id kont)
            exp
            (lookup kont rest)))
@@ -140,7 +139,7 @@
          (($ continuation kargs body)
           (if (not (= (length args) (length kargs)))
               (throw 'args-dont-match cont args kargs)
-              (make-local (map make-var kargs args)
+              (make-local (map cons kargs args)
                           ;; gah, this doesn't work
                           ;; identifiers need to be separated earlier
                           ;; not just as part of compilation
@@ -162,13 +161,12 @@
              (split-inlinable bindings))
          (lambda (new-substs uninlinable-bindings)
            (define substs* (append new-substs substs))
-           (make-local (map (lambda (x) (inline x substs*))
+           (make-local (map (match-lambda
+                             ((id . val)
+                              `(,id . ,(inline val substs*))))
                             uninlinable-bindings)
                        (inline body substs*)))))
 
-      (($ var id exp)
-       (make-var id (inline exp substs)))
-
       (($ seq body)
        (make-seq (map (lambda (x) (inline x substs))
                       body)))

From 88c052214f257525e4c64277baa2ea23129ce060 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 23 Jun 2015 15:46:26 +0100
Subject: [PATCH 36/90] Handle more identifier characters

---
 module/language/js-il/compile-javascript.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 3ef9a950e..2645b4c99 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -74,8 +74,17 @@
               ((#\+) (display "_a" port))
               ((#\\) (display "_b" port))
               ((#\/) (display "_f" port))
+              ((#\%) (display "_c" port))
+              ((#\$) (display "_d" port))
+              ((#\~) (display "_t" port))
+              ((#\^) (display "_i" port))
+              ((#\&) (display "_j" port))
+              ((#\:) (display "_k" port))
+              ((#\@) (display "_m" port))
+              ;; unused: noqrvxy
               (else
-               (throw 'bad-id-char  c)))))
+               (display "_z" port)
+               (display (char->integer c) port)))))
       name))))
 
 (define (bind-rest-args rest num-drop)

From b631576f13677e7834a9604ee6b664f0ff2acc06 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 23 Jun 2015 15:52:42 +0100
Subject: [PATCH 37/90] Fixup binop unparsing

---
 module/language/javascript.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 748621355..741282a61 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -85,7 +85,7 @@
     (($ var id exp)
      `(var ,id ,(unparse-js exp)))
     (($ binop op arg1 arg2)
-     `(binop ,op ,arg1 ,arg2))))
+     `(binop ,op ,(unparse-js arg1) ,(unparse-js arg2)))))
 
 (define (print-exp exp port)
   (match exp

From 89029a54f43e7698e7ddb5f72ada4c44ec5a1c68 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 24 Jun 2015 19:57:28 +0100
Subject: [PATCH 38/90] Explicitly test for undefined arguments to handle false
 values like 0

---
 module/language/javascript.scm               | 39 ++++++++++++++++++--
 module/language/javascript/simplify.scm      | 10 ++++-
 module/language/js-il/compile-javascript.scm | 11 ++++--
 3 files changed, 52 insertions(+), 8 deletions(-)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 741282a61..8829b3be0 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -15,6 +15,8 @@
             make-branch branch
             make-var var
             make-binop binop
+            make-ternary ternary
+            make-prefix prefix
 
             print-statement))
 
@@ -59,6 +61,8 @@
 (define-js-type branch test then else)
 (define-js-type var id exp)
 (define-js-type binop op arg1 arg2)
+(define-js-type ternary test then else)
+(define-js-type prefix op expr)
 
 (define (unparse-js exp)
   (match exp
@@ -85,7 +89,12 @@
     (($ var id exp)
      `(var ,id ,(unparse-js exp)))
     (($ binop op arg1 arg2)
-     `(binop ,op ,(unparse-js arg1) ,(unparse-js arg2)))))
+     `(binop ,op ,(unparse-js arg1) ,(unparse-js arg2)))
+    (($ ternary test then else)
+     `(ternary ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
+    (($ prefix op expr)
+     `(prefix ,op ,(unparse-js expr)))
+    ))
 
 (define (print-exp exp port)
   (match exp
@@ -136,17 +145,41 @@
      (print-binop op port)
      (display "(" port)
      (print-exp arg2 port)
-     (display ")" port))))
+     (display ")" port))
+
+    (($ ternary test then else)
+     (display "(" port)
+     (print-exp test port)
+     (display ") ? (" port)
+     (print-exp then port)
+     (display ") : (" port)
+     (print-exp else port)
+     (display ")" port))
+
+    (($ prefix op exp)
+     (print-prefix op port)
+     (display "(" port)
+     (print-exp exp port)
+     (display ")" port))
+    ))
 
 (define (print-binop op port)
   (case op
     ((or) (display "||" port))
     ((and) (display "&&" port))
     ((=) (display "==" port))
-    ((+ - < <= > >=) (format port "~a" op))
+    ((+ - < <= > >= ===) (format port "~a" op))
     (else
      (throw 'unprintable-binop op))))
 
+(define (print-prefix op port)
+  (case op
+    ((not) (display "!" port))
+    ((typeof + -)
+     (format port "~a" op))
+    (else
+     (throw 'unprintable-prefix op))))
+
 (define (print-statement stmt port)
   (match stmt
     (($ var id exp)
diff --git a/module/language/javascript/simplify.scm b/module/language/javascript/simplify.scm
index b3360aa40..2e3bde5f0 100644
--- a/module/language/javascript/simplify.scm
+++ b/module/language/javascript/simplify.scm
@@ -40,7 +40,15 @@
                     (flatten-block else)))
       (($ call function args)
        (make-call (flatten-exp function)
-                  (map flatten-exp args)))))
+                  (map flatten-exp args)))
+
+      (($ ternary test then else)
+       (make-ternary (flatten-exp test)
+                     (flatten-exp then)
+                     (flatten-exp else)))
+      (($ prefix op exp)
+       (make-prefix op (flatten-exp exp)))
+      ))
   (define (maybe-make-block exp)
     (match exp
       ((exp) exp)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 2645b4c99..67a34921d 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -104,10 +104,13 @@
 (define (bind-opt-args opts num-drop)
   (map (lambda (opt idx)
          (make-var (rename-id opt)
-                   (make-binop 'or
-                               (make-refine (make-id "arguments")
-                                            (make-const (+ num-drop idx)))
-                               (make-refine *scheme* (make-const "UNDEFINED")))))
+                   (let ((arg (make-refine (make-id "arguments")
+                                            (make-const (+ num-drop idx)))))
+                     (make-ternary (make-binop '===
+                                               (make-prefix 'typeof arg)
+                                               (make-id "undefined"))
+                                   (make-refine *scheme* (make-const "UNDEFINED"))
+                                   arg))))
        opts
        (iota (length opts))))
 

From b147a36751d6287763a30812624128d695ba5ae2 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 24 Jun 2015 20:31:24 +0100
Subject: [PATCH 39/90] Add missing simplify.scm to Makefile

---
 module/Makefile.am | 1 +
 1 file changed, 1 insertion(+)

diff --git a/module/Makefile.am b/module/Makefile.am
index f16d6b41b..8de78c221 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -215,6 +215,7 @@ JS_IL_LANG_SOURCES =				\
 
 JS_LANG_SOURCES =				\
   language/javascript.scm			\
+  language/javascript/simplify.scm		\
   language/javascript/spec.scm
 
 SCRIPTS_SOURCES =				\

From 23f829b1750fc02bb9d354dacd9e9d2e4abf1462 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 14 Jun 2017 21:13:56 +0100
Subject: [PATCH 40/90] Fix build of (language cps compile-js)

* module/language/cps/compile-js.scm (compile-js): Use lower-cps
  from (language cps compile-bytecode) rather than optimize, which is no
  longer there.
---
 module/language/cps/compile-js.scm | 12 ++----------
 1 file changed, 2 insertions(+), 10 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 34b1ffe56..ddfe88c3a 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -5,18 +5,10 @@
   #: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 lower-cps (@@ (language cps compile-bytecode) lower-cps))
 
 (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))
+  (set! exp (lower-cps exp opts))
   (match exp
     (($ $program (($ $cont ks funs) ...))
      ;; TODO: I should special case the compilation for the initial fun,

From 0e4fb0920f8108e1005a4cb8696b689b239ccb0d Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 14 Jun 2017 23:07:40 +0100
Subject: [PATCH 41/90] compile-js uses the new cps representation

* module/language/cps/compile-js.scm: Rewrite to use cps
---
 module/language/cps/compile-js.scm | 89 ++++++++++++++----------------
 1 file changed, 41 insertions(+), 48 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index ddfe88c3a..03e9e7d66 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -1,48 +1,52 @@
 (define-module (language cps compile-js)
   #:use-module (language cps)
+  #:use-module (language cps intmap)
+  #:use-module (language cps utils)
   #:use-module ((language js-il)
                 #:renamer (lambda (x) (if (eqv? x 'make-prompt) 'make-prompt* x)))
   #:use-module (ice-9 match)
   #:export (compile-js))
 
+(define intmap-select (@@ (language cps compile-bytecode) intmap-select))
 (define lower-cps (@@ (language cps compile-bytecode) lower-cps))
 
 (define (compile-js exp env opts)
-  (set! exp (lower-cps exp opts))
-  (match exp
-    (($ $program (($ $cont ks 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)
-     (values (make-program
-              (map (lambda (k fun)
-                     (cons (make-kid k) (compile-fun fun)))
-                   ks
-                   funs))
-             env
-             env))))
+  ;; 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)
+  (define (intmap->program map)
+    (intmap-fold-right (lambda (kfun body accum)
+                         (acons (make-kid kfun)
+                                (compile-fun (intmap-select map body) kfun)
+                                accum))
+                       (compute-reachable-functions map 0)
+                       '()))
+  (values (make-program (intmap->program (lower-cps exp opts))) env env))
 
-(define (compile-fun fun)
-  (match fun
-    (($ $kfun _ _ self ($ $cont tail ($ $ktail)) clause)
+
+(define (compile-fun cps kfun)
+  (match (intmap-ref cps kfun)
+    (($ $kfun src meta self tail clause)
      (make-function
       (make-id self)
       (make-kid tail)
-      (compile-clauses clause self)))))
+      (compile-clauses cps clause self)))))
 
-(define (compile-clauses clause self)
-  (match clause
-    (($ $cont k ($ $kclause arity body #f))
-     `((,(make-kid k)
+
+(define (compile-clauses cps clause self)
+  (match (intmap-ref cps clause)
+    (($ $kclause arity body #f)
+     `((,(make-kid clause)
         ,(arity->params arity self)
-        ,(compile-clause arity body self))))
-    (($ $cont k ($ $kclause arity body next))
-     `((,(make-kid k)
+        ,(compile-clause cps arity body self))))
+    (($ $kclause arity body next)
+     `((,(make-kid clause)
         ,(arity->params arity self)
-        ,(compile-clause arity body self))
-       . ,(compile-clauses next self)))))
+        ,(compile-clause cps arity body self))
+       . ,(compile-clauses cps next self)))))
+
 
 (define (arity->params arity self)
   (match arity
@@ -58,34 +62,23 @@
                        kw-syms)
                   allow-other-keys?))))
 
-(define (compile-clause arity body self)
+
+(define (compile-clause cps arity body self)
   (match arity
     (($ $arity req opt rest ((_ _ kw-syms) ...) _)
      (let ((ids (map make-id
                      (append req opt kw-syms (if rest (list rest) '())))))
        (make-continuation
         (cons (make-id self) ids)
-        (match body
-          (($ $cont k cont)
-           (make-local `((,(make-kid k) . ,(compile-cont cont)))
-                       (make-continue (make-kid k) ids)))))))))
+        (make-local `((,(make-kid body) . ,(compile-cont cps body)))
+                    (make-continue (make-kid body) ids)))))))
 
-(define (compile-term term)
-  (match term
-    (($ $letk (($ $cont ks conts) ...) body)
-     (make-local (map (lambda (k cont)
-                        (cons (make-kid k)
-                              (compile-cont cont)))
-                      ks
-                      conts)
-                 (compile-term body)))
-    (($ $continue k src exp)
-     (compile-exp exp k))))
 
-(define (compile-cont cont)
-  (match cont
-    (($ $kargs names syms body)
-     (make-continuation (map make-id syms) (compile-term body)))
+(define (compile-cont cps cont)
+  (match (intmap-ref cps cont)
+    ;; The term in a $kargs is always a $continue
+    (($ $kargs names syms ($ $continue k src exp))
+     (make-continuation (map make-id syms) (compile-exp exp k)))
     (($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
      (let ((ids (map make-id (append req (list rest)))))
        (make-continuation ids (make-continue (make-kid k2) ids))))

From 8777c20e941d3a927a20c62e42b31f0fbd3a7571 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 15 Jun 2017 20:21:47 +0100
Subject: [PATCH 42/90] Handle multiple conts in a function body

* module/language/cps/compile-js.scm (compile-clause, compile-clauses):
  Extract all conts in the function body, and bind in clauses.
  (extract-and-compile-conts): New Procedure
---
 module/language/cps/compile-js.scm | 53 ++++++++++++++++++++++--------
 1 file changed, 40 insertions(+), 13 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 03e9e7d66..e7509359f 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -35,17 +35,45 @@
       (compile-clauses cps clause self)))))
 
 
+(define (extract-and-compile-conts cps)
+  (define (step id body accum)
+    (match body
+      ;; The term in a $kargs is always a $continue
+      (($ $kargs names syms ($ $continue k src exp))
+       (acons (make-kid id)
+              (make-continuation (map make-id syms) (compile-exp exp k))
+              accum))
+      (($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
+       (let ((ids (map make-id (append req (list rest)))))
+         (acons (make-kid id)
+                (make-continuation ids (make-continue (make-kid k2) ids))
+                accum)))
+      (($ $kreceive ($ $arity req _ #f _ _) k2)
+       (let ((ids (map make-id req)))
+         (acons (make-kid id)
+                (make-continuation ids (make-continue (make-kid k2) ids))
+                accum)))
+      (else accum)))
+  (intmap-fold step cps '()))
+
+
 (define (compile-clauses cps clause self)
-  (match (intmap-ref cps clause)
-    (($ $kclause arity body #f)
-     `((,(make-kid clause)
-        ,(arity->params arity self)
-        ,(compile-clause cps arity body self))))
-    (($ $kclause arity body next)
-     `((,(make-kid clause)
-        ,(arity->params arity self)
-        ,(compile-clause cps arity body self))
-       . ,(compile-clauses cps next self)))))
+  ;; FIXME: This duplicates all the conts in each clause, and requires
+  ;; the inliner to remove them. A better solution is to change the
+  ;; function type to contain a separate map of conts, but this requires
+  ;; more code changes, and is should constitute a separate commit.
+  (define function-conts (extract-and-compile-conts cps))
+  (let loop ((clause clause))
+   (match (intmap-ref cps clause)
+     (($ $kclause arity body #f)
+      `((,(make-kid clause)
+         ,(arity->params arity self)
+         ,(compile-clause cps arity body self function-conts))))
+     (($ $kclause arity body next)
+      `((,(make-kid clause)
+         ,(arity->params arity self)
+         ,(compile-clause cps arity body self function-conts))
+        . ,(loop next))))))
 
 
 (define (arity->params arity self)
@@ -63,15 +91,14 @@
                   allow-other-keys?))))
 
 
-(define (compile-clause cps arity body self)
+(define (compile-clause cps arity body self bindings)
   (match arity
     (($ $arity req opt rest ((_ _ kw-syms) ...) _)
      (let ((ids (map make-id
                      (append req opt kw-syms (if rest (list rest) '())))))
        (make-continuation
         (cons (make-id self) ids)
-        (make-local `((,(make-kid body) . ,(compile-cont cps body)))
-                    (make-continue (make-kid body) ids)))))))
+        (make-local bindings (make-continue (make-kid body) ids)))))))
 
 
 (define (compile-cont cps cont)

From 602bfb559dc00375cacf3f70e04b8b80e5c5959f Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 15 Jun 2017 20:25:24 +0100
Subject: [PATCH 43/90] Update primitives in no-values-primitives

* module/language/js-il/inlining.scm (no-values-primitives): Update.
---
 module/language/js-il/inlining.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index 72df2226b..7d30dbeb8 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -69,7 +69,7 @@
   counts)
 
 (define no-values-primitives
-  '(define!
+  '(
     cache-current-module!
     set-cdr!
     set-car!
@@ -83,6 +83,7 @@
     unwind
     push-fluid
     pop-fluid
+    handle-interrupts
     ))
 
 (define no-values-primitive?

From 723fc850f604addee991b01b075efcfe16b0bdab Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 15 Jun 2017 22:34:39 +0100
Subject: [PATCH 44/90] Add #:js-inline? and #:js-flatten? debugging options

* module/language/js-il/compile-javascript.scm (compile-javascript):
  Check for #:js-inline? and #:js-flatten?, and turn off
  inline-single-calls and flatten-blocks respectively.
---
 module/language/js-il/compile-javascript.scm | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 67a34921d..ed764410b 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -15,9 +15,13 @@
   (eqv? obj (pointer->scm (make-pointer unbound-bits))))
 
 (define (compile-javascript exp env opts)
-  (set! exp (inline-single-calls exp))
+  (match (memq #:js-inline? opts)
+    ((#:js-inline? #f _ ...) #f)
+    (_ (set! exp (inline-single-calls exp))))
   (set! exp (compile-exp exp))
-  (set! exp (flatten-blocks exp))
+  (match (memq #:js-flatten? opts)
+    ((#:js-flatten? #f _ ...) #f)
+    (_ (set! exp (flatten-blocks exp))))
   (values exp env env))
 
 (define *scheme* (make-id "scheme"))

From e7712410207e4c6249460af161a66334b908c8fd Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Fri, 16 Jun 2017 17:42:49 +0100
Subject: [PATCH 45/90] JS-IL inliner has different count-calls for different
 clauses

* module/language/js-il/inlining.scm(inline-single-calls): Factor into
  another function inline-clause, so that count-calls is only called on
  the clause.
---
 module/language/js-il/inlining.scm | 43 ++++++++++++++++++------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index 7d30dbeb8..1d3182069 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -1,3 +1,9 @@
+;; FIXME: It is currently wrong to think of inlining as an optimisation
+;; since in the cps-soup world we need inlining to rebuild the scope
+;; tree for variables.
+;; FIXME: since *all* conts are passed to each clause, there can be
+;; "dead" conts thare are included in a clause
+
 (define-module (language js-il inlining)
   #:use-module ((srfi srfi-1) #:select (partition))
   #:use-module (ice-9 match)
@@ -94,7 +100,26 @@
     (lambda (prim)
       (hashv-ref h prim))))
 
+
 (define (inline-single-calls exp)
+  (define (handle-function fun)
+    (match fun
+      (($ function self tail ((ids params bodies) ...))
+       (make-function self
+                      tail
+                      (map (lambda (id param body)
+                             (list id param (inline-clause body)))
+                           ids
+                           params
+                           bodies)))))
+  (match exp
+    (($ program ((ids . funs) ...))
+     (make-program (map (lambda (id fun)
+                          (cons id (handle-function fun)))
+                        ids
+                        funs)))))
+
+(define (inline-clause exp)
 
   (define calls (count-calls exp))
 
@@ -179,20 +204,4 @@
 
       (exp exp)))
 
-  (define (handle-function fun)
-    (match fun
-      (($ function self tail ((ids params bodies) ...))
-       (make-function self
-                      tail
-                      (map (lambda (id param body)
-                             (list id param (inline body '())))
-                           ids
-                           params
-                           bodies)))))
-
-  (match exp
-    (($ program ((ids . funs) ...))
-     (make-program (map (lambda (id fun)
-                          (cons id (handle-function fun)))
-                        ids
-                        funs)))))
+  (inline exp '()))

From 936050c657729b21b8d42045a8e5287d2194e25d Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Fri, 16 Jun 2017 18:11:02 +0100
Subject: [PATCH 46/90] Add some primitives to runtime.js

* module/language/js-il/runtime.js(add/immediate, sub/immediate,
  load-u64, u64-=-scm, handle-interrupts): Add primitives.
---
 module/language/js-il/runtime.js | 44 +++++++++++++++++++++++++++++++-
 1 file changed, 43 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 4a4c5421c..6ef6ff1f2 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -33,6 +33,10 @@ scheme.primitives.add1 = function (x) {
     return x + 1;
 };
 
+scheme.primitives["add/immediate"] = function (x, y) {
+    return x + y;
+};
+
 scheme.primitives.sub = function (x, y) {
     return x - y;
 };
@@ -41,6 +45,10 @@ scheme.primitives.sub1 = function (x) {
     return x - 1;
 };
 
+scheme.primitives["sub/immediate"] = function (x, y) {
+    return x - y;
+};
+
 scheme.primitives.mul = function (x, y) {
     return x * y;
 };
@@ -73,6 +81,32 @@ scheme.primitives.quo = not_implemented_yet;
 scheme.primitives.rem = not_implemented_yet;
 scheme.primitives.mod = not_implemented_yet;
 
+// Unboxed Numbers
+scheme.primitives["load-u64"] = function(x) {
+    return x;
+};
+
+scheme.primitives["u64-=-scm"] = function(x, y) {
+    // i.e. br-if-u64-=-scm
+    return coerce_bool(x === y);
+};
+
+scheme.primitives["u64-<=-scm"] = function(x, y) {
+    return coerce_bool(x <= y);
+};
+
+scheme.primitives["u64-<-scm"] = function(x, y) {
+    return coerce_bool(x < y);
+};
+
+scheme.primitives["u64->-scm"] = function(x, y) {
+    return coerce_bool(x > y);
+};
+
+scheme.primitives["u64->=-scm"] = function(x, y) {
+    return coerce_bool(x >= y);
+};
+
 // Boxes
 scheme.Box = function (x) {
     this.x = x;
@@ -259,7 +293,9 @@ scheme.primitives["builtin-ref"] = function (idx) {
 
 // Modules
 scheme.primitives["define!"] = function(sym, obj) {
-    scheme.env[sym.name] = new scheme.Box(obj);
+    var b = new scheme.Box(obj);
+    scheme.env[sym.name] = b;
+    return b;
 };
 
 scheme.primitives["cache-current-module!"] = function (module, scope) {
@@ -430,6 +466,12 @@ var find_prompt = function(prompt) {
     // FIXME: should error
     return undefined;
 };
+
+scheme.primitives["handle-interrupts"] = function () {
+    // TODO: implement
+    return;
+};
+
 // Dynstack frames
 scheme.frame = {};
 

From c2589b5c48da8bdcb4690fc5124e9bb6a54b0b22 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 20 Jun 2017 19:05:59 +0100
Subject: [PATCH 47/90] Rebuild nested scopes for js continuations

* module/language/cps/compile-js.scm (compile-cont, compile-clause):
  Rebuild nested scopes for $kargs, using dominator information.
  (compile-fun, compile-clauses): Pass down dominator information.
---
 module/language/cps/compile-js.scm | 60 ++++++++++++++++++++----------
 1 file changed, 41 insertions(+), 19 deletions(-)

diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index e7509359f..363814cd5 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -5,6 +5,7 @@
   #:use-module ((language js-il)
                 #:renamer (lambda (x) (if (eqv? x 'make-prompt) 'make-prompt* x)))
   #:use-module (ice-9 match)
+  #:use-module ((srfi srfi-1) #:select (append-map))
   #:export (compile-js))
 
 (define intmap-select (@@ (language cps compile-bytecode) intmap-select))
@@ -27,12 +28,13 @@
 
 
 (define (compile-fun cps kfun)
+  (define doms (compute-dom-edges (compute-idoms cps kfun)))
   (match (intmap-ref cps kfun)
     (($ $kfun src meta self tail clause)
      (make-function
       (make-id self)
       (make-kid tail)
-      (compile-clauses cps clause self)))))
+      (compile-clauses cps doms clause self)))))
 
 
 (define (extract-and-compile-conts cps)
@@ -57,22 +59,21 @@
   (intmap-fold step cps '()))
 
 
-(define (compile-clauses cps clause self)
+(define (compile-clauses cps doms clause self)
   ;; FIXME: This duplicates all the conts in each clause, and requires
   ;; the inliner to remove them. A better solution is to change the
   ;; function type to contain a separate map of conts, but this requires
   ;; more code changes, and is should constitute a separate commit.
-  (define function-conts (extract-and-compile-conts cps))
   (let loop ((clause clause))
    (match (intmap-ref cps clause)
      (($ $kclause arity body #f)
       `((,(make-kid clause)
          ,(arity->params arity self)
-         ,(compile-clause cps arity body self function-conts))))
+         ,(compile-clause cps doms arity body self))))
      (($ $kclause arity body next)
       `((,(make-kid clause)
          ,(arity->params arity self)
-         ,(compile-clause cps arity body self function-conts))
+         ,(compile-clause cps doms arity body self))
         . ,(loop next))))))
 
 
@@ -91,27 +92,48 @@
                   allow-other-keys?))))
 
 
-(define (compile-clause cps arity body self bindings)
+(define (compile-clause cps doms arity body self)
   (match arity
     (($ $arity req opt rest ((_ _ kw-syms) ...) _)
      (let ((ids (map make-id
                      (append req opt kw-syms (if rest (list rest) '())))))
        (make-continuation
         (cons (make-id self) ids)
-        (make-local bindings (make-continue (make-kid body) ids)))))))
+        (make-local (list (cons (make-kid body) (compile-cont cps doms body)))
+                    (make-continue (make-kid body) ids)))))))
 
-
-(define (compile-cont cps cont)
-  (match (intmap-ref cps cont)
-    ;; The term in a $kargs is always a $continue
-    (($ $kargs names syms ($ $continue k src exp))
-     (make-continuation (map make-id syms) (compile-exp exp k)))
-    (($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
-     (let ((ids (map make-id (append req (list rest)))))
-       (make-continuation ids (make-continue (make-kid k2) ids))))
-    (($ $kreceive ($ $arity req _ #f _ _) k2)
-     (let ((ids (map make-id req)))
-       (make-continuation ids (make-continue (make-kid k2) ids))))))
+(define (compile-cont cps doms cont)
+  (define (redominate label exp)
+    ;; This ensures that functions which are dominated by a $kargs [e.g.
+    ;; because they need its arguments] are moved into its body, and so
+    ;; we get correct scoping.
+    (define (find&compile-dominated label)
+      (append-map (lambda (label)
+                    (match (intmap-ref cps label)
+                      (($ $ktail) '()) ; ignore tails
+                      (($ $kargs)
+                       ;; kargs may bind more arguments
+                       (list (cons (make-kid label) (compile label))))
+                      (else
+                       ;; otherwise, even if it dominates other conts,
+                       ;; it doesn't need to contain them
+                       (cons (cons (make-kid label) (compile label))
+                             (find&compile-dominated label)))))
+                  (intmap-ref doms label)))
+    (make-local (find&compile-dominated label) exp))
+  (define (compile cont)
+    (match (intmap-ref cps cont)
+      ;; The term in a $kargs is always a $continue
+      (($ $kargs names syms ($ $continue k src exp))
+       (make-continuation (map make-id syms)
+                          (redominate cont (compile-exp exp k))))
+      (($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
+       (let ((ids (map make-id (append req (list rest)))))
+         (make-continuation ids (make-continue (make-kid k2) ids))))
+      (($ $kreceive ($ $arity req _ #f _ _) k2)
+       (let ((ids (map make-id req)))
+         (make-continuation ids (make-continue (make-kid k2) ids))))))
+  (compile cont))
 
 (define (compile-exp exp k)
  (match exp

From 536d94feb3288c22517e565f45059ec5ea824cc8 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 20 Jun 2017 22:50:06 +0100
Subject: [PATCH 48/90] Compile Syntax Objects to Javascript

* module/language/js-il/compile-javascript.scm (compile-const):
  Handle the new syntax object struct.
* module/language/js-il/runtime.js(scheme.Syntax): Add Syntax Object type
---
 module/language/js-il/compile-javascript.scm | 8 ++++++++
 module/language/js-il/runtime.js             | 8 ++++++++
 2 files changed, 16 insertions(+)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index ed764410b..4ac782064 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -6,6 +6,7 @@
   #:use-module (language javascript simplify)
   #:use-module (language js-il inlining)
   #:use-module (system foreign)
+  #:use-module (system syntax internal)
   #:export (compile-javascript))
 
 (define (undefined? obj)
@@ -355,5 +356,12 @@
            (list (make-const (symbol->string (keyword->symbol c)))))))
         ((undefined? c)
          (make-refine *scheme* (make-const "UNDEFINED")))
+        ((syntax? c)
+         (make-call
+          (make-refine *scheme* (make-const "Syntax"))
+          (map compile-const
+               (list (syntax-expression c)
+                     (syntax-wrap c)
+                     (syntax-module c)))))
         (else
          (throw 'uncompilable-const c))))
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 6ef6ff1f2..85669da11 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -291,6 +291,14 @@ scheme.primitives["builtin-ref"] = function (idx) {
     return scheme.builtins[idx];
 };
 
+// Syntax Objects
+scheme.Syntax = function (expr, wrap, module) {
+    this.expr = expr;
+    this.wrap = wrap;
+    this.module = module;
+    return this;
+};
+
 // Modules
 scheme.primitives["define!"] = function(sym, obj) {
     var b = new scheme.Box(obj);

From 2204fb64f6c81f481e54a4cf48b2db1a96dc46a1 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Tue, 20 Jun 2017 23:12:09 +0100
Subject: [PATCH 49/90] Add more variables to no-values-primitives

* module/language/js-il/inlining.scm (no-values-primitives):
  Add primitives
---
 module/language/js-il/inlining.scm | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index 1d3182069..e07e30467 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -90,6 +90,9 @@
     push-fluid
     pop-fluid
     handle-interrupts
+    push-dynamic-state
+    pop-dynamic-state
+    fluid-set!
     ))
 
 (define no-values-primitive?

From b3c0fcdb25b4217a526661f1e9989f1a1f533da2 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 22 Jun 2017 14:55:07 +0100
Subject: [PATCH 50/90] Implement cached-module-box

* module/language/js-il/runtime.js (scheme): Add module_cache field.
  (scheme.primitives) Add cached-module-box primitive.
  (def_guile0) Convenience for adding to (guile) module cache.
---
 module/language/js-il/runtime.js | 59 +++++++++++++++++++++++++++++++-
 1 file changed, 58 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 85669da11..cccccc6b6 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -4,6 +4,7 @@ var scheme = {
     utils : {},
     env : {},
     cache: [],
+    module_cache: {},
     builtins: [],
     dynstack : [],
     // TODO: placeholders
@@ -314,7 +315,21 @@ scheme.primitives["cached-toplevel-box"] = function (scope, sym, is_bound) {
     return scheme.cache[scope][sym.name];
 };
 
-scheme.primitives["cached-module-box"] = not_implemented_yet;
+scheme.primitives["cached-module-box"] = function (module_name, sym, is_public, is_bound)  {
+    var cache = scheme.module_cache;
+
+    while (scheme.EMPTY != module_name.cdr) {
+        cache = cache[module_name.car.name];
+    }
+
+    cache = cache[module_name.car.name];
+    var r = cache[sym.name];
+    if (typeof r === 'undefined') {
+        throw {r : "cached-module-box", s : sym, m : module_name};
+    } else {
+        return r;
+    }
+};
 
 scheme.primitives["current-module"] = function () {
     return scheme.env;
@@ -493,3 +508,45 @@ scheme.frame.Fluid = function(fluid, old_value) {
     this.fluid = fluid;
     this.old_value = old_value;
 };
+
+// Module Cache
+scheme.module_cache["guile"] = scheme.env;
+
+function def_guile0 (name, fn) {
+    var sym = new scheme.Symbol(name); // put in obarray
+    var clos = new scheme.Closure(fn, 0);
+    var box = new scheme.Box(clos);
+    scheme.module_cache["guile"][name] = box;
+};
+
+function scm_list (self, cont) {
+    var l = scheme.EMPTY;
+    for (var i = arguments.length - 1; i >= 2; i--){
+        l = scheme.primitives.cons(arguments[i],l);
+    };
+    return cont(l);
+};
+def_guile0("list", scm_list);
+
+function scm_add(self, cont) {
+
+    var total = 0;
+    for (var i = arguments.length - 1; i >= 2; i--){
+        total += arguments[i];
+    };
+    return cont(total);
+
+};
+def_guile0("+", scm_add);
+
+function scm_mul(self, cont) {
+
+    var total = 1;
+    for (var i = arguments.length - 1; i >= 2; i--){
+        total *= arguments[i];
+    };
+    return cont(total);
+
+};
+def_guile0("*", scm_mul);
+

From ff7fff920d1a26cf01837d0ad5e44ac471ef94e9 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 28 Jun 2017 10:38:00 +0100
Subject: [PATCH 51/90] Add macro type in runtime.js

* module/language/js-il/runtime.js
  (scheme.Macro): Add type.
  (make-syntax-transformer): Add guile procedure.
---
 module/language/js-il/runtime.js | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index cccccc6b6..5a2afa225 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -550,3 +550,15 @@ function scm_mul(self, cont) {
 };
 def_guile0("*", scm_mul);
 
+// Macros
+scheme.Macro = function (name, type, binding) {
+    // TODO: prim field?
+    this.name = name;
+    this.type = type;
+    this.binding = binding;
+    return this;
+};
+
+def_guile0("make-syntax-transformer", function (self, cont, name, type, binding) {
+    return cont(new scheme.Macro(name, type, binding));
+});

From 479294fc056b5c0e8cb0ca20a1bdf760f02898fb Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 28 Jun 2017 15:03:03 +0100
Subject: [PATCH 52/90] Implement Winding & Unwinding

* module/language/js-il/runtime.js
  (wind, unwind): Implement.
  (callcc): Wind when invoking continuation.
---
 module/language/js-il/runtime.js | 71 +++++++++++++++++++++++++++++---
 1 file changed, 65 insertions(+), 6 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5a2afa225..5fc10c250 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -380,7 +380,7 @@ var abort_to_prompt = function(self, k, prompt) {
         kont = new scheme.Closure(f, 0);
     };
 
-    unwind(idx);
+    unwind(scheme.dynstack, idx); // FIXME:
 
     var handler = frame.handler;
     args.unshift(kont);
@@ -396,8 +396,17 @@ var call_with_values = function (self, k, producer, consumer) {
 };
 
 var callcc = function (self, k, closure) {
+    var dynstack = scheme.dynstack.slice();
+
     var f = function (self, k2) {
         var args = Array.prototype.slice.call(arguments, 2);
+
+        var i = shared_stack_length(dynstack, scheme.dynstack);
+
+        unwind(scheme.dynstack, i);
+        wind(dynstack, i);
+        scheme.dynstack = dynstack;
+
         return k.apply(k,args);
     };
     return closure.fun(closure, k, new scheme.Closure(f, 0));
@@ -461,8 +470,17 @@ scheme.primitives["fluid-ref"] = function (fluid) {
 scheme.primitives["variable?"] = not_implemented_yet;
 
 // Dynamic Wind
-scheme.primitives["wind"] = not_implemented_yet;
-scheme.primitives["unwind"] = not_implemented_yet;
+scheme.primitives["wind"] = function(enter, leave) {
+    var frame = new scheme.frame.DynWind(enter, leave);
+    scheme.dynstack.unshift(frame);
+};
+
+scheme.primitives["unwind"] = function () {
+    var frame = scheme.dynstack.shift();
+    if (!(frame instanceof scheme.frame.DynWind)) {
+        throw "not a dynamic wind frame";
+    };
+};
 
 // Misc
 scheme.primitives["prompt"] = function(escape_only, tag, handler){
@@ -470,9 +488,45 @@ scheme.primitives["prompt"] = function(escape_only, tag, handler){
     scheme.dynstack.unshift(frame);
 };
 
-var unwind = function (idx) {
-    // TODO: call winders
-    scheme.dynstack = scheme.dynstack.slice(idx+1);
+var shared_stack_length = function (dynstack1, dynstack2) {
+    // Assumes that if it matches at i then it matches for all x<i,
+    // which will be fine given that we don't reuse frames
+    var size1 = dynstack1.length;
+    var size2 = dynstack2.length;
+    var last = Math.min(size1, size2);
+
+    var i = last-1;
+    for (; i >= 0; i--) {
+        if (dynstack1[i] === dynstack2[i]) {
+            break;
+        }
+    };
+
+    return i + 1;
+};
+
+var wind = function (dynstack, idx) {
+    for (var i = idx; i < dynstack.length; i++) {
+        var frame = dynstack[i];
+        if (frame instanceof scheme.frame.DynWind) {
+            // TODO: how to handle continuations and errors in this?
+            frame.wind.fun(frame.wind, scheme.initial_cont);
+        } else {
+            throw "unsupported frame type -- wind";
+        }
+    }
+};
+
+var unwind = function (dynstack, idx) {
+    for (var i = dynstack.length - 1; i >= idx; i--) {
+        var frame = dynstack[i];
+        if (frame instanceof scheme.frame.DynWind) {
+            // TODO: how to handle continuations and errors in this?
+            frame.unwind.fun(frame.unwind, scheme.initial_cont);
+        } else {
+            throw "unsupported frame type -- unwind";
+        }
+    }
 };
 
 var find_prompt = function(prompt) {
@@ -509,6 +563,11 @@ scheme.frame.Fluid = function(fluid, old_value) {
     this.old_value = old_value;
 };
 
+scheme.frame.DynWind = function(wind, unwind) {
+    this.wind = wind;
+    this.unwind = unwind;
+};
+
 // Module Cache
 scheme.module_cache["guile"] = scheme.env;
 

From cf1ddd466bb58922fbf843fd7413e85eabb2f500 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 28 Jun 2017 17:15:57 +0100
Subject: [PATCH 53/90] Implement structs in runtime.js

* module/language/js-il/runtime.js:
  (scheme.Struct): new type.
  (allocate-struct/immediate, struct-vtable, struct-set!, struct-ref,
  struct-set!/immediate, struct-ref/immediate): Implement primitives.
  (def_guile_val): New helper.
  (string=?, string-append): Implement string functions.
  (standard-vtable-fields, <standard-vtable>, vtable-index-layout,
  vtable-index-printer, vtable-offset-user, make-struct/no-tail,
  make-vtable, struct-vtable?): Implement struct functions.
---
 module/language/js-il/runtime.js | 138 +++++++++++++++++++++++++++++--
 1 file changed, 131 insertions(+), 7 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5fc10c250..6b33f5cb9 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -418,13 +418,37 @@ scheme.builtins[3] = new scheme.Closure(call_with_values, 0);
 scheme.builtins[4] = new scheme.Closure(callcc, 0);
 
 // Structs
-scheme.primitives["struct?"] = not_implemented_yet;
-scheme.primitives["struct-set!/immediate"] = not_implemented_yet;
-scheme.primitives["struct-vtable"] = not_implemented_yet;
-scheme.primitives["struct-ref/immediate"] = not_implemented_yet;
-scheme.primitives["struct-ref"] = not_implemented_yet;
-scheme.primitives["struct-set!"] = not_implemented_yet;
-scheme.primitives["allocate-struct/immediate"] = not_implemented_yet;
+scheme.Struct = function (vtable, nfields) {
+    this.is_vtable = false;
+    this.vtable = vtable;
+    this.fields = [];
+
+    // FIXME: worth doing?
+    for(var i = 0; i < nfields; i++){
+        this.fields[i]=scheme.UNDEFINED;
+    }
+
+    return this;
+};
+
+scheme.primitives["allocate-struct/immediate"] = function (vtable, nfields) {
+    return new scheme.Struct(vtable, nfields);
+};
+
+scheme.primitives["struct-vtable"] = function(struct) {
+    return struct.vtable;
+};
+
+scheme.primitives["struct-set!"] = function (struct, idx, obj) {
+    return struct.fields[idx] = obj;
+};
+
+scheme.primitives["struct-ref"] = function (struct, idx) {
+    return struct.fields[idx];
+};
+
+scheme.primitives["struct-set!/immediate"] = scheme.primitives["struct-set!"];
+scheme.primitives["struct-ref/immediate"] = scheme.primitives["struct-ref"];
 
 // Equality
 scheme.primitives["eq?"] = function(x, y) {
@@ -578,6 +602,12 @@ function def_guile0 (name, fn) {
     scheme.module_cache["guile"][name] = box;
 };
 
+function def_guile_val (name, val) {
+    var sym = new scheme.Symbol(name); // put in obarray
+    var box = new scheme.Box(val);
+    scheme.module_cache["guile"][name] = box;
+};
+
 function scm_list (self, cont) {
     var l = scheme.EMPTY;
     for (var i = arguments.length - 1; i >= 2; i--){
@@ -621,3 +651,97 @@ scheme.Macro = function (name, type, binding) {
 def_guile0("make-syntax-transformer", function (self, cont, name, type, binding) {
     return cont(new scheme.Macro(name, type, binding));
 });
+
+// Strings
+def_guile0("string=?", function (self, cont, s1, s2) {
+    return cont(coerce_bool(s1.s === s2.s));
+});
+
+def_guile0("string-append", function (self, cont, s1, s2) {
+    var s = new scheme.String(s1.s + s2.s);
+    return cont(s);
+});
+
+// Structs
+var vtable_base_layout = new scheme.String("pruhsruhpwphuhuh");
+def_guile_val("standard-vtable-fields", vtable_base_layout);
+
+var scm_vtable_index_layout = 0;
+var scm_vtable_index_flags = 1;
+var scm_vtable_index_self = 2;
+var scm_vtable_index_instance_finalize = 3;
+var scm_vtable_index_instance_printer = 4;
+var scm_vtable_index_name = 5;
+var scm_vtable_index_size = 6;
+var scm_vtable_index_reserved_7 = 7;
+var scm_vtable_offset_user = 8;
+
+function scm_struct_init(struct, layout, args) {
+    // FIXME: assumes there are no tail arrays
+    var nfields = layout.length / 2; // assumes even
+    var arg = 0;
+
+    for (var i = 0; i < nfields; i++) {
+        if (layout[2*i+1] == 'o') {
+            continue;
+        }
+        switch (layout[2*i]) {
+        case 'p' :
+            struct.fields[i] = (arg < args.length) ? args[arg] : scheme.FALSE;
+            arg += 1;
+            break;
+        case 'u' :
+            struct.fields[i] = (arg < args.length) ? args[arg] : 0;
+            arg += 1;
+            break;
+        case 's' :
+            struct.fields[i] = struct;
+        }
+    }
+};
+
+// Set up <standard-vtable>
+var scm_standard_vtable = new scheme.Struct(undefined, 0);
+scm_standard_vtable.vtable = scm_standard_vtable;
+scm_standard_vtable.is_vtable = true; // ?
+scm_struct_init(scm_standard_vtable,
+                vtable_base_layout.s,
+                [new scheme.Symbol(vtable_base_layout.s)]);
+//   scm_set_struct_vtable_name_x (scm_standard_vtable_vtable, name);
+
+def_guile_val("<standard-vtable>", scm_standard_vtable);
+def_guile_val("vtable-index-layout", scm_vtable_index_layout);
+def_guile_val("vtable-index-printer", scm_vtable_index_instance_printer);
+def_guile_val("vtable-offset-user", scm_vtable_offset_user);
+
+
+function scm_make_struct (vtable, args) {
+    var layout = vtable.fields[scm_vtable_index_layout].name;
+    var s = new scheme.Struct(vtable, layout.length / 2);
+    scm_struct_init(s, layout, args);
+    return s;
+}
+
+def_guile0("make-struct/no-tail", function (self, cont, vtable) {
+    var args = Array.prototype.slice.call(arguments, 3);
+    return cont(scm_make_struct(vtable, args));
+});
+
+def_guile0("make-vtable", function(self, cont, fields, printer) {
+    var layout = new scheme.Symbol(fields.s); // make-struct-layout
+    var str = scm_make_struct(scm_standard_vtable, [layout, printer]);
+    str.is_vtable = true;
+    return cont(str);
+});
+
+def_guile0("make-struct-layout", function (self, cont, str) {
+    var layout = new scheme.Symbol(str.s);
+    return cont(layout);
+});
+
+def_guile0("struct-vtable?", function (self, cont, obj) {
+    // We don't inherit flags, so =struct-vtable?= may give the wrong
+    // answer where SCM_VTABLE_FLAG_VTABLE would have been set
+    var bool = coerce_bool(obj instanceof scheme.Struct && obj.is_vtable);
+    return cont(bool);
+});

From 0b9b08a28d5c103241b1bf53df8992fbcfce0ce7 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 21:03:11 +0100
Subject: [PATCH 54/90] Implement immediate version of vector primitives.

* module/language/js-il/runtime.js
  (make-vector/immediate, vector-set!/immediate,
  vector-ref/immediate): New Primitives.
---
 module/language/js-il/runtime.js | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 6b33f5cb9..a140147f3 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -235,9 +235,21 @@ scheme.primitives["vector?"] = function (obj) {
     return coerce_bool(obj instanceof scheme.Vector);
 };
 
-scheme.primitives["make-vector/immediate"] = not_implemented_yet;
-scheme.primitives["vector-set!/immediate"] = not_implemented_yet;
-scheme.primitives["vector-ref/immediate"] = not_implemented_yet;
+scheme.primitives["make-vector/immediate"] = function(length, init) {
+    var v = new scheme.Vector();
+
+    var temp = []
+    for (var i=0; i < length; i++) {
+        temp[i] = init;
+    }
+
+    v.array = temp;
+
+    return v;
+};
+
+scheme.primitives["vector-set!/immediate"] = scheme.primitives["vector-set!"];
+scheme.primitives["vector-ref/immediate"] = scheme.primitives["vector-ref"];
 
 // Bytevectors
 

From 2a3c43a5a9594be20993467456ad906ce32c6fd0 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 21:11:02 +0100
Subject: [PATCH 55/90] Implement builtin list procedures.

* module/language/js-il/runtime.js
  (make-list, length, list?, reverse, append, memq, member, delete!):
  New procedures
---
 module/language/js-il/runtime.js | 90 ++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index a140147f3..5011f2eaf 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -651,6 +651,96 @@ function scm_mul(self, cont) {
 };
 def_guile0("*", scm_mul);
 
+// Lists
+def_guile0("make-list", function (self, cont, n, obj) {
+    var list = scheme.EMPTY;
+
+    for (var i = 0; i <= n; i++) {
+        list = new scheme.Pair(obj, list);
+    }
+
+    return cont(list);
+});
+
+def_guile0("length", function (self, cont, list) {
+   var len = 0;
+
+    while (!scheme.is_true(scheme.primitives["null?"](list))) {
+        if (scheme.is_true(scheme.primitives["pair?"](list))) {
+            list = list.cdr;
+            len += 1;
+        } else {
+            console.log("length bad");
+            not_implemented_yet();
+        }
+    }
+
+    return cont(len);
+});
+
+def_guile0("list?", function (self, cont, list) {
+
+    while (!scheme.is_true(scheme.primitives["null?"](list))) {
+        if (scheme.is_true(scheme.primitives["pair?"](list))) {
+            list = list.cdr;
+        } else {
+            return cont(scheme.FALSE);
+        }
+    }
+
+    return cont(scheme.TRUE);
+});
+
+def_guile0("reverse", function (self, cont, lst) {
+    var l = scheme.EMPTY;
+    while (lst != scheme.EMPTY) {
+        l = scheme.primitives.cons(lst.car, l);
+        lst = lst.cdr;
+    }
+    return cont(l);
+});
+
+def_guile0("append", function (self, cont, l1, l2) {
+    if (arguments.length != 4) {
+        console.log("FIXAPPEND", arguments.length);
+        throw "fail";
+    }
+
+
+    if (l1 === scheme.EMPTY) {
+        return cont(l2);
+    }
+
+    var l = new scheme.Pair(l1.car, l2);
+
+    var lp = l;
+    while (scheme.is_true(scheme.primitives["pair?"](l1.cdr))) {
+
+        var lo = new scheme.Pair(l1.cdr.car, l2);
+        lp.cdr = l2;
+
+        lp = lp.cdr;
+        l1 = l1.cdr;
+    }
+
+    return cont(l);
+});
+
+def_guile0("memq", function (self, cont, val, args) {
+    return cont(scheme.FALSE);
+});
+
+def_guile0("member", function (self, cont, elt, list) {
+    // FIXME: needs equal? console.log("member", arguments);
+    // throw "";
+    return cont(scheme.FALSE);
+});
+
+def_guile0("delete!", function (self, cont, elt, list) {
+    // FIXME:
+    return cont(list);
+});
+
 // Macros
 scheme.Macro = function (name, type, binding) {
     // TODO: prim field?

From 5d49a5be186930fcdc750f99753d93a67317299c Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 21:12:47 +0100
Subject: [PATCH 56/90] Implement built-in syntax procedures.

* module/language/js-il/runtime.js
  (syntax?, make-syntax, syntax-expression, syntax-wrap,
  syntax-module): New procedures.
---
 module/language/js-il/runtime.js | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5011f2eaf..e7d78e1b6 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -754,6 +754,27 @@ def_guile0("make-syntax-transformer", function (self, cont, name, type, binding)
     return cont(new scheme.Macro(name, type, binding));
 });
 
+function scm_is_syntax (self, cont, obj) {
+    return cont(coerce_bool(obj instanceof scheme.Syntax));
+};
+def_guile0("syntax?", scm_is_syntax);
+
+def_guile0("make-syntax", function (self, cont, expr, wrap, module) {
+    return cont(new scheme.Syntax(expr, wrap, module));
+});
+
+def_guile0("syntax-expression", function (self, cont, obj) {
+    return cont(obj.expr);
+});
+
+def_guile0("syntax-wrap", function (self, cont, obj) {
+    return cont(obj.wrap);
+});
+
+def_guile0("syntax-module", function (self, cont, obj) {
+    return cont(obj.module);
+});
+
 // Strings
 def_guile0("string=?", function (self, cont, s1, s2) {
     return cont(coerce_bool(s1.s === s2.s));

From 2adebea5d0694a00b62ec32108da5f6d05c33579 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 21:14:57 +0100
Subject: [PATCH 57/90] Implement built-in symbol procedures.

* module/language/js-il/runtime.js
  (symbol->string, gensym): New procedures.
---
 module/language/js-il/runtime.js | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index e7d78e1b6..11072829c 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -775,6 +775,22 @@ def_guile0("syntax-module", function (self, cont, obj) {
     return cont(obj.module);
 });
 
+// Symbols
+def_guile0("symbol->string", function (self, cont, sym) {
+    return cont(new scheme.String(sym.name));
+});
+
+var gensym_counter = 0;
+function scm_gensym (self, cont, prefix) {
+    var name = prefix ? prefix.s : "gen ";
+    name += gensym_counter;
+    gensym_counter += 1;
+
+    return cont(new scheme.Symbol(name));
+};
+def_guile0("gensym", scm_gensym);
+
+
 // Strings
 def_guile0("string=?", function (self, cont, s1, s2) {
     return cont(coerce_bool(s1.s === s2.s));

From 2273eb4d061d6c2d17675ef773b0568f2482ee58 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 21:17:22 +0100
Subject: [PATCH 58/90] Implement built-in string procedures.

* module/language/js-il/runtime.js
  (string-append): Extend to more than 2 arguments.
  (string-join): New procedure.
---
 module/language/js-il/runtime.js | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 11072829c..c6d70cb80 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -797,8 +797,32 @@ def_guile0("string=?", function (self, cont, s1, s2) {
 });
 
 def_guile0("string-append", function (self, cont, s1, s2) {
-    var s = new scheme.String(s1.s + s2.s);
-    return cont(s);
+    var s = "";
+
+    for (var i = 2; i < arguments.length; i++) {
+        s += arguments[i].s;
+    }
+
+    //console.log("sap", s1, s2, arguments.length);
+    return cont(new scheme.String(s));
+});
+
+def_guile0("string-join", function (self, cont, strings) {
+    var s = "";
+
+    while (!scheme.is_true(scheme.primitives["null?"](strings))) {
+        if (scheme.is_true(scheme.primitives["pair?"](strings))) {
+            s += strings.car.s;
+            strings = strings.cdr;
+        } else {
+            console.log("string-join bad");
+            not_implemented_yet();
+        }
+    }
+
+    return cont(new scheme.String(s));
+});
+
 });
 
 // Structs

From ebe9d00153e38f502c6484acc0c24444458b26a6 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 22:44:27 +0100
Subject: [PATCH 59/90] Implement struct built-ins.

* module/language/js-il/runtime.js
  (struct?): New primitive.
  (<applicable-struct-vtable>, record-type-vtable,
  set-struct-vtable-name!, make-struct): Implement built-ins.
---
 module/language/js-il/runtime.js | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index c6d70cb80..51f1c6cc5 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -443,6 +443,10 @@ scheme.Struct = function (vtable, nfields) {
     return this;
 };
 
+scheme.primitives["struct?"] = function (obj) {
+    return coerce_bool(obj instanceof scheme.Struct);
+};
+
 scheme.primitives["allocate-struct/immediate"] = function (vtable, nfields) {
     return new scheme.Struct(vtable, nfields);
 };
@@ -908,3 +912,27 @@ def_guile0("struct-vtable?", function (self, cont, obj) {
     var bool = coerce_bool(obj instanceof scheme.Struct && obj.is_vtable);
     return cont(bool);
 });
+
+var applicable_vtable = scm_make_struct(scm_standard_vtable, [new scheme.Symbol(vtable_base_layout.s)]);
+applicable_vtable.children_applicable_vtables = true;
+
+def_guile_val("<applicable-struct-vtable>", applicable_vtable);
+
+def_guile_val("record-type-vtable", scm_standard_vtable); // FIXME:
+
+def_guile0("set-struct-vtable-name!", function (self, cont, val, args) {
+    // FIXME:
+    return cont(scheme.FALSE);
+});
+
+def_guile0("make-struct", function (self, cont, vtable, tailsize) {
+    if (tailsize === 0) {
+        // make-struct/no-tail
+        var args = Array.prototype.slice.call(arguments, 4);
+        return cont(scm_make_struct(vtable, args));
+    } else {
+        console.log("make-struct with tail", arguments);
+        not_implemented_yet();
+    }
+});
+

From 30dc57cb0409def8e410e2f2e9fc628f35397169 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 22:46:13 +0100
Subject: [PATCH 60/90] define! primitive only takes one argument.

* module/language/js-il/runtime.js (define!): Ignore argument.
---
 module/language/js-il/runtime.js | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 51f1c6cc5..5c544f868 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -313,8 +313,8 @@ scheme.Syntax = function (expr, wrap, module) {
 };
 
 // Modules
-scheme.primitives["define!"] = function(sym, obj) {
-    var b = new scheme.Box(obj);
+scheme.primitives["define!"] = function(sym) {
+    var b = new scheme.Box(scheme.UNDEFINED);
     scheme.env[sym.name] = b;
     return b;
 };

From 30cc1e07511bb60bb7b4b85913e1f60111c8e38c Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 22:55:00 +0100
Subject: [PATCH 61/90] scm_struct_init skips hidden fields.

* module/language/js-il/runtime.js (scm_struct_init): skip 'h' fields.
---
 module/language/js-il/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5c544f868..35fa2184d 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -849,7 +849,7 @@ function scm_struct_init(struct, layout, args) {
     var arg = 0;
 
     for (var i = 0; i < nfields; i++) {
-        if (layout[2*i+1] == 'o') {
+        if (layout[2*i+1] == 'o' || layout[2*i+1] == 'h') {
             continue;
         }
         switch (layout[2*i]) {

From bfaf07091adb55bda4f768ceeeab1d04870a16c6 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 23:12:58 +0100
Subject: [PATCH 62/90] Implement hashtable built-ins

* module/language/js-il/runtime.js
  (scheme.HashTable): New Constructor.
  (make-hash-table, hash-clear!, hashq-remove!, hashq-ref, hashq-set!,
  hash-for-each): Implement built-ins.
---
 module/language/js-il/runtime.js | 79 ++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 35fa2184d..9d099b5f0 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -936,3 +936,82 @@ def_guile0("make-struct", function (self, cont, vtable, tailsize) {
     }
 });
 
+// Hashtables
+def_guile0("make-hash-table", function (self, cont, size) {
+    return cont(new scheme.HashTable());
+});
+
+def_guile0("make-weak-key-hash-table", function (self, cont, size) {
+    // FIXME: not weak
+    return cont(new scheme.HashTable());
+});
+
+def_guile0("hash-clear!", function (self, cont, hashtable) {
+    if (hashtable instanceof scheme.HashTable) {
+        hashtable.table = {};
+        return cont(scheme.FALSE);
+    } else {
+        console.log("hash-clear!", arguments);
+        not_implemented_yet();
+    }
+});
+
+def_guile0("hashq-remove!", function (self, cont, htable, key) {
+    if (htable instanceof scheme.HashTable) {
+        delete htable.table[scm_hash(key)];
+        return cont(scheme.FALSE);
+    } else {
+        console.log("hashq-ref", arguments);
+        not_implemented_yet();
+    }
+});
+
+var scm_hash = function (obj) {
+    if (obj instanceof scheme.Symbol) {
+        return obj.name;
+    }
+
+    console.log("Can't hash object", obj);
+    throw "BadHash";
+};
+
+scheme.HashTable = function ( ) {
+    this.table = {};
+    this.lookup = function (obj, dflt) {
+        var hash = scm_hash(obj);
+        if (this.table.hasOwnProperty(hash)) {
+            return this.table[hash];
+        } else {
+            return dflt;
+        }
+    };
+
+    return this;
+}
+
+def_guile0("hashq-ref", function(self, cont, obarray, sym, dflt) {
+
+    if (obarray instanceof scheme.HashTable) {
+        return cont(obarray.lookup(sym, dflt ? dflt : scheme.FALSE));
+    } else {
+        console.log("hashq-ref", arguments);
+        not_implemented_yet();
+    }
+});
+
+
+def_guile0("hashq-set!", function (self, cont, hashtable, key, obj) {
+    if (hashtable instanceof scheme.HashTable) {
+        hashtable.table[scm_hash(key)] = obj;
+        return cont(scheme.FALSE);
+    } else {
+        console.log("hashq-set!", arguments);
+        not_implemented_yet();
+    }
+});
+
+def_guile0("hash-for-each", function (self, cont, module, symbol) {
+    // FIXME:
+    return cont(scheme.FALSE);
+});
+

From 3d29f2874f1f9f11295a14592024c99923bee50a Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 23:19:00 +0100
Subject: [PATCH 63/90] Implement procedure built-ins.

* module/language/js-il/runtime.js
  (procedure?, set-procedure-property!, make-procedure-with-setter): Implement.
---
 module/language/js-il/runtime.js | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 9d099b5f0..feda26a35 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -936,6 +936,19 @@ def_guile0("make-struct", function (self, cont, vtable, tailsize) {
     }
 });
 
+// Procedures
+def_guile0("procedure?", function (self, cont, obj) {
+    return cont(coerce_bool(obj instanceof scheme.Closure));
+});
+
+def_guile0("set-procedure-property!", function (self, cont, procedure, property, obj) {
+    return cont(scheme.FALSE);
+});
+
+def_guile0("make-procedure-with-setter", function (self, cont, procedure, setter) {
+    return cont(scheme.FALSE);
+});
+
 // Hashtables
 def_guile0("make-hash-table", function (self, cont, size) {
     return cont(new scheme.HashTable());

From 3c62ab81853eda1ff11b97abb545c39cce0a2f42 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 2 Aug 2017 23:24:20 +0100
Subject: [PATCH 64/90] Implement module built-ins.

* module/language/js-il/runtime.js
  (variable?): New Primitive.
  (primitive-load-path, module-local-variable, module-variable,
  %get-pre-modules-obarray, set-current-module): Implement built-ins.
---
 module/language/js-il/runtime.js | 75 ++++++++++++++++++++++++++++++--
 1 file changed, 72 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index feda26a35..1ff5ae17a 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -507,7 +507,10 @@ scheme.primitives["fluid-ref"] = function (fluid) {
 };
 
 // Variables
-scheme.primitives["variable?"] = not_implemented_yet;
+scheme.primitives["variable?"] = function (obj) {
+    // FIXME: should variables be distinct from boxes?
+    return coerce_bool(obj instanceof scheme.Box);
+};
 
 // Dynamic Wind
 scheme.primitives["wind"] = function(enter, leave) {
@@ -827,8 +830,6 @@ def_guile0("string-join", function (self, cont, strings) {
     return cont(new scheme.String(s));
 });
 
-});
-
 // Structs
 var vtable_base_layout = new scheme.String("pruhsruhpwphuhuh");
 def_guile_val("standard-vtable-fields", vtable_base_layout);
@@ -1028,3 +1029,71 @@ def_guile0("hash-for-each", function (self, cont, module, symbol) {
     return cont(scheme.FALSE);
 });
 
+// Modules
+def_guile0("make-variable", function (self, cont, val) {
+    return cont(new scheme.Box(val));
+});
+
+def_guile0("define!", function (self, cont, symbol, value) {
+    // FIXME: reuse module-define!
+    if (symbol.name in scheme.env) {
+        scheme.env[symbol.name].x = value;
+    } else {
+        scheme.env[symbol.name] = new scheme.Box(value);
+    }
+    return cont();
+});
+
+var boot_modules = {};
+
+function scm_primitive_load_path (self, cont, path) {
+    if (path.s in boot_modules) {
+        boot_modules[path.s](); // FIXME: note modules should share cont?
+        return cont(scheme.UNDEFINED);
+    } else {
+        console.log("primitive load path", arguments);
+        not_implemented_yet();
+    }
+};
+def_guile0("primitive-load-path", scm_primitive_load_path);
+
+boot_modules["ice-9/deprecated"] = function () {};
+boot_modules["ice-9/ports"] = function () {};
+boot_modules["ice-9/posix"] = function () {};
+boot_modules["ice-9/threads"] = function () {};
+boot_modules["srfi/srfi-4"] = function () {};
+
+def_guile0("module-local-variable", function (self, cont, module, symbol) {
+    if (module instanceof scheme.Struct) {
+      // Assumes we get a module with a hashtable
+      var obarray = scheme.primitives["struct-ref"](module, 0);
+      return cont(obarray.lookup(symbol, scheme.FALSE)); // hashq-ref
+    } else {
+      // FIXME: could be #f, then should use the pre-mod obarray
+      console.log("module-local-variable needs real modules");
+      throw "fail";
+    }
+});
+
+def_guile0("module-variable", function (self, cont, module, symbol) {
+    if (module instanceof scheme.Struct) {
+       console.log("FIXME: should only be called pre-bootstrap");
+       throw "fail";
+    }
+    if (module instanceof scheme.HashTable) {
+       console.log("modvar htable");
+       throw "fail";
+    }
+    return cont(module[symbol.name]);
+});
+
+def_guile0("%get-pre-modules-obarray", function (self, cont) {
+    var obarray = new scheme.HashTable();
+    obarray.table = scheme.env;
+    return cont(obarray);
+});
+
+def_guile0("set-current-module", function (self, cont, module) {
+    return cont(scheme.FALSE);
+});
+

From 46fa3b2fb8cbce9b55870a3f472d8a9b3f6f50c6 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 3 Aug 2017 00:16:02 +0100
Subject: [PATCH 65/90] Implement misc built-ins

* module/language/js-il/runtime.js
  (scm->u64): New primitive
  (integer?, char=?, make-fluid, read-hash-extend, make-hook,
  simple-format, scm-error): Implement built-ins.
  (syntax-session-id, macroexpand, %exception-handler,
  print-exception, *features*, %load-hook, current-reader): Stubbed
  variables.
---
 module/language/js-il/runtime.js | 53 ++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 1ff5ae17a..72e0a0a3b 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -108,6 +108,10 @@ scheme.primitives["u64->=-scm"] = function(x, y) {
     return coerce_bool(x >= y);
 };
 
+scheme.primitives["scm->u64"] = function(x) {
+    return x;
+};
+
 // Boxes
 scheme.Box = function (x) {
     this.x = x;
@@ -636,6 +640,7 @@ function scm_list (self, cont) {
 };
 def_guile0("list", scm_list);
 
+// Numbers
 function scm_add(self, cont) {
 
     var total = 0;
@@ -658,6 +663,11 @@ function scm_mul(self, cont) {
 };
 def_guile0("*", scm_mul);
 
+def_guile0("integer?", function(self, cont, obj) {
+    // return coerce_bool(Number.isInteger(obj));  // ES6
+    return cont(coerce_bool(typeof(obj) === 'number'));
+});
+
 // Lists
 def_guile0("make-list", function (self, cont, n, obj) {
     var list = scheme.EMPTY;
@@ -797,6 +807,10 @@ function scm_gensym (self, cont, prefix) {
 };
 def_guile0("gensym", scm_gensym);
 
+// Chars
+def_guile0("char=?", function (self, cont, char1, char2) {
+    return cont(char1.c === char2.c);
+});
 
 // Strings
 def_guile0("string=?", function (self, cont, s1, s2) {
@@ -830,6 +844,11 @@ def_guile0("string-join", function (self, cont, strings) {
     return cont(new scheme.String(s));
 });
 
+// Fluids
+def_guile0("make-fluid", function (self, cont, val) {
+    return cont(new scheme.Fluid(val));
+});
+
 // Structs
 var vtable_base_layout = new scheme.String("pruhsruhpwphuhuh");
 def_guile_val("standard-vtable-fields", vtable_base_layout);
@@ -1097,3 +1116,37 @@ def_guile0("set-current-module", function (self, cont, module) {
     return cont(scheme.FALSE);
 });
 
+// Stubs
+function stub(name) {
+    function scm_fn (self, cont) {
+        console.log(name, arguments);
+        not_implemented_yet();
+    };
+    def_guile0(name, scm_fn);
+};
+
+stub("syntax-session-id");
+stub("macroexpand");
+stub("%exception-handler");
+stub("print-exception");
+stub("*features*");
+stub("%load-hook");
+stub("current-reader");
+
+def_guile0("read-hash-extend", function (self, cont, char, fun) {
+    return cont(scheme.FALSE);
+});
+
+def_guile0("make-hook", function (self, cont, nargs) {
+    return cont(scheme.FALSE);
+});
+
+function scm_simple_format (self, cont) {
+    not_implemented_yet();
+};
+def_guile0("simple-format", scm_simple_format);
+
+def_guile0("scm-error", function (self, cont, key, subr, message, args, data) {
+  not_implemented_yet();
+});
+

From 70c25b1290cc1bf5f07fe432272e7b550f205201 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 3 Aug 2017 00:22:03 +0100
Subject: [PATCH 66/90] Make child structs applicable.

* module/language/js-il/runtime.js (scheme.Struct): When certain flags
  are set, child structs should be marked as applicable.
---
 module/language/js-il/runtime.js | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 72e0a0a3b..8e0480eda 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -439,6 +439,22 @@ scheme.Struct = function (vtable, nfields) {
     this.vtable = vtable;
     this.fields = [];
 
+    if (this.vtable && this.vtable.hasOwnProperty('children_applicable_vtables')) {
+        this.is_vtable = true;
+        this.children_applicable = true;
+    }
+
+    if (this.vtable && this.vtable.hasOwnProperty('children_applicable')) {
+        this.is_applicable = true;
+        this.fun = function (self, cont) {
+            var scm_applicable_struct_index_procedure = 0;
+            var clos = self.fields[scm_applicable_struct_index_procedure];
+            return clos.fun(clos, cont);
+        };
+    } else {
+        this.fun = function () { throw "not applicable"; };
+    }
+
     // FIXME: worth doing?
     for(var i = 0; i < nfields; i++){
         this.fields[i]=scheme.UNDEFINED;

From 2da7a82d9d1aba1e81dd1f359ef5942bc416ca65 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 3 Aug 2017 00:23:45 +0100
Subject: [PATCH 67/90] struct-set! primitive returns no values

* module/language/js-il/runtime.js (struct-set!): Don't return a value.
---
 module/language/js-il/runtime.js | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 8e0480eda..e0fc34da1 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -476,7 +476,8 @@ scheme.primitives["struct-vtable"] = function(struct) {
 };
 
 scheme.primitives["struct-set!"] = function (struct, idx, obj) {
-    return struct.fields[idx] = obj;
+    struct.fields[idx] = obj;
+    return;
 };
 
 scheme.primitives["struct-ref"] = function (struct, idx) {

From 7438a192f8eddf0699db4883c4e1535f5ae8467b Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Thu, 3 Aug 2017 00:26:02 +0100
Subject: [PATCH 68/90] Unwind prompt frames

* module/language/js-il/runtime.js(unwind): Unwind prompts.
---
 module/language/js-il/runtime.js | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index e0fc34da1..970e33c65 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -541,7 +541,8 @@ scheme.primitives["wind"] = function(enter, leave) {
 
 scheme.primitives["unwind"] = function () {
     var frame = scheme.dynstack.shift();
-    if (!(frame instanceof scheme.frame.DynWind)) {
+    if (!(frame instanceof scheme.frame.DynWind) &&
+        !(frame instanceof scheme.frame.Prompt)) {
         throw "not a dynamic wind frame";
     };
 };

From 56439a88aebc81b5df5cb08cae4c0b9c4df2b88c Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 9 Aug 2017 16:06:50 +0100
Subject: [PATCH 69/90] Add `guild jslink' to bundle JS programs

* module/Makefile.am (SOURCES): Install runtime.js and jslink.scm
* module/language/js-il/compile-javascript.scm (compile-exp):
  Compilation units take a continuation to facilitate linking.
* module/scripts/jslink.scm: New script.
---
 module/Makefile.am                           |   2 +
 module/language/js-il/compile-javascript.scm |  21 ++-
 module/scripts/jslink.scm                    | 175 +++++++++++++++++++
 3 files changed, 187 insertions(+), 11 deletions(-)
 create mode 100644 module/scripts/jslink.scm

diff --git a/module/Makefile.am b/module/Makefile.am
index 044da6e7c..26b9dd1e9 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -193,6 +193,7 @@ SOURCES =					\
   language/js-il.scm				\
   language/js-il/inlining.scm			\
   language/js-il/compile-javascript.scm		\
+  language/js-il/runtime.js			\
   language/js-il/spec.scm			\
 						\
   language/scheme/compile-tree-il.scm		\
@@ -257,6 +258,7 @@ SOURCES =					\
   scripts/frisk.scm				\
   scripts/generate-autoload.scm			\
   scripts/help.scm				\
+  scripts/jslink.scm				\
   scripts/lint.scm				\
   scripts/list.scm				\
   scripts/punify.scm				\
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 4ac782064..5967fb41c 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -141,18 +141,17 @@
              (make-call (compile-id name)
                         (list
                          (make-id "undefined")
-                         (make-refine *scheme* (make-const "initial_cont")))))))
-       (make-call (make-function
-                   '()
-                   (append
-                    (map (lambda (id f)
-                           (make-var (rename-id id)
-                                     (compile-exp f)))
-                         (cons name names)
-                         (cons fun funs))
+                         (make-id "unit_cont"))))))
+       (make-function
+        (list "unit_cont")
+        (append
+         (map (lambda (id f)
+                (make-var (rename-id id)
+                          (compile-exp f)))
+              (cons name names)
+              (cons fun funs))
 
-                    (list entry-call)))
-                  '())))
+         (list entry-call)))))
 
     (($ il:continuation params body)
      (make-function (map rename-id params) (list (compile-exp body))))
diff --git a/module/scripts/jslink.scm b/module/scripts/jslink.scm
new file mode 100644
index 000000000..890c1729a
--- /dev/null
+++ b/module/scripts/jslink.scm
@@ -0,0 +1,175 @@
+(define-module (scripts jslink)
+  #:use-module (system base compile)
+  #:use-module (system base language)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 format)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 binary-ports)
+  #:export (jslink))
+
+(define %summary "Link a JS module.")
+
+(define* (copy-port from #:optional (to (current-output-port)) #:key (buffer-size 1024))
+  (define bv (make-bytevector buffer-size))
+  (let loop ()
+    (let ((num-read (get-bytevector-n! from bv 0 buffer-size)))
+      (unless (eof-object? num-read)
+        (put-bytevector to bv 0 num-read)
+        (loop)))))
+
+(define boot-dependencies
+  '(("ice-9/posix" . #f)
+    ("ice-9/ports" . #f)
+    ("ice-9/threads" . #f)
+    ("srfi/srfi-4" . #f)
+
+    ("ice-9/deprecated" . #t)
+    ("ice-9/boot-9" . #t)
+    ;; FIXME: needs to be at end, or I get strange errors
+    ("ice-9/psyntax-pp" . #t)
+    ))
+
+(define (fail . messages)
+  (format (current-error-port) "error: ~{~a~}~%" messages)
+  (exit 1))
+
+(define %options
+  (list (option '(#\h "help") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'help? #t result)))
+
+        (option '("version") #f #f
+                (lambda (opt name arg result)
+                  (show-version)
+                  (exit 0)))
+
+        (option '(#\o "output") #t #f
+                (lambda (opt name arg result)
+                  (if (assoc-ref result 'output-file)
+                      (fail "`-o' option cannot be specified more than once")
+                      (alist-cons 'output-file arg result))))
+
+        (option '(#\d "depends") #t #f
+                (lambda (opt name arg result)
+                  (let ((depends (assoc-ref result 'depends)))
+                    (alist-cons 'depends (cons arg depends)
+                                result))))
+
+        (option '("no-boot") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'no-boot? #t result)))
+        ))
+
+(define (parse-args args)
+  "Parse argument list @var{args} and return an alist with all the relevant
+options."
+  (args-fold args %options
+             (lambda (opt name arg result)
+               (format (current-error-port) "~A: unrecognized option" name)
+               (exit 1))
+             (lambda (file result)
+               (let ((input-files (assoc-ref result 'input-files)))
+                 (alist-cons 'input-files (cons file input-files)
+                             result)))
+
+             ;; default option values
+             '((input-files)
+               (depends)
+               (no-boot? . #f)
+               )))
+
+(define (show-version)
+  (format #t "compile (GNU Guile) ~A~%" (version))
+  (format #t "Copyright (C) 2017 Free Software Foundation, Inc.
+License LGPLv3+: GNU LGPL version 3 or later <http://gnu.org/licenses/lgpl.html>.
+This is free software: you are free to change and redistribute it.
+There is NO WARRANTY, to the extent permitted by law.~%"))
+
+(define (show-help)
+  (format #t "Usage: jslink [OPTION] FILE
+Link Javascript FILE with all its dependencies
+
+  -h, --help           print this help message
+  -o, --output=OFILE   write output to OFILE
+  -o, --depends=DEP    add dependency on DEP
+
+Report bugs to <~A>.~%"
+          %guile-bug-report-address))
+
+(define* (link-file file #:key (extra-dependencies '()) output-file no-boot?)
+  (let ((dependencies (if no-boot?
+                          extra-dependencies
+                          (append boot-dependencies extra-dependencies)))
+        (output-file (or output-file "main.js")) ;; FIXME: changeable
+        )
+    (with-output-to-file output-file
+      (lambda ()
+        (format #t "(function () {\n")
+        (link-runtime)
+        (format #t "/* ---------- end of runtime ---------- */\n")
+        (for-each (lambda (x)
+                    (let ((path (car x))
+                          (file (cdr x)))
+                      (link-dependency path file))
+                    (format #t "/* ---------- */\n"))
+                  dependencies)
+        (format #t "/* ---------- end of dependencies ---------- */\n")
+        (link-main file no-boot?)
+        (format #t "})();")
+        output-file))))
+
+(define *runtime-file* (%search-load-path "language/js-il/runtime.js"))
+
+(define (link-runtime)
+  (call-with-input-file *runtime-file* copy-port))
+
+(define (link-dependency path file)
+  (define (compile-dependency file)
+    (call-with-input-file file
+      (lambda (in)
+        ((language-printer (lookup-language 'javascript))
+         (read-and-compile in
+                           #:from 'scheme
+                           #:to 'javascript
+                           #:env (default-environment (lookup-language 'scheme)))
+         (current-output-port)))))
+  (format #t "boot_modules[~s] =\n" path)
+  (cond ((string? file)
+         (compile-dependency file))
+        (file (compile-dependency (%search-load-path path)))
+        (else
+         (format #t "function (cont) { return cont(scheme.UNDEFINED); };")))
+  (newline))
+
+(define (link-main file no-boot?)
+  ;; FIXME: continuation should be changeable with a switch
+  (call-with-input-file file
+    (lambda (in)
+      (format #t "var main =\n")
+      (copy-port in)
+      (newline)
+      (if no-boot?
+          (format #t "main(scheme.initial_cont);\n")
+          (format #t "boot_modules[\"ice-9/boot-9\"](function() {return main((function (x) {console.log(x); return x; }));});"))))) ; scheme.initial_cont
+
+(define (jslink . args)
+  (let* ((options      (parse-args args))
+         (help?        (assoc-ref options 'help?))
+         (dependencies (assoc-ref options 'depends))
+         (input-files  (assoc-ref options 'input-files))
+         (output-file  (assoc-ref options 'output-file))
+         (no-boot?     (assoc-ref options 'no-boot?)))
+
+    (if (or help? (null? input-files))
+        (begin (show-help) (exit 0)))
+
+    (unless (null? (cdr input-files))
+      (fail "can only link one file at a time"))
+    (format #t "wrote `~A'\n"
+            (link-file (car input-files)
+                       #:extra-dependencies dependencies
+                       #:output-file output-file
+                       #:no-boot? no-boot?))))
+
+(define main jslink)

From 024bd93b0d6ee6ebf03467dd5cbb6eb37d46713f Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Fri, 11 Aug 2017 14:02:13 +0100
Subject: [PATCH 70/90] modules should be passed current continuation

* module/language/js-il/runtime.js (primitive-load-path): modules
  should be passed the current continuation.
---
 module/language/js-il/runtime.js | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 970e33c65..c9328a675 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1085,8 +1085,7 @@ var boot_modules = {};
 
 function scm_primitive_load_path (self, cont, path) {
     if (path.s in boot_modules) {
-        boot_modules[path.s](); // FIXME: note modules should share cont?
-        return cont(scheme.UNDEFINED);
+        return boot_modules[path.s](cont);
     } else {
         console.log("primitive load path", arguments);
         not_implemented_yet();

From 3f9bc2dbb00102b17488afaa353083e36c230940 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 14 Aug 2017 16:26:39 +0100
Subject: [PATCH 71/90] Implement basic `equal?' implementation

* module/language/js-il/runtime.js (equal?): Remove primitive.
  Implement as builtin procedure. This version Only handles pairs.
---
 module/language/js-il/runtime.js | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index c9328a675..34dd3a66a 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -496,8 +496,6 @@ scheme.primitives["eqv?"] = function(x, y) {
     return coerce_bool(x === y);
 };
 
-scheme.primitives["equal?"] = not_implemented_yet;
-
 // Fluids
 scheme.Fluid = function (x) {
     this.value = x;
@@ -761,6 +759,24 @@ def_guile0("append", function (self, cont, l1, l2) {
     return cont(l);
 });
 
+function scm_equal(x,y) {
+    if (x instanceof scheme.Pair) {
+        if (y instanceof scheme.Pair) {
+            return (scm_equal(x.car,y.car) && scm_equal(x.cdr,y.cdr));
+        } else {
+            return false;
+        }
+    } else if (y instanceof scheme.Pair) {
+        return false;
+    } else {
+        return (x === y);
+    }
+}
+
+def_guile0("equal?", function (self, cont, x, y) {
+    return cont(coerce_bool(scm_equal(x,y)));
+});
+
 def_guile0("memq", function (self, cont, val, args) {
     return cont(scheme.FALSE);
 });

From 166def2da08da12b776e65ee7086e45e6d8ca498 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 14 Aug 2017 16:31:20 +0100
Subject: [PATCH 72/90] Implement unboxed integer primitives.

* module/language/js-il/runtime.js (u64-=, u64->scm): New primitives.
---
 module/language/js-il/runtime.js | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 34dd3a66a..ec639a4c4 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -87,6 +87,10 @@ scheme.primitives["load-u64"] = function(x) {
     return x;
 };
 
+scheme.primitives["u64-="] = function(x, y) {
+    return coerce_bool(x === y);
+};
+
 scheme.primitives["u64-=-scm"] = function(x, y) {
     // i.e. br-if-u64-=-scm
     return coerce_bool(x === y);
@@ -112,6 +116,10 @@ scheme.primitives["scm->u64"] = function(x) {
     return x;
 };
 
+scheme.primitives["u64->scm"] = function(x) {
+    return x;
+};
+
 // Boxes
 scheme.Box = function (x) {
     this.x = x;

From e57f9bc06a765cd8bdc546bf591250974419166f Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 14 Aug 2017 16:52:28 +0100
Subject: [PATCH 73/90] Reimplement JS module system primitives.

* module/language/js-il/runtime.js
  (scm_hash, scheme.HashTable): moved for bootstrapping purposes.

  (define!, cached-toplevel-box, cached-module-box, current-module,
  resolve): Reimplement primitives.

  (define!, module-local-variable, module-variable,
  %get-pre-modules-obarray, set-current-module): Reimplement builtin
  procedures.

  (make-undefined-variable): New builtin procedure.

  (scm_pre_modules_obarray, the_root_module, scm_public_lookup,
  scm_public_variable, scm_private_lookup, scm_current_module,
  scm_lookup, scm_module_ensure_local_variable, scm_module_variable,
  scm_module_define, module_system_is_booted,
  module_make_local_var_x_var, the_module, k_ensure,
  resolve_module_var, scm_post_boot_init_modules): New helper
  variables and procedures, designed to resemble C versions.

  (scheme.call): New helper procedure

  (def_guile0, def_guile_val): Reimplement helper procedure.
---
 module/language/js-il/runtime.js | 304 +++++++++++++++++++++++--------
 1 file changed, 232 insertions(+), 72 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index ec639a4c4..6ce8a7f8a 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -324,11 +324,36 @@ scheme.Syntax = function (expr, wrap, module) {
     return this;
 };
 
+// Hashtables
+var scm_hash = function (obj) {
+    if (obj instanceof scheme.Symbol) {
+        return obj.name;
+    }
+
+    console.log("Can't hash object", obj);
+    throw "BadHash";
+};
+
+scheme.HashTable = function ( ) {
+    // HashTable definition needs to come before scm_pre_modules_obarray
+    this.table = {};
+    this.lookup = function (obj, dflt) {
+        var hash = scm_hash(obj);
+        if (this.table.hasOwnProperty(hash)) {
+            return this.table[hash];
+        } else {
+            return dflt;
+        }
+    };
+
+    return this;
+};
+
 // Modules
 scheme.primitives["define!"] = function(sym) {
-    var b = new scheme.Box(scheme.UNDEFINED);
-    scheme.env[sym.name] = b;
-    return b;
+    var mod = scm_current_module ();
+    var v = scm_module_ensure_local_variable (mod, sym);
+    return v;
 };
 
 scheme.primitives["cache-current-module!"] = function (module, scope) {
@@ -336,33 +361,178 @@ scheme.primitives["cache-current-module!"] = function (module, scope) {
 };
 
 scheme.primitives["cached-toplevel-box"] = function (scope, sym, is_bound) {
-    return scheme.cache[scope][sym.name];
+    var module = scheme.cache[scope]; // FIXME: what if not there?
+
+    if (!scheme.is_true(module)) {
+        module = scm_the_root_module();
+    }
+
+    var v = scm_module_lookup(module, sym);
+
+    if (is_bound) {
+        // not_implemented_yet();
+    }
+
+    return v;
 };
 
+var scm_pre_modules_obarray = new scheme.HashTable();
+var the_root_module;
+
+function scm_the_root_module() {
+    if (module_system_is_booted)
+        return the_root_module.x;
+    else
+        return scheme.FALSE;
+}
+
 scheme.primitives["cached-module-box"] = function (module_name, sym, is_public, is_bound)  {
-    var cache = scheme.module_cache;
+    var v;
 
-    while (scheme.EMPTY != module_name.cdr) {
-        cache = cache[module_name.car.name];
-    }
-
-    cache = cache[module_name.car.name];
-    var r = cache[sym.name];
-    if (typeof r === 'undefined') {
-        throw {r : "cached-module-box", s : sym, m : module_name};
+    if (!module_system_is_booted) {
+        if (module_name instanceof scheme.Pair
+            && module_name.car.name === "guile"
+            && module_name.cdr === scheme.EMPTY) {
+            v = scm_lookup (sym);
+        } else {
+            not_implemented_yet();
+        }
+    } else if (sym.name === "equal?") {
+        // FIXME: this hack exists to work around a miscompilation of
+        // equal? which is not being handled as a toplevel reference.
+        // This leads to an infinite loop in the temporary definition of
+        // resolve-module, which is called by cache-module-box.
+        v = scm_pre_modules_obarray.table["equal?"];
+    } else if (scheme.is_true(is_public)) {
+        v = scm_public_lookup (module_name, sym);
     } else {
-        return r;
+        v = scm_private_lookup (module_name, sym);
     }
+
+    if (is_bound) {
+        // not_implemented_yet();
+    }
+
+    return v;
 };
 
-scheme.primitives["current-module"] = function () {
-    return scheme.env;
-};
+function scm_public_lookup(module_name, name) {
+    var v = scm_public_variable (module_name, name);
+    // if false, error
+    return v;
+}
+
+function scm_public_variable(module_name, name) {
+    var mod = scheme.call(resolve_module_var.x, module_name, k_ensure, scheme.FALSE);
+
+    // if (scm_is_false (mod))
+    //   scm_misc_error ("public-lookup", "Module named ~s does not exist",
+    //                   scm_list_1 (module_name));
+
+    // iface = scm_module_public_interface (mod);
+
+    // if (scm_is_false (iface))
+    //   scm_misc_error ("public-lookup", "Module ~s has no public interface",
+    //                   scm_list_1 (mod));
+
+    return scm_module_variable (mod, name);
+}
+
+function scm_private_lookup(module_name, sym) {
+    // FIXME: scm_private_variable + miscerror if not bound
+    return scm_public_lookup(module_name, sym);
+}
+
+scheme.primitives["current-module"] = scm_current_module;
 
 scheme.primitives["resolve"] = function (sym, is_bound) {
-    return scheme.env[sym.name];
+    var v = scm_lookup(sym);
+
+    if (is_bound) {
+        // not_implemented_yet();
+    };
+
+    return v;
 };
 
+function scm_current_module() {
+    if (module_system_is_booted) {
+        return the_module.value;
+    } else {
+        return scheme.FALSE;
+    }
+}
+
+function scm_lookup(sym) {
+    return scm_module_lookup(scm_current_module(), sym);
+};
+
+scheme.call = function (func) {
+    var args = Array.prototype.slice.call(arguments, 1);
+    args.unshift(scheme.initial_cont);
+    args.unshift(func);
+    return func.fun.apply(func, args);
+};
+
+function scm_module_ensure_local_variable(module, sym) {
+    if (module_system_is_booted) {
+        // SCM_VALIDATE_MODULE (1, module);
+        // SCM_VALIDATE_SYMBOL (2, sym);
+        // FIXME: this will need a specific continuation
+        return scheme.call(module_make_local_var_x_var.x, module, sym);
+    } else {
+        var box = scm_pre_modules_obarray.lookup(sym, false);
+        if (box) {
+            return box;
+        } else {
+            var v = new scheme.Box(scheme.UNDEFINED);
+            scm_pre_modules_obarray.table[sym.name] = v;
+            return v;
+        }
+    }
+}
+
+function scm_module_variable(module, sym) {
+    // if booted, validate module
+    // validate symbol
+    if (scheme.is_true(module)) {
+        // 1. Check Module Obarray
+        if (module instanceof scheme.Struct) {
+            var obarray = module.fields[0];
+            return obarray.lookup(sym, scheme.UNDEFINED);
+        }
+        // 2. Search among the imported variables
+        // 3. Query the custom binder
+        // 4. Return False
+        not_implemented_yet();
+    }
+
+    return scm_pre_modules_obarray.lookup(sym, scheme.UNDEFINED);
+}
+
+function scm_module_define(module, sym, val) {
+    var v = scm_module_ensure_local_variable(module, sym);
+    v.x = val;
+    return v;
+}
+
+function scm_module_lookup(module, sym) {
+    var v = scm_module_variable(module, sym);
+    if (scheme.is_true(v)) {
+        return v;
+    }
+    not_implemented_yet(); // FIXME: unbound
+}
+
+
+var module_system_is_booted = false;
+
+var module_make_local_var_x_var =
+    scm_module_define(scm_current_module(),
+                      new scheme.Symbol("module-make-local-var!"),
+                      scheme.UNDEFINED);
+
+
 // bleh
 scheme.initial_cont = function (x) { return x; };
 scheme.primitives.return = function (x) { return x; };
@@ -510,6 +680,8 @@ scheme.Fluid = function (x) {
     return this;
 };
 
+var the_module = new scheme.Fluid(scheme.FALSE);
+
 scheme.primitives["pop-fluid"] = function () {
     var frame = scheme.dynstack.shift();
     if (frame instanceof scheme.frame.Fluid) {
@@ -639,20 +811,15 @@ scheme.frame.DynWind = function(wind, unwind) {
     this.unwind = unwind;
 };
 
-// Module Cache
-scheme.module_cache["guile"] = scheme.env;
-
 function def_guile0 (name, fn) {
-    var sym = new scheme.Symbol(name); // put in obarray
     var clos = new scheme.Closure(fn, 0);
-    var box = new scheme.Box(clos);
-    scheme.module_cache["guile"][name] = box;
+    def_guile_val(name, clos);
 };
 
 function def_guile_val (name, val) {
     var sym = new scheme.Symbol(name); // put in obarray
     var box = new scheme.Box(val);
-    scheme.module_cache["guile"][name] = box;
+    scm_pre_modules_obarray.table[name] = box;
 };
 
 function scm_list (self, cont) {
@@ -1041,28 +1208,9 @@ def_guile0("hashq-remove!", function (self, cont, htable, key) {
     }
 });
 
-var scm_hash = function (obj) {
-    if (obj instanceof scheme.Symbol) {
-        return obj.name;
-    }
 
-    console.log("Can't hash object", obj);
-    throw "BadHash";
-};
 
-scheme.HashTable = function ( ) {
-    this.table = {};
-    this.lookup = function (obj, dflt) {
-        var hash = scm_hash(obj);
-        if (this.table.hasOwnProperty(hash)) {
-            return this.table[hash];
-        } else {
-            return dflt;
-        }
-    };
 
-    return this;
-}
 
 def_guile0("hashq-ref", function(self, cont, obarray, sym, dflt) {
 
@@ -1094,15 +1242,13 @@ def_guile0("hash-for-each", function (self, cont, module, symbol) {
 def_guile0("make-variable", function (self, cont, val) {
     return cont(new scheme.Box(val));
 });
+def_guile0("make-undefined-variable", function (self, cont, val) {
+    return cont(new scheme.Box(scheme.UNDEFINED));
+});
 
 def_guile0("define!", function (self, cont, symbol, value) {
-    // FIXME: reuse module-define!
-    if (symbol.name in scheme.env) {
-        scheme.env[symbol.name].x = value;
-    } else {
-        scheme.env[symbol.name] = new scheme.Box(value);
-    }
-    return cont();
+    // FIXME: validate symbol
+    return cont(scm_module_define(scm_current_module(), symbol, value));
 });
 
 var boot_modules = {};
@@ -1124,39 +1270,53 @@ boot_modules["ice-9/threads"] = function () {};
 boot_modules["srfi/srfi-4"] = function () {};
 
 def_guile0("module-local-variable", function (self, cont, module, symbol) {
-    if (module instanceof scheme.Struct) {
-      // Assumes we get a module with a hashtable
-      var obarray = scheme.primitives["struct-ref"](module, 0);
-      return cont(obarray.lookup(symbol, scheme.FALSE)); // hashq-ref
-    } else {
-      // FIXME: could be #f, then should use the pre-mod obarray
-      console.log("module-local-variable needs real modules");
-      throw "fail";
+    // module system is booted, then validate module
+    // validate symbol
+    if (!scheme.is_true(module)) {
+        // hashq ref
+        return cont(scm_pre_modules_obarray.lookup(symbol, scheme.UNDEFINED));
     }
+    // 1. check module_obarray
+    var obarray = module.fields[0]; // SCM_MODULE_OBARRAY
+    var b = obarray.lookup(symbol, scheme.UNDEFINED);
+    if (b != scheme.UNDEFINED) { // is_true
+        return cont(b);
+    }
+
+    // FIXME: check binders
+    return cont(scheme.FALSE);
 });
 
 def_guile0("module-variable", function (self, cont, module, symbol) {
-    if (module instanceof scheme.Struct) {
-       console.log("FIXME: should only be called pre-bootstrap");
-       throw "fail";
-    }
-    if (module instanceof scheme.HashTable) {
-       console.log("modvar htable");
-       throw "fail";
-    }
-    return cont(module[symbol.name]);
+    return cont(scm_module_variable(module, symbol));
 });
 
 def_guile0("%get-pre-modules-obarray", function (self, cont) {
-    var obarray = new scheme.HashTable();
-    obarray.table = scheme.env;
-    return cont(obarray);
+    return cont(scm_pre_modules_obarray);
 });
 
 def_guile0("set-current-module", function (self, cont, module) {
-    return cont(scheme.FALSE);
+
+    if (!module_system_is_booted) {
+        scm_post_boot_init_modules ();
+    }
+    // SCM_VALIDATE_MODULE (SCM_ARG1, module);
+
+    var old = scm_current_module ();
+    the_module.value = module;
+    return cont(old);
 });
 
+var k_ensure;
+var resolve_module_var;
+
+function scm_post_boot_init_modules() {
+    module_system_is_booted = true;
+    the_root_module = scm_lookup (new scheme.Symbol("the-root-module"));
+    k_ensure = new scheme.Keyword("ensure");
+    resolve_module_var = scm_lookup (new scheme.Symbol("resolve-module"));
+}
+
 // Stubs
 function stub(name) {
     function scm_fn (self, cont) {

From 17e48e86419927e076c7b42c4e2f0e8ab866536e Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 20:34:51 +0100
Subject: [PATCH 74/90] scheme.HashTable uses ES6 Map objects

* module/language/js-il/runtime.js:
  (scheme.HashTable): Change object interface.
  (cached-module-box): Update primitive.
  (scm_module_ensure_local_variable, def_guile_val): Update helpers
  (scm_hash): Remove helper.
  (make-weak-key-hash-table, hash-clear!, hashq-remove! hashq-ref,
  hashq-set!, hash-for-each): Update builtins.
  (make-weak-value-hash-table, hash-map->list): New builtins.
---
 module/language/js-il/runtime.js | 130 ++++++++++++++++++-------------
 1 file changed, 75 insertions(+), 55 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 6ce8a7f8a..aa38b0a70 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -325,27 +325,43 @@ scheme.Syntax = function (expr, wrap, module) {
 };
 
 // Hashtables
-var scm_hash = function (obj) {
-    if (obj instanceof scheme.Symbol) {
-        return obj.name;
-    }
-
-    console.log("Can't hash object", obj);
-    throw "BadHash";
-};
-
-scheme.HashTable = function ( ) {
+scheme.HashTable = function (is_weak) {
     // HashTable definition needs to come before scm_pre_modules_obarray
-    this.table = {};
+
+    // ignore the is_weak argument, since we can't iterate over js WeakMaps
+    this.table = new Map(); // WeakMap();
+
     this.lookup = function (obj, dflt) {
-        var hash = scm_hash(obj);
-        if (this.table.hasOwnProperty(hash)) {
-            return this.table[hash];
+        if (this.table.has(obj)) {
+            return this.table.get(obj);
         } else {
             return dflt;
         }
     };
 
+    this.get = function(key) {
+        return this.table.get(key);
+    };
+
+    this.set = function (key, obj) {
+        this.table.set(key, obj);
+        return obj;
+    };
+
+    this.delete = function (key) {
+        this.table.delete(key);
+        return scheme.FALSE; // or handle
+    };
+
+    this.clear = function () {
+        this.table.clear();
+        return scheme.UNSPECIFIED;
+    };
+
+    this.keys = function () {
+        return [...this.table.keys()];
+    };
+
     return this;
 };
 
@@ -402,7 +418,7 @@ scheme.primitives["cached-module-box"] = function (module_name, sym, is_public,
         // equal? which is not being handled as a toplevel reference.
         // This leads to an infinite loop in the temporary definition of
         // resolve-module, which is called by cache-module-box.
-        v = scm_pre_modules_obarray.table["equal?"];
+        v = scm_pre_modules_obarray.get(sym);
     } else if (scheme.is_true(is_public)) {
         v = scm_public_lookup (module_name, sym);
     } else {
@@ -486,7 +502,7 @@ function scm_module_ensure_local_variable(module, sym) {
             return box;
         } else {
             var v = new scheme.Box(scheme.UNDEFINED);
-            scm_pre_modules_obarray.table[sym.name] = v;
+            scm_pre_modules_obarray.set(sym, v);
             return v;
         }
     }
@@ -819,7 +835,7 @@ function def_guile0 (name, fn) {
 function def_guile_val (name, val) {
     var sym = new scheme.Symbol(name); // put in obarray
     var box = new scheme.Box(val);
-    scm_pre_modules_obarray.table[name] = box;
+    scm_pre_modules_obarray.set(sym,box);
 };
 
 function scm_list (self, cont) {
@@ -1184,58 +1200,62 @@ def_guile0("make-hash-table", function (self, cont, size) {
 });
 
 def_guile0("make-weak-key-hash-table", function (self, cont, size) {
-    // FIXME: not weak
-    return cont(new scheme.HashTable());
+    return cont(new scheme.HashTable(true));
+});
+
+def_guile0("make-weak-value-hash-table", function (self, cont, size) {
+    // FIXME:
+    return cont(new scheme.HashTable(true));
 });
 
 def_guile0("hash-clear!", function (self, cont, hashtable) {
-    if (hashtable instanceof scheme.HashTable) {
-        hashtable.table = {};
-        return cont(scheme.FALSE);
-    } else {
-        console.log("hash-clear!", arguments);
-        not_implemented_yet();
-    }
+    return cont(hashtable.clear());
 });
 
 def_guile0("hashq-remove!", function (self, cont, htable, key) {
-    if (htable instanceof scheme.HashTable) {
-        delete htable.table[scm_hash(key)];
-        return cont(scheme.FALSE);
-    } else {
-        console.log("hashq-ref", arguments);
-        not_implemented_yet();
-    }
+    return cont(htable.delete(key));
 });
 
-
-
-
-
 def_guile0("hashq-ref", function(self, cont, obarray, sym, dflt) {
-
-    if (obarray instanceof scheme.HashTable) {
-        return cont(obarray.lookup(sym, dflt ? dflt : scheme.FALSE));
-    } else {
-        console.log("hashq-ref", arguments);
-        not_implemented_yet();
-    }
+    return cont(obarray.lookup(sym, dflt ? dflt : scheme.FALSE));
 });
 
-
 def_guile0("hashq-set!", function (self, cont, hashtable, key, obj) {
-    if (hashtable instanceof scheme.HashTable) {
-        hashtable.table[scm_hash(key)] = obj;
-        return cont(scheme.FALSE);
-    } else {
-        console.log("hashq-set!", arguments);
-        not_implemented_yet();
-    }
+    return cont(hashtable.set(key,obj));
 });
 
-def_guile0("hash-for-each", function (self, cont, module, symbol) {
-    // FIXME:
-    return cont(scheme.FALSE);
+def_guile0("hash-for-each", function (self, cont, proc, htable) {
+    var keys = htable.keys(); // don't know if I can use js iterators
+
+    var loop = function (i) {
+        if (i === keys.length) {
+            return cont(scheme.UNSPECIFIED);
+        } else {
+            var newk = function() {
+                return loop(i+1);
+            };
+            return proc.fun(proc, newk, keys[i], htable.get(keys[i]));
+        }
+    };
+
+    return loop(0);
+});
+
+def_guile0("hash-map->list", function (self, cont, proc, htable) {
+    var keys = htable.keys(); // don't know if I can use js iterators
+
+    var loop = function (i, retval, k) {
+        if (i === keys.length) {
+            return k(retval);
+        } else {
+            var newk = function(result) {
+                return loop(i+1, scheme.primitives.cons(result, retval), k);
+            };
+            return proc.fun(proc, newk, keys[i], htable.get(keys[i]));
+        }
+    };
+
+    return loop(0, scheme.EMPTY, cont);
 });
 
 // Modules

From d3dea512c9b5d77e1e977b5d12a65f37602777f9 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:30:28 +0100
Subject: [PATCH 75/90] Separate public / private module lookups

* module/language/js-il/runtime.js:
  (scm_public_variable, scm_module_public_interface,
  module_public_interface_var, scm_post_boot_init_modules):
  Implement Public Variable Lookup
  (scm_private_lookup, scm_private_variable): Implement Private Lookup
---
 module/language/js-il/runtime.js | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index aa38b0a70..299a0d3fb 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -445,18 +445,34 @@ function scm_public_variable(module_name, name) {
     //   scm_misc_error ("public-lookup", "Module named ~s does not exist",
     //                   scm_list_1 (module_name));
 
-    // iface = scm_module_public_interface (mod);
+    var iface = scm_module_public_interface (mod);
 
     // if (scm_is_false (iface))
     //   scm_misc_error ("public-lookup", "Module ~s has no public interface",
     //                   scm_list_1 (mod));
 
-    return scm_module_variable (mod, name);
+    return scm_module_variable (iface, name);
+}
+
+var module_public_interface_var;
+
+function scm_module_public_interface (module) {
+      return scheme.call(module_public_interface_var.x, module);
 }
 
 function scm_private_lookup(module_name, sym) {
     // FIXME: scm_private_variable + miscerror if not bound
-    return scm_public_lookup(module_name, sym);
+    return scm_private_variable(module_name, sym);
+}
+
+function scm_private_variable (module_name, name) {
+    var mod = scheme.call(resolve_module_var.x, module_name, k_ensure, scheme.FALSE);
+
+    // if (scm_is_false (mod))
+    //     scm_misc_error ("private-lookup", "Module named ~s does not exist",
+    //                     scm_list_1 (module_name));
+
+    return scm_module_variable (mod, name);
 }
 
 scheme.primitives["current-module"] = scm_current_module;
@@ -1335,6 +1351,7 @@ function scm_post_boot_init_modules() {
     the_root_module = scm_lookup (new scheme.Symbol("the-root-module"));
     k_ensure = new scheme.Keyword("ensure");
     resolve_module_var = scm_lookup (new scheme.Symbol("resolve-module"));
+    module_public_interface_var = scm_lookup (new scheme.Symbol("module-public-interface"));
 }
 
 // Stubs

From 84aa3697cc7f45dd98fcfa7bb8440cb04b935bcc Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:34:10 +0100
Subject: [PATCH 76/90] Search for variables in imports.

* module/language/js-il/runtime.js:
  (scm_module_variable): Look in imports if not in obarray.
  (module_imported_variable): New procedure.
  (scm_module_index_obarray, scm_module_index_uses,
  scm_module_index_import_obarray): New variables.
---
 module/language/js-il/runtime.js | 45 +++++++++++++++++++++++++++++++-
 1 file changed, 44 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 299a0d3fb..cfc1faa6b 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -531,7 +531,16 @@ function scm_module_variable(module, sym) {
         // 1. Check Module Obarray
         if (module instanceof scheme.Struct) {
             var obarray = module.fields[0];
-            return obarray.lookup(sym, scheme.UNDEFINED);
+            var v = obarray.lookup(sym, scheme.UNDEFINED);
+            if (v === scheme.UNDEFINED) { // is_false
+                // 2. Search among the imported variables
+                v = module_imported_variable(module, sym);
+                return v;
+                // can't be imported
+                not_implemented_yet();
+            } else {
+                return v;
+            }
         }
         // 2. Search among the imported variables
         // 3. Query the custom binder
@@ -542,6 +551,40 @@ function scm_module_variable(module, sym) {
     return scm_pre_modules_obarray.lookup(sym, scheme.UNDEFINED);
 }
 
+var scm_module_index_obarray = 0;
+var scm_module_index_uses = 1;
+var scm_module_index_import_obarray = 8;
+function module_imported_variable(module, sym)  {
+    // search cached imported bindings
+    var imports = module.fields[scm_module_index_import_obarray];
+    var v = imports.lookup(sym, scheme.UNDEFINED);
+    if (!(scheme.UNDEFINED === (v))) {
+        return v;
+    }
+    // search use list
+    var uses = module.fields[scm_module_index_uses];
+    var found_var = scheme.FALSE;
+    var found_iface = scheme.FALSE;
+    for (; uses instanceof scheme.Pair; uses = uses.cdr) {
+        var iface = uses.car;
+        var v = scm_module_variable(iface, sym);
+        if (scheme.is_true(v)) {
+            if (scheme.is_true(found_var)) {
+                console.log("resolve duplicate binding");
+                not_implemented_yet();
+            } else {
+                found_var = v;
+                found_iface = iface;
+            }
+        }
+    }
+    if (scheme.is_true(found_var)) {
+        imports.set(sym, found_var);
+        return found_var;
+    }
+    return scheme.FALSE;
+}
+
 function scm_module_define(module, sym, val) {
     var v = scm_module_ensure_local_variable(module, sym);
     v.x = val;

From 7ee8973df5438b9f64b14016e77238df5fc22998 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:37:26 +0100
Subject: [PATCH 77/90] Implement Hook Builtins

* module/language/js-il/runtime.js:
  (scheme.Hook): new constructor
  (make-hook, run-hook): Implement builtins.
---
 module/language/js-il/runtime.js | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index cfc1faa6b..c337fc483 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1418,8 +1418,35 @@ def_guile0("read-hash-extend", function (self, cont, char, fun) {
     return cont(scheme.FALSE);
 });
 
+scheme.Hook = function (arity) {
+    this.arity = arity;
+    this.procs = [];
+};
+
 def_guile0("make-hook", function (self, cont, nargs) {
-    return cont(scheme.FALSE);
+    var arity = (nargs === undefined) ? 0 : nargs;
+    return cont(new scheme.Hook(arity));
+});
+
+def_guile0("run-hook", function (self, cont, hook) {
+    var procs = hook.procs;
+    var args = Array.prototype.slice.call(arguments, 3);
+    // FIXME: validate hook
+    // FIXME: check num args = arity or error
+
+    var loop = function (i) {
+        if (i === procs.length) {
+            return cont(scheme.UNSPECIFIED);
+        } else {
+            var newk = function() {
+                return loop(i+1);
+            };
+
+            var proc = procs[i];
+            return proc.fun.apply(proc.fun, [proc, newk].concat(args));
+        }
+    };
+    return loop(0);
 });
 
 function scm_simple_format (self, cont) {

From 8321baee15cf65c45a608458792a0e028cbded5e Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:40:39 +0100
Subject: [PATCH 78/90] Implement list builtins

* module/language/js-il/runtime.js
  (cons, memq, member, delete!): Implement builtins
---
 module/language/js-il/runtime.js | 40 ++++++++++++++++++++++++++++----
 1 file changed, 36 insertions(+), 4 deletions(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index c337fc483..5398868cf 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -945,6 +945,10 @@ def_guile0("make-list", function (self, cont, n, obj) {
     return cont(list);
 });
 
+def_guile0("cons", function (self, cont, car, cdr) {
+    return cont(scheme.primitives.cons(car, cdr));
+});
+
 def_guile0("length", function (self, cont, list) {
    var len = 0;
 
@@ -1027,18 +1031,46 @@ def_guile0("equal?", function (self, cont, x, y) {
     return cont(coerce_bool(scm_equal(x,y)));
 });
 
-def_guile0("memq", function (self, cont, val, args) {
+def_guile0("memq", function (self, cont, elt, list) {
+    // FIXME: validate list
+    for (; list != scheme.EMPTY && list != scheme.NIL; list = list.cdr) {
+        if (elt === list.car) { // FIXME: eqv
+            return cont(list);
+        }
+    }
     return cont(scheme.FALSE);
 });
 
 def_guile0("member", function (self, cont, elt, list) {
-    // FIXME: needs equal? console.log("member", arguments);
-    // throw "";
+    // FIXME: validate list
+    for (; list != scheme.EMPTY && list != scheme.NIL; list = list.cdr) {
+        if (scm_equal(elt, list.car)) {
+            return cont(list);
+        }
+    }
     return cont(scheme.FALSE);
 });
 
 def_guile0("delete!", function (self, cont, elt, list) {
-    // FIXME:
+    // FIXME: validate list
+    if (list instanceof scheme.Pair) {
+        // initially skip car;
+        for (var prev = list, walk = list.cdr;
+             walk instanceof scheme.Pair;
+             walk = walk.cdr) {
+
+            if (scm_equal(walk.car, elt)) {
+                prev.cdr = walk.cdr;
+            } else {
+                prev = prev.cdr;
+            }
+        }
+        // fixup car in return value, but can't delete
+        if (scm_equal(list.car, elt)) {
+            return cont(list.cdr);
+        }
+    }
+
     return cont(list);
 });
 

From fd2445fcf4fd67ec9c4205e6b2789b5a3e6a1784 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:43:10 +0100
Subject: [PATCH 79/90] *features* is an empty list

* module/language/js-il/runtime.js(*features*): Stop stubbing
---
 module/language/js-il/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5398868cf..49271bc9f 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1442,7 +1442,7 @@ stub("syntax-session-id");
 stub("macroexpand");
 stub("%exception-handler");
 stub("print-exception");
-stub("*features*");
+def_guile_val("*features*", scheme.EMPTY);
 stub("%load-hook");
 stub("current-reader");
 

From 7e5d9d945ec2880df28b287491ac9dfec4d30625 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:44:04 +0100
Subject: [PATCH 80/90] Argument to make-fluid is optional

* module/language/js-il/runtime.js(make-fluid): Supply default argument
---
 module/language/js-il/runtime.js | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 49271bc9f..105247993 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1162,6 +1162,9 @@ def_guile0("string-join", function (self, cont, strings) {
 
 // Fluids
 def_guile0("make-fluid", function (self, cont, val) {
+    if (val === undefined) {
+        val = scheme.FALSE;
+    }
     return cont(new scheme.Fluid(val));
 });
 

From b84797947d2d4944902903d1dc14117f2c2faa9c Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:44:48 +0100
Subject: [PATCH 81/90] pop-fluid uses field of frame not fluid

* module/language/js-il/runtime.js(pop-fluid): Fix primitive.
---
 module/language/js-il/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 105247993..5591baa8e 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -760,7 +760,7 @@ var the_module = new scheme.Fluid(scheme.FALSE);
 scheme.primitives["pop-fluid"] = function () {
     var frame = scheme.dynstack.shift();
     if (frame instanceof scheme.frame.Fluid) {
-        frame.fluid.value = frame.fluid.old_value;
+        frame.fluid.value = frame.old_value;
         return;
     } else {
         throw "not a frame";

From c5fa12f344b128b10213f326cfe1e4631a0b1673 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Wed, 16 Aug 2017 21:46:12 +0100
Subject: [PATCH 82/90] Implement variable-bound? builtin

* module/language/js-il/runtime.js(variable-bound?): Implement builtin
---
 module/language/js-il/runtime.js | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 5591baa8e..786e6c3e3 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1360,6 +1360,10 @@ def_guile0("make-undefined-variable", function (self, cont, val) {
     return cont(new scheme.Box(scheme.UNDEFINED));
 });
 
+def_guile0("variable-bound?", function (self, cont, box) {
+    return cont(coerce_bool(!(box.x === scheme.UNDEFINED)));
+});
+
 def_guile0("define!", function (self, cont, symbol, value) {
     // FIXME: validate symbol
     return cont(scm_module_define(scm_current_module(), symbol, value));

From d4ef33f6cfc6882b0ff02faf2069610b69e74ab4 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 27 Aug 2017 22:18:40 +0100
Subject: [PATCH 83/90] Add assignment js-type to (language javascript)

* module/language/javascript.scm
  (assign): new js-type
  (print-exp, unparse-js): Handle case.
* module/language/javascript/simplify.scm (flatten-blocks):  Handle case.
---
 module/language/javascript.scm          | 11 +++++++++++
 module/language/javascript/simplify.scm |  2 ++
 2 files changed, 13 insertions(+)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 8829b3be0..4a4943545 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -4,6 +4,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:export (
+            make-assign assign
             make-const const
             make-function function
             make-return return
@@ -50,6 +51,7 @@
 (define (print-js exp port)
   (format port "#<js ~S>" (unparse-js exp)))
 
+(define-js-type assign id exp)
 (define-js-type const c)
 (define-js-type function args body)
 (define-js-type return exp)
@@ -66,6 +68,8 @@
 
 (define (unparse-js exp)
   (match exp
+    (($ assign id exp)
+     `(assign ,id ,(unparse-js exp)))
     (($ const c)
      `(const ,c))
     (($ function args body)
@@ -99,6 +103,13 @@
 (define (print-exp exp port)
   (match exp
 
+    (($ assign id exp)
+     (print-id id port)
+     (format port " = ")
+     (display "(" port)
+     (print-exp exp port)
+     (display ")" port))
+
     (($ const c)
      (print-const c port))
 
diff --git a/module/language/javascript/simplify.scm b/module/language/javascript/simplify.scm
index 2e3bde5f0..a26b7fd2e 100644
--- a/module/language/javascript/simplify.scm
+++ b/module/language/javascript/simplify.scm
@@ -15,6 +15,8 @@
     (fold-right flatten '() stmts))
   (define (flatten-exp exp)
     (match exp
+      (($ assign id exp)
+       (make-assign id (flatten-exp exp)))
       (($ const c) exp)
       (($ new exp)
        (make-new (flatten-exp exp)))

From 4ef95dd74cc98d5accc3359cf22e0cae0037e367 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 27 Aug 2017 22:22:24 +0100
Subject: [PATCH 84/90] Handle more JavaScript binary operators

* module/language/javascript.scm (print-binop): Handle `begin' & `instanceof'
---
 module/language/javascript.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 4a4943545..1e9e660ba 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -179,7 +179,8 @@
     ((or) (display "||" port))
     ((and) (display "&&" port))
     ((=) (display "==" port))
-    ((+ - < <= > >= ===) (format port "~a" op))
+    ((begin) (display "," port))
+    ((+ - < <= > >= === instanceof) (format port "~a" op))
     (else
      (throw 'unprintable-binop op))))
 

From 062e413cda68b7c8fdb7112c189e3e95ec7bd2b5 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Sun, 27 Aug 2017 22:23:39 +0100
Subject: [PATCH 85/90] Keywords cannot be both keyword and optional

* module/language/js-il/compile-javascript.scm
  (compile-jump-table, bind-opt-kw-args): Keywords should not be
  parsed as optional arguments when both are present.
---
 module/language/js-il/compile-javascript.scm | 48 +++++++++++++++++++-
 1 file changed, 46 insertions(+), 2 deletions(-)

diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 5967fb41c..6fff2d280 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -131,6 +131,51 @@
        kws
        ids))
 
+(define (bind-opt-kw-args opts kws ids num-drop)
+  ;; FIXME: what we really need is a rewrite of all the complex argument
+  ;; handling , not another special case.
+  ;; NB: our generated IDs will not clash since they are not prefixed
+  ;; with k_ or v_
+  (define skip? (make-id "skip"))
+  (define skip-idx (make-id "skip_idx"))
+  (define (bind-opt-args opts num-drop)
+    (map (lambda (opt idx)
+           (make-var (rename-id opt)
+                     (let ((arg (make-refine (make-id "arguments")
+                                             (make-const (+ num-drop idx)))))
+                       (make-ternary (make-binop 'or
+                                                 skip?
+                                                 (make-binop '===
+                                                             (make-prefix 'typeof arg)
+                                                             (make-id "undefined")))
+                                     (make-refine *scheme* (make-const "UNDEFINED"))
+                                     (make-ternary (make-binop 'instanceof
+                                                               arg
+                                                               (make-refine *scheme* (make-const "Keyword")))
+                                                   (make-binop 'begin
+                                                               (make-assign "skip" (compile-const #t))
+                                                               (make-refine *scheme* (make-const "UNDEFINED")))
+                                                   (make-binop 'begin
+                                                               (make-assign "skip_idx" (make-binop '+ skip-idx (make-const 1)))
+                                                               arg))))))
+         opts
+         (iota (length opts))))
+  (define (bind-kw-args kws ids)
+    (define lookup (make-refine *utils* (make-const "keyword_ref")))
+    (map (lambda (kw id)
+           (make-var (rename-id id)
+                     (make-call lookup
+                                (list (compile-const kw)
+                                      (make-id "arguments")
+                                      skip-idx
+                                      (make-refine *scheme* (make-const "UNDEFINED"))))))
+         kws
+         ids))
+  (append (list  (make-var "skip" (compile-const #f))
+                 (make-var "skip_idx" (compile-const num-drop)))
+        (bind-opt-args opts num-drop)
+        (bind-kw-args kws ids)))
+
 
 (define (compile-exp exp)
   ;; TODO: handle ids for js
@@ -284,8 +329,7 @@
                              (map compile-id opts)))))))
       (($ il:params self req opts #f ((kws names ids) ...) _)
        (append
-        (bind-opt-args opts (+ offset (length req)))
-        (bind-kw-args kws names (+ offset (length req)))
+        (bind-opt-kw-args opts kws names (+ offset (length req)))
         (list
          (make-return
           (make-call (compile-id k)

From 11378b73df276609ec950c4225b0ef526201e73f Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 28 Aug 2017 13:43:01 +0100
Subject: [PATCH 86/90] Create stub module forms for dependecies

* module/scripts/jslink.scm: Module files need a module form, or
  functions like resolve-module won't work correctly.
---
 module/scripts/jslink.scm | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/module/scripts/jslink.scm b/module/scripts/jslink.scm
index 890c1729a..d5cdcef72 100644
--- a/module/scripts/jslink.scm
+++ b/module/scripts/jslink.scm
@@ -1,6 +1,7 @@
 (define-module (scripts jslink)
   #:use-module (system base compile)
   #:use-module (system base language)
+  #:use-module (language javascript)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 format)
@@ -20,9 +21,9 @@
 
 (define boot-dependencies
   '(("ice-9/posix" . #f)
-    ("ice-9/ports" . #f)
-    ("ice-9/threads" . #f)
-    ("srfi/srfi-4" . #f)
+    ("ice-9/ports" . (ice-9 ports))
+    ("ice-9/threads" . (ice-9 threads))
+    ("srfi/srfi-4" . (srfi srfi-4))
 
     ("ice-9/deprecated" . #t)
     ("ice-9/boot-9" . #t)
@@ -137,6 +138,11 @@ Report bugs to <~A>.~%"
   (format #t "boot_modules[~s] =\n" path)
   (cond ((string? file)
          (compile-dependency file))
+        ((list? file)
+         (print-statement (compile `(define-module ,file)
+                                   #:from 'scheme #:to 'javascript)
+                          (current-output-port))
+         (newline))
         (file (compile-dependency (%search-load-path path)))
         (else
          (format #t "function (cont) { return cont(scheme.UNDEFINED); };")))

From 37369c0cb09afce58283a2f11bb87800cfc7ed29 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 28 Aug 2017 13:47:30 +0100
Subject: [PATCH 87/90] read argument to --depends switch

* module/scripts/jslink.scm: Need to use `read' on --depends switch to
  pass a pair.
---
 module/scripts/jslink.scm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/module/scripts/jslink.scm b/module/scripts/jslink.scm
index d5cdcef72..015231552 100644
--- a/module/scripts/jslink.scm
+++ b/module/scripts/jslink.scm
@@ -53,8 +53,10 @@
 
         (option '(#\d "depends") #t #f
                 (lambda (opt name arg result)
+                  (define (read-from-string s)
+                    (call-with-input-string s read))
                   (let ((depends (assoc-ref result 'depends)))
-                    (alist-cons 'depends (cons arg depends)
+                    (alist-cons 'depends (cons (read-from-string arg) depends)
                                 result))))
 
         (option '("no-boot") #f #f

From c7554f2746661429b3373ab71d2eb6c73ef76e01 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 28 Aug 2017 13:48:47 +0100
Subject: [PATCH 88/90] extra-dependencies go before boot-dependencies

* module/scripts/jslink.scm (link-file): psyntax needs to come last in
  the list of dependencies, so need to append extra-dependencies
  before boot-dependencies
---
 module/scripts/jslink.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/scripts/jslink.scm b/module/scripts/jslink.scm
index 015231552..968835d69 100644
--- a/module/scripts/jslink.scm
+++ b/module/scripts/jslink.scm
@@ -103,7 +103,8 @@ Report bugs to <~A>.~%"
 (define* (link-file file #:key (extra-dependencies '()) output-file no-boot?)
   (let ((dependencies (if no-boot?
                           extra-dependencies
-                          (append boot-dependencies extra-dependencies)))
+                          ;; FIXME: extra-dependencies need to come before psyntax
+                          (append extra-dependencies boot-dependencies)))
         (output-file (or output-file "main.js")) ;; FIXME: changeable
         )
     (with-output-to-file output-file

From 6c5c5d068d986fe1458a49839945bfb3467c1593 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 28 Aug 2017 13:50:41 +0100
Subject: [PATCH 89/90] Mention all arguments to guild jslink in --help

* module/scripts/jslink.scm (show-help): Add missing switches.
---
 module/scripts/jslink.scm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/module/scripts/jslink.scm b/module/scripts/jslink.scm
index 968835d69..f03c6e953 100644
--- a/module/scripts/jslink.scm
+++ b/module/scripts/jslink.scm
@@ -94,8 +94,10 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
 Link Javascript FILE with all its dependencies
 
   -h, --help           print this help message
+  -v, --version        show version information
   -o, --output=OFILE   write output to OFILE
-  -o, --depends=DEP    add dependency on DEP
+  -d, --depends=DEP    add dependency on DEP
+      --no-boot        link without boot-9 & its dependencies
 
 Report bugs to <~A>.~%"
           %guile-bug-report-address))

From 05c57a6a66904861bb760aea13dd3ad3117c5966 Mon Sep 17 00:00:00 2001
From: Ian Price <ianprice90@googlemail.com>
Date: Mon, 28 Aug 2017 14:08:31 +0100
Subject: [PATCH 90/90] Update Copyright Headers

* module/Makefile.am:
* module/language/cps/compile-js.scm:
* module/language/cps/spec.scm:
* module/language/javascript.scm:
* module/language/javascript/spec.scm:
* module/language/js-il.scm:
* module/language/js-il/compile-javascript.scm:
* module/language/js-il/inlining.scm:
* module/language/js-il/runtime.js: Update copyright headers
---
 module/Makefile.am                           |  2 +-
 module/language/cps/compile-js.scm           | 20 ++++++++++++++
 module/language/cps/spec.scm                 |  2 +-
 module/language/javascript.scm               | 20 ++++++++++++++
 module/language/javascript/spec.scm          | 20 ++++++++++++++
 module/language/js-il.scm                    | 20 ++++++++++++++
 module/language/js-il/compile-javascript.scm | 20 ++++++++++++++
 module/language/js-il/inlining.scm           | 20 ++++++++++++++
 module/language/js-il/runtime.js             | 20 ++++++++++++++
 module/language/js-il/spec.scm               | 20 ++++++++++++++
 module/scripts/jslink.scm                    | 29 ++++++++++++++++++++
 11 files changed, 191 insertions(+), 2 deletions(-)

diff --git a/module/Makefile.am b/module/Makefile.am
index 26b9dd1e9..4d4701f29 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ##  	Copyright (C) 2009, 2010, 2011, 2012, 2013,
-##        2014, 2015 Free Software Foundation, Inc.
+##        2014, 2015, 2017 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 363814cd5..244a16925 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -1,3 +1,23 @@
+;;; Continuation-passing style (CPS) to JS-IL compiler
+
+;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 (define-module (language cps compile-js)
   #:use-module (language cps)
   #:use-module (language cps intmap)
diff --git a/module/language/cps/spec.scm b/module/language/cps/spec.scm
index 26d0c9425..d89763785 100644
--- a/module/language/cps/spec.scm
+++ b/module/language/cps/spec.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 1e9e660ba..2e1ca7dcd 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -1,3 +1,23 @@
+;;; JavaScript Language
+
+;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 ;; Only has enough of the ecmascript language for compilation from cps
 (define-module (language javascript)
   #:use-module (ice-9 match)
diff --git a/module/language/javascript/spec.scm b/module/language/javascript/spec.scm
index f04341f42..b7a4a3dda 100644
--- a/module/language/javascript/spec.scm
+++ b/module/language/javascript/spec.scm
@@ -1,3 +1,23 @@
+;;; JavaScript Language
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 ;; in future, this should be merged with ecmacript
 
 (define-module (language javascript spec)
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index e5fe19683..c0c10655a 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -1,3 +1,23 @@
+;;; JavaScript Intermediate Language (JS-IL)
+
+;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 (define-module (language js-il)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm
index 6fff2d280..a6c399451 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -1,3 +1,23 @@
+;;; JavaScript Intermediate Language (JS-IL) to Javascript Compiler
+
+;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 (define-module (language js-il compile-javascript)
   #:use-module ((srfi srfi-1) #:select (fold-right))
   #:use-module (ice-9 match)
diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm
index e07e30467..5b51f580e 100644
--- a/module/language/js-il/inlining.scm
+++ b/module/language/js-il/inlining.scm
@@ -1,3 +1,23 @@
+;;; JavaScript Intermediate Language (JS-IL) Inliner
+
+;; Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 ;; FIXME: It is currently wrong to think of inlining as an optimisation
 ;; since in the cps-soup world we need inlining to rebuild the scope
 ;; tree for variables.
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
index 786e6c3e3..142e3db86 100644
--- a/module/language/js-il/runtime.js
+++ b/module/language/js-il/runtime.js
@@ -1,3 +1,23 @@
+// JavaScript Runtime
+
+// Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+// This library is free software; you can redistribute it and/or
+// modify it under the terms of the GNU Lesser General Public
+// License as published by the Free Software Foundation; either
+// version 3 of the License, or (at your option) any later version.
+//
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+// Lesser General Public License for more details.
+//
+// You should have received a copy of the GNU Lesser General Public
+// License along with this library; if not, write to the Free Software
+// Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+// Code:
+
 var scheme = {
     obarray : {},
     primitives : {},
diff --git a/module/language/js-il/spec.scm b/module/language/js-il/spec.scm
index fa4dc8eca..2e933abe4 100644
--- a/module/language/js-il/spec.scm
+++ b/module/language/js-il/spec.scm
@@ -1,3 +1,23 @@
+;;; JavaScript Intermediate Language (JS-IL)
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
 (define-module (language js-il spec)
   #:use-module (system base language)
   #:use-module (language js-il compile-javascript)
diff --git a/module/scripts/jslink.scm b/module/scripts/jslink.scm
index f03c6e953..06d4dec17 100644
--- a/module/scripts/jslink.scm
+++ b/module/scripts/jslink.scm
@@ -1,3 +1,32 @@
+;;; jslink --- Link Together JS Modules
+
+;; Copyright 2017 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ian Price <ianprice90@gmail.com>
+
+;;; Commentary:
+
+;; Usage: jslink [ARGS]
+;;
+;; A command-line tool for linking together compiled JS modules.
+
+;;; Code:
+
 (define-module (scripts jslink)
   #:use-module (system base compile)
   #:use-module (system base language)