aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/host')
-rw-r--r--new-luxc/source/luxc/lang/host/scheme.lux260
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)))
- )