The Common Lisp compiler is alive.

1 files changed, 0 insertions, 365 deletions

diff --git a/new-luxc/source/luxc/lang/host/common-lisp.lux b/new-luxc/source/luxc/lang/host/common-lisp.lux
deleted file mode 100644
index 50a942636..000000000
--- a/new-luxc/source/luxc/lang/host/common-lisp.lux
+++ /dev/null
@@ -1,365 +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 " "))
-             " &rest " (..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))
-
-  (type: #export Lambda [PVar Expression])
-
-  (def: #export nil
-    Expression
-    (:abstraction "()"))
-
-  (def: #export bool
-    (-> Bit Expression)
-    (|>> (case> #0 ..nil
-                #1 (:abstraction "t"))))
-
-  (def: #export int
-    (-> Int Expression)
-    (|>> %i :abstraction))
-
-  (def: #export float
-    (-> Frac Expression)
-    (|>> (cond> [(f/= number.positive-infinity)]
-                [(new> "(/ 1.0 0.0)")]
-                
-                [(f/= number.negative-infinity)]
-                [(new> "(/ -1.0 0.0)")]
-                
-                [number.not-a-number?]
-                [(new> "(/ 0.0 0.0)")]
-                
-                ## else
-                [%f])
-         :abstraction))
-
-  (def: #export (double value)
-    (-> Frac Expression)
-    (:abstraction
-     (.cond (f/= number.positive-infinity value)
-            "(/ 1.0d0 0.0d0)"
-            
-            (f/= number.negative-infinity value)
-            "(/ -1.0d0 0.0d0)"
-            
-            (number.not-a-number? value)
-            "(/ 0.0d0 0.0d0)"
-            
-            ## else
-            (.let [raw (%f value)]
-              (.if (text.contains? "E" raw)
-                (text.replace-once "E" "d" raw)
-                (format raw "d0"))))))
-
-  (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))
-
-  (template [<name> <prefix>]
-    [(def: #export <name>
-       (-> Text Expression)
-       (|>> (format <prefix>) :abstraction))]
-
-    [symbol "'"]
-    [keyword ":"])
-
-  (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)))
-  
-  (template [<name> <function>]
-    [(def: #export <name>
-       (-> (List Expression) Expression)
-       ($apply (..global <function>)))]
-
-    [vector "vector"]
-    [list   "list"]
-    )
-
-  (def: #export (labels definitions body)
-    (-> (List [SVar Lambda]) Expression Expression)
-    (..form (.list (..global "labels")
-                   (..form (list/map (.function (_ [def-name [def-args def-body]])
-                                       (..form (.list (@@ def-name)
-                                                      (@@ def-args)
-                                                      def-body)))
-                                     definitions))
-                   body)))
-
-  (def: #export (destructuring-bind [bindings expression] body)
-    (-> [PVar Expression] Expression Expression)
-    (..form (.list (..global "destructuring-bind")
-                   (@@ bindings) expression
-                   body)))
-
-  (def: #export ($apply1 func)
-    (-> Expression (-> Expression Expression))
-    (|>> (.list) (..$apply func)))
-
-  (template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name> (..$apply1 (..global <scheme-name>)))]
-
-    [length "length"]
-    [function "function"]
-    [copy-seq "copy-seq"]
-    [null "null"]
-    [car "car"]
-    [cdr "cdr"]
-    [error "error"]
-    [not "not"]
-    [floor/1 "floor"]
-    [type-of "type-of"]
-    [write-to-string "write-to-string"]
-    [read-from-string "read-from-string"]
-    [print "print"]
-    [reverse "reverse"]
-    [sxhash/1 "sxhash"]
-    [string-upcase/1 "string-upcase"]
-    [string-downcase/1 "string-downcase"]
-    [char-int/1 "char-int"]
-    [text/1 "text"]
-    )
-
-  (def: #export (make-array/init size init)
-    (-> Expression Expression Expression)
-    (..$apply (..global "make-array")
-              (.list (..list (.list size))
-                     (..keyword "initial-element")
-                     init)))
-
-  (def: #export get-universal-time
-    Expression
-    (..$apply (..global "get-universal-time") (.list)))
-
-  (def: #export (funcall args func)
-    (-> (List Expression) Expression Expression)
-    (..$apply (..global "funcall") (list& func args)))
-
-  (def: #export (apply args func)
-    (-> Expression Expression Expression)
-    (..$apply (..global "apply") (.list func args)))
-  
-  (def: #export ($apply2 func)
-    (-> Expression (-> Expression Expression Expression))
-    (.function (_ _0 _1)
-      (..$apply func (.list _0 _1))))
-
-  (template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name> (..$apply2 (..global <scheme-name>)))]
-
-    [append "append"]
-    [cons "cons"]
-    [svref "svref"]
-    [char/2 "char"]
-    )
-
-  (def: #export (search/start2 reference space start)
-    (-> Expression Expression Expression Expression)
-    (..$apply (..global "search")
-              (.list reference space
-                     (..keyword "start2") start)))
-
-  (def: #export ($apply3 func)
-    (-> Expression (-> Expression Expression Expression Expression))
-    (.function (_ _0 _1 _2)
-      (..$apply func (.list _0 _1 _2))))
-
-  (template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name> ($apply3 (..global <scheme-name>)))]
-
-    [subseq/3 "subseq"]
-    [map/3 "map"]
-    [concatenate/3 "concatenate"]
-    [format/3 "format"]
-    )
-
-  (def: #export concatenate/string
-    (-> Expression Expression Expression)
-    (concatenate/3 (..symbol "string")))
-
-  (template [<lux-name> <scheme-name>]
-    [(def: #export <lux-name>
-       (-> (List Expression) Expression)
-       (|>> (.list& (..global <scheme-name>)) ..form))]
-
-    [or "or"]
-    [and "and"]
-    )
-
-  (template [<lux-name> <scheme-name>]
-    [(def: #export (<lux-name> param subject)
-       (-> Expression Expression Expression)
-       (..form (.list (..global <scheme-name>) subject param)))]
-
-    [=   "="]
-    [eq "eq"]
-    [equal "equal"]
-    [<   "<"]
-    [<=  "<="]
-    [>   ">"]
-    [>=  ">="]
-    [string= "string="]
-    [string< "string<"]
-    [+   "+"]
-    [-   "-"]
-    [/   "/"]
-    [*   "*"]
-    [rem "rem"]
-    [floor "floor"]
-    [mod "mod"]
-    [ash "ash"]
-    [logand "logand"]
-    [logior "logior"]
-    [logxor "logxor"]
-    )
-
-  (template [<lux-name> <scheme-name>]
-    [(def: #export (<lux-name> bindings body)
-       (-> (List [SVar Expression]) Expression Expression)
-       (..form (.list (..global <scheme-name>)
-                      (|> bindings
-                          (list/map (.function (_ [fname fvalue])
-                                      (..form (.list (@@ fname) fvalue))))
-                          ..form)
-                      body)))]
-
-    [let  "let"]
-    [let* "let*"]
-    )
-
-  (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)
-    (-> PVar Expression Expression)
-    (..form (.list (..global "lambda")
-                   (@@ input)
-                   body)))
-
-  (def: #export (defparameter name body)
-    (-> SVar Expression Expression)
-    (..form (.list (..global "defparameter") (@@ name) body)))
-
-  (def: #export (defun name inputs body)
-    (-> SVar (List SVar) Expression Expression)
-    (..form (.list (..global "defun") (@@ name) (@@ (..poly inputs)) body)))
-
-  (def: #export progn
-    (-> (List Expression) Expression)
-    (|>> (#.Cons (..global "progn")) ..form))
-
-  (def: #export (setq! name value)
-    (-> SVar Expression Expression)
-    (..form (.list (..global "setq") (@@ name) value)))
-
-  (def: #export (setf! access value)
-    (-> Expression Expression Expression)
-    (..form (.list (..global "setf") access value)))
-
-  (type: #export Handler
-    {#condition-type Expression
-     #condition SVar
-     #body Expression})
-  
-  (def: #export (handler-case handlers body)
-    (-> (List Handler) Expression Expression)
-    (..form (.list& (..global "handler-case")
-                    body
-                    (list/map (.function (_ [type condition handler])
-                                (..form (.list type (@@ (..poly (.list condition)))
-                                               handler)))
-                              handlers))))
-
-  (template [<name> <prefix>]
-    [(def: #export (<name> conditions expression)
-       (-> (List Text) Expression Expression)
-       (case conditions
-         #.Nil
-         expression
-         
-         (#.Cons single #.Nil)
-         (:abstraction
-          (format <prefix> single " " (:representation expression)))
-         
-         _
-         (:abstraction
-          (format <prefix> (|> conditions (list/map ..symbol)
-                               (.list& (..symbol "or")) ..form
-                               :representation)
-                  " " (:representation expression)))))]
-
-    [conditional+ "#+"]
-    [conditional- "#-"])
-  )