aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux429
1 files changed, 235 insertions, 194 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 4c4b02f8a..b6d71e893 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -10,59 +10,69 @@
(_jvm_interface "Function" []
("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
-(_lux_declare-tags [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT])
+(_lux_declare-tags [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT #NamedT])
(_lux_declare-tags [#None #Some])
(_lux_declare-tags [#Nil #Cons])
## Basic types
-(_lux_def Bool (#DataT "java.lang.Boolean"))
+(_lux_def Bool (#NamedT ["lux" "Bool"]
+ (#DataT "java.lang.Boolean")))
(_lux_export Bool)
-(_lux_def Int (#DataT "java.lang.Long"))
+(_lux_def Int (#NamedT ["lux" "Int"]
+ (#DataT "java.lang.Long")))
(_lux_export Int)
-(_lux_def Real (#DataT "java.lang.Double"))
+(_lux_def Real (#NamedT ["lux" "Real"]
+ (#DataT "java.lang.Double")))
(_lux_export Real)
-(_lux_def Char (#DataT "java.lang.Character"))
+(_lux_def Char (#NamedT ["lux" "Char"]
+ (#DataT "java.lang.Character")))
(_lux_export Char)
-(_lux_def Text (#DataT "java.lang.String"))
+(_lux_def Text (#NamedT ["lux" "Text"]
+ (#DataT "java.lang.String")))
(_lux_export Text)
-(_lux_def Unit (#TupleT #Nil))
+(_lux_def Unit (#NamedT ["lux" "Unit"]
+ (#TupleT #Nil)))
(_lux_export Unit)
-(_lux_def Void (#VariantT #Nil))
+(_lux_def Void (#NamedT ["lux" "Void"]
+ (#VariantT #Nil)))
(_lux_export Void)
-(_lux_def Ident (#TupleT (#Cons Text (#Cons Text #Nil))))
+(_lux_def Ident (#NamedT ["lux" "Ident"]
+ (#TupleT (#Cons Text (#Cons Text #Nil)))))
(_lux_export Ident)
## (deftype (List a)
## (| #Nil
## (#Cons a (List a))))
(_lux_def List
- (#AllT (#Some #Nil) "lux;List" "a"
- (#VariantT (#Cons ## "lux;Nil"
- (#TupleT #Nil)
- (#Cons ## "lux;Cons"
- (#TupleT (#Cons (#BoundT "a")
- (#Cons (#AppT (#BoundT "lux;List") (#BoundT "a"))
- #Nil)))
- #Nil)))))
+ (#NamedT ["lux" "List"]
+ (#AllT (#Some #Nil) "lux;List" "a"
+ (#VariantT (#Cons ## "lux;Nil"
+ (#TupleT #Nil)
+ (#Cons ## "lux;Cons"
+ (#TupleT (#Cons (#BoundT "a")
+ (#Cons (#AppT (#BoundT "lux;List") (#BoundT "a"))
+ #Nil)))
+ #Nil))))))
(_lux_export List)
## (deftype (Maybe a)
## (| #None
## (#Some a)))
(_lux_def Maybe
- (#AllT (#Some #Nil) "lux;Maybe" "a"
- (#VariantT (#Cons ## "lux;None"
- (#TupleT #Nil)
- (#Cons ## "lux;Some"
- (#BoundT "a")
- #Nil)))))
+ (#NamedT ["lux" "Maybe"]
+ (#AllT (#Some #Nil) "lux;Maybe" "a"
+ (#VariantT (#Cons ## "lux;None"
+ (#TupleT #Nil)
+ (#Cons ## "lux;Some"
+ (#BoundT "a")
+ #Nil))))))
(_lux_export Maybe)
## (deftype #rec Type
@@ -73,51 +83,57 @@
## (#BoundT Text)
## (#VarT Int)
## (#AllT (Maybe (List (, Text Type))) Text Text Type)
-## (#AppT Type Type)))
+## (#AppT Type Type)
+## (#NamedT Ident Type)
+## ))
(_lux_def Type
- (_lux_case (#AppT (#BoundT "Type") (#BoundT "_"))
- Type
- (_lux_case (#AppT List (#TupleT (#Cons Text (#Cons Type #Nil))))
- TypeEnv
- (_lux_case (#AppT List Type)
- TypeList
- (#AppT (#AllT (#Some #Nil) "Type" "_"
- (#VariantT (#Cons ## "lux;DataT"
- Text
- (#Cons ## "lux;VariantT"
- TypeList
- (#Cons ## "lux;TupleT"
- TypeList
- (#Cons ## "lux;LambdaT"
- (#TupleT (#Cons Type (#Cons Type #Nil)))
- (#Cons ## "lux;BoundT"
- Text
- (#Cons ## "lux;VarT"
- Int
- (#Cons ## "lux;ExT"
- Int
- (#Cons ## "lux;AllT"
- (#TupleT (#Cons (#AppT Maybe TypeEnv) (#Cons Text (#Cons Text (#Cons Type #Nil)))))
- (#Cons ## "lux;AppT"
- (#TupleT (#Cons Type (#Cons Type #Nil)))
- #Nil)))))))))))
- Void)))))
+ (#NamedT ["lux" "Type"]
+ (_lux_case (#AppT (#BoundT "Type") (#BoundT "_"))
+ Type
+ (_lux_case (#AppT List (#TupleT (#Cons Text (#Cons Type #Nil))))
+ TypeEnv
+ (_lux_case (#AppT List Type)
+ TypeList
+ (#AppT (#AllT (#Some #Nil) "Type" "_"
+ (#VariantT (#Cons ## "lux;DataT"
+ Text
+ (#Cons ## "lux;VariantT"
+ TypeList
+ (#Cons ## "lux;TupleT"
+ TypeList
+ (#Cons ## "lux;LambdaT"
+ (#TupleT (#Cons Type (#Cons Type #Nil)))
+ (#Cons ## "lux;BoundT"
+ Text
+ (#Cons ## "lux;VarT"
+ Int
+ (#Cons ## "lux;ExT"
+ Int
+ (#Cons ## "lux;AllT"
+ (#TupleT (#Cons (#AppT Maybe TypeEnv) (#Cons Text (#Cons Text (#Cons Type #Nil)))))
+ (#Cons ## "lux;AppT"
+ (#TupleT (#Cons Type (#Cons Type #Nil)))
+ (#Cons ## "lux;NamedT"
+ (#TupleT (#Cons Ident (#Cons Type #Nil)))
+ #Nil))))))))))))
+ Void))))))
(_lux_export Type)
## (deftype (Bindings k v)
## (& #counter Int
## #mappings (List (, k v))))
(_lux_def Bindings
- (#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)))])]))
+ (#NamedT ["lux" "Bindings"]
+ (#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])
@@ -127,38 +143,41 @@
## #locals (Bindings k v)
## #closure (Bindings k v)))
(_lux_def Env
- (#AllT (#Some #Nil) "lux;Env" "k"
- (#AllT #None "" "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))))))))
+ (#NamedT ["lux" "Env"]
+ (#AllT (#Some #Nil) "lux;Env" "k"
+ (#AllT #None "" "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])
## (deftype Cursor
## (, Text Int Int))
(_lux_def Cursor
- (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil)))))
+ (#NamedT ["lux" "Cursor"]
+ (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil))))))
(_lux_export Cursor)
## (deftype (Meta m v)
## (| (#Meta m v)))
(_lux_def Meta
- (#AllT (#Some #Nil) "lux;Meta" "m"
- (#AllT #None "" "v"
- (#VariantT (#Cons ## "lux;Meta"
- (#TupleT (#Cons (#BoundT "m")
- (#Cons (#BoundT "v")
- #Nil)))
- #Nil)))))
+ (#NamedT ["lux" "Meta"]
+ (#AllT (#Some #Nil) "lux;Meta" "m"
+ (#AllT #None "" "v"
+ (#VariantT (#Cons ## "lux;Meta"
+ (#TupleT (#Cons (#BoundT "m")
+ (#Cons (#BoundT "v")
+ #Nil)))
+ #Nil))))))
(_lux_export Meta)
(_lux_declare-tags [#Meta])
@@ -174,45 +193,47 @@
## (#TupleS (List (w (AST' w))))
## (#RecordS (List (, (w (AST' w)) (w (AST' w)))))))
(_lux_def AST'
- (_lux_case (#AppT (#BoundT "w")
- (#AppT (#BoundT "lux;AST'")
- (#BoundT "w")))
- AST
- (_lux_case (#AppT [List AST])
- ASTList
- (#AllT (#Some #Nil) "lux;AST'" "w"
- (#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)
- )))))))))
- )))))
+ (#NamedT ["lux" "AST'"]
+ (_lux_case (#AppT (#BoundT "w")
+ (#AppT (#BoundT "lux;AST'")
+ (#BoundT "w")))
+ AST
+ (_lux_case (#AppT [List AST])
+ ASTList
+ (#AllT (#Some #Nil) "lux;AST'" "w"
+ (#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])
## (deftype AST
## (Meta Cursor (AST' (Meta Cursor))))
(_lux_def AST
- (_lux_case (#AppT Meta Cursor)
- w
- (#AppT w (#AppT AST' w))))
+ (#NamedT ["lux" "AST"]
+ (_lux_case (#AppT Meta Cursor)
+ w
+ (#AppT w (#AppT AST' w)))))
(_lux_export AST)
(_lux_def ASTList (#AppT List AST))
@@ -221,13 +242,14 @@
## (| (#Left l)
## (#Right r)))
(_lux_def Either
- (#AllT (#Some #Nil) "lux;Either" "l"
- (#AllT #None "" "r"
- (#VariantT (#Cons ## "lux;Left"
- (#BoundT "l")
- (#Cons ## "lux;Right"
- (#BoundT "r")
- #Nil))))))
+ (#NamedT ["lux" "Either"]
+ (#AllT (#Some #Nil) "lux;Either" "l"
+ (#AllT #None "" "r"
+ (#VariantT (#Cons ## "lux;Left"
+ (#BoundT "l")
+ (#Cons ## "lux;Right"
+ (#BoundT "r")
+ #Nil)))))))
(_lux_export Either)
(_lux_declare-tags [#Left #Right])
@@ -245,9 +267,10 @@
## (deftype Source
## (List (Meta Cursor Text)))
(_lux_def Source
- (#AppT [List
- (#AppT [(#AppT [Meta Cursor])
- Text])]))
+ (#NamedT ["lux" "Source"]
+ (#AppT [List
+ (#AppT [(#AppT [Meta Cursor])
+ Text])])))
(_lux_export Source)
## (deftype Host
@@ -255,13 +278,14 @@
## #loader (^ java.net.URLClassLoader)
## #classes (^ clojure.lang.Atom)))
(_lux_def Host
- (#TupleT (#Cons [## "lux;writer"
- (#DataT "org.objectweb.asm.ClassWriter")
- (#Cons [## "lux;loader"
- (#DataT "java.lang.ClassLoader")
- (#Cons [## "lux;classes"
- (#DataT "clojure.lang.Atom")
- #Nil])])])))
+ (#NamedT ["lux" "Host"]
+ (#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])
## (deftype (DefData' m)
@@ -289,11 +313,12 @@
## (| (#Local Int)
## (#Global Ident)))
(_lux_def LuxVar
- (#VariantT (#Cons [## "lux;Local"
- Int
- (#Cons [## "lux;Global"
- Ident
- #Nil])])))
+ (#NamedT ["lux" "LuxVar"]
+ (#VariantT (#Cons [## "lux;Local"
+ Int
+ (#Cons [## "lux;Global"
+ Ident
+ #Nil])]))))
(_lux_export LuxVar)
(_lux_declare-tags [#Local #Global])
@@ -339,39 +364,41 @@
## #host Host
## ))
(_lux_def Compiler
- (#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;types"
- (#AppT [(#AppT [Bindings Int]) Type])
- (#Cons [## "lux;expected"
- Type
- (#Cons [## "lux;seed"
- Int
- (#Cons [## "lux;eval?"
- Bool
- (#Cons [## "lux;host"
- Host
- #Nil])])])])])])])])]))])
- Void]))
+ (#NamedT ["lux" "Compiler"]
+ (#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;types"
+ (#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 #types #expected #seed #eval? #host])
## (deftype Macro
## (-> (List AST) (StateE Compiler (List AST))))
(_lux_def Macro
- (#LambdaT ASTList
- (#AppT (#AppT StateE Compiler)
- ASTList)))
+ (#NamedT ["lux" "Macro"]
+ (#LambdaT ASTList
+ (#AppT (#AppT StateE Compiler)
+ ASTList))))
(_lux_export Macro)
## Base functions & macros
@@ -477,35 +504,35 @@
(_lux_: Macro
(_lux_lambda _ tokens
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"]))
- (#Cons [(_meta (#SymbolS ["" ""]))
- (#Cons [arg
- (#Cons [(_lux_case args'
- #Nil
- body
-
- _
- (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
- (#Cons [(_meta (#TupleS args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #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
- (#Cons [(_lux_case args'
- #Nil
- body
-
- _
- (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
- (#Cons [(_meta (#TupleS args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil]))
+ (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil))
+ (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
+ (#Cons (_meta (#SymbolS "" ""))
+ (#Cons arg
+ (#Cons (_lux_case args'
+ #Nil
+ body
+
+ _
+ (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''"))
+ (#Cons (_meta (#TupleS args'))
+ (#Cons body #Nil))))))
+ #Nil))))))
+ #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
+ (#Cons (_lux_case args'
+ #Nil
+ body
+
+ _
+ (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''"))
+ (#Cons (_meta (#TupleS args'))
+ (#Cons body #Nil))))))
+ #Nil))))))
+ #Nil))
_
(fail "Wrong syntax for lambda")))))
@@ -2136,6 +2163,9 @@
(#AllT ?env ?name ?arg ?body)
($ text:++ "(All " ?name " [" ?arg "] " (type:show ?body) ")")
+
+ (#NamedT name type)
+ (ident->text name)
))
(def (beta-reduce env type)
@@ -2169,6 +2199,9 @@
_
type)
+ (#NamedT name type)
+ (beta-reduce env type)
+
_
type
))
@@ -2188,6 +2221,9 @@
(do Maybe/Monad
[type-fn* (apply-type F A)]
(apply-type type-fn* param))
+
+ (#NamedT name type)
+ (apply-type type param)
_
#None))
@@ -2204,6 +2240,8 @@
(#AllT _ _ _ body)
(resolve-struct-type body)
+ (#NamedT name type)
+ (resolve-struct-type type)
_
#None))
@@ -3046,7 +3084,10 @@
(` (#AllT (~ env') (~ (text$ name)) (~ (text$ arg)) (~ (type->syntax type)))))
(#AppT fun arg)
- (` (#AppT (~ (type->syntax fun)) (~ (type->syntax arg))))))
+ (` (#AppT (~ (type->syntax fun)) (~ (type->syntax arg))))
+
+ (#NamedT [module name] type)
+ (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
(defmacro #export (loop tokens)
(case tokens
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 19:58:13 +0000