diff options
author | Eduardo Julián | 2021-07-14 14:44:53 -0400 |
---|---|---|
committer | GitHub | 2021-07-14 14:44:53 -0400 |
commit | 89ca40f2f101b2b38187eab5cf905371cd47eb57 (patch) | |
tree | f05fd1677a70988c6b39c07e52d031d86eff28f1 /stdlib/source/lux/target/scheme.lux | |
parent | 2431e767a09894c2f685911ba7f1ba0b7de2a165 (diff) | |
parent | 8252bdb938a0284dd12e7365b4eb84b5357bacac (diff) |
Merge pull request #58 from LuxLang/hierarchy_normalization
Hierarchy normalization
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/target/scheme.lux | 379 |
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))) - ) |