aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/target/scheme.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/scheme.lux379
1 files changed, 0 insertions, 379 deletions
diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux
deleted file mode 100644
index a34023c6a..000000000
--- a/stdlib/source/lux/target/scheme.lux
+++ /dev/null
@@ -1,379 +0,0 @@
-(.module:
- [lux (#- Code int or and if cond let)
- ["@" target]
- [abstract
- [equivalence (#+ Equivalence)]
- [hash (#+ Hash)]]
- [control
- [pipe (#+ new> cond> case>)]]
- [data
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#\." functor fold monoid)]]]
- [macro
- ["." template]]
- [math
- [number
- ["n" nat]
- ["f" frac]]]
- [type
- abstract]])
-
-(def: nest
- (-> Text Text)
- (.let [nested_new_line (format text.new_line text.tab)]
- (text.replace_all text.new_line nested_new_line)))
-
-(abstract: #export (Code k)
- Text
-
- (implementation: #export equivalence
- (All [brand] (Equivalence (Code brand)))
-
- (def: (= reference subject)
- (\ text.equivalence = (:representation reference) (:representation subject))))
-
- (implementation: #export hash
- (All [brand] (Hash (Code brand)))
-
- (def: &equivalence ..equivalence)
- (def: hash (|>> :representation (\ text.hash hash))))
-
- (template [<type> <brand> <super>+]
- [(abstract: #export (<brand> brand) Any)
- (`` (type: #export <type> (|> Any <brand> (~~ (template.splice <super>+)))))]
-
- [Expression Expression' [Code]]
- )
-
- (template [<type> <brand> <super>+]
- [(abstract: #export <brand> Any)
- (`` (type: #export <type> (|> <brand> (~~ (template.splice <super>+)))))]
-
- [Var Var' [Expression' Code]]
- [Computation Computation' [Expression' Code]]
- )
-
- (type: #export Arguments
- {#mandatory (List Var)
- #rest (Maybe Var)})
-
- (def: #export manual
- (-> Text Code)
- (|>> :abstraction))
-
- (def: #export code
- (-> (Code Any) Text)
- (|>> :representation))
-
- (def: #export var
- (-> Text Var)
- (|>> :abstraction))
-
- (def: (arguments [mandatory rest])
- (-> Arguments (Code Any))
- (case rest
- (#.Some rest)
- (case mandatory
- #.Nil
- rest
-
- _
- (|> (format " . " (:representation rest))
- (format (|> mandatory
- (list\map ..code)
- (text.join_with " ")))
- (text.enclose ["(" ")"])
- :abstraction))
-
- #.None
- (|> mandatory
- (list\map ..code)
- (text.join_with " ")
- (text.enclose ["(" ")"])
- :abstraction)))
-
- (def: #export nil
- Computation
- (:abstraction "'()"))
-
- (def: #export bool
- (-> Bit Computation)
- (|>> (case> #0 "#f"
- #1 "#t")
- :abstraction))
-
- (def: #export int
- (-> Int Computation)
- (|>> %.int :abstraction))
-
- (def: #export float
- (-> Frac Computation)
- (|>> (cond> [(f.= f.positive_infinity)]
- [(new> "+inf.0" [])]
-
- [(f.= f.negative_infinity)]
- [(new> "-inf.0" [])]
-
- [f.not_a_number?]
- [(new> "+nan.0" [])]
-
- ## else
- [%.frac])
- :abstraction))
-
- (def: #export positive_infinity Computation (..float f.positive_infinity))
- (def: #export negative_infinity Computation (..float f.negative_infinity))
- (def: #export not_a_number Computation (..float f.not_a_number))
-
- (def: sanitize
- (-> Text Text)
- (`` (|>> (~~ (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)
- (|>> ..sanitize %.text :abstraction))
-
- (def: #export symbol
- (-> Text Computation)
- (|>> (format "'") :abstraction))
-
- (def: form
- (-> (List (Code Any)) Code)
- (.let [nested_new_line (format text.new_line text.tab)]
- (|>> (case> #.Nil
- (:abstraction "()")
-
- (#.Cons head tail)
- (|> tail
- (list\map (|>> :representation nest))
- (#.Cons (:representation head))
- (text.join_with nested_new_line)
- (text.enclose ["(" ")"])
- :abstraction)))))
-
- (def: #export (apply/* args func)
- (-> (List Expression) Expression Computation)
- (..form (#.Cons func args)))
-
- (template [<name> <function>]
- [(def: #export (<name> members)
- (-> (List Expression) Computation)
- (..apply/* members (..var <function>)))]
-
- [vector/* "vector"]
- [list/* "list"]
- )
-
- (def: #export apply/0
- (-> Expression Computation)
- (..apply/* (list)))
-
- (template [<lux_name> <scheme_name>]
- [(def: #export <lux_name>
- (apply/0 (..var <scheme_name>)))]
-
- [newline/0 "newline"]
- )
-
- (template [<apply> <arg>+ <type>+ <function>+]
- [(`` (def: #export (<apply> procedure)
- (-> Expression (~~ (template.splice <type>+)) Computation)
- (function (_ (~~ (template.splice <arg>+)))
- (..apply/* (list (~~ (template.splice <arg>+))) procedure))))
-
- (`` (template [<definition> <function>]
- [(def: #export <definition> (<apply> (..var <function>)))]
-
- (~~ (template.splice <function>+))))]
-
- [apply/1 [_0] [Expression]
- [[exact/1 "exact"]
- [integer->char/1 "integer->char"]
- [char->integer/1 "char->integer"]
- [number->string/1 "number->string"]
- [string->number/1 "string->number"]
- [floor/1 "floor"]
- [truncate/1 "truncate"]
- [string/1 "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-hash/1 "string-hash"]
- [reverse/1 "reverse"]
- [display/1 "display"]
- [exit/1 "exit"]
- [string-length/1 "string-length"]
- [load-relative/1 "load-relative"]]]
-
- [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"]
- [make-string/2 "make-string"]]]
-
- [apply/3 [_0 _1 _2] [Expression Expression Expression]
- [[substring/3 "substring"]
- [vector-set!/3 "vector-set!"]
- [string-contains/3 "string-contains"]]]
-
- [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression]
- [[vector-copy!/5 "vector-copy!"]]]
- )
-
- ## TODO: define "vector-ref/2" like a normal apply/2 function.
- ## "vector-ref/2" as an 'invoke' is problematic, since it only works
- ## in Kawa.
- ## However, the way Kawa defines "vector-ref" causes trouble,
- ## because it does a runtime type-check which throws an error when
- ## it checks against custom values/objects/classes made for
- ## JVM<->Scheme interop.
- ## There are 2 ways to deal with this:
- ## 0. To fork Kawa, and get rid of the type-check so the normal
- ## "vector-ref" can be used instead.
- ## 1. To carry on, and then, when it's time to compile the compiler
- ## itself into Scheme, switch from 'invoke' to normal 'vector-ref'.
- ## Either way, the 'invoke' needs to go away.
- (def: #export (vector-ref/2 vector index)
- (-> Expression Expression Computation)
- (..form (list (..var "invoke") vector (..symbol "getRaw") index)))
-
- (template [<lux_name> <scheme_name>]
- [(def: #export (<lux_name> param subject)
- (-> Expression Expression Computation)
- (..apply/2 (..var <scheme_name>) subject param))]
-
- [=/2 "="]
- [eq?/2 "eq?"]
- [eqv?/2 "eqv?"]
- [</2 "<"]
- [<=/2 "<="]
- [>/2 ">"]
- [>=/2 ">="]
- [string=?/2 "string=?"]
- [string<?/2 "string<?"]
- [+/2 "+"]
- [-/2 "-"]
- [//2 "/"]
- [*/2 "*"]
- [expt/2 "expt"]
- [remainder/2 "remainder"]
- [quotient/2 "quotient"]
- [mod/2 "mod"]
- [arithmetic-shift/2 "arithmetic-shift"]
- [bitwise-and/2 "bitwise-and"]
- [bitwise-ior/2 "bitwise-ior"]
- [bitwise-xor/2 "bitwise-xor"]
- )
-
- (template [<lux_name> <scheme_name>]
- [(def: #export <lux_name>
- (-> (List Expression) Computation)
- (|>> (list& (..var <scheme_name>)) ..form))]
-
- [or "or"]
- [and "and"]
- )
-
- (template [<lux_name> <scheme_name> <var> <pre>]
- [(def: #export (<lux_name> bindings body)
- (-> (List [<var> Expression]) Expression Computation)
- (..form (list (..var <scheme_name>)
- (|> bindings
- (list\map (function (_ [binding/name binding/value])
- (..form (list (|> binding/name <pre>)
- binding/value))))
- ..form)
- body)))]
-
- [let "let" Var (<|)]
- [let* "let*" Var (<|)]
- [letrec "letrec" Var (<|)]
- [let_values "let-values" Arguments ..arguments]
- [let*_values "let*-values" Arguments ..arguments]
- [letrec_values "letrec-values" Arguments ..arguments]
- )
-
- (def: #export (if test then else)
- (-> Expression Expression Expression Computation)
- (..form (list (..var "if") test then else)))
-
- (def: #export (when test then)
- (-> Expression Expression Computation)
- (..form (list (..var "when") test then)))
-
- (def: #export (lambda arguments body)
- (-> Arguments Expression Computation)
- (..form (list (..var "lambda")
- (..arguments arguments)
- body)))
-
- (def: #export (define_function name arguments body)
- (-> Var Arguments Expression Computation)
- (..form (list (..var "define")
- (|> arguments
- (update@ #mandatory (|>> (#.Cons name)))
- ..arguments)
- body)))
-
- (def: #export (define_constant name value)
- (-> Var Expression Computation)
- (..form (list (..var "define") name value)))
-
- (def: #export begin
- (-> (List Expression) Computation)
- (|>> (#.Cons (..var "begin")) ..form))
-
- (def: #export (set! name value)
- (-> Var Expression Computation)
- (..form (list (..var "set!") name value)))
-
- (def: #export (with_exception_handler handler body)
- (-> Expression Expression Computation)
- (..form (list (..var "with-exception-handler") handler body)))
-
- (def: #export (call_with_current_continuation body)
- (-> Expression Computation)
- (..form (list (..var "call-with-current-continuation") body)))
-
- (def: #export (guard variable clauses else body)
- (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation)
- (..form (list (..var "guard")
- (..form (|> (case else
- #.None
- (list)
-
- (#.Some else)
- (list (..form (list (..var "else") else))))
- (list\compose (list\map (function (_ [when then])
- (..form (list when then)))
- clauses))
- (list& variable)))
- body)))
- )
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 13:38:44 +0000