aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/host/scheme.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/host/scheme.lux (renamed from stdlib/source/lux/platform/compiler/host/scheme.lux)197
1 files changed, 104 insertions, 93 deletions
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]
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-23 18:48:52 +0000