diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/host')
-rw-r--r-- | new-luxc/source/luxc/lang/host/scheme.lux | 260 |
1 files changed, 0 insertions, 260 deletions
diff --git a/new-luxc/source/luxc/lang/host/scheme.lux b/new-luxc/source/luxc/lang/host/scheme.lux deleted file mode 100644 index 7c8c67ab0..000000000 --- a/new-luxc/source/luxc/lang/host/scheme.lux +++ /dev/null @@ -1,260 +0,0 @@ -(.module: - [lux #- not or and list if function cond when let] - (lux (control pipe) - (data [maybe "maybe/" Functor<Maybe>] - [text] - text/format - [number] - (coll [list "list/" Functor<List> Fold<List>])) - (type abstract))) - -(abstract: #export Single {} Any) -(abstract: #export Poly {} Any) - -(abstract: #export (Var kind) - {} - - Text - - (def: name (All [k] (-> (Var k) Text)) (|>> @representation)) - - (def: #export var (-> Text (Var Single)) (|>> @abstraction)) - - (def: #export (poly vars) - (-> (List (Var Single)) (Var Poly)) - (@abstraction - (format "(" (|> vars (list/map ..name) (text.join-with " ")) ")"))) - - (def: #export (poly+ vars rest) - (-> (List (Var Single)) (Var Single) (Var Poly)) - (@abstraction - (format "(" (|> vars (list/map ..name) (text.join-with " ")) - " . " (..name rest) - ")"))) - ) - -(type: #export SVar (Var Single)) -(type: #export PVar (Var Poly)) -(type: #export *Var (Ex [k] (Var k))) - -(abstract: #export Expression - {} - - Text - - (def: #export expression (-> Expression Text) (|>> @representation)) - - (def: #export code (-> Text Expression) (|>> @abstraction)) - - (def: #export nil - Expression - (@abstraction "'()")) - - (def: #export bool - (-> Bool Expression) - (|>> (case> true "#t" - false "#f") - @abstraction)) - - (def: #export int - (-> Int Expression) - (|>> %i @abstraction)) - - (def: #export float - (-> Frac Expression) - (|>> (cond> [(f/= number.positive-infinity)] - [(new> "+inf.0")] - - [(f/= number.negative-infinity)] - [(new> "-inf.0")] - - [number.not-a-number?] - [(new> "+nan.0")] - - ## else - [%f]) - @abstraction)) - - (def: #export positive-infinity Expression (..float number.positive-infinity)) - (def: #export negative-infinity Expression (..float number.negative-infinity)) - (def: #export not-a-number Expression (..float number.not-a-number)) - - (def: #export string - (-> Text Expression) - (|>> %t @abstraction)) - - (def: #export symbol - (-> Text Expression) - (|>> (format "'") @abstraction)) - - (def: #export (form elements) - (-> (List Expression) Expression) - (@abstraction - (format "(" (|> elements (list/map expression) (text.join-with " ")) ")"))) - - (def: #export @@ - (All [k] (-> (Var k) Expression)) - (|>> ..name @abstraction)) - - (def: #export global - (-> Text Expression) - (|>> var @@)) - - (def: #export (apply func args) - (-> Expression (List Expression) Expression) - (form (#.Cons func args))) - - (do-template [<name> <function>] - [(def: #export <name> - (-> (List Expression) Expression) - (apply (..global <function>)))] - - [vector "vector"] - [list "list"] - ) - - (def: #export (apply1 func) - (-> Expression (-> Expression Expression)) - (|>> (.list) (..apply func))) - - (do-template [<lux-name> <scheme-name>] - [(def: #export <lux-name> (apply1 (..global <scheme-name>)))] - - [length "length"] - [values "values"] - [null? "null?"] - [car "car"] - [cdr "cdr"] - [raise "raise"] - [error-object-message "error-object-message"] - [make-vector "make-vector"] - [not "not"] - [string-hash "string-hash"] - ) - - (def: #export (apply2 func) - (-> Expression (-> Expression Expression Expression)) - (.function (_ _0 _1) - (..apply func (.list _0 _1)))) - - (do-template [<lux-name> <scheme-name>] - [(def: #export <lux-name> (apply2 (..global <scheme-name>)))] - - [append "append"] - [cons "cons"] - [vector-ref "vector-ref"] - [list-tail "list-tail"] - ) - - (def: #export (apply3 func) - (-> Expression (-> Expression Expression Expression Expression)) - (.function (_ _0 _1 _2) - (..apply func (.list _0 _1 _2)))) - - (do-template [<lux-name> <scheme-name>] - [(def: #export <lux-name> (apply3 (..global <scheme-name>)))] - - [vector-set! "vector-set!"] - ) - - (def: #export (vector-copy! _0 _1 _2 _3 _4) - (-> Expression Expression Expression Expression Expression - Expression) - (..apply (..global "vector-copy!") - (.list _0 _1 _2 _3 _4))) - - (do-template [<lux-name> <scheme-name>] - [(def: #export <lux-name> - (-> (List Expression) Expression) - (|>> (.list& (..global <scheme-name>)) ..form))] - - [or "or"] - [and "and"] - ) - - (do-template [<lux-name> <scheme-name>] - [(def: #export (<lux-name> param subject) - (-> Expression Expression Expression) - (..form (.list (..global <scheme-name>) subject param)))] - - [= "="] - [eq? "eq?"] - [eqv? "eqv?"] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [string=? "string=?"] - [string<? "string<?"] - [+ "+"] - [- "-"] - [/ "/"] - [* "*"] - [expt "expt"] - [remainder "remainder"] - [quotient "quotient"] - [mod "mod"] - [arithmetic-shift "arithmetic-shift"] - [bit-and "bitwise-and"] - [bit-or "bitwise-ior"] - [bit-xor "bitwise-xor"] - ) - - (do-template [<lux-name> <scheme-name> <var>] - [(def: #export (<lux-name> bindings body) - (-> (List [<var> Expression]) Expression Expression) - (..form (.list (..global <scheme-name>) - (|> bindings - (list/map (.function (_ [fname fvalue]) - (..form (.list (@@ fname) fvalue)))) - ..form) - body)))] - - [let "let" SVar] - [let* "let*" SVar] - [letrec "letrec" SVar] - [let-values "let-values" PVar] - ) - - (def: #export (if test then else) - (-> Expression Expression Expression Expression) - (..form (.list (..global "if") test then else))) - - (def: #export (when test then) - (-> Expression Expression Expression) - (..form (.list (..global "when") test then))) - - (def: #export (cond clauses else) - (-> (List [Expression Expression]) Expression Expression) - (list/fold (.function (_ [test then] next) - (if test then next)) - else - (list.reverse clauses))) - - (def: #export (lambda input body) - (-> *Var Expression Expression) - (..form (.list (..global "lambda") (@@ input) body))) - - (def: #export (define name inputs body) - (-> SVar (List SVar) Expression Expression) - (..form (.list (..global "define") - (case inputs - #.Nil - (@@ name) - - _ - (@@ (..poly (#.Cons name inputs)))) - body))) - - (def: #export begin - (-> (List Expression) Expression) - (|>> (#.Cons (..global "begin")) ..form)) - - (def: #export (set! name value) - (-> SVar Expression Expression) - (..form (.list (..global "set!") (@@ name) value))) - - (def: #export (with-exception-handler handler body) - (-> Expression Expression Expression) - (..form (.list (..global "with-exception-handler") handler body))) - ) |