aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
authorEduardo Julian2015-08-28 06:37:46 -0400
committerEduardo Julian2015-08-28 06:37:46 -0400
commitf403ee7a9662f81c91aa124f0573c5957a88ebe5 (patch)
treeee5d447757614421f408decede0c88a8cbfc859b /source/lux.lux
parent37a9044d8ec523a282c0470d65380ce5cff27084 (diff)
Due to several performance issues and my inability to optimize them away due to too many corner cases, I decided the abandon the path towards a more mathematical implementation of tuples & variants.
Diffstat (limited to 'source/lux.lux')
-rw-r--r--source/lux.lux885
1 files changed, 440 insertions, 445 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 97030a7ef..4120b262c 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -11,50 +11,51 @@
("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
## Basic types
-(_lux_def Bool (11 ["lux" "Bool"]
- (4 "java.lang.Boolean")))
+(_lux_def Bool (9 ["lux" "Bool"]
+ (0 "java.lang.Boolean")))
(_lux_export Bool)
-(_lux_def Int (11 ["lux" "Int"]
- (4 "java.lang.Long")))
+(_lux_def Int (9 ["lux" "Int"]
+ (0 "java.lang.Long")))
(_lux_export Int)
-(_lux_def Real (11 ["lux" "Real"]
- (4 "java.lang.Double")))
+(_lux_def Real (9 ["lux" "Real"]
+ (0 "java.lang.Double")))
(_lux_export Real)
-(_lux_def Char (11 ["lux" "Char"]
- (4 "java.lang.Character")))
+(_lux_def Char (9 ["lux" "Char"]
+ (0 "java.lang.Character")))
(_lux_export Char)
-(_lux_def Text (11 ["lux" "Text"]
- (4 "java.lang.String")))
+(_lux_def Text (9 ["lux" "Text"]
+ (0 "java.lang.String")))
(_lux_export Text)
-(_lux_def Void (11 ["lux" "Void"]
- (0 [])))
-(_lux_export Void)
-
-(_lux_def Unit (11 ["lux" "Unit"]
- (1 [])))
+(_lux_def Unit (9 ["lux" "Unit"]
+ (2 (0))))
(_lux_export Unit)
-(_lux_def Ident (11 ["lux" "Ident"]
- (3 Text Text)))
+(_lux_def Void (9 ["lux" "Void"]
+ (1 (0))))
+(_lux_export Void)
+
+(_lux_def Ident (9 ["lux" "Ident"]
+ (2 (1 Text (1 Text (0))))))
(_lux_export Ident)
## (deftype (List a)
## (| #Nil
## (#Cons a (List a))))
(_lux_def List
- (11 ["lux" "List"]
- (9 (1 (0)) "lux;List" "a"
- (2 ## "lux;Nil"
- Unit
- ## "lux;Cons"
- (3 (6 "a")
- (10 (6 "lux;List") (6 "a")))
- ))))
+ (9 ["lux" "List"]
+ (7 (1 (0)) "lux;List" "a"
+ (1 (1 ## "lux;Nil"
+ (2 (0))
+ (1 ## "lux;Cons"
+ (2 (1 (4 "a")
+ (1 (8 (4 "lux;List") (4 "a"))
+ (0))))
+ (0)))))))
(_lux_export List)
(_lux_declare-tags [#Nil #Cons] List)
@@ -62,78 +63,76 @@
## (| #None
## (1 a)))
(_lux_def Maybe
- (11 ["lux" "Maybe"]
- (9 (1 #Nil) "lux;Maybe" "a"
- (2 ## "lux;None"
- Unit
- ## "lux;Some"
- (6 "a")
- ))))
+ (9 ["lux" "Maybe"]
+ (7 (1 (0)) "lux;Maybe" "a"
+ (1 (1 ## "lux;None"
+ (2 (0))
+ (1 ## "lux;Some"
+ (4 "a")
+ (0)))))))
(_lux_export Maybe)
(_lux_declare-tags [#None #Some] Maybe)
## (deftype #rec Type
-## (| #VoidT
-## #UnitT
-## (#SumT Type Type)
-## (#ProdT Type Type)
-## (#DataT Text)
+## (| (#DataT Text)
+## (#VariantT (List Type))
+## (#TupleT (List Type))
## (#LambdaT Type Type)
## (#BoundT Text)
## (#VarT Int)
-## (#ExT Int)
## (#AllT (Maybe (List (, Text Type))) Text Text Type)
## (#AppT Type Type)
## (#NamedT Ident Type)
-## ))
+## ))
(_lux_def Type
- (11 ["lux" "Type"]
- (_lux_case (10 (6 "Type") (6 "_"))
- Type
- (_lux_case (10 List (3 Text Type))
- TypeEnv
- (10 (9 (#Some #Nil) "Type" "_"
- (2 ## lux;VoidT
- Unit
- (2 ## lux;UnitT
- Unit
- (2 ## lux;SumT
- (3 Type Type)
- (2 ## lux;ProdT
- (3 Type Type)
- (2 ## "lux;DataT"
- Text
- (2 ## "lux;LambdaT"
- (3 Type Type)
- (2 ## "lux;BoundT"
- Text
- (2 ## "lux;VarT"
- Int
- (2 ## "lux;ExT"
+ (9 ["lux" "Type"]
+ (_lux_case (8 (4 "Type") (4 "_"))
+ Type
+ (_lux_case (8 List (2 (1 Text (1 Type (0)))))
+ TypeEnv
+ (_lux_case (8 List Type)
+ TypeList
+ (8 (7 (1 (0)) "Type" "_"
+ (1 (1 ## "lux;DataT"
+ Text
+ (1 ## "lux;VariantT"
+ TypeList
+ (1 ## "lux;TupleT"
+ TypeList
+ (1 ## "lux;LambdaT"
+ (2 (1 Type (1 Type (0))))
+ (1 ## "lux;BoundT"
+ Text
+ (1 ## "lux;VarT"
Int
- (2 ## "lux;AllT"
- (3 (10 Maybe TypeEnv) (3 Text (3 Text Type)))
- (2 ## "lux;AppT"
- (3 Type Type)
- ## "lux;NamedT"
- (3 Ident Type)))))))))))))
- Void)))))
+ (1 ## "lux;ExT"
+ Int
+ (1 ## "lux;AllT"
+ (2 (1 (8 Maybe TypeEnv) (1 Text (1 Text (1 Type (0))))))
+ (1 ## "lux;AppT"
+ (2 (1 Type (1 Type (0))))
+ (1 ## "lux;NamedT"
+ (2 (1 Ident (1 Type (0))))
+ (0)))))))))))))
+ Void))))))
(_lux_export Type)
-(_lux_declare-tags [#VoidT #UnitT #SumT #ProdT #DataT #LambdaT #BoundT #VarT #ExT #AllT #AppT #NamedT] Type)
+(_lux_declare-tags [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT #NamedT] Type)
## (deftype (Bindings k v)
## (& #counter Int
## #mappings (List (, k v))))
(_lux_def Bindings
(#NamedT ["lux" "Bindings"]
- (#AllT (#Some #Nil) "lux;Bindings" "k"
- (#AllT #None "" "v"
- (#ProdT ## lux;counter
- Int
- ## lux;mappings
- (#AppT List
- (#ProdT (#BoundT "k")
- (#BoundT "v"))))))))
+ (#AllT [(#Some #Nil) "lux;Bindings" "k"
+ (#AllT [#None "" "v"
+ (#TupleT (#Cons ## "lux;counter"
+ Int
+ (#Cons ## "lux;mappings"
+ (#AppT [List
+ (#TupleT (#Cons [(#BoundT "k")
+ (#Cons [(#BoundT "v")
+ #Nil])]))])
+ #Nil)))])])))
(_lux_export Bindings)
(_lux_declare-tags [#counter #mappings] Bindings)
@@ -146,16 +145,17 @@
(#NamedT ["lux" "Env"]
(#AllT (#Some #Nil) "lux;Env" "k"
(#AllT #None "" "v"
- (#ProdT ## "lux;name"
- Text
- (#ProdT ## "lux;inner-closures"
- Int
- (#ProdT ## "lux;locals"
- (#AppT (#AppT Bindings (#BoundT "k"))
- (#BoundT "v"))
- ## "lux;closure"
- (#AppT (#AppT Bindings (#BoundT "k"))
- (#BoundT "v")))))))))
+ (#TupleT (#Cons ## "lux;name"
+ Text
+ (#Cons ## "lux;inner-closures"
+ Int
+ (#Cons ## "lux;locals"
+ (#AppT (#AppT Bindings (#BoundT "k"))
+ (#BoundT "v"))
+ (#Cons ## "lux;closure"
+ (#AppT (#AppT Bindings (#BoundT "k"))
+ (#BoundT "v"))
+ #Nil)))))))))
(_lux_export Env)
(_lux_declare-tags [#name #inner-closures #locals #closure] Env)
@@ -163,7 +163,7 @@
## (, Text Int Int))
(_lux_def Cursor
(#NamedT ["lux" "Cursor"]
- (#ProdT Text (#ProdT Int Int))))
+ (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil))))))
(_lux_export Cursor)
## (deftype (Meta m v)
@@ -172,9 +172,13 @@
(#NamedT ["lux" "Meta"]
(#AllT (#Some #Nil) "lux;Meta" "m"
(#AllT #None "" "v"
- (#ProdT (#BoundT "m")
- (#BoundT "v"))))))
+ (#VariantT (#Cons ## "lux;Meta"
+ (#TupleT (#Cons (#BoundT "m")
+ (#Cons (#BoundT "v")
+ #Nil)))
+ #Nil))))))
(_lux_export Meta)
+(_lux_declare-tags [#Meta] Meta)
## (deftype (AST' w)
## (| (#BoolS Bool)
@@ -196,28 +200,29 @@
(_lux_case (#AppT [List AST])
ASTList
(#AllT (#Some #Nil) "lux;AST'" "w"
- (#SumT ## "lux;BoolS"
- Bool
- (#SumT ## "lux;IntS"
- Int
- (#SumT ## "lux;RealS"
- Real
- (#SumT ## "lux;CharS"
- Char
- (#SumT ## "lux;TextS"
- Text
- (#SumT ## "lux;SymbolS"
- Ident
- (#SumT ## "lux;TagS"
- Ident
- (#SumT ## "lux;FormS"
- ASTList
- (#SumT ## "lux;TupleS"
- ASTList
- ## "lux;RecordS"
- (#AppT List (#ProdT AST AST))
- ))))))))
- ))))))
+ (#VariantT (#Cons ## "lux;BoolS"
+ Bool
+ (#Cons ## "lux;IntS"
+ Int
+ (#Cons ## "lux;RealS"
+ Real
+ (#Cons ## "lux;CharS"
+ Char
+ (#Cons ## "lux;TextS"
+ Text
+ (#Cons ## "lux;SymbolS"
+ Ident
+ (#Cons ## "lux;TagS"
+ Ident
+ (#Cons ## "lux;FormS"
+ ASTList
+ (#Cons ## "lux;TupleS"
+ ASTList
+ (#Cons ## "lux;RecordS"
+ (#AppT List (#TupleT (#Cons AST (#Cons AST #Nil))))
+ #Nil)
+ )))))))))
+ ))))))
(_lux_export AST')
(_lux_declare-tags [#BoolS #IntS #RealS #CharS #TextS #SymbolS #TagS #FormS #TupleS #RecordS] AST')
@@ -239,30 +244,32 @@
(#NamedT ["lux" "Either"]
(#AllT (#Some #Nil) "lux;Either" "l"
(#AllT #None "" "r"
- (#SumT ## "lux;Left"
- (#BoundT "l")
- ## "lux;Right"
- (#BoundT "r"))))))
+ (#VariantT (#Cons ## "lux;Left"
+ (#BoundT "l")
+ (#Cons ## "lux;Right"
+ (#BoundT "r")
+ #Nil)))))))
(_lux_export Either)
(_lux_declare-tags [#Left #Right] Either)
## (deftype (StateE s a)
## (-> s (Either Text (, s a))))
(_lux_def StateE
- (#AllT (#Some #Nil) "lux;StateE" "s"
- (#AllT #None "" "a"
- (#LambdaT (#BoundT "s")
- (#AppT (#AppT [Either Text])
- (#ProdT (#BoundT "s")
- (#BoundT "a")))))))
+ (#AllT [(#Some #Nil) "lux;StateE" "s"
+ (#AllT [#None "" "a"
+ (#LambdaT [(#BoundT "s")
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [(#BoundT "s")
+ (#Cons [(#BoundT "a")
+ #Nil])]))])])])]))
## (deftype Source
## (List (Meta Cursor Text)))
(_lux_def Source
(#NamedT ["lux" "Source"]
- (#AppT List
- (#AppT (#AppT Meta Cursor)
- Text))))
+ (#AppT [List
+ (#AppT [(#AppT [Meta Cursor])
+ Text])])))
(_lux_export Source)
## (deftype Host
@@ -271,12 +278,13 @@
## #classes (^ clojure.lang.Atom)))
(_lux_def Host
(#NamedT ["lux" "Host"]
- (#ProdT ## "lux;writer"
- (#DataT "org.objectweb.asm.ClassWriter")
- (#ProdT ## "lux;loader"
- (#DataT "java.lang.ClassLoader")
- ## "lux;classes"
- (#DataT "clojure.lang.Atom")))))
+ (#TupleT (#Cons [## "lux;writer"
+ (#DataT "org.objectweb.asm.ClassWriter")
+ (#Cons [## "lux;loader"
+ (#DataT "java.lang.ClassLoader")
+ (#Cons [## "lux;classes"
+ (#DataT "clojure.lang.Atom")
+ #Nil])])]))))
(_lux_declare-tags [#writer #loader #classes] Host)
## (deftype (DefData' m)
@@ -287,15 +295,17 @@
(_lux_def DefData'
(#NamedT ["lux" "DefData'"]
(#AllT [(#Some #Nil) "lux;DefData'" ""
- (#SumT ## "lux;ValueD"
- (#ProdT Type
- Unit)
- (#SumT ## "lux;TypeD"
- Type
- (#SumT ## "lux;MacroD"
- (#BoundT "")
- ## "lux;AliasD"
- Ident)))])))
+ (#VariantT (#Cons [## "lux;ValueD"
+ (#TupleT (#Cons [Type
+ (#Cons [Unit
+ #Nil])]))
+ (#Cons [## "lux;TypeD"
+ Type
+ (#Cons [## "lux;MacroD"
+ (#BoundT "")
+ (#Cons [## "lux;AliasD"
+ Ident
+ #Nil])])])]))])))
(_lux_export DefData')
(_lux_declare-tags [#ValueD #TypeD #MacroD #AliasD] DefData')
@@ -304,10 +314,11 @@
## (#Global Ident)))
(_lux_def LuxVar
(#NamedT ["lux" "LuxVar"]
- (#SumT ## "lux;Local"
- Int
- ## "lux;Global"
- Ident)))
+ (#VariantT (#Cons [## "lux;Local"
+ Int
+ (#Cons [## "lux;Global"
+ Ident
+ #Nil])]))))
(_lux_export LuxVar)
(_lux_declare-tags [#Local #Global] LuxVar)
@@ -320,28 +331,34 @@
## ))
(_lux_def Module
(#NamedT ["lux" "Module"]
- (#AllT (#Some #Nil) "lux;Module" "Compiler"
- (#ProdT ## "lux;module-aliases"
- (#AppT List (#ProdT Text Text))
- (#ProdT ## "lux;defs"
- (#AppT List (#ProdT Text
- (#ProdT Bool
- (#AppT DefData' (#LambdaT ASTList
- (#AppT (#AppT StateE (#BoundT "Compiler"))
- ASTList))))))
- (#ProdT ## "lux;imports"
- (#AppT List Text)
- (#ProdT ## "lux;tags"
- (#AppT List
- (#ProdT Text
- (#ProdT Int
- (#ProdT (#AppT List Ident)
- Type))))
- ## "lux;types"
- (#AppT List
- (#ProdT Text
- (#ProdT (#AppT List Ident)
- Type))))))))))
+ (#AllT [(#Some #Nil) "lux;Module" "Compiler"
+ (#TupleT (#Cons [## "lux;module-aliases"
+ (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))])
+ (#Cons [## "lux;defs"
+ (#AppT [List (#TupleT (#Cons [Text
+ (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [ASTList
+ (#AppT [(#AppT [StateE (#BoundT "Compiler")])
+ ASTList])])])
+ #Nil])]))
+ #Nil])]))])
+ (#Cons [## "lux;imports"
+ (#AppT [List Text])
+ (#Cons [## "lux;tags"
+ (#AppT [List
+ (#TupleT (#Cons Text
+ (#Cons (#TupleT (#Cons Int
+ (#Cons (#AppT [List Ident])
+ (#Cons Type
+ #Nil))))
+ #Nil)))])
+ (#Cons [## "lux;types"
+ (#AppT [List
+ (#TupleT (#Cons Text
+ (#Cons (#TupleT (#Cons (#AppT [List Ident])
+ (#Cons Type
+ #Nil)))
+ #Nil)))])
+ #Nil])])])])]))])))
(_lux_export Module)
(_lux_declare-tags [#module-aliases #defs #imports #tags #types] Module)
@@ -358,28 +375,30 @@
## ))
(_lux_def Compiler
(#NamedT ["lux" "Compiler"]
- (#AppT (#AllT (#Some #Nil) "lux;Compiler" ""
- (#ProdT ## "lux;source"
- Source
- (#ProdT ## "lux;cursor"
- Cursor
- (#ProdT ## "lux;modules"
- (#AppT List (#ProdT Text
- (#AppT Module (#AppT (#BoundT "lux;Compiler") (#BoundT "")))))
- (#ProdT ## "lux;envs"
- (#AppT List (#AppT (#AppT [Env Text])
- (#ProdT LuxVar Type)))
- (#ProdT ## "lux;type-vars"
- (#AppT (#AppT Bindings Int) Type)
- (#ProdT ## "lux;expected"
- Type
- (#ProdT ## "lux;seed"
- Int
- (#ProdT ## "lux;eval?"
- Bool
- ## "lux;host"
- Host)))))))))
- Void)))
+ (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" ""
+ (#TupleT (#Cons [## "lux;source"
+ Source
+ (#Cons [## "lux;cursor"
+ Cursor
+ (#Cons [## "lux;modules"
+ (#AppT [List (#TupleT (#Cons [Text
+ (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])])
+ #Nil])]))])
+ (#Cons [## "lux;envs"
+ (#AppT [List (#AppT [(#AppT [Env Text])
+ (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])
+ (#Cons [## "lux;type-vars"
+ (#AppT [(#AppT [Bindings Int]) Type])
+ (#Cons [## "lux;expected"
+ Type
+ (#Cons [## "lux;seed"
+ Int
+ (#Cons [## "lux;eval?"
+ Bool
+ (#Cons [## "lux;host"
+ Host
+ #Nil])])])])])])])])]))])
+ Void])))
(_lux_export Compiler)
(_lux_declare-tags [#source #cursor #modules #envs #type-vars #expected #seed #eval? #host] Compiler)
@@ -407,7 +426,7 @@
(#AppT Meta Cursor))
AST)
(_lux_lambda _ data
- [_cursor data])))
+ (#Meta _cursor data))))
## (def (return x)
## (All [a]
@@ -419,8 +438,9 @@
(#LambdaT (#BoundT "a")
(#LambdaT Compiler
(#AppT (#AppT Either Text)
- (#ProdT Compiler
- (#BoundT "a"))))))
+ (#TupleT (#Cons Compiler
+ (#Cons (#BoundT "a")
+ #Nil)))))))
(_lux_lambda _ val
(_lux_lambda _ state
(#Right state val)))))
@@ -435,8 +455,9 @@
(#LambdaT Text
(#LambdaT Compiler
(#AppT (#AppT Either Text)
- (#ProdT Compiler
- (#BoundT "a"))))))
+ (#TupleT (#Cons Compiler
+ (#Cons (#BoundT "a")
+ #Nil)))))))
(_lux_lambda _ msg
(_lux_lambda _ state
(#Left msg)))))
@@ -472,7 +493,7 @@
(_meta (#TupleS tokens)))))
(_lux_def record$
- (_lux_: (#LambdaT (#AppT List (#ProdT AST AST)) AST)
+ (_lux_: (#LambdaT (#AppT List (#TupleT (#Cons AST (#Cons AST #Nil)))) AST)
(_lux_lambda _ tokens
(_meta (#RecordS tokens)))))
@@ -493,7 +514,7 @@
(_lux_: Macro
(_lux_lambda _ tokens
(_lux_case tokens
- (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))
+ (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil))
(return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
(#Cons (_meta (#SymbolS "" ""))
(#Cons arg
@@ -508,7 +529,7 @@
#Nil))))))
#Nil))
- (#Cons [_ (#SymbolS self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)))
+ (#Cons (#Meta _ (#SymbolS self)) (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil)))
(return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
(#Cons (_meta (#SymbolS self))
(#Cons arg
@@ -531,9 +552,9 @@
(_lux_: Macro
(lambda'' [tokens]
(_lux_case tokens
- (#Cons [_ (#TagS ["" "export"])]
- (#Cons [_ (#FormS (#Cons name args))]
- (#Cons type (#Cons body #Nil))))
+ (#Cons [(#Meta [_ (#TagS ["" "export"])])
+ (#Cons [(#Meta [_ (#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 +568,7 @@
(#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
#Nil])]))
- (#Cons [_ (#TagS "" "export")] (#Cons name (#Cons type (#Cons body #Nil))))
+ (#Cons [(#Meta [_ (#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 +579,8 @@
(#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
#Nil])]))
- (#Cons [_ (#FormS (#Cons name args))]
- (#Cons type (#Cons body #Nil)))
+ (#Cons [(#Meta [_ (#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 +593,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 +611,7 @@
(def'' (defmacro tokens)
Macro
(_lux_case tokens
- (#Cons [[_ (#FormS (#Cons [name args]))] (#Cons [body #Nil])])
+ (#Cons [(#Meta [_ (#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 +621,7 @@
(#Cons [(form$ (#Cons [(symbol$ ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
#Nil])]))
- (#Cons [[_ (#TagS ["" "export"])] (#Cons [[_ (#FormS (#Cons [name args]))] (#Cons [body #Nil])])])
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])])
(return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def''"])
(#Cons [(tag$ ["" "export"])
(#Cons [(form$ (#Cons [name args]))
@@ -640,12 +661,12 @@
(defmacro (All' tokens)
(_lux_case tokens
- (#Cons [[_ (#TupleS #Nil)]
+ (#Cons [(#Meta [_ (#TupleS #Nil)])
(#Cons [body #Nil])])
(return (#Cons [body
#Nil]))
- (#Cons [[_ (#TupleS (#Cons [[_ (#SymbolS ["" arg-name])] other-args]))]
+ (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#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 +685,7 @@
(defmacro (B' tokens)
(_lux_case tokens
- (#Cons [[_ (#SymbolS ["" bound-name])]
+ (#Cons [(#Meta [_ (#SymbolS ["" bound-name])])
#Nil])
(return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"]))
(#Cons [(_meta (#TextS bound-name))
@@ -732,15 +753,15 @@
(fail "Wrong syntax for list&")))
(defmacro (lambda' tokens)
- (let'' [name tokens'] (_lux_: (#ProdT Ident ($' List AST))
+ (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List AST)))
(_lux_case tokens
- (#Cons [[_ (#SymbolS name)] tokens'])
+ (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
[name tokens']
_
[["" ""] tokens]))
(_lux_case tokens'
- (#Cons [[_ (#TupleS args)] (#Cons [body #Nil])])
+ (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
(_lux_case args
#Nil
(fail "lambda' requires a non-empty arguments tuple.")
@@ -762,8 +783,8 @@
(defmacro (def''' tokens)
(_lux_case tokens
- (#Cons [[_ (#TagS ["" "export"])]
- (#Cons [[_ (#FormS (#Cons [name args]))]
+ (#Cons [(#Meta [_ (#TagS ["" "export"])])
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
(#Cons [type (#Cons [body #Nil])])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
@@ -775,7 +796,7 @@
body))))))
(form$ (list (symbol$ ["" "_lux_export"]) name))))
- (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
(form$ (list (symbol$ ["" "_lux_:"])
@@ -783,7 +804,7 @@
body))))
(form$ (list (symbol$ ["" "_lux_export"]) name))))
- (#Cons [[_ (#FormS (#Cons [name args]))]
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
(#Cons [type (#Cons [body #Nil])])])
(return (list (form$ (list (symbol$ ["" "_lux_def"])
name
@@ -805,7 +826,7 @@
(def''' (as-pairs xs)
(All' [a]
- (->' ($' List (B' a)) ($' List (#ProdT (B' a) (B' a)))))
+ (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
(_lux_case xs
(#Cons [x (#Cons [y xs'])])
(#Cons [[x y] (as-pairs xs')])
@@ -815,8 +836,8 @@
(defmacro (let' tokens)
(_lux_case tokens
- (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])])
- (return (list (foldL (_lux_: (->' AST (#ProdT AST AST)
+ (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
+ (return (list (foldL (_lux_: (->' AST (#TupleT (list AST AST))
AST)
(lambda' [body binding]
(_lux_case binding
@@ -853,7 +874,7 @@
(def''' (spliced? token)
(->' AST Bool)
(_lux_case token
- [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [_ #Nil])]))]
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
true
_
@@ -861,8 +882,9 @@
(def''' (wrap-meta content)
(->' AST AST)
- (_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
- content))))
+ (_meta (#FormS (list (_meta (#TagS ["lux" "Meta"]))
+ (_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
+ content)))))))
(def''' (untemplate-list tokens)
(->' ($' List AST) AST)
@@ -901,7 +923,7 @@
true
(let' [elems' (map (lambda' [elem]
(_lux_case elem
- [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
spliced
_
@@ -922,23 +944,23 @@
(def''' (untemplate replace? subst token)
(->' Bool Text AST AST)
- (_lux_case (_lux_: (#ProdT Bool AST) [replace? token])
- [_ [_ (#BoolS value)]]
+ (_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token])
+ [_ (#Meta [_ (#BoolS value)])]
(wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
- [_ [_ (#IntS value)]]
+ [_ (#Meta [_ (#IntS value)])]
(wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))
- [_ [_ (#RealS value)]]
+ [_ (#Meta [_ (#RealS value)])]
(wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))
- [_ [_ (#CharS value)]]
+ [_ (#Meta [_ (#CharS value)])]
(wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))
- [_ [_ (#TextS value)]]
+ [_ (#Meta [_ (#TextS value)])]
(wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))
- [_ [_ (#TagS [module name])]]
+ [_ (#Meta [_ (#TagS [module name])])]
(let' [module' (_lux_case module
""
subst
@@ -947,7 +969,7 @@
module)]
(wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
- [_ [_ (#SymbolS [module name])]]
+ [_ (#Meta [_ (#SymbolS [module name])])]
(let' [module' (_lux_case module
""
subst
@@ -956,19 +978,19 @@
module)]
(wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
- [_ [_ (#TupleS elems)]]
+ [_ (#Meta [_ (#TupleS elems)])]
(splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
- [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]]
+ [true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])]
unquoted
- [_ [meta (#FormS elems)]]
- (let' [[_ form'] (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
- [meta form'])
+ [_ (#Meta [meta (#FormS elems)])]
+ (let' [(#Meta [_ form']) (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
+ (#Meta [meta form']))
- [_ [_ (#RecordS fields)]]
+ [_ (#Meta [_ (#RecordS fields)])]
(wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
- (untemplate-list (map (_lux_: (->' (#ProdT AST AST) AST)
+ (untemplate-list (map (_lux_: (->' (#TupleT (list AST AST)) AST)
(lambda' [kv]
(let' [[k v] kv]
(tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
@@ -994,17 +1016,16 @@
(defmacro #export (|> tokens)
(_lux_case tokens
(#Cons [init apps])
- (return (list (foldL (_lux_: (->' AST AST AST)
- (lambda' [acc app]
- (_lux_case app
- [_ (#TupleS parts)]
- (tuple$ (list:++ parts (list acc)))
+ (return (list (foldL (lambda' [acc app]
+ (_lux_case app
+ (#Meta [_ (#TupleS parts)])
+ (tuple$ (list:++ parts (list acc)))
- [_ (#FormS parts)]
- (form$ (list:++ parts (list acc)))
+ (#Meta [_ (#FormS parts)])
+ (form$ (list:++ parts (list acc)))
- _
- (`' ((~ app) (~ acc))))))
+ _
+ (`' ((~ app) (~ acc)))))
init
apps)))
@@ -1026,7 +1047,7 @@
(def''' #export Lux
Type
(All' [a]
- (->' Compiler ($' Either Text (#ProdT Compiler (B' a))))))
+ (->' Compiler ($' Either Text (#TupleT (list Compiler (B' a)))))))
## (defsig (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1037,44 +1058,44 @@
Type
(#NamedT ["lux" "Monad"]
(All' [m]
- (#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))))))))
+ (#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)))))))))
(_lux_declare-tags [#return #bind] Monad)
(def''' Maybe/Monad
($' Monad Maybe)
{#return
(lambda' return [x]
- (#Some x))
+ (#Some x))
#bind
(lambda' [f ma]
- (_lux_case ma
- #None #None
- (#Some a) (f a)))})
+ (_lux_case ma
+ #None #None
+ (#Some a) (f a)))})
(def''' Lux/Monad
($' Monad Lux)
{#return
(lambda' [x]
- (lambda' [state]
- (#Right state x)))
+ (lambda' [state]
+ (#Right state x)))
#bind
(lambda' [f ma]
- (lambda' [state]
- (_lux_case (ma state)
- (#Left msg)
- (#Left msg)
+ (lambda' [state]
+ (_lux_case (ma state)
+ (#Left msg)
+ (#Left msg)
- (#Right state' a)
- (f a state'))))})
+ (#Right state' a)
+ (f a state'))))})
(defmacro #export (^ tokens)
(_lux_case tokens
- (#Cons [_ (#SymbolS "" class-name)] #Nil)
+ (#Cons (#Meta _ (#SymbolS "" class-name)) #Nil)
(return (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))
_
@@ -1083,8 +1104,7 @@
(defmacro #export (-> tokens)
(_lux_case (reverse tokens)
(#Cons output inputs)
- (return (list (foldL (_lux_: (->' AST AST AST)
- (lambda' [o i] (`' (#;LambdaT (~ i) (~ o)))))
+ (return (list (foldL (lambda' [o i] (`' (#;LambdaT (~ i) (~ o))))
output
inputs)))
@@ -1092,32 +1112,23 @@
(fail "Wrong syntax for ->")))
(defmacro #export (, tokens)
- (_lux_case (reverse tokens)
- (#Cons last prevs)
- (return (list (foldL (_lux_: (->' AST AST AST)
- (lambda' [r l] (`' (#;ProdT (~ l) (~ r)))))
- last
- prevs)))
-
- _
- (fail ", must have at least 2 members."))
- )
+ (return (list (`' (#;TupleT (~ (untemplate-list tokens)))))))
(defmacro (do tokens)
(_lux_case tokens
- (#Cons monad (#Cons [_ (#TupleS bindings)] (#Cons body #Nil)))
+ (#Cons monad (#Cons (#Meta _ (#TupleS bindings)) (#Cons body #Nil)))
(let' [body' (foldL (_lux_: (-> AST (, AST AST) AST)
(lambda' [body' binding]
- (let' [[var value] binding]
- (_lux_case var
- [_ (#TagS "" "let")]
- (`' (;let' (~ value) (~ body')))
-
- _
- (`' (bind (_lux_lambda (~ (symbol$ ["" ""]))
- (~ var)
- (~ body'))
- (~ value)))))))
+ (let' [[var value] binding]
+ (_lux_case var
+ (#Meta _ (#TagS "" "let"))
+ (`' (;let' (~ value) (~ body')))
+
+ _
+ (`' (bind (_lux_lambda (~ (symbol$ ["" ""]))
+ (~ var)
+ (~ body'))
+ (~ value)))))))
body
(reverse (as-pairs bindings)))]
(return (list (`' (_lux_case (~ monad)
@@ -1156,7 +1167,7 @@
(def''' (get-ident x)
(-> AST ($' Maybe Ident))
(_lux_case x
- [_ (#SymbolS sname)]
+ (#Meta [_ (#SymbolS sname)])
(#Some sname)
_
@@ -1165,7 +1176,7 @@
(def''' (get-name x)
(-> AST ($' Maybe Text))
(_lux_case x
- [_ (#SymbolS ["" sname])]
+ (#Meta [_ (#SymbolS ["" sname])])
(#Some sname)
_
@@ -1174,7 +1185,7 @@
(def''' (tuple->list tuple)
(-> AST ($' Maybe ($' List AST)))
(_lux_case tuple
- [_ (#TupleS members)]
+ (#Meta [_ (#TupleS members)])
(#Some members)
_
@@ -1213,7 +1224,7 @@
(def''' (apply-template env template)
(-> RepEnv AST AST)
(_lux_case template
- [_ (#SymbolS ["" sname])]
+ (#Meta [_ (#SymbolS ["" sname])])
(_lux_case (get-rep sname env)
(#Some subst)
subst
@@ -1221,13 +1232,13 @@
_
template)
- [_ (#TupleS elems)]
+ (#Meta [_ (#TupleS elems)])
(tuple$ (map (apply-template env) elems))
- [_ (#FormS elems)]
+ (#Meta [_ (#FormS elems)])
(form$ (map (apply-template env) elems))
- [_ (#RecordS members)]
+ (#Meta [_ (#RecordS members)])
(record$ (map (_lux_: (-> (, AST AST) (, AST AST))
(lambda' [kv]
(let' [[slot value] kv]
@@ -1249,7 +1260,7 @@
(defmacro #export (do-template tokens)
(_lux_case tokens
- (#Cons [[_ (#TupleS bindings)] (#Cons [[_ (#TupleS templates)] data])])
+ (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#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)])
@@ -1334,7 +1345,7 @@
(def''' (replace-syntax reps syntax)
(-> RepEnv AST AST)
(_lux_case syntax
- [_ (#SymbolS ["" name])]
+ (#Meta [_ (#SymbolS ["" name])])
(_lux_case (get-rep name reps)
(#Some replacement)
replacement
@@ -1342,18 +1353,18 @@
#None
syntax)
- [_ (#FormS parts)]
- [_ (#FormS (map (replace-syntax reps) parts))]
+ (#Meta [_ (#FormS parts)])
+ (#Meta [_ (#FormS (map (replace-syntax reps) parts))])
- [_ (#TupleS members)]
- [_ (#TupleS (map (replace-syntax reps) members))]
+ (#Meta [_ (#TupleS members)])
+ (#Meta [_ (#TupleS (map (replace-syntax reps) members))])
- [_ (#RecordS slots)]
- [_ (#RecordS (map (_lux_: (-> (, AST AST) (, AST AST))
- (lambda' [slot]
- (let' [[k v] slot]
- [(replace-syntax reps k) (replace-syntax reps v)])))
- slots))]
+ (#Meta [_ (#RecordS slots)])
+ (#Meta [_ (#RecordS (map (_lux_: (-> (, AST AST) (, AST AST))
+ (lambda' [slot]
+ (let' [[k v] slot]
+ [(replace-syntax reps k) (replace-syntax reps v)])))
+ slots))])
_
syntax)
@@ -1362,13 +1373,13 @@
(defmacro #export (All tokens)
(let' [[self-ident tokens'] (_lux_: (, Text ASTList)
(_lux_case tokens
- (#Cons [[_ (#SymbolS ["" self-ident])] tokens'])
+ (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
[self-ident tokens']
_
["" tokens]))]
(_lux_case tokens'
- (#Cons [[_ (#TupleS args)] (#Cons [body #Nil])])
+ (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
(_lux_case (map% Maybe/Monad get-name args)
(#Some idents)
(_lux_case idents
@@ -1379,9 +1390,8 @@
(let' [replacements (map (_lux_: (-> Text (, Text AST))
(lambda' [ident] [ident (`' (#;BoundT (~ (text$ ident))))]))
(list& self-ident idents))
- body' (foldL (_lux_: (-> AST Text AST)
- (lambda' [body' arg']
- (`' (#;AllT [#;None "" (~ (text$ arg')) (~ body')]))))
+ body' (foldL (lambda' [body' arg']
+ (`' (#;AllT [#;None "" (~ (text$ arg')) (~ body')])))
(replace-syntax replacements body)
(reverse targs))]
## (#;Some #;Nil)
@@ -1503,7 +1513,7 @@
(def''' (macro-expand token)
(-> AST ($' Lux ($' List AST)))
(_lux_case token
- [_ (#FormS (#Cons [[_ (#SymbolS macro-name)] args]))]
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
(do Lux/Monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
@@ -1523,7 +1533,7 @@
(def''' (macro-expand-all syntax)
(-> AST ($' Lux ($' List AST)))
(_lux_case syntax
- [_ (#FormS (#Cons [[_ (#SymbolS macro-name)] args]))]
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
(do Lux/Monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
@@ -1539,13 +1549,13 @@
[parts' (map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))]
(wrap (list (form$ (list:join parts')))))))
- [_ (#FormS (#Cons [harg targs]))]
+ (#Meta [_ (#FormS (#Cons [harg targs]))])
(do Lux/Monad
[harg+ (macro-expand-all harg)
targs+ (map% Lux/Monad macro-expand-all targs)]
(wrap (list (form$ (list:++ harg+ (list:join targs+))))))
- [_ (#TupleS members)]
+ (#Meta [_ (#TupleS members)])
(do Lux/Monad
[members' (map% Lux/Monad macro-expand-all members)]
(wrap (list (tuple$ (list:join members')))))
@@ -1556,15 +1566,14 @@
(def''' (walk-type type)
(-> AST AST)
(_lux_case type
- [_ (#FormS (#Cons [[_ (#TagS tag)] parts]))]
- (form$ (#Cons (tag$ tag) (map walk-type parts)))
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))])
+ (form$ (#Cons [(tag$ tag) (map walk-type parts)]))
- [_ (#TupleS members)]
+ (#Meta [_ (#TupleS members)])
(tuple$ (map walk-type members))
- [_ (#FormS (#Cons [type-fn args]))]
- (foldL (_lux_: (-> AST AST AST)
- (lambda' [type-fn arg] (`' (#;AppT (~ type-fn) (~ arg)))))
+ (#Meta [_ (#FormS (#Cons [type-fn args]))])
+ (foldL (lambda' [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))
(walk-type type-fn)
(map walk-type args))
@@ -1619,50 +1628,40 @@
(def''' (unfold-type-def type)
(-> AST ($' Lux (, AST ($' Maybe ($' List AST)))))
(_lux_case type
- [_ (#FormS (#Cons [_ (#SymbolS "" "|")] cases))]
+ (#Meta _ (#FormS (#Cons (#Meta _ (#SymbolS "" "|")) cases)))
(do Lux/Monad
[members (map% Lux/Monad
(: (-> AST ($' Lux (, Text AST)))
(lambda' [case]
(_lux_case case
- [_ (#TagS "" member-name)]
+ (#Meta _ (#TagS "" member-name))
(return [member-name (`' Unit)])
- [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))]
+ (#Meta _ (#FormS (#Cons (#Meta _ (#TagS "" member-name)) (#Cons member-type #Nil))))
(return [member-name member-type])
_
(fail "Wrong syntax for variant case."))))
- cases)
- variant-type (: (Lux AST)
- (_lux_case (reverse members)
- (#Cons last prevs)
- (return (foldL (_lux_: (->' AST AST AST)
- (lambda' [r l] (`' (#;SumT (~ l) (~ r)))))
- (second last)
- (map second prevs)))
-
- _
- (fail "| must have at least 2 members.")))]
- (return [variant-type
+ cases)]
+ (return [(`' (#;VariantT (~ (untemplate-list (map second members)))))
(#Some (|> members
(map first)
(map (: (-> Text AST)
(lambda' [name] (tag$ ["" name]))))))]))
- [_ (#FormS (#Cons [_ (#SymbolS "" "&")] pairs))]
+ (#Meta _ (#FormS (#Cons (#Meta _ (#SymbolS "" "&")) pairs)))
(do Lux/Monad
[members (map% Lux/Monad
(: (-> (, AST AST) ($' Lux (, Text AST)))
(lambda' [pair]
(_lux_case pair
- [[_ (#TagS "" member-name)] member-type]
+ [(#Meta _ (#TagS "" member-name)) member-type]
(return [member-name member-type])
_
(fail "Wrong syntax for variant case."))))
(as-pairs pairs))]
- (return [(`' (, (~@ (map second members))))
+ (return [(`' (#TupleT (~ (untemplate-list (map second members)))))
(#Some (|> members
(map first)
(map (: (-> Text AST)
@@ -1674,24 +1673,24 @@
(defmacro #export (deftype tokens)
(let' [[export? tokens'] (: (, Bool (List AST))
(_lux_case tokens
- (#Cons [_ (#TagS "" "export")] tokens')
+ (#Cons (#Meta _ (#TagS "" "export")) tokens')
[true tokens']
_
[false tokens]))
[rec? tokens'] (: (, Bool (List AST))
(_lux_case tokens'
- (#Cons [_ (#TagS "" "rec")] tokens')
+ (#Cons (#Meta _ (#TagS "" "rec")) tokens')
[true tokens']
_
[false tokens']))
parts (: (Maybe (, Text (List AST) AST))
(_lux_case tokens'
- (#Cons [_ (#SymbolS "" name)] (#Cons type #Nil))
+ (#Cons (#Meta _ (#SymbolS "" name)) (#Cons type #Nil))
(#Some name #Nil type)
- (#Cons [_ (#FormS (#Cons [_ (#SymbolS "" name)] args))] (#Cons type #Nil))
+ (#Cons (#Meta _ (#FormS (#Cons (#Meta _ (#SymbolS "" name)) args))) (#Cons type #Nil))
(#Some name args type)
_
@@ -1747,8 +1746,7 @@
(_lux_case (reverse tokens)
(#Cons value actions)
(let' [dummy (symbol$ ["" ""])]
- (return (list (foldL (: (-> AST AST AST)
- (lambda' [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))))
+ (return (list (foldL (lambda' [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))
value
actions))))
@@ -1758,20 +1756,20 @@
(defmacro (def' tokens)
(let' [[export? tokens'] (: (, Bool (List AST))
(_lux_case tokens
- (#Cons [_ (#TagS "" "export")] tokens')
+ (#Cons (#Meta _ (#TagS "" "export")) tokens')
[true tokens']
_
[false tokens]))
parts (: (Maybe (, AST (List AST) (Maybe AST) AST))
(_lux_case tokens'
- (#Cons [_ (#FormS (#Cons name args))] (#Cons type (#Cons body #Nil)))
+ (#Cons (#Meta _ (#FormS (#Cons name args))) (#Cons type (#Cons body #Nil)))
(#Some name args (#Some type) body)
(#Cons name (#Cons type (#Cons body #Nil)))
(#Some name #Nil (#Some type) body)
- (#Cons [_ (#FormS (#Cons name args))] (#Cons body #Nil))
+ (#Cons (#Meta _ (#FormS (#Cons name args))) (#Cons body #Nil))
(#Some name args #None body)
(#Cons name (#Cons body #Nil))
@@ -1817,7 +1815,7 @@
(lambda' expander [branch]
(let' [[pattern body] branch]
(_lux_case pattern
- [_ (#FormS (#Cons [_ (#SymbolS macro-name)] macro-args))]
+ (#Meta _ (#FormS (#Cons (#Meta _ (#SymbolS macro-name)) macro-args)))
(do Lux/Monad
[expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args)))
expansions (map% Lux/Monad expander (as-pairs expansion))]
@@ -1876,7 +1874,7 @@
(def' (symbol? ast)
(-> AST Bool)
(case ast
- [_ (#SymbolS _)]
+ (#Meta _ (#SymbolS _))
true
_
@@ -1884,7 +1882,7 @@
(defmacro #export (let tokens)
(case tokens
- (\ (list [_ (#TupleS bindings)] body))
+ (\ (list (#Meta _ (#TupleS bindings)) body))
(if (multiple? 2 (length bindings))
(|> bindings as-pairs reverse
(foldL (: (-> AST (, AST AST) AST)
@@ -1904,7 +1902,7 @@
(def' (ast:show ast)
(-> AST Text)
(case ast
- [_ ast]
+ (#Meta _ ast)
(case ast
(\or (#BoolS val) (#IntS val) (#RealS val))
(->text val)
@@ -1940,10 +1938,10 @@
(defmacro #export (lambda tokens)
(case (: (Maybe (, Ident AST (List AST) AST))
(case tokens
- (\ (list [_ (#TupleS (#Cons head tail))] body))
+ (\ (list (#Meta _ (#TupleS (#Cons head tail))) body))
(#Some ["" ""] head tail body)
- (\ (list [_ (#SymbolS [_ name])] [_ (#TupleS (#Cons head tail))] body))
+ (\ (list (#Meta _ (#SymbolS [_ name])) (#Meta _ (#TupleS (#Cons head tail))) body))
(#Some ["" name] head tail body)
_
@@ -1969,20 +1967,20 @@
(defmacro #export (def tokens)
(let [[export? tokens'] (: (, Bool (List AST))
(case tokens
- (#Cons [_ (#TagS "" "export")] tokens')
+ (#Cons (#Meta _ (#TagS "" "export")) tokens')
[true tokens']
_
[false tokens]))
parts (: (Maybe (, AST (List AST) (Maybe AST) AST))
(case tokens'
- (\ (list [_ (#FormS (#Cons name args))] type body))
+ (\ (list (#Meta _ (#FormS (#Cons name args))) type body))
(#Some name args (#Some type) body)
(\ (list name type body))
(#Some name #Nil (#Some type) body)
- (\ (list [_ (#FormS (#Cons name args))] body))
+ (\ (list (#Meta _ (#FormS (#Cons name args))) body))
(#Some name args #None body)
(\ (list name body))
@@ -2030,17 +2028,17 @@
(defmacro #export (defsig tokens)
(let [[export? tokens'] (: (, Bool (List AST))
(case tokens
- (\ (list& [_ (#TagS "" "export")] tokens'))
+ (\ (list& (#Meta _ (#TagS "" "export")) tokens'))
[true tokens']
_
[false tokens]))
?parts (: (Maybe (, Ident (List AST) (List AST)))
(case tokens'
- (\ (list& [_ (#FormS (list& [_ (#SymbolS name)] args))] sigs))
+ (\ (list& (#Meta _ (#FormS (list& (#Meta _ (#SymbolS name)) args))) sigs))
(#Some name args sigs)
- (\ (list& [_ (#SymbolS name)] sigs))
+ (\ (list& (#Meta _ (#SymbolS name)) sigs))
(#Some name #Nil sigs)
_
@@ -2054,7 +2052,7 @@
(: (-> AST (Lux (, Text AST)))
(lambda [token]
(case token
- (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))])
+ (\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_:")) type (#Meta _ (#SymbolS ["" name]))))))
(wrap (: (, Text AST) [name type]))
_
@@ -2063,7 +2061,8 @@
#let [[_module _name] name+
def-name (symbol$ name)
tags (: (List AST) (map (. (: (-> Text AST) (lambda [n] (tag$ ["" n]))) first) members))
- sig-type (: AST (` (, (~@ (map second members)))))
+ types (map second members)
+ sig-type (: AST (` (#;TupleT (~ (untemplate-list types)))))
sig-decl (: AST (` (_lux_declare-tags [(~@ tags)] (~ def-name))))
sig+ (: AST
(case args
@@ -2141,20 +2140,24 @@
(def (type:show type)
(-> Type Text)
(case type
- #VoidT
- "(|)"
+ (#DataT name)
+ ($ text:++ "(^ " name ")")
- #UnitT
- "(,)"
-
- (#SumT left right)
- ($ text:++ "(| " (type:show left) " " (type:show right) ")")
+ (#TupleT members)
+ (case members
+ #;Nil
+ "(,)"
- (#ProdT left right)
- ($ text:++ "(, " (type:show left) " " (type:show right) ")")
+ _
+ ($ text:++ "(, " (|> members (map type:show) (interpose " ") (foldL text:++ "")) ")"))
- (#DataT name)
- ($ text:++ "(^ " name ")")
+ (#VariantT members)
+ (case members
+ #;Nil
+ "(|)"
+
+ _
+ ($ text:++ "(| " (|> members (map type:show) (interpose " ") (foldL text:++ "")) ")"))
(#LambdaT input output)
($ text:++ "(-> " (type:show input) " " (type:show output) ")")
@@ -2181,11 +2184,11 @@
(def (beta-reduce env type)
(-> (List (, Text Type)) Type Type)
(case type
- (#SumT left right)
- (#SumT (beta-reduce env left) (beta-reduce env right))
+ (#VariantT ?cases)
+ (#VariantT (map (beta-reduce env) ?cases))
- (#ProdT left right)
- (#ProdT (beta-reduce env left) (beta-reduce env right))
+ (#TupleT ?members)
+ (#TupleT (map (beta-reduce env) ?members))
(#AppT ?type-fn ?type-arg)
(#AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg))
@@ -2241,16 +2244,9 @@
(def (resolve-struct-type type)
(-> Type (Maybe (List Type)))
(case type
- (#ProdT left right)
- (case right
- (#ProdT _)
- (do Maybe/Monad
- [rights (resolve-struct-type right)]
- (wrap (list& left rights)))
-
- _
- (#Some (list left right)))
-
+ (#TupleT slots)
+ (#Some slots)
+
(#AppT fun arg)
(do Maybe/Monad
[output (apply-type fun arg)]
@@ -2342,7 +2338,7 @@
(: (-> AST (Lux (, AST AST)))
(lambda [token]
(case token
- (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS tag-name)] value))])
+ (\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_def")) (#Meta _ (#SymbolS tag-name)) value))))
(wrap (: (, AST AST) [(tag$ tag-name) value]))
_
@@ -2353,14 +2349,14 @@
(defmacro #export (defstruct tokens)
(let [[export? tokens'] (: (, Bool (List AST))
(case tokens
- (\ (list& [_ (#TagS "" "export")] tokens'))
+ (\ (list& (#Meta _ (#TagS "" "export")) tokens'))
[true tokens']
_
[false tokens]))
?parts (: (Maybe (, AST (List AST) AST (List AST)))
(case tokens'
- (\ (list& [_ (#FormS (list& name args))] type defs))
+ (\ (list& (#Meta _ (#FormS (list& name args))) type defs))
(#Some name args type defs)
(\ (list& name type defs))
@@ -2393,8 +2389,7 @@
[(defmacro #export (<name> tokens)
(case (reverse tokens)
(\ (list& last init))
- (return (list (foldL (: (-> AST AST AST)
- (lambda [post pre] (` <form>)))
+ (return (list (foldL (lambda [post pre] (` <form>))
last
init)))
@@ -2422,7 +2417,7 @@
(: (-> AST (Lux Text))
(lambda [def]
(case def
- [_ (#SymbolS "" name)]
+ (#Meta _ (#SymbolS "" name))
(return name)
_
@@ -2432,7 +2427,7 @@
(def (parse-alias tokens)
(-> (List AST) (Lux (, (Maybe Text) (List AST))))
(case tokens
- (\ (list& [_ (#TagS "" "as")] [_ (#SymbolS "" alias)] tokens'))
+ (\ (list& (#Meta _ (#TagS "" "as")) (#Meta _ (#SymbolS "" alias)) tokens'))
(return (: (, (Maybe Text) (List AST)) [(#Some alias) tokens']))
_
@@ -2441,17 +2436,17 @@
(def (parse-referrals tokens)
(-> (List AST) (Lux (, Referrals (List AST))))
(case tokens
- (\ (list& [_ (#TagS "" "refer")] referral tokens'))
+ (\ (list& (#Meta _ (#TagS "" "refer")) referral tokens'))
(case referral
- [_ (#TagS "" "all")]
+ (#Meta _ (#TagS "" "all"))
(return (: (, Referrals (List AST)) [#All tokens']))
- (\ [_ (#FormS (list& [_ (#TagS "" "only")] defs))])
+ (\ (#Meta _ (#FormS (list& (#Meta _ (#TagS "" "only")) defs))))
(do Lux/Monad
[defs' (extract-defs defs)]
(return (: (, Referrals (List AST)) [(#Only defs') tokens'])))
- (\ [_ (#FormS (list& [_ (#TagS "" "exclude")] defs))])
+ (\ (#Meta _ (#FormS (list& (#Meta _ (#TagS "" "exclude")) defs))))
(do Lux/Monad
[defs' (extract-defs defs)]
(return (: (, Referrals (List AST)) [(#Exclude defs') tokens'])))
@@ -2465,7 +2460,7 @@
(def (extract-symbol syntax)
(-> AST (Lux Ident))
(case syntax
- [_ (#SymbolS ident)]
+ (#Meta _ (#SymbolS ident))
(return ident)
_
@@ -2474,7 +2469,7 @@
(def (parse-openings tokens)
(-> (List AST) (Lux (, (Maybe Openings) (List AST))))
(case tokens
- (\ (list& [_ (#TagS "" "open")] [_ (#FormS (list& [_ (#TextS prefix)] structs))] tokens'))
+ (\ (list& (#Meta _ (#TagS "" "open")) (#Meta _ (#FormS (list& (#Meta _ (#TextS prefix)) structs))) tokens'))
(do Lux/Monad
[structs' (map% Lux/Monad extract-symbol structs)]
(return (: (, (Maybe Openings) (List AST)) [(#Some prefix structs') tokens'])))
@@ -2488,10 +2483,10 @@
(: (-> AST (Lux AST))
(lambda [token]
(case token
- [_ (#SymbolS "" sub-name)]
+ (#Meta _ (#SymbolS "" sub-name))
(return (symbol$ ["" ($ text:++ super-name "/" sub-name)]))
- (\ [_ (#FormS (list& [_ (#SymbolS "" sub-name)] parts))])
+ (\ (#Meta _ (#FormS (list& (#Meta _ (#SymbolS "" sub-name)) parts))))
(return (form$ (list& (symbol$ ["" ($ text:++ super-name "/" sub-name)]) parts)))
_
@@ -2505,10 +2500,10 @@
(: (-> AST (Lux (List Import)))
(lambda [token]
(case token
- [_ (#SymbolS "" m-name)]
+ (#Meta _ (#SymbolS "" m-name))
(wrap (list [m-name #None #All #None]))
- (\ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))])
+ (\ (#Meta _ (#FormS (list& (#Meta _ (#SymbolS "" m-name)) extra))))
(do Lux/Monad
[alias+extra (parse-alias extra)
#let [[alias extra] alias+extra]
@@ -2700,10 +2695,10 @@
(` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
structs)))]]
(wrap ($ list:++
- (: (List AST) (list (` (_lux_import (~ (text$ m-name))))))
- (: (List AST) (case m-alias
- #None (list)
- (#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name)))))))
+ (list (` (_lux_import (~ (text$ m-name)))))
+ (case m-alias
+ #None (list)
+ (#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))
(map (: (-> Text AST)
(lambda [def]
(` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
@@ -2714,10 +2709,9 @@
_
(wrap (: (List AST)
- (list:++ (map (: (-> Text AST)
- (lambda [m-name] (` (_lux_import (~ (text$ m-name))))))
+ (list:++ (map (lambda [m-name] (` (_lux_import (~ (text$ m-name)))))
unknowns)
- (: (List AST) (list (` (import (~@ tokens)))))))))))
+ (list (` (import (~@ tokens))))))))))
(def (try-both f x1 x2)
(All [a b]
@@ -2854,7 +2848,7 @@
(case tokens
(\ (list struct body))
(case struct
- [_ (#SymbolS name)]
+ (#Meta _ (#SymbolS name))
(do Lux/Monad
[struct-type (find-var-type name)
output (resolve-type-tags struct-type)]
@@ -2880,6 +2874,12 @@
_
(fail "Wrong syntax for using")))
+(def (flip f)
+ (All [a b c]
+ (-> (-> a b c) (-> b a c)))
+ (lambda [y x]
+ (f x y)))
+
(defmacro #export (cond tokens)
(if (i= 0 (i% (length tokens) 2))
(fail "cond requires an even number of arguments.")
@@ -2910,7 +2910,7 @@
(defmacro #export (get@ tokens)
(case tokens
- (\ (list [_ (#TagS slot')] record))
+ (\ (list (#Meta _ (#TagS slot')) record))
(do Lux/Monad
[slot (normalize slot')
output (resolve-tag slot)
@@ -2952,11 +2952,11 @@
(defmacro #export (open tokens)
(case tokens
- (\ (list& [_ (#SymbolS struct-name)] tokens'))
+ (\ (list& (#Meta _ (#SymbolS struct-name)) tokens'))
(do Lux/Monad
[@module get-module-name
#let [prefix (case tokens'
- (\ (list [_ (#TextS prefix)]))
+ (\ (list (#Meta _ (#TextS prefix))))
prefix
_
@@ -2999,12 +2999,12 @@
(: (-> AST AST (Lux AST))
(lambda [so-far part]
(case part
- [_ (#SymbolS slot)]
- (return (: AST (` (get@ (~ (tag$ slot)) (~ so-far)))))
+ (#Meta _ (#SymbolS slot))
+ (return (` (get@ (~ (tag$ slot)) (~ so-far))))
- (\ [_ (#FormS (list& [_ (#SymbolS slot)] args))])
- (return (: AST (` ((get@ (~ (tag$ slot)) (~ so-far))
- (~@ args)))))
+ (\ (#Meta _ (#FormS (list& (#Meta _ (#SymbolS slot)) args))))
+ (return (` ((get@ (~ (tag$ slot)) (~ so-far))
+ (~@ args))))
_
(fail "Wrong syntax for ::"))))
@@ -3016,7 +3016,7 @@
(defmacro #export (set@ tokens)
(case tokens
- (\ (list [_ (#TagS slot')] value record))
+ (\ (list (#Meta _ (#TagS slot')) value record))
(do Lux/Monad
[slot (normalize slot')
output (resolve-tag slot)
@@ -3051,7 +3051,7 @@
(defmacro #export (update@ tokens)
(case tokens
- (\ (list [_ (#TagS slot')] fun record))
+ (\ (list (#Meta _ (#TagS slot')) fun record))
(do Lux/Monad
[slot (normalize slot')
output (resolve-tag slot)
@@ -3086,9 +3086,9 @@
(defmacro #export (\template tokens)
(case tokens
- (\ (list [_ (#TupleS data)]
- [_ (#TupleS bindings)]
- [_ (#TupleS templates)]))
+ (\ (list (#Meta _ (#TupleS data))
+ (#Meta _ (#TupleS bindings))
+ (#Meta _ (#TupleS templates))))
(case (: (Maybe (List AST))
(do Maybe/Monad
[bindings' (map% Maybe/Monad get-name bindings)
@@ -3132,29 +3132,26 @@
(def (type->syntax type)
(-> Type AST)
(case type
- (\template [<tag>]
- [<tag>
- (` <tag>)])
- [[#VoidT] [#UnitT]]
-
- (\template [<tag>]
- [(<tag> left right)
- (` (<tag> (~ (type->syntax left)) (~ (type->syntax right))))])
- [[#SumT] [#ProdT]]
-
(#DataT name)
(` (#;DataT (~ (text$ name))))
+
+ (#;VariantT cases)
+ (` (#;VariantT (~ (untemplate-list (map type->syntax cases)))))
+ (#TupleT parts)
+ (` (#;TupleT (~ (untemplate-list (map type->syntax parts)))))
+
(#LambdaT in out)
(` (#;LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
(#BoundT name)
(` (#;BoundT (~ (text$ name))))
+
+ (#VarT id)
+ (` (#;VarT (~ (int$ id))))
- (\template [<tag>]
- [(<tag> id)
- (` (<tag> (~ (int$ id))))])
- [[#VarT] [#ExT]]
+ (#ExT id)
+ (` (#;ExT (~ (int$ id))))
(#AllT env name arg type)
(let [env' (: AST
@@ -3174,7 +3171,7 @@
(defmacro #export (loop tokens)
(case tokens
- (\ (list [_ (#TupleS bindings)] body))
+ (\ (list (#Meta _ (#TupleS bindings)) body))
(let [pairs (as-pairs bindings)
vars (map first pairs)
inits (map second pairs)]
@@ -3204,6 +3201,4 @@
(fail "Wrong syntax for loop")))
(defmacro #export (export tokens)
- (return (map (: (-> AST AST)
- (lambda [token] (` (_lux_export (~ token)))))
- tokens)))
+ (return (map (lambda [token] (` (_lux_export (~ token)))) tokens)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-08 20:32:33 +0000