- Migrated Scheme back-end to stdlib.

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)))
-  )