aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host/common-lisp.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/host/common-lisp.lux')
-rw-r--r--new-luxc/source/luxc/lang/host/common-lisp.lux365
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- "#-"])
- )
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 02:35:05 +0000