aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/data/text.lux2
-rw-r--r--stdlib/source/lux/host/js.lux263
-rw-r--r--stdlib/source/lux/host/scheme.lux (renamed from stdlib/source/lux/platform/compiler/host/scheme.lux)197
-rw-r--r--stdlib/source/test/lux.lux5
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 (#+)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:33:56 +0000