aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux154
1 files changed, 82 insertions, 72 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 7c5fd5c8d..bdb845f1b 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -63,7 +63,7 @@
## (1 a)))
(_lux_def Maybe
(11 ["lux" "Maybe"]
- (9 (1 (0)) "lux;Maybe" "a"
+ (9 (1 #Nil) "lux;Maybe" "a"
(2 ## "lux;None"
Unit
## "lux;Some"
@@ -92,7 +92,7 @@
Type
(_lux_case (10 List (3 Text Type))
TypeEnv
- (10 (9 (1 (0)) "Type" "_"
+ (10 (9 (#Some #Nil) "Type" "_"
(2 ## lux;VoidT
Unit
(2 ## lux;UnitT
@@ -493,7 +493,7 @@
(_lux_: Macro
(_lux_lambda _ tokens
(_lux_case tokens
- (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil))
+ (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))
(return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
(#Cons (_meta (#SymbolS "" ""))
(#Cons arg
@@ -508,7 +508,7 @@
#Nil))))))
#Nil))
- (#Cons (#Meta _ (#SymbolS self)) (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil)))
+ (#Cons [_ (#SymbolS self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)))
(return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
(#Cons (_meta (#SymbolS self))
(#Cons arg
@@ -531,9 +531,9 @@
(_lux_: Macro
(lambda'' [tokens]
(_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])])
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])])
+ (#Cons [_ (#TagS ["" "export"])]
+ (#Cons [_ (#FormS (#Cons name args))]
+ (#Cons type (#Cons body #Nil))))
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
(#Cons [name
(#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
@@ -547,7 +547,7 @@
(#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
#Nil])]))
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (#Cons [_ (#TagS "" "export")] (#Cons name (#Cons type (#Cons body #Nil))))
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
(#Cons [name
(#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
@@ -558,8 +558,8 @@
(#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
#Nil])]))
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])
+ (#Cons [_ (#FormS (#Cons name args))]
+ (#Cons type (#Cons body #Nil)))
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
(#Cons [name
(#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
@@ -572,7 +572,7 @@
#Nil])])])))
#Nil]))
- (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (#Cons name (#Cons type (#Cons body #Nil)))
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
(#Cons [name
(#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
@@ -590,7 +590,7 @@
(def'' (defmacro tokens)
Macro
(_lux_case tokens
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
+ (#Cons [[_ (#FormS (#Cons [name args]))] (#Cons [body #Nil])])
(return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def''"])
(#Cons [(form$ (#Cons [name args]))
(#Cons [(symbol$ ["lux" "Macro"])
@@ -600,7 +600,7 @@
(#Cons [(form$ (#Cons [(symbol$ ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
#Nil])]))
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])])
+ (#Cons [[_ (#TagS ["" "export"])] (#Cons [[_ (#FormS (#Cons [name args]))] (#Cons [body #Nil])])])
(return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def''"])
(#Cons [(tag$ ["" "export"])
(#Cons [(form$ (#Cons [name args]))
@@ -640,12 +640,12 @@
(defmacro (All' tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS #Nil)])
+ (#Cons [[_ (#TupleS #Nil)]
(#Cons [body #Nil])])
(return (#Cons [body
#Nil]))
- (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#SymbolS ["" arg-name])]) other-args]))])
+ (#Cons [[_ (#TupleS (#Cons [[_ (#SymbolS ["" arg-name])] other-args]))]
(#Cons [body #Nil])])
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"]))
(#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"]))
@@ -664,7 +664,7 @@
(defmacro (B' tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS ["" bound-name])])
+ (#Cons [[_ (#SymbolS ["" bound-name])]
#Nil])
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"]))
(#Cons [(_meta (#TextS bound-name))
@@ -732,15 +732,15 @@
(fail "Wrong syntax for list&")))
(defmacro (lambda' tokens)
- (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List AST)))
+ (let'' [name tokens'] (_lux_: (#ProdT Ident ($' List AST))
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
+ (#Cons [[_ (#SymbolS name)] tokens'])
[name tokens']
_
[["" ""] tokens]))
(_lux_case tokens'
- (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+ (#Cons [[_ (#TupleS args)] (#Cons [body #Nil])])
(_lux_case args
#Nil
(fail "lambda' requires a non-empty arguments tuple.")
@@ -762,8 +762,8 @@
(defmacro (def''' tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])])
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [[_ (#TagS ["" "export"])]
+ (#Cons [[_ (#FormS (#Cons [name args]))]
(#Cons [type (#Cons [body #Nil])])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
@@ -775,7 +775,7 @@
body))))))
(form$ (list (symbol$ ["" "_lux_export"]) name))))
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
(form$ (list (symbol$ ["" "_lux_:"])
@@ -783,7 +783,7 @@
body))))
(form$ (list (symbol$ ["" "_lux_export"]) name))))
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [[_ (#FormS (#Cons [name args]))]
(#Cons [type (#Cons [body #Nil])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
@@ -805,7 +805,7 @@
(def''' (as-pairs xs)
(All' [a]
- (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
+ (->' ($' List (B' a)) ($' List (#ProdT (B' a) (B' a)))))
(_lux_case xs
(#Cons [x (#Cons [y xs'])])
(#Cons [[x y] (as-pairs xs')])
@@ -815,8 +815,8 @@
(defmacro (let' tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
- (return (list (foldL (_lux_: (->' AST (#TupleT (list AST AST))
+ (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])])
+ (return (list (foldL (_lux_: (->' AST (#ProdT AST AST)
AST)
(lambda' [body binding]
(_lux_case binding
@@ -853,7 +853,7 @@
(def''' (spliced? token)
(->' AST Bool)
(_lux_case token
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
+ [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [_ #Nil])]))]
true
_
@@ -861,9 +861,8 @@
(def''' (wrap-meta content)
(->' AST AST)
- (_meta (#FormS (list (_meta (#TagS ["lux" "Meta"]))
- (_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
- content)))))))
+ (_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
+ content))))
(def''' (untemplate-list tokens)
(->' ($' List AST) AST)
@@ -902,7 +901,7 @@
true
(let' [elems' (map (lambda' [elem]
(_lux_case elem
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
+ [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
spliced
_
@@ -923,23 +922,23 @@
(def''' (untemplate replace? subst token)
(->' Bool Text AST AST)
- (_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token])
- [_ (#Meta [_ (#BoolS value)])]
+ (_lux_case (_lux_: (#ProdT Bool AST) [replace? token])
+ [_ [_ (#BoolS value)]]
(wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
- [_ (#Meta [_ (#IntS value)])]
+ [_ [_ (#IntS value)]]
(wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))
- [_ (#Meta [_ (#RealS value)])]
+ [_ [_ (#RealS value)]]
(wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))
- [_ (#Meta [_ (#CharS value)])]
+ [_ [_ (#CharS value)]]
(wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))
- [_ (#Meta [_ (#TextS value)])]
+ [_ [_ (#TextS value)]]
(wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))
- [_ (#Meta [_ (#TagS [module name])])]
+ [_ [_ (#TagS [module name])]]
(let' [module' (_lux_case module
""
subst
@@ -948,7 +947,7 @@
module)]
(wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
- [_ (#Meta [_ (#SymbolS [module name])])]
+ [_ [_ (#SymbolS [module name])]]
(let' [module' (_lux_case module
""
subst
@@ -957,19 +956,19 @@
module)]
(wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
- [_ (#Meta [_ (#TupleS elems)])]
+ [_ [_ (#TupleS elems)]]
(splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
- [true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])]
+ [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]]
unquoted
- [_ (#Meta [meta (#FormS elems)])]
- (let' [(#Meta [_ form']) (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
- (#Meta [meta form']))
+ [_ [meta (#FormS elems)]]
+ (let' [[_ form'] (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
+ [meta form'])
- [_ (#Meta [_ (#RecordS fields)])]
+ [_ [_ (#RecordS fields)]]
(wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
- (untemplate-list (map (_lux_: (->' (#TupleT (list AST AST)) AST)
+ (untemplate-list (map (_lux_: (->' (#ProdT AST AST) AST)
(lambda' [kv]
(let' [[k v] kv]
(tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
@@ -995,16 +994,17 @@
(defmacro #export (|> tokens)
(_lux_case tokens
(#Cons [init apps])
- (return (list (foldL (lambda' [acc app]
- (_lux_case app
- (#Meta [_ (#TupleS parts)])
- (tuple$ (list:++ parts (list acc)))
+ (return (list (foldL (_lux_: (->' AST AST AST)
+ (lambda' [acc app]
+ (_lux_case app
+ [_ (#TupleS parts)]
+ (tuple$ (list:++ parts (list acc)))
- (#Meta [_ (#FormS parts)])
- (form$ (list:++ parts (list acc)))
+ [_ (#FormS parts)]
+ (form$ (list:++ parts (list acc)))
- _
- (`' ((~ app) (~ acc)))))
+ _
+ (`' ((~ app) (~ acc))))))
init
apps)))
@@ -1026,7 +1026,7 @@
(def''' #export Lux
Type
(All' [a]
- (->' Compiler ($' Either Text (#TupleT (list Compiler (B' a)))))))
+ (->' Compiler ($' Either Text (#ProdT Compiler (B' a))))))
## (defsig (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1037,10 +1037,10 @@
Type
(#NamedT ["lux" "Monad"]
(All' [m]
- (#TupleT (list (All' [a] (->' (B' a) ($' (B' m) (B' a))))
- (All' [a b] (->' (->' (B' a) ($' (B' m) (B' b)))
- ($' (B' m) (B' a))
- ($' (B' m) (B' b)))))))))
+ (#ProdT (All' [a] (->' (B' a) ($' (B' m) (B' a))))
+ (All' [a b] (->' (->' (B' a) ($' (B' m) (B' b)))
+ ($' (B' m) (B' a))
+ ($' (B' m) (B' b))))))))
(_lux_declare-tags [#return #bind] Monad)
(def''' Maybe/Monad
@@ -1074,7 +1074,7 @@
(defmacro #export (^ tokens)
(_lux_case tokens
- (#Cons (#Meta _ (#SymbolS "" class-name)) #Nil)
+ (#Cons [_ (#SymbolS "" class-name)] #Nil)
(return (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))
_
@@ -1083,7 +1083,8 @@
(defmacro #export (-> tokens)
(_lux_case (reverse tokens)
(#Cons output inputs)
- (return (list (foldL (lambda' [o i] (`' (#;LambdaT (~ i) (~ o))))
+ (return (list (foldL (_lux_: (->' AST AST AST)
+ (lambda' [o i] (`' (#;LambdaT (~ i) (~ o)))))
output
inputs)))
@@ -1091,16 +1092,25 @@
(fail "Wrong syntax for ->")))
(defmacro #export (, tokens)
- (return (list (`' (#;TupleT (~ (untemplate-list tokens)))))))
+ (_lux_case (reverse tokens)
+ (#Cons last prevs)
+ (return (list (foldL (_lux_: (->' AST AST AST)
+ (lambda' [r l] (`' (#;ProdT (~ l) (~ r)))))
+ last
+ prevs)))
+
+ _
+ (fail "Wrong syntax for ,"))
+ )
(defmacro (do tokens)
(_lux_case tokens
- (#Cons monad (#Cons (#Meta _ (#TupleS bindings)) (#Cons body #Nil)))
+ (#Cons monad (#Cons [_ (#TupleS bindings)] (#Cons body #Nil)))
(let' [body' (foldL (_lux_: (-> AST (, AST AST) AST)
(lambda' [body' binding]
(let' [[var value] binding]
(_lux_case var
- (#Meta _ (#TagS "" "let"))
+ [_ (#TagS "" "let")]
(`' (;let' (~ value) (~ body')))
_
@@ -1146,7 +1156,7 @@
(def''' (get-ident x)
(-> AST ($' Maybe Ident))
(_lux_case x
- (#Meta [_ (#SymbolS sname)])
+ [_ (#SymbolS sname)]
(#Some sname)
_
@@ -1155,7 +1165,7 @@
(def''' (get-name x)
(-> AST ($' Maybe Text))
(_lux_case x
- (#Meta [_ (#SymbolS ["" sname])])
+ [_ (#SymbolS ["" sname])]
(#Some sname)
_
@@ -1164,7 +1174,7 @@
(def''' (tuple->list tuple)
(-> AST ($' Maybe ($' List AST)))
(_lux_case tuple
- (#Meta [_ (#TupleS members)])
+ [_ (#TupleS members)]
(#Some members)
_
@@ -1203,7 +1213,7 @@
(def''' (apply-template env template)
(-> RepEnv AST AST)
(_lux_case template
- (#Meta [_ (#SymbolS ["" sname])])
+ [_ (#SymbolS ["" sname])]
(_lux_case (get-rep sname env)
(#Some subst)
subst
@@ -1211,13 +1221,13 @@
_
template)
- (#Meta [_ (#TupleS elems)])
+ [_ (#TupleS elems)]
(tuple$ (map (apply-template env) elems))
- (#Meta [_ (#FormS elems)])
+ [_ (#FormS elems)]
(form$ (map (apply-template env) elems))
- (#Meta [_ (#RecordS members)])
+ [_ (#RecordS members)]
(record$ (map (_lux_: (-> (, AST AST) (, AST AST))
(lambda' [kv]
(let' [[slot value] kv]
@@ -1239,7 +1249,7 @@
(defmacro #export (do-template tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])])
+ (#Cons [[_ (#TupleS bindings)] (#Cons [[_ (#TupleS templates)] data])])
(_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List AST))))
[(map% Maybe/Monad get-name bindings)
(map% Maybe/Monad tuple->list data)])
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 07:12:42 +0000