- Updated JS machinery.

- Moved Scheme machinery around.

4 files changed, 372 insertions, 95 deletions

diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 4ff4f8fa5..1b414f2f2 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -28,6 +28,8 @@
 (do-template [<name> <code>]
   [(def: #export <name> (from-code <code>))]
 
+  [null 0]
+  [alarm 7]
   [back-space 8]
   [tab 9]
   [new-line 10]
diff --git a/stdlib/source/lux/host/js.lux b/stdlib/source/lux/host/js.lux
new file mode 100644
index 000000000..e10c0395f
--- /dev/null
+++ b/stdlib/source/lux/host/js.lux
@@ -0,0 +1,263 @@
+(.module:
+  [lux (#- Code or and function if cond undefined false true)
+   [control
+    [pipe (#+ case>)]]
+   [data
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor fold)]]]
+   [macro
+    ["." template]]
+   [type
+    abstract]])
+
+(def: argument (text.enclose ["(" ")"]))
+(def: element (text.enclose ["[" "]"]))
+
+(abstract: #export (Code brand)
+  {}
+
+  Text
+
+  (def: #export code
+    (-> (Code Any) Text)
+    (|>> :representation))
+
+  (do-template [<type> <brand> <super>+]
+    [(abstract: #export (<brand> brand) {} Any)
+     (`` (type: #export <type> (|> Any <brand> (~~ (template.splice <super>+)))))]
+    
+    [Expression Expression' [Code]]
+    [Location Location' [Expression' Code]]
+    )
+
+  (do-template [<type> <brand> <super>+]
+    [(abstract: #export <brand> {} Any)
+     (`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+)))))]
+
+    [Var Var' [Location' Expression' Code]]
+    [Access Access' [Location' Expression' Code]]
+    [Computation Computation' [Expression' Code]]
+    [Statement Statement' [Code]]
+    )
+
+  (do-template [<name> <literal>]
+    [(def: #export <name> Computation (|> <literal> ..argument :abstraction))]
+
+    [null "null"]
+    [undefined "undefined"]
+    [false "false"]
+    [true "true"]
+    )
+
+  (def: #export boolean
+    (-> Bit Computation)
+    (|>> (case>
+          #0 ..false
+          #1 ..true)))
+
+  (def: #export number
+    (-> Frac Computation)
+    (|>> %f ..argument :abstraction))
+
+  (def: sanitize
+    (-> Text Text)
+    (`` (|>> (~~ (do-template [<find> <replace>]
+                   [(text.replace-all <find> <replace>)]
+
+                   [text.tab "\t"]
+                   [text.vertical-tab "\v"]
+                   [text.null "\0"]
+                   [text.back-space "\b"]
+                   [text.form-feed "\f"]
+                   [text.new-line "\n"]
+                   [text.carriage-return "\r"]
+                   ["'" "\'"]
+                   [text.double-quote (format "\" text.double-quote)]
+                   ["\" "\\"]
+                   ))
+             )))
+
+  (def: #export string
+    (-> Text Computation)
+    (|>> ..sanitize %t ..argument :abstraction))
+
+  (def: argument-separator ", ")
+  (def: field-separator ": ")
+  (def: statement-suffix ";")
+
+  (def: #export array
+    (-> (List Expression) Computation)
+    (|>> (list/map ..code)
+         (text.join-with ..argument-separator)
+         ..element
+         ..argument
+         :abstraction))
+
+  (def: #export (at index array-or-object)
+    (-> Expression Expression Access)
+    (|> (format (:representation array-or-object) (..element (:representation index)))
+        ..argument
+        :abstraction))
+
+  (def: #export (the field object)
+    (-> Var Expression Access)
+    (:abstraction (format (:representation object) "." (:representation field))))
+
+  (def: #export (do method inputs object)
+    (-> Var (List Expression) Expression Access)
+    (|> (format (:representation (..the method object))
+                (|> inputs
+                    (list/map ..code)
+                    (text.join-with ..argument-separator)
+                    ..argument))
+        ..argument
+        :abstraction))
+
+  (def: #export object
+    (-> (List [Text Computation]) Computation)
+    (|>> (list/map (.function (_ [key val])
+                     (format (:representation (..string key)) ..field-separator (:representation val))))
+         (text.join-with ..argument-separator)
+         (text.enclose ["{" "}"])
+         ..argument
+         :abstraction))
+
+  (def: #export var
+    (-> Text Var)
+    (|>> :abstraction))
+
+  (def: #export (then pre post)
+    (-> Statement Statement Statement)
+    (:abstraction (format (:representation pre) " " (:representation post))))
+
+  (def: block (-> Statement Text) (|>> :representation (text.enclose ["{" "}"])))
+
+  (def: #export (function name inputs body)
+    (-> Var (List Var) Statement Computation)
+    (|> body
+        ..block
+        (format "function " (:representation name)
+                (|> inputs
+                    (list/map ..code)
+                    (text.join-with ..argument-separator)
+                    ..argument)
+                " ")
+        ..argument
+        :abstraction))
+
+  (def: #export (closure inputs body)
+    (-> (List Var) Statement Computation)
+    (|> body
+        ..block
+        (format "function"
+                (|> inputs
+                    (list/map ..code)
+                    (text.join-with ..argument-separator)
+                    ..argument)
+                " ")
+        ..argument
+        :abstraction))
+
+  (def: #export (apply function inputs)
+    (-> Expression (List Expression) Computation)
+    (|> inputs
+        (list/map ..code)
+        (text.join-with ..argument-separator)
+        ..argument
+        (format (:representation function))
+        :abstraction))
+
+  (do-template [<name> <op>]
+    [(def: #export (<name> param subject)
+       (-> Expression Expression Computation)
+       (|> (format (:representation subject) " " <op> " " (:representation param))
+           ..argument
+           :abstraction))]
+
+    [=  "==="]
+    [<  "<"]
+    [<= "<="]
+    [>  ">"]
+    [>= ">="]
+    
+    [+  "+"]
+    [-  "-"]
+    [*  "*"]
+    [/  "/"]
+    [%  "%"]
+
+    [or      "||"]
+    [and     "&&"]
+    [bit-or  "|"]
+    [bit-and "&"]
+    )
+
+  (def: #export (i32 value)
+    {#.doc "A 32-bit integer expression."}
+    (-> Int Computation)
+    (:abstraction (..argument (format (%i value) "|0"))))
+
+  (def: #export (? test then else)
+    (-> Expression Expression Expression Computation)
+    (|> (format (:representation test)
+                " ? " (:representation then)
+                " : " (:representation else))
+        ..argument
+        :abstraction))
+
+  (def: #export type-of
+    (-> Expression Computation)
+    (|>> :representation
+         (format "typeof ")
+         ..argument
+         :abstraction))
+
+  (def: #export use-strict
+    Statement
+    (:abstraction (format text.double-quote "use strict" text.double-quote ..statement-suffix)))
+
+  (def: #export (declare name)
+    (-> Var Statement)
+    (:abstraction (format "var " (:representation name) ..statement-suffix)))
+
+  (def: #export (define name value)
+    (-> Var Expression Statement)
+    (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement-suffix)))
+
+  (def: #export (set name value)
+    (-> Location Expression Statement)
+    (:abstraction (format (:representation name) " = " (:representation value) ..statement-suffix)))
+
+  (def: #export (if test then! else!)
+    (-> Expression Statement Statement Statement)
+    (:abstraction (format "if(" (:representation test) ") "
+                          (..block then!)
+                          " else "
+                          (..block else!))))
+
+  (def: #export (while test body)
+    (-> Expression Statement Statement)
+    (:abstraction (format "while(" (:representation test) ") "
+                          (..block body))))
+
+  (def: #export (throw message)
+    (-> Expression Statement)
+    (:abstraction (format "throw Error(" (:representation message) ")" ..statement-suffix)))
+
+  (def: #export (return value)
+    (-> Expression Statement)
+    (:abstraction (format "return " (:representation value) ..statement-suffix)))
+
+  (def: #export (delete value)
+    (-> Location Statement)
+    (:abstraction (format "delete " (:representation value) ..statement-suffix)))
+  )
+
+(def: #export (cond clauses else!)
+  (-> (List [Expression Statement]) Statement Statement)
+  (list/fold (.function (_ [test then!] next!)
+               (..if test then! next!))
+             else!
+             (list.reverse clauses)))
diff --git a/stdlib/source/lux/platform/compiler/host/scheme.lux b/stdlib/source/lux/host/scheme.lux
index df5a091f3..7194935e6 100644
--- a/stdlib/source/lux/platform/compiler/host/scheme.lux
+++ b/stdlib/source/lux/host/scheme.lux
@@ -1,42 +1,51 @@
 (.module:
-  [lux (#- Code' Code int or and if function cond when let)
+  [lux (#- Code int or and if function cond let)
+   ["." function]
    [control
-    pipe]
+    [pipe (#+ new> cond> case>)]]
    [data
-    ["." number]
+    [number
+     ["." frac]]
     ["." text
      format]
     [collection
      ["." list ("#/." functor fold)]]]
+   [macro
+    ["." template]]
    [type
     abstract]])
 
-(abstract: Global' {} Any)
-(abstract: Var' {} Any)
-(abstract: Computation' {} Any)
-(abstract: (Expression' k) {} Any)
-
-(abstract: (Code' k)
+(abstract: #export (Code k)
   {}
   
   Text
 
-  (type: #export Code (Ex [k] (Code' k)))
-  (type: #export Expression (Code' (Ex [k] (Expression' k))))
-  (type: #export Global (Code' (Expression' Global')))
-  (type: #export Computation (Code' (Expression' Computation')))
-  (type: #export Var (Code' (Expression' Var')))
+  (do-template [<type> <brand> <super>+]
+    [(abstract: #export (<brand> brand) {} Any)
+     (`` (type: #export <type> (|> Any <brand> (~~ (template.splice <super>+)))))]
+    
+    [Expression Expression' [Code]]
+    )
+
+  (do-template [<type> <brand> <super>+]
+    [(abstract: #export <brand> {} Any)
+     (`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+)))))]
+
+    [Global Global' [Expression' Code]]
+    [Var Var' [Expression' Code]]
+    [Computation Computation' [Expression' Code]]
+    )
 
   (type: #export Arguments
     {#mandatory (List Var)
      #rest (Maybe Var)})
 
-  (def: #export code (-> Code Text) (|>> :representation))
+  (def: #export code (-> (Code Any) Text) (|>> :representation))
 
   (def: #export var (-> Text Var) (|>> :abstraction))
 
   (def: (arguments [vars rest])
-    (-> Arguments Code)
+    (-> Arguments (Code Any))
     (case rest
       (#.Some rest)
       (case vars
@@ -74,26 +83,42 @@
 
   (def: #export float
     (-> Frac Computation)
-    (|>> (cond> [(f/= number.positive-infinity)]
-                [(new> "+inf.0")]
+    (|>> (cond> [(f/= frac.positive-infinity)]
+                [(new> "+inf.0" [])]
                 
-                [(f/= number.negative-infinity)]
-                [(new> "-inf.0")]
+                [(f/= frac.negative-infinity)]
+                [(new> "-inf.0" [])]
                 
-                [number.not-a-number?]
-                [(new> "+nan.0")]
+                [frac.not-a-number?]
+                [(new> "+nan.0" [])]
                 
                 ## else
                 [%f])
          :abstraction))
 
-  (def: #export positive-infinity Computation (..float number.positive-infinity))
-  (def: #export negative-infinity Computation (..float number.negative-infinity))
-  (def: #export not-a-number Computation (..float number.not-a-number))
-
+  (def: #export positive-infinity Computation (..float frac.positive-infinity))
+  (def: #export negative-infinity Computation (..float frac.negative-infinity))
+  (def: #export not-a-number Computation (..float frac.not-a-number))
+
+  (def: sanitize
+    (-> Text Text)
+    (`` (|>> (~~ (do-template [<find> <replace>]
+                   [(text.replace-all <find> <replace>)]
+
+                   [text.alarm "\a"]
+                   [text.back-space "\b"]
+                   [text.tab "\t"]
+                   [text.new-line "\n"]
+                   [text.carriage-return "\r"]
+                   [text.double-quote (format "\" text.double-quote)]
+                   ["\" "\\"]
+                   ["|" "\|"]
+                   ))
+             )))
+  
   (def: #export string
     (-> Text Computation)
-    (|>> %t :abstraction))
+    (|>> ..sanitize %t :abstraction))
 
   (def: #export symbol
     (-> Text Computation)
@@ -104,7 +129,7 @@
     (|>> :abstraction))
 
   (def: form
-    (-> (List Code) Text)
+    (-> (List (Code Any)) Text)
     (|>> (list/map ..code)
          (text.join-with " ")
          (text.enclose ["(" ")"])))
@@ -132,50 +157,54 @@
     [newline/0 "newline"]
     )
 
-  (def: #export (apply/1 func)
-    (-> Expression (-> Expression Computation))
-    (|>> (list) (..apply/* func)))
-
-  (do-template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name> (apply/1 (..global <scheme-name>)))]
-
-    [exact/1 "exact"]
-    [integer->char/1 "integer->char"]
-    [number->string/1 "number->string"]
-    [string/1 "string"]
-    [length/1 "length"]
-    [values/1 "values"]
-    [null?/1 "null?"]
-    [car/1 "car"]
-    [cdr/1 "cdr"]
-    [raise/1 "raise"]
-    [error-object-message/1 "error-object-message"]
-    [make-vector/1 "make-vector"]
-    [vector-length/1 "vector-length"]
-    [not/1 "not"]
-    [string-length/1 "string-length"]
-    [string-hash/1 "string-hash"]
-    [reverse/1 "reverse"]
-    [display/1 "display"]
-    [exit/1 "exit"]
-    )
-  
-  (def: #export (apply/2 func)
-    (-> Expression (-> Expression Expression Computation))
-    (.function (_ _0 _1)
-      (..apply/* func (list _0 _1))))
-
-  (do-template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name> (apply/2 (..global <scheme-name>)))]
-
-    [append/2 "append"]
-    [cons/2 "cons"]
-    [make-vector/2 "make-vector"]
-    [vector-ref/2 "vector-ref"]
-    [list-tail/2 "list-tail"]
-    [map/2 "map"]
-    [string-ref/2 "string-ref"]
-    [string-append/2 "string-append"]
+  (do-template [<apply> <arg>+ <type>+ <function>+]
+    [(`` (def: #export (<apply> function)
+           (-> Expression (~~ (template.splice <type>+)) Computation)
+           (.function (_ (~~ (template.splice <arg>+)))
+             (..apply/* function (list (~~ (template.splice <arg>+)))))))
+
+     (`` (do-template [<definition> <function>]
+           [(def: #export <definition> (<apply> (..global <function>)))]
+
+           (~~ (template.splice <function>+))))]
+
+    [apply/1 [_0] [Expression]
+     [[exact/1 "exact"]
+      [integer->char/1 "integer->char"]
+      [number->string/1 "number->string"]
+      [string/1 "string"]
+      [length/1 "length"]
+      [values/1 "values"]
+      [null?/1 "null?"]
+      [car/1 "car"]
+      [cdr/1 "cdr"]
+      [raise/1 "raise"]
+      [error-object-message/1 "error-object-message"]
+      [make-vector/1 "make-vector"]
+      [vector-length/1 "vector-length"]
+      [not/1 "not"]
+      [string-length/1 "string-length"]
+      [string-hash/1 "string-hash"]
+      [reverse/1 "reverse"]
+      [display/1 "display"]
+      [exit/1 "exit"]]]
+
+    [apply/2 [_0 _1] [Expression Expression]
+     [[append/2 "append"]
+      [cons/2 "cons"]
+      [make-vector/2 "make-vector"]
+      [vector-ref/2 "vector-ref"]
+      [list-tail/2 "list-tail"]
+      [map/2 "map"]
+      [string-ref/2 "string-ref"]
+      [string-append/2 "string-append"]]]
+
+    [apply/3 [_0 _1 _2] [Expression Expression Expression]
+     [[substring/3 "substring"]
+      [vector-set!/3 "vector-set!"]]]
+
+    [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression]
+     [[vector-copy!/5 "vector-copy!"]]]
     )
 
   (do-template [<lux-name> <scheme-name>]
@@ -206,24 +235,6 @@
     [bit-xor/2 "bitwise-xor"]
     )
 
-  (def: #export (apply/3 func)
-    (-> Expression (-> Expression Expression Expression Computation))
-    (.function (_ _0 _1 _2)
-      (..apply/* func (list _0 _1 _2))))
-
-  (do-template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name> (apply/3 (..global <scheme-name>)))]
-
-    [substring/3 "substring"]
-    [vector-set!/3 "vector-set!"]
-    )
-
-  (def: #export (vector-copy!/5 _0 _1 _2 _3 _4)
-    (-> Expression Expression Expression Expression Expression
-        Computation)
-    (..apply/* (..global "vector-copy!")
-               (list _0 _1 _2 _3 _4)))
-  
   (do-template [<lux-name> <scheme-name>]
     [(def: #export <lux-name>
        (-> (List Expression) Computation)
@@ -247,9 +258,9 @@
                           :abstraction)
                       body))))]
 
-    [let           "let"           Var       .id]
-    [let*          "let*"          Var       .id]
-    [letrec        "letrec"        Var       .id]
+    [let           "let"           Var       function.identity]
+    [let*          "let*"          Var       function.identity]
+    [letrec        "letrec"        Var       function.identity]
     [let-values    "let-values"    Arguments ..arguments]
     [let*-values   "let*-values"   Arguments ..arguments]
     [letrec-values "letrec-values" Arguments ..arguments]
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index e498c1445..d754862a8 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -23,6 +23,9 @@
     [format
      [css (#+)]
      [markdown (#+)]]]
+   [host
+    [js (#+)]
+    [scheme (#+)]]
    ## [control
    ##  ["._" contract]
    ##  ["._" concatenative]
@@ -96,8 +99,6 @@
     ["/." jvm]]
    ["/." control]]
   ## [control
-  ##  ## [parser (#+)]
-  ##  ## [thread (#+)]
   ##  ## [region (#+)]
   ##  ## [security
   ##  ##  [privacy (#+)]