aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/target/common_lisp.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/common_lisp.lux468
1 files changed, 0 insertions, 468 deletions
diff --git a/stdlib/source/lux/target/common_lisp.lux b/stdlib/source/lux/target/common_lisp.lux
deleted file mode 100644
index f68d28c28..000000000
--- a/stdlib/source/lux/target/common_lisp.lux
+++ /dev/null
@@ -1,468 +0,0 @@
-(.module:
- [lux (#- Code int if cond or and comment let)
- [control
- [pipe (#+ case> cond> new>)]]
- [data
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#\." monad fold monoid)]]]
- [macro
- ["." template]]
- [math
- [number
- ["f" frac]]]
- [type
- abstract]])
-
-(def: as_form
- (-> Text Text)
- (text.enclose ["(" ")"]))
-
-(abstract: #export (Code brand)
- Text
-
- (def: #export manual
- (-> Text Code)
- (|>> :abstraction))
-
- (def: #export code
- (-> (Code Any) Text)
- (|>> :representation))
-
- (template [<type> <super>]
- [(with_expansions [<brand> (template.identifier [<type> "'"])]
- (`` (abstract: #export (<brand> brand) Any))
- (`` (type: #export (<type> brand)
- (<super> (<brand> brand)))))]
-
- [Expression Code]
- [Computation Expression]
- [Access Computation]
- [Var Access]
-
- [Input Code]
- )
-
- (template [<type> <super>]
- [(with_expansions [<brand> (template.identifier [<type> "'"])]
- (`` (abstract: #export <brand> Any))
- (`` (type: #export <type> (<super> <brand>))))]
-
- [Label Code]
- [Tag Expression]
- [Literal Expression]
- [Var/1 Var]
- [Var/* Input]
- )
-
- (type: #export Lambda
- {#input Var/*
- #output (Expression Any)})
-
- (def: #export nil
- Literal
- (:abstraction "()"))
-
- (template [<prefix> <name>]
- [(def: #export <name>
- (-> Text Literal)
- (|>> (format <prefix>) :abstraction))]
-
- ["'" symbol]
- [":" keyword])
-
- (def: #export bool
- (-> Bit Literal)
- (|>> (case> #0 ..nil
- #1 (..symbol "t"))))
-
- (def: #export int
- (-> Int Literal)
- (|>> %.int :abstraction))
-
- (def: #export float
- (-> Frac Literal)
- (|>> (cond> [(f.= f.positive_infinity)]
- [(new> "(/ 1.0 0.0)" [])]
-
- [(f.= f.negative_infinity)]
- [(new> "(/ -1.0 0.0)" [])]
-
- [f.not_a_number?]
- [(new> "(/ 0.0 0.0)" [])]
-
- ## else
- [%.frac])
- :abstraction))
-
- (def: #export (double value)
- (-> Frac Literal)
- (:abstraction
- (.cond (f.= f.positive_infinity value)
- "(/ 1.0d0 0.0d0)"
-
- (f.= f.negative_infinity value)
- "(/ -1.0d0 0.0d0)"
-
- (f.not_a_number? value)
- "(/ 0.0d0 0.0d0)"
-
- ## else
- (.let [raw (%.frac value)]
- (.if (text.contains? "E" raw)
- (text.replace_once "E" "d" raw)
- (format raw "d0"))))))
-
- (def: sanitize
- (-> Text Text)
- (`` (|>> (~~ (template [<find> <replace>]
- [(text.replace_all <find> <replace>)]
-
- ["\" "\\"]
- [text.tab "\t"]
- [text.vertical_tab "\v"]
- [text.null "\0"]
- [text.back_space "\b"]
- [text.form_feed "\f"]
- [text.new_line "\n"]
- [text.carriage_return "\r"]
- [text.double_quote (format "\" text.double_quote)]
- ))
- )))
-
- (def: #export string
- (-> Text Literal)
- (|>> ..sanitize
- (text.enclose' text.double_quote)
- :abstraction))
-
- (def: #export var
- (-> Text Var/1)
- (|>> :abstraction))
-
- (def: #export args
- (-> (List Var/1) Var/*)
- (|>> (list\map ..code)
- (text.join_with " ")
- ..as_form
- :abstraction))
-
- (def: #export (args& singles rest)
- (-> (List Var/1) Var/1 Var/*)
- (|> (case singles
- #.Nil
- ""
-
- (#.Cons _)
- (|> singles
- (list\map ..code)
- (text.join_with " ")
- (text.suffix " ")))
- (format "&rest " (:representation rest))
- ..as_form
- :abstraction))
-
- (def: form
- (-> (List (Expression Any)) Expression)
- (|>> (list\map ..code)
- (text.join_with " ")
- ..as_form
- :abstraction))
-
- (def: #export (call/* func)
- (-> (Expression Any) (-> (List (Expression Any)) (Computation Any)))
- (|>> (#.Cons func) ..form))
-
- (template [<name> <function>]
- [(def: #export <name>
- (-> (List (Expression Any)) (Computation Any))
- (..call/* (..var <function>)))]
-
- [vector/* "vector"]
- [list/* "list"]
- )
-
- (def: #export (labels definitions body)
- (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any))
- (..form (list (..var "labels")
- (..form (list\map (function (_ [def_name [def_args def_body]])
- (..form (list def_name (:transmutation def_args) def_body)))
- definitions))
- body)))
-
- (def: #export (destructuring-bind [bindings expression] body)
- (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any))
- (..form (list& (..var "destructuring-bind")
- (:transmutation bindings) expression
- body)))
-
- (template [<call> <input_var>+ <input_type>+ <function>+]
- [(`` (def: #export (<call> [(~~ (template.splice <input_var>+))] function)
- (-> [(~~ (template.splice <input_type>+))] (Expression Any) (Computation Any))
- (..call/* function (list (~~ (template.splice <input_var>+))))))
-
- (`` (template [<lux_name> <host_name>]
- [(def: #export (<lux_name> args)
- (-> [(~~ (template.splice <input_type>+))] (Computation Any))
- (<call> args (..var <host_name>)))]
-
- (~~ (template.splice <function>+))))]
-
- [call/0 [] []
- [[get-universal-time/0 "get-universal-time"]
- [make-hash-table/0 "make-hash-table"]]]
- [call/1 [in0] [(Expression Any)]
- [[length/1 "length"]
- [function/1 "function"]
- [copy-seq/1 "copy-seq"]
- [null/1 "null"]
- [error/1 "error"]
- [not/1 "not"]
- [floor/1 "floor"]
- [type-of/1 "type-of"]
- [write-to-string/1 "write-to-string"]
- [read-from-string/1 "read-from-string"]
- [print/1 "print"]
- [reverse/1 "reverse"]
- [sxhash/1 "sxhash"]
- [string-upcase/1 "string-upcase"]
- [string-downcase/1 "string-downcase"]
- [char-int/1 "char-int"]
- [text/1 "text"]
- [hash-table-size/1 "hash-table-size"]
- [hash-table-rehash-size/1 "hash-table-rehash-size"]
- [code-char/1 "code-char"]
- [char-code/1 "char-code"]
- [string/1 "string"]
- [write-line/1 "write-line"]
- [pprint/1 "pprint"]
- [identity/1 "identity"]]]
- [call/2 [in0 in1] [(Expression Any) (Expression Any)]
- [[apply/2 "apply"]
- [append/2 "append"]
- [cons/2 "cons"]
- [char/2 "char"]
- [nth/2 "nth"]
- [nthcdr/2 "nthcdr"]
- [coerce/2 "coerce"]
- [eq/2 "eq"]
- [equal/2 "equal"]
- [string=/2 "string="]
- [=/2 "="]
- [+/2 "+"]
- [*/2 "*"]]]
- [call/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)]
- [[subseq/3 "subseq"]
- [map/3 "map"]
- [concatenate/3 "concatenate"]
- [format/3 "format"]]]
- )
-
- (template [<call> <input_type>+ <function>+]
- [(`` (template [<lux_name> <host_name>]
- [(def: #export (<lux_name> args)
- (-> [(~~ (template.splice <input_type>+))] (Access Any))
- (:transmutation (<call> args (..var <host_name>))))]
-
- (~~ (template.splice <function>+))))]
-
- [call/1 [(Expression Any)]
- [[car/1 "car"]
- [cdr/1 "cdr"]
- [cadr/1 "cadr"]
- [cddr/1 "cddr"]]]
- [call/2 [(Expression Any) (Expression Any)]
- [[svref/2 "svref"]
- [elt/2 "elt"]
- [gethash/2 "gethash"]]]
- )
-
- (def: #export (make-hash-table/with_size size)
- (-> (Expression Any) (Computation Any))
- (..call/* (..var "make-hash-table")
- (list (..keyword "size")
- size)))
-
- (def: #export (funcall/+ [func args])
- (-> [(Expression Any) (List (Expression Any))] (Computation Any))
- (..call/* (..var "funcall") (list& func args)))
-
- (def: #export (search/3 [reference space start])
- (-> [(Expression Any) (Expression Any) (Expression Any)] (Computation Any))
- (..call/* (..var "search")
- (list reference
- space
- (..keyword "start2") start)))
-
- (def: #export (concatenate/2|string [left right])
- (-> [(Expression Any) (Expression Any)] (Computation Any))
- (concatenate/3 [(..symbol "string") left right]))
-
- (template [<lux_name> <host_name>]
- [(def: #export (<lux_name> left right)
- (-> (Expression Any) (Expression Any) (Computation Any))
- (..form (list (..var <host_name>) left right)))]
-
- [or "or"]
- [and "and"]
- )
-
- (template [<lux_name> <host_name>]
- [(def: #export (<lux_name> [param subject])
- (-> [(Expression Any) (Expression Any)] (Computation Any))
- (..form (list (..var <host_name>) subject param)))]
-
- [</2 "<"]
- [<=/2 "<="]
- [>/2 ">"]
- [>=/2 ">="]
- [string</2 "string<"]
- [-/2 "-"]
- [//2 "/"]
- [rem/2 "rem"]
- [floor/2 "floor"]
- [mod/2 "mod"]
- [ash/2 "ash"]
- [logand/2 "logand"]
- [logior/2 "logior"]
- [logxor/2 "logxor"]
- )
-
- (def: #export (if test then else)
- (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any))
- (..form (list (..var "if") test then else)))
-
- (def: #export (when test then)
- (-> (Expression Any) (Expression Any) (Computation Any))
- (..form (list (..var "when") test then)))
-
- (def: #export (lambda input body)
- (-> Var/* (Expression Any) Literal)
- (..form (list (..var "lambda") (:transmutation input) body)))
-
- (template [<lux_name> <host_name>]
- [(def: #export (<lux_name> bindings body)
- (-> (List [Var/1 (Expression Any)]) (List (Expression Any)) (Computation Any))
- (..form (list& (..var <host_name>)
- (|> bindings
- (list\map (function (_ [name value])
- (..form (list name value))))
- ..form)
- body)))]
-
- [let "let"]
- [let* "let*"]
- )
-
- (def: #export (defparameter name body)
- (-> Var/1 (Expression Any) (Expression Any))
- (..form (list (..var "defparameter") name body)))
-
- (def: #export (defun name inputs body)
- (-> Var/1 Var/* (Expression Any) (Expression Any))
- (..form (list (..var "defun") name (:transmutation inputs) body)))
-
- (template [<name> <symbol>]
- [(def: #export <name>
- (-> (List (Expression Any)) (Computation Any))
- (|>> (list& (..var <symbol>)) ..form))]
-
- [progn "progn"]
- [tagbody "tagbody"]
- [values/* "values"]
- )
-
- (def: #export (setq name value)
- (-> Var/1 (Expression Any) (Expression Any))
- (..form (list (..var "setq") name value)))
-
- (def: #export (setf access value)
- (-> (Access Any) (Expression Any) (Expression Any))
- (..form (list (..var "setf") access value)))
-
- (type: #export Handler
- {#condition_type (Expression Any)
- #condition Var/1
- #body (Expression Any)})
-
- (def: #export (handler-case handlers body)
- (-> (List Handler) (Expression Any) (Computation Any))
- (..form (list& (..var "handler-case")
- body
- (list\map (function (_ [type condition handler])
- (..form (list type
- (:transmutation (..args (list condition)))
- handler)))
- handlers))))
-
- (template [<name> <prefix>]
- [(def: #export (<name> conditions expression)
- (-> (List Text) (Expression Any) (Expression Any))
- (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- "#-"])
-
- (def: #export label
- (-> Text Label)
- (|>> :abstraction))
-
- (def: #export (block name body)
- (-> Label (List (Expression Any)) (Computation Any))
- (..form (list& (..var "block") (:transmutation name) body)))
-
- (def: #export (return-from target value)
- (-> Label (Expression Any) (Computation Any))
- (..form (list (..var "return-from") (:transmutation target) value)))
-
- (def: #export (return value)
- (-> (Expression Any) (Computation Any))
- (..form (list (..var "return") value)))
-
- (def: #export (cond clauses else)
- (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any))
- (..form (list& (..var "cond")
- (list\compose (list\map (function (_ [test then])
- (..form (list test then)))
- clauses)
- (list (..form (list (..bool true) else)))))))
-
- (def: #export tag
- (-> Text Tag)
- (|>> :abstraction))
-
- (def: #export go
- (-> Tag (Expression Any))
- (|>> (list (..var "go"))
- ..form))
-
- (def: #export values-list/1
- (-> (Expression Any) (Expression Any))
- (|>> (list (..var "values-list"))
- ..form))
-
- (def: #export (multiple-value-setq bindings values)
- (-> Var/* (Expression Any) (Expression Any))
- (..form (list (..var "multiple-value-setq")
- (:transmutation bindings)
- values)))
- )
-
-(def: #export (while condition body)
- (-> (Expression Any) (Expression Any) (Computation Any))
- (..form (list (..var "loop") (..var "while") condition
- (..var "do") body)))