diff options
author | Eduardo Julian | 2019-05-01 20:33:42 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-05-01 20:33:42 -0400 |
commit | c923517c864dad362ef00ae78b449bb40cc27e84 (patch) | |
tree | a758099e76424db4fc8ec8d8cc18a8a699d68d66 /new-luxc/source/luxc/lang/host/common-lisp.lux | |
parent | 0c20f4a8362d42572edecb6ef9844b75c4c859f8 (diff) |
The Common Lisp compiler is alive.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/lang/host/common-lisp.lux | 365 |
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- "#-"]) - ) |