aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux752
-rw-r--r--source/lux/codata/function.lux4
-rw-r--r--source/lux/codata/lazy.lux12
-rw-r--r--source/lux/codata/reader.lux12
-rw-r--r--source/lux/codata/state.lux12
-rw-r--r--source/lux/codata/stream.lux8
-rw-r--r--source/lux/data/bool.lux8
-rw-r--r--source/lux/data/char.lux4
-rw-r--r--source/lux/data/error.lux8
-rw-r--r--source/lux/data/id.lux14
-rw-r--r--source/lux/data/io.lux8
-rw-r--r--source/lux/data/list.lux28
-rw-r--r--source/lux/data/maybe.lux14
-rw-r--r--source/lux/data/number/int.lux40
-rw-r--r--source/lux/data/number/real.lux40
-rw-r--r--source/lux/data/text.lux18
-rw-r--r--source/lux/data/writer.lux8
-rw-r--r--source/lux/meta/lux.lux16
-rw-r--r--source/lux/meta/syntax.lux8
19 files changed, 547 insertions, 467 deletions
diff --git a/source/lux.lux b/source/lux.lux
index b6d71e893..4120b262c 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -10,70 +10,68 @@
(_jvm_interface "Function" []
("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
-(_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 (#NamedT ["lux" "Bool"]
- (#DataT "java.lang.Boolean")))
+(_lux_def Bool (9 ["lux" "Bool"]
+ (0 "java.lang.Boolean")))
(_lux_export Bool)
-(_lux_def Int (#NamedT ["lux" "Int"]
- (#DataT "java.lang.Long")))
+(_lux_def Int (9 ["lux" "Int"]
+ (0 "java.lang.Long")))
(_lux_export Int)
-(_lux_def Real (#NamedT ["lux" "Real"]
- (#DataT "java.lang.Double")))
+(_lux_def Real (9 ["lux" "Real"]
+ (0 "java.lang.Double")))
(_lux_export Real)
-(_lux_def Char (#NamedT ["lux" "Char"]
- (#DataT "java.lang.Character")))
+(_lux_def Char (9 ["lux" "Char"]
+ (0 "java.lang.Character")))
(_lux_export Char)
-(_lux_def Text (#NamedT ["lux" "Text"]
- (#DataT "java.lang.String")))
+(_lux_def Text (9 ["lux" "Text"]
+ (0 "java.lang.String")))
(_lux_export Text)
-(_lux_def Unit (#NamedT ["lux" "Unit"]
- (#TupleT #Nil)))
+(_lux_def Unit (9 ["lux" "Unit"]
+ (2 (0))))
(_lux_export Unit)
-(_lux_def Void (#NamedT ["lux" "Void"]
- (#VariantT #Nil)))
+(_lux_def Void (9 ["lux" "Void"]
+ (1 (0))))
(_lux_export Void)
-(_lux_def Ident (#NamedT ["lux" "Ident"]
- (#TupleT (#Cons Text (#Cons Text #Nil)))))
+(_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
- (#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))))))
+ (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)
## (deftype (Maybe a)
## (| #None
-## (#Some a)))
+## (1 a)))
(_lux_def Maybe
- (#NamedT ["lux" "Maybe"]
- (#AllT (#Some #Nil) "lux;Maybe" "a"
- (#VariantT (#Cons ## "lux;None"
- (#TupleT #Nil)
- (#Cons ## "lux;Some"
- (#BoundT "a")
- #Nil))))))
+ (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
## (| (#DataT Text)
@@ -87,37 +85,38 @@
## (#NamedT Ident Type)
## ))
(_lux_def Type
- (#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))))))
+ (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
+ (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 [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT #NamedT] Type)
## (deftype (Bindings k v)
## (& #counter Int
@@ -135,7 +134,7 @@
#Nil])]))])
#Nil)))])])))
(_lux_export Bindings)
-(_lux_declare-tags [#counter #mappings])
+(_lux_declare-tags [#counter #mappings] Bindings)
## (deftype (Env k v)
## (& #name Text
@@ -158,7 +157,7 @@
(#BoundT "v"))
#Nil)))))))))
(_lux_export Env)
-(_lux_declare-tags [#name #inner-closures #locals #closure])
+(_lux_declare-tags [#name #inner-closures #locals #closure] Env)
## (deftype Cursor
## (, Text Int Int))
@@ -179,7 +178,7 @@
#Nil)))
#Nil))))))
(_lux_export Meta)
-(_lux_declare-tags [#Meta])
+(_lux_declare-tags [#Meta] Meta)
## (deftype (AST' w)
## (| (#BoolS Bool)
@@ -225,7 +224,7 @@
)))))))))
))))))
(_lux_export AST')
-(_lux_declare-tags [#BoolS #IntS #RealS #CharS #TextS #SymbolS #TagS #FormS #TupleS #RecordS])
+(_lux_declare-tags [#BoolS #IntS #RealS #CharS #TextS #SymbolS #TagS #FormS #TupleS #RecordS] AST')
## (deftype AST
## (Meta Cursor (AST' (Meta Cursor))))
@@ -251,7 +250,7 @@
(#BoundT "r")
#Nil)))))))
(_lux_export Either)
-(_lux_declare-tags [#Left #Right])
+(_lux_declare-tags [#Left #Right] Either)
## (deftype (StateE s a)
## (-> s (Either Text (, s a))))
@@ -286,7 +285,7 @@
(#Cons [## "lux;classes"
(#DataT "clojure.lang.Atom")
#Nil])])]))))
-(_lux_declare-tags [#writer #loader #classes])
+(_lux_declare-tags [#writer #loader #classes] Host)
## (deftype (DefData' m)
## (| (#TypeD Type)
@@ -294,20 +293,21 @@
## (#MacroD m)
## (#AliasD Ident)))
(_lux_def DefData'
- (#AllT [(#Some #Nil) "lux;DefData'" ""
- (#VariantT (#Cons [## "lux;TypeD"
- Type
- (#Cons [## "lux;ValueD"
- (#TupleT (#Cons [Type
- (#Cons [Unit
- #Nil])]))
- (#Cons [## "lux;MacroD"
- (#BoundT "")
- (#Cons [## "lux;AliasD"
- Ident
- #Nil])])])]))]))
+ (#NamedT ["lux" "DefData'"]
+ (#AllT [(#Some #Nil) "lux;DefData'" ""
+ (#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 [#TypeD #ValueD #MacroD #AliasD])
+(_lux_declare-tags [#ValueD #TypeD #MacroD #AliasD] DefData')
## (deftype LuxVar
## (| (#Local Int)
@@ -320,44 +320,54 @@
Ident
#Nil])]))))
(_lux_export LuxVar)
-(_lux_declare-tags [#Local #Global])
+(_lux_declare-tags [#Local #Global] LuxVar)
## (deftype (Module Compiler)
## (& #module-aliases (List (, Text Text))
## #defs (List (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST)))))))
## #imports (List Text)
-## #tags (List (, Text (, Int (List Ident))))
+## #tags (List (, Text (, Int (List Ident) Type)))
+## #types (List (, Text (, (List Ident) Type)))
## ))
(_lux_def Module
- (#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])
- #Nil)))
- #Nil)))])
- #Nil])])])]))]))
+ (#NamedT ["lux" "Module"]
+ (#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])
+(_lux_declare-tags [#module-aliases #defs #imports #tags #types] Module)
## (deftype #rec Compiler
## (& #source Source
## #cursor Cursor
## #modules (List (, Text (Module Compiler)))
## #envs (List (Env Text (, LuxVar Type)))
-## #types (Bindings Int Type)
+## #type-vars (Bindings Int Type)
## #expected Type
## #seed Int
## #eval? Bool
@@ -377,7 +387,7 @@
(#Cons [## "lux;envs"
(#AppT [List (#AppT [(#AppT [Env Text])
(#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])
- (#Cons [## "lux;types"
+ (#Cons [## "lux;type-vars"
(#AppT [(#AppT [Bindings Int]) Type])
(#Cons [## "lux;expected"
Type
@@ -390,7 +400,7 @@
#Nil])])])])])])])])]))])
Void])))
(_lux_export Compiler)
-(_lux_declare-tags [#source #cursor #modules #envs #types #expected #seed #eval? #host])
+(_lux_declare-tags [#source #cursor #modules #envs #type-vars #expected #seed #eval? #host] Compiler)
## (deftype Macro
## (-> (List AST) (StateE Compiler (List AST))))
@@ -1046,12 +1056,13 @@
## bind))
(def''' Monad
Type
- (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))))))))
-(_lux_declare-tags [#return #bind])
+ (#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)))))))))
+(_lux_declare-tags [#return #bind] Monad)
(def''' Maybe/Monad
($' Monad Maybe)
@@ -1070,7 +1081,7 @@
{#return
(lambda' [x]
(lambda' [state]
- (#Right [state x])))
+ (#Right state x)))
#bind
(lambda' [f ma]
@@ -1079,12 +1090,12 @@
(#Left msg)
(#Left msg)
- (#Right [state' a])
+ (#Right state' a)
(f a state'))))})
(defmacro #export (^ tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil])
+ (#Cons (#Meta _ (#SymbolS "" class-name)) #Nil)
(return (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))
_
@@ -1092,8 +1103,8 @@
(defmacro #export (-> tokens)
(_lux_case (reverse tokens)
- (#Cons [output inputs])
- (return (list (foldL (lambda' [o i] (`' (#;LambdaT [(~ i) (~ o)])))
+ (#Cons output inputs)
+ (return (list (foldL (lambda' [o i] (`' (#;LambdaT (~ i) (~ o))))
output
inputs)))
@@ -1425,7 +1436,7 @@
($' Lux Text)
(_lux_case state
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
(_lux_case (reverse envs)
@@ -1441,7 +1452,7 @@
($' Maybe Macro))
(do Maybe/Monad
[$module (get module modules)
- gdef (let' [{#module-aliases _ #defs bindings #imports _ #tags tags} (_lux_: ($' Module Compiler) $module)]
+ gdef (let' [{#module-aliases _ #defs bindings #imports _ #tags tags #types types} (_lux_: ($' Module Compiler) $module)]
(get name bindings))]
(_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef)
[exported? (#MacroD macro')]
@@ -1465,7 +1476,7 @@
(lambda' [state]
(_lux_case state
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
(#Right state (find-macro' modules current-module module name)))))))
@@ -1632,7 +1643,7 @@
_
(fail "Wrong syntax for variant case."))))
cases)]
- (return [(`' (#VariantT (~ (untemplate-list (map second members)))))
+ (return [(`' (#;VariantT (~ (untemplate-list (map second members)))))
(#Some (|> members
(map first)
(map (: (-> Text AST)
@@ -1687,16 +1698,18 @@
(_lux_case parts
(#Some name args type)
(do Lux/Monad
- [type+tags?? (unfold-type-def type)]
- (let' [[type tags??] type+tags??
+ [type+tags?? (unfold-type-def type)
+ module-name get-module-name]
+ (let' [type-name (symbol$ ["" name])
+ [type tags??] type+tags??
with-export (: (List AST)
(if export?
- (list (`' (_lux_export (~ (symbol$ ["" name])))))
+ (list (`' (_lux_export (~ type-name))))
#Nil))
with-tags (: (List AST)
(_lux_case tags??
(#Some tags)
- (list (`' (_lux_declare-tags [(~@ tags)])))
+ (list (`' (_lux_declare-tags [(~@ tags)] (~ type-name))))
_
(list)))
@@ -1714,10 +1727,12 @@
(#Some type)
_
- (#Some (`' (;All (~ (symbol$ ["" name])) [(~@ args)] (~ type)))))))]
+ (#Some (`' (;All (~ type-name) [(~@ args)] (~ type)))))))]
(_lux_case type'
(#Some type'')
- (return (list& (`' (_lux_def (~ (symbol$ ["" name])) (;type (~ type''))))
+ (return (list& (`' (_lux_def (~ type-name) (;type (#;NamedT [(~ (text$ module-name))
+ (~ (text$ name))]
+ (~ type'')))))
(list:++ with-export with-tags)))
#None
@@ -2001,37 +2016,15 @@
(-> Text (Lux AST))
(case state
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
(#Right {#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed (i+ 1 seed) #eval? eval? #expected expected
#cursor cursor}
(symbol$ ["" ($ text:++ "__gensym__" prefix (->text seed))]))))
-(defmacro #export (sig tokens)
- (do Lux/Monad
- [tokens' (map% Lux/Monad macro-expand tokens)
- members (map% Lux/Monad
- (: (-> AST (Lux (, Ident AST)))
- (lambda [token]
- (case token
- (\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_:")) type (#Meta _ (#SymbolS name))))))
- (do Lux/Monad
- [name' (normalize name)]
- (wrap (: (, Ident AST) [name' type])))
-
- _
- (fail "Signatures require typed members!"))))
- (list:join tokens'))]
- (wrap (list (` (#;RecordT (~ (untemplate-list (map (: (-> (, Ident AST) AST)
- (lambda [pair]
- (let [[name type] pair]
- (` [(~ (|> name ident->text text$))
- (~ type)]))))
- members)))))))))
-
(defmacro #export (defsig tokens)
(let [[export? tokens'] (: (, Bool (List AST))
(case tokens
@@ -2040,28 +2033,48 @@
_
[false tokens]))
- ?parts (: (Maybe (, AST (List AST) (List AST)))
+ ?parts (: (Maybe (, Ident (List AST) (List AST)))
(case tokens'
- (\ (list& (#Meta _ (#FormS (list& name args))) sigs))
+ (\ (list& (#Meta _ (#FormS (list& (#Meta _ (#SymbolS name)) args))) sigs))
(#Some name args sigs)
- (\ (list& name sigs))
+ (\ (list& (#Meta _ (#SymbolS name)) sigs))
(#Some name #Nil sigs)
_
#None))]
(case ?parts
(#Some name args sigs)
- (let [sigs' (: AST
- (case args
- #Nil
- (` (;sig (~@ sigs)))
-
- _
- (` (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))]
- (return (list& (` (_lux_def (~ name) (~ sigs')))
+ (do Lux/Monad
+ [name+ (normalize name)
+ sigs' (map% Lux/Monad macro-expand sigs)
+ members (map% Lux/Monad
+ (: (-> AST (Lux (, Text AST)))
+ (lambda [token]
+ (case token
+ (\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_:")) type (#Meta _ (#SymbolS ["" name]))))))
+ (wrap (: (, Text AST) [name type]))
+
+ _
+ (fail "Signatures require typed members!"))))
+ (list:join sigs'))
+ #let [[_module _name] name+
+ def-name (symbol$ name)
+ tags (: (List AST) (map (. (: (-> Text AST) (lambda [n] (tag$ ["" n]))) first) 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
+ #Nil
+ sig-type
+
+ _
+ (` (#;NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]]
+ (return (list& (` (_lux_def (~ def-name) (~ sig+)))
+ sig-decl
(if export?
- (list (` (_lux_export (~ name))))
+ (list (` (_lux_export (~ def-name))))
#Nil))))
#None
@@ -2229,27 +2242,90 @@
#None))
(def (resolve-struct-type type)
- (-> Type (Maybe Type))
+ (-> Type (Maybe (List Type)))
(case type
(#TupleT slots)
- (#Some type)
+ (#Some slots)
(#AppT fun arg)
- (apply-type fun arg)
+ (do Maybe/Monad
+ [output (apply-type fun arg)]
+ (resolve-struct-type output))
(#AllT _ _ _ body)
(resolve-struct-type body)
(#NamedT name type)
(resolve-struct-type type)
+
_
#None))
+(def (find-module name)
+ (-> Text (Lux (Module Compiler)))
+ (lambda [state]
+ (let [{#source source #modules modules
+ #envs envs #type-vars types #host host
+ #seed seed #eval? eval? #expected expected
+ #cursor cursor} state]
+ (case (get name modules)
+ (#Some module)
+ (#Right state module)
+
+ _
+ (#Left ($ text:++ "Unknown module: " name))))))
+
+(def get-current-module
+ (Lux (Module Compiler))
+ (do Lux/Monad
+ [module-name get-module-name]
+ (find-module module-name)))
+
+(def (resolve-tag [module name])
+ (-> Ident (Lux (, Int (List Ident) Type)))
+ (do Lux/Monad
+ [=module (find-module module)
+ #let [{#module-aliases _ #defs bindings #imports _ #tags tags-table #types types} =module]]
+ (case (get name tags-table)
+ (#Some output)
+ (return output)
+
+ _
+ (fail (text:++ "Unknown tag: " (ident->text [module name]))))))
+
+(def (resolve-type-tags type)
+ (-> Type (Lux (Maybe (, (List Ident) (List Type)))))
+ (case type
+ (#AppT fun arg)
+ (resolve-type-tags fun)
+
+ (#AllT env name arg body)
+ (resolve-type-tags body)
+
+ (#NamedT [module name] _)
+ (do Lux/Monad
+ [=module (find-module module)
+ #let [{#module-aliases _ #defs bindings #imports _ #tags tags #types types} =module]]
+ (case (get name types)
+ (#Some [tags (#NamedT _ _type)])
+ (case (resolve-struct-type _type)
+ (#Some members)
+ (return (#Some [tags members]))
+
+ _
+ (return #None))
+
+ _
+ (return #None)))
+
+ _
+ (return #None)))
+
(def expected-type
(Lux Type)
(lambda [state]
(let [{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor} state]
(#Right state expected))))
@@ -2450,7 +2526,7 @@
(-> Text (Lux Bool))
(case state
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
(case (get module modules)
@@ -2465,7 +2541,7 @@
(-> Text (Lux (List Text)))
(case state
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
(case (get module modules)
@@ -2477,7 +2553,7 @@
(if export?
(list name)
(list)))))
- (let [{#module-aliases _ #defs defs #imports _ #tags tags} =module]
+ (let [{#module-aliases _ #defs defs #imports _ #tags tags #types types} =module]
defs))]
(#Right state (list:join to-alias)))
@@ -2648,7 +2724,7 @@
(-> Text Compiler (Maybe Type))
(case state
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
(some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
@@ -2683,22 +2759,22 @@
(-> Ident Compiler (Maybe Type))
(let [[v-prefix v-name] name
{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor} state]
(case (get v-prefix modules)
#None
#None
- (#Some {#defs defs #module-aliases _ #imports _ #tags tags})
+ (#Some {#defs defs #module-aliases _ #imports _ #tags tags #types types})
(case (get v-name defs)
#None
#None
- (#Some _ def-data)
+ (#Some [_ def-data])
(case def-data
(#TypeD _) (#Some Type)
- (#ValueD [type _]) (#Some type)
+ (#ValueD type _) (#Some type)
(#MacroD m) (#Some Macro)
(#AliasD name') (find-in-defs name' state))))))
@@ -2720,7 +2796,7 @@
_
(let [{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor} state]
(#Left ($ text:++ "Unknown var: " (ident->text ident) "\n\n" (show-envs envs))))))
@@ -2730,25 +2806,43 @@
_
(let [{#source source #modules modules
- #envs envs #types types #host host
+ #envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor} state]
(#Left ($ text:++ "Unknown var: " (ident->text ident) "\n\n" (show-envs envs))))))
)))
-(def (use-field field-name type)
- (-> Text Type (, AST AST))
- (let [[module name] (split-slot field-name)
- pattern (: AST
- (case (resolve-struct-type type)
- (#Some (#TupleT slots))
- (record$ (map (: (-> (, Text Type) (, AST AST))
- (lambda [[sname stype]] (use-field sname stype)))
- slots))
+(def (zip2 xs ys)
+ (All [a b] (-> (List a) (List b) (List (, a b))))
+ (case xs
+ (#Cons x xs')
+ (case ys
+ (#Cons y ys')
+ (list& [x y] (zip2 xs' ys'))
- _
- (symbol$ ["" name])))]
- [(tag$ [module name]) pattern]))
+ _
+ (list))
+
+ _
+ (list)))
+
+(def (use-field [module name] type)
+ (-> Ident Type (Lux (, AST AST)))
+ (do Lux/Monad
+ [output (resolve-type-tags type)
+ pattern (: (Lux AST)
+ (case output
+ (#Some [tags members])
+ (do Lux/Monad
+ [slots (map% Lux/Monad
+ (: (-> (, Ident Type) (Lux (, AST AST)))
+ (lambda [[sname stype]] (use-field sname stype)))
+ (zip2 tags members))]
+ (return (record$ slots)))
+
+ #None
+ (return (symbol$ ["" name]))))]
+ (return [(tag$ [module name]) pattern])))
(defmacro #export (using tokens)
(case tokens
@@ -2756,12 +2850,15 @@
(case struct
(#Meta _ (#SymbolS name))
(do Lux/Monad
- [struct-type (find-var-type name)]
- (case (resolve-struct-type struct-type)
- (#Some (#TupleT slots))
- (let [pattern (record$ (map (: (-> (, Text Type) (, AST AST))
- (lambda [[sname stype]] (use-field sname stype)))
- slots))]
+ [struct-type (find-var-type name)
+ output (resolve-type-tags struct-type)]
+ (case output
+ (#Some [tags members])
+ (do Lux/Monad
+ [slots (map% Lux/Monad (: (-> (, Ident Type) (Lux (, AST AST)))
+ (lambda [[sname stype]] (use-field sname stype)))
+ (zip2 tags members))
+ #let [pattern (record$ slots)]]
(return (list (` (_lux_case (~ struct) (~ pattern) (~ body))))))
_
@@ -2798,73 +2895,82 @@
_
(fail "Wrong syntax for cond"))))
+(def (enumerate' idx xs)
+ (All [a] (-> Int (List a) (List (, Int a))))
+ (case xs
+ (#Cons x xs')
+ (#Cons [idx x] (enumerate' (i+ 1 idx) xs'))
+
+ #Nil
+ #Nil))
+
+(def (enumerate xs)
+ (All [a] (-> (List a) (List (, Int a))))
+ (enumerate' 0 xs))
+
(defmacro #export (get@ tokens)
(case tokens
(\ (list (#Meta _ (#TagS slot')) record))
- (case record
- (#Meta _ (#SymbolS name))
- (do Lux/Monad
- [type (find-var-type name)
- g!blank (gensym "")
- g!output (gensym "")]
- (case (resolve-struct-type type)
- (#Some (#TupleT slots))
- (do Lux/Monad
- [slot (normalize slot')]
- (let [[s-prefix s-name] (: Ident slot)
- pattern (record$ (map (: (-> (, Text Type) (, AST AST))
- (lambda [slot]
- (let [[r-slot-name r-type] slot
- [r-prefix r-name] (split-slot r-slot-name)]
- [(tag$ [r-prefix r-name]) (if (and (text:= s-prefix r-prefix)
- (text:= s-name r-name))
- g!output
- g!blank)])))
- slots))]
- (return (list (` (_lux_case (~ record) (~ pattern) (~ g!output)))))))
+ (do Lux/Monad
+ [slot (normalize slot')
+ output (resolve-tag slot)
+ #let [[idx tags type] output]
+ g!_ (gensym "_")
+ g!output (gensym "")]
+ (case (resolve-struct-type type)
+ (#Some members)
+ (let [pattern (record$ (map (: (-> (, Ident (, Int Type)) (, AST AST))
+ (lambda [[[r-prefix r-name] [r-idx r-type]]]
+ [(tag$ [r-prefix r-name]) (if (i= idx r-idx)
+ g!output
+ g!_)]))
+ (zip2 tags (enumerate members))))]
+ (return (list (` (_lux_case (~ record) (~ pattern) (~ g!output))))))
- _
- (fail "get@ can only use records.")))
-
- _
- (do Lux/Monad
- [_record (gensym "")]
- (return (list (` (let [(~ _record) (~ record)]
- (get@ (~ (tag$ slot')) (~ _record))))))))
+ _
+ (fail "get@ can only use records.")))
_
(fail "Wrong syntax for get@")))
-(def (open-field prefix field-name source type)
- (-> Text Text AST Type (List AST))
- (let [[module name] (split-slot field-name)
- source+ (: AST (` (get@ (~ (tag$ [module name])) (~ source))))]
- (case (resolve-struct-type type)
- (#Some (#TupleT slots))
- (list:join (map (: (-> (, Text Type) (List AST))
+(def (open-field prefix [module name] source type)
+ (-> Text Ident AST Type (Lux (List AST)))
+ (do Lux/Monad
+ [output (resolve-type-tags type)
+ #let [source+ (: AST (` (get@ (~ (tag$ [module name])) (~ source))))]]
+ (case output
+ (#Some [tags members])
+ (do Lux/Monad
+ [decls' (map% Lux/Monad
+ (: (-> (, Ident Type) (Lux (List AST)))
(lambda [[sname stype]] (open-field prefix sname source+ stype)))
- slots))
+ (zip2 tags members))]
+ (return (list:join decls')))
_
- (list (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+)))))))
+ (return (list (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+))))))))
(defmacro #export (open tokens)
(case tokens
(\ (list& (#Meta _ (#SymbolS struct-name)) tokens'))
(do Lux/Monad
- [#let [prefix (case tokens'
+ [@module get-module-name
+ #let [prefix (case tokens'
(\ (list (#Meta _ (#TextS prefix))))
prefix
_
"")]
struct-type (find-var-type struct-name)
+ output (resolve-type-tags struct-type)
#let [source (symbol$ struct-name)]]
- (case (resolve-struct-type struct-type)
- (#Some (#TupleT slots))
- (return (list:join (map (: (-> (, Text Type) (List AST))
- (lambda [[sname stype]] (open-field prefix sname source stype)))
- slots)))
+ (case output
+ (#Some [tags members])
+ (do Lux/Monad
+ [decls' (map% Lux/Monad (: (-> (, Ident Type) (Lux (List AST)))
+ (lambda [[sname stype]] (open-field prefix sname source stype)))
+ (zip2 tags members))]
+ (return (list:join decls')))
_
(fail "Can only \"open\" records.")))
@@ -2911,47 +3017,34 @@
(defmacro #export (set@ tokens)
(case tokens
(\ (list (#Meta _ (#TagS slot')) value record))
- (case record
- (#Meta _ (#SymbolS name))
- (do Lux/Monad
- [type (find-var-type name)]
- (case (resolve-struct-type type)
- (#Some (#TupleT slots))
- (do Lux/Monad
- [pattern' (map% Lux/Monad
- (: (-> (, Text Type) (Lux (, Text AST)))
- (lambda [slot]
- (let [[r-slot-name r-type] slot]
- (do Lux/Monad
- [g!slot (gensym "")]
- (return [r-slot-name g!slot])))))
- slots)
- slot (normalize slot')]
- (let [[s-prefix s-name] (: Ident slot)
- pattern (record$ (map (: (-> (, Text AST) (, AST AST))
- (lambda [slot]
- (let [[r-slot-name r-var] slot]
- [(tag$ (split-slot r-slot-name)) r-var])))
- pattern'))
- output (record$ (map (: (-> (, Text AST) (, AST AST))
- (lambda [slot]
- (let [[r-slot-name r-var] slot
- [r-prefix r-name] (split-slot r-slot-name)]
- [(tag$ [r-prefix r-name]) (if (and (text:= s-prefix r-prefix)
- (text:= s-name r-name))
- value
- r-var)])))
- pattern'))]
- (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
+ (do Lux/Monad
+ [slot (normalize slot')
+ output (resolve-tag slot)
+ #let [[idx tags type] output]]
+ (case (resolve-struct-type type)
+ (#Some members)
+ (do Lux/Monad
+ [pattern' (map% Lux/Monad
+ (: (-> (, Ident (, Int Type)) (Lux (, Ident Int AST)))
+ (lambda [[r-slot-name [r-idx r-type]]]
+ (do Lux/Monad
+ [g!slot (gensym "")]
+ (return [r-slot-name r-idx g!slot]))))
+ (zip2 tags (enumerate members)))]
+ (let [pattern (record$ (map (: (-> (, Ident Int AST) (, AST AST))
+ (lambda [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name) r-var]))
+ pattern'))
+ output (record$ (map (: (-> (, Ident Int AST) (, AST AST))
+ (lambda [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name) (if (i= idx r-idx)
+ value
+ r-var)]))
+ pattern'))]
+ (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
- _
- (fail "set@ can only use records.")))
-
- _
- (do Lux/Monad
- [_record (gensym "")]
- (return (list (` (let [(~ _record) (~ record)]
- (set@ (~ (tag$ slot')) (~ value) (~ _record))))))))
+ _
+ (fail "set@ can only use records.")))
_
(fail "Wrong syntax for set@")))
@@ -2959,47 +3052,34 @@
(defmacro #export (update@ tokens)
(case tokens
(\ (list (#Meta _ (#TagS slot')) fun record))
- (case record
- (#Meta _ (#SymbolS name))
- (do Lux/Monad
- [type (find-var-type name)]
- (case (resolve-struct-type type)
- (#Some (#TupleT slots))
- (do Lux/Monad
- [pattern' (map% Lux/Monad
- (: (-> (, Text Type) (Lux (, Text AST)))
- (lambda [slot]
- (let [[r-slot-name r-type] slot]
- (do Lux/Monad
- [g!slot (gensym "")]
- (return [r-slot-name g!slot])))))
- slots)
- slot (normalize slot')]
- (let [[s-prefix s-name] (: Ident slot)
- pattern (record$ (map (: (-> (, Text AST) (, AST AST))
- (lambda [slot]
- (let [[r-slot-name r-var] slot]
- [(tag$ (split-slot r-slot-name)) r-var])))
- pattern'))
- output (record$ (map (: (-> (, Text AST) (, AST AST))
- (lambda [slot]
- (let [[r-slot-name r-var] slot
- [r-prefix r-name] (split-slot r-slot-name)]
- [(tag$ [r-prefix r-name]) (if (and (text:= s-prefix r-prefix)
- (text:= s-name r-name))
- (` ((~ fun) (~ r-var)))
- r-var)])))
- pattern'))]
- (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
+ (do Lux/Monad
+ [slot (normalize slot')
+ output (resolve-tag slot)
+ #let [[idx tags type] output]]
+ (case (resolve-struct-type type)
+ (#Some members)
+ (do Lux/Monad
+ [pattern' (map% Lux/Monad
+ (: (-> (, Ident (, Int Type)) (Lux (, Ident Int AST)))
+ (lambda [[r-slot-name [r-idx r-type]]]
+ (do Lux/Monad
+ [g!slot (gensym "")]
+ (return [r-slot-name r-idx g!slot]))))
+ (zip2 tags (enumerate members)))]
+ (let [pattern (record$ (map (: (-> (, Ident Int AST) (, AST AST))
+ (lambda [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name) r-var]))
+ pattern'))
+ output (record$ (map (: (-> (, Ident Int AST) (, AST AST))
+ (lambda [[r-slot-name r-idx r-var]]
+ [(tag$ r-slot-name) (if (i= idx r-idx)
+ (` ((~ fun) (~ r-var)))
+ r-var)]))
+ pattern'))]
+ (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
- _
- (fail "update@ can only use records.")))
-
- _
- (do Lux/Monad
- [_record (gensym "")]
- (return (list (` (let [(~ _record) (~ record)]
- (update@ (~ (tag$ slot')) (~ fun) (~ _record))))))))
+ _
+ (fail "update@ can only use records.")))
_
(fail "Wrong syntax for update@")))
@@ -3053,25 +3133,25 @@
(-> Type AST)
(case type
(#DataT name)
- (` (#DataT (~ (text$ name))))
+ (` (#;DataT (~ (text$ name))))
- (#VariantT cases)
- (` (#VariantT (~ (untemplate-list (map type->syntax cases)))))
+ (#;VariantT cases)
+ (` (#;VariantT (~ (untemplate-list (map type->syntax cases)))))
(#TupleT parts)
- (` (#TupleT (~ (untemplate-list (map type->syntax parts)))))
+ (` (#;TupleT (~ (untemplate-list (map type->syntax parts)))))
(#LambdaT in out)
- (` (#LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
+ (` (#;LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
(#BoundT name)
- (` (#BoundT (~ (text$ name))))
+ (` (#;BoundT (~ (text$ name))))
(#VarT id)
- (` (#VarT (~ (int$ id))))
+ (` (#;VarT (~ (int$ id))))
(#ExT id)
- (` (#ExT (~ (int$ id))))
+ (` (#;ExT (~ (int$ id))))
(#AllT env name arg type)
(let [env' (: AST
@@ -3081,13 +3161,13 @@
(lambda [[label type]]
(tuple$ (list (text$ label) (type->syntax type)))))
_env)))))))]
- (` (#AllT (~ env') (~ (text$ name)) (~ (text$ arg)) (~ (type->syntax type)))))
+ (` (#;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))))))
+ (` (#;NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
(defmacro #export (loop tokens)
(case tokens
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux
index 8eb87c00b..7898e998d 100644
--- a/source/lux/codata/function.lux
+++ b/source/lux/codata/function.lux
@@ -26,5 +26,5 @@
## [Structures]
(defstruct #export Comp/Monoid (All [a] (m;Monoid (-> a a)))
- (def unit id)
- (def ++ .))
+ (def m;unit id)
+ (def m;++ .))
diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux
index de5c40eef..893c74d9e 100644
--- a/source/lux/codata/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -9,8 +9,8 @@
(;import lux
(lux (meta macro
ast)
- (control functor
- monad)
+ (control (functor #as F #refer #all)
+ (monad #as M #refer #all))
(data list))
(.. function))
@@ -37,13 +37,13 @@
## [Structs]
(defstruct #export Lazy/Functor (Functor Lazy)
- (def (map f ma)
+ (def (F;map f ma)
(lambda [k] (ma (. k f)))))
(defstruct #export Lazy/Monad (Monad Lazy)
- (def _functor Lazy/Functor)
+ (def M;_functor Lazy/Functor)
- (def (wrap a)
+ (def (M;wrap a)
(... a))
- (def join !))
+ (def M;join !))
diff --git a/source/lux/codata/reader.lux b/source/lux/codata/reader.lux
index ee1798793..e91687c3a 100644
--- a/source/lux/codata/reader.lux
+++ b/source/lux/codata/reader.lux
@@ -7,8 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import (lux #refer (#exclude Reader))
- (lux/control functor
- monad))
+ (lux/control (functor #as F #refer #all)
+ (monad #as M #refer #all)))
## [Types]
(deftype #export (Reader r a)
@@ -17,17 +17,17 @@
## [Structures]
(defstruct #export Reader/Functor (All [r]
(Functor (Reader r)))
- (def (map f fa)
+ (def (F;map f fa)
(lambda [env]
(f (fa env)))))
(defstruct #export Reader/Monad (All [r]
(Monad (Reader r)))
- (def _functor Reader/Functor)
+ (def M;_functor Reader/Functor)
- (def (wrap x)
+ (def (M;wrap x)
(lambda [env] x))
- (def (join mma)
+ (def (M;join mma)
(lambda [env]
(mma env env))))
diff --git a/source/lux/codata/state.lux b/source/lux/codata/state.lux
index c6fd8397d..bc9858a29 100644
--- a/source/lux/codata/state.lux
+++ b/source/lux/codata/state.lux
@@ -7,8 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control functor
- monad))
+ (lux/control (functor #as F #refer #all)
+ (monad #as M #refer #all)))
## [Types]
(deftype #export (State s a)
@@ -16,20 +16,20 @@
## [Structures]
(defstruct #export State/Functor (Functor State)
- (def (map f ma)
+ (def (F;map f ma)
(lambda [state]
(let [[state' a] (ma state)]
[state' (f a)]))))
(defstruct #export State/Monad (All [s]
(Monad (State s)))
- (def _functor State/Functor)
+ (def M;_functor State/Functor)
- (def (wrap x)
+ (def (M;wrap x)
(lambda [state]
[state x]))
- (def (join mma)
+ (def (M;join mma)
(lambda [state]
(let [[state' ma] (mma state)]
(ma state')))))
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 728adc174..64491eb5c 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -113,14 +113,14 @@
## [Structures]
(defstruct #export Stream/Functor (Functor Stream)
- (def (map f fa)
+ (def (F;map f fa)
(let [[h t] (! fa)]
(... [(f h) (map f t)]))))
(defstruct #export Stream/CoMonad (CoMonad Stream)
- (def _functor Stream/Functor)
- (def unwrap head)
- (def (split wa)
+ (def CM;_functor Stream/Functor)
+ (def CM;unwrap head)
+ (def (CM;split wa)
(:: Stream/Functor (F;map repeat wa))))
## [Pattern-matching]
diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux
index 8f7a3bd13..92f5486ef 100644
--- a/source/lux/data/bool.lux
+++ b/source/lux/data/bool.lux
@@ -14,19 +14,19 @@
## [Structures]
(defstruct #export Bool/Eq (E;Eq Bool)
- (def (= x y)
+ (def (E;= x y)
(if x
y
(not y))))
(defstruct #export Bool/Show (S;Show Bool)
- (def (show x)
+ (def (S;show x)
(if x "true" "false")))
(do-template [<name> <unit> <op>]
[(defstruct #export <name> (m;Monoid Bool)
- (def unit <unit>)
- (def (++ x y)
+ (def m;unit <unit>)
+ (def (m;++ x y)
(<op> x y)))]
[ Or/Monoid false or]
diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux
index 04579c3a7..b97ec644d 100644
--- a/source/lux/data/char.lux
+++ b/source/lux/data/char.lux
@@ -13,9 +13,9 @@
## [Structures]
(defstruct #export Char/Eq (E;Eq Char)
- (def (= x y)
+ (def (E;= x y)
(_jvm_ceq x y)))
(defstruct #export Char/Show (S;Show Char)
- (def (show x)
+ (def (S;show x)
($ text:++ "#\"" (_jvm_invokevirtual "java.lang.Object" "toString" [] x []) "\"")))
diff --git a/source/lux/data/error.lux b/source/lux/data/error.lux
index 7388dd786..cb5c309a6 100644
--- a/source/lux/data/error.lux
+++ b/source/lux/data/error.lux
@@ -17,18 +17,18 @@
## [Structures]
(defstruct #export Error/Functor (Functor Error)
- (def (map f ma)
+ (def (F;map f ma)
(case ma
(#Fail msg) (#Fail msg)
(#Ok datum) (#Ok (f datum)))))
(defstruct #export Error/Monad (Monad Error)
- (def _functor Error/Functor)
+ (def M;_functor Error/Functor)
- (def (wrap a)
+ (def (M;wrap a)
(#Ok a))
- (def (join mma)
+ (def (M;join mma)
(case mma
(#Fail msg) (#Fail msg)
(#Ok ma) ma)))
diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux
index 58e7360b8..3ad6b056b 100644
--- a/source/lux/data/id.lux
+++ b/source/lux/data/id.lux
@@ -17,16 +17,16 @@
## [Structures]
(defstruct #export Id/Functor (Functor Id)
- (def (map f fa)
+ (def (F;map f fa)
(let [(#Id a) fa]
(#Id (f a)))))
(defstruct #export Id/Monad (Monad Id)
- (def _functor Id/Functor)
- (def (wrap a) (#Id a))
- (def (join mma) (let [(#Id ma) mma] ma)))
+ (def M;_functor Id/Functor)
+ (def (M;wrap a) (#Id a))
+ (def (M;join mma) (let [(#Id ma) mma] ma)))
(defstruct #export Id/CoMonad (CoMonad Id)
- (def _functor Id/Functor)
- (def (unwrap wa) (let [(#Id a) wa] a))
- (def (split wa) (#Id wa)))
+ (def CM;_functor Id/Functor)
+ (def (CM;unwrap wa) (let [(#Id a) wa] a))
+ (def (CM;split wa) (#Id wa)))
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
index ae71f9f34..f03dbddc6 100644
--- a/source/lux/data/io.lux
+++ b/source/lux/data/io.lux
@@ -30,16 +30,16 @@
## [Structures]
(defstruct #export IO/Functor (F;Functor IO)
- (def (map f ma)
+ (def (F;map f ma)
(io (f (ma [])))))
(defstruct #export IO/Monad (M;Monad IO)
- (def _functor IO/Functor)
+ (def M;_functor IO/Functor)
- (def (wrap x)
+ (def (M;wrap x)
(io x))
- (def (join mma)
+ (def (M;join mma)
(mma [])))
## [Functions]
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 87afe7fe9..5a8357251 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -258,30 +258,30 @@
(defstruct #export List/Monoid (All [a]
(Monoid (List a)))
- (def unit #;Nil)
- (def (++ xs ys)
+ (def m;unit #;Nil)
+ (def (m;++ xs ys)
(case xs
#;Nil ys
(#;Cons [x xs']) (#;Cons [x (++ xs' ys)]))))
(defstruct #export List/Functor (Functor List)
- (def (map f ma)
+ (def (F;map f ma)
(case ma
#;Nil #;Nil
(#;Cons [a ma']) (#;Cons [(f a) (map f ma')]))))
(defstruct #export List/Monad (Monad List)
- (def _functor List/Functor)
+ (def M;_functor List/Functor)
- (def (wrap a)
+ (def (M;wrap a)
(#;Cons [a #;Nil]))
- (def (join mma)
+ (def (M;join mma)
(using List/Monoid
(foldL ++ unit mma))))
(defstruct #export PList/Dict (Dict PList)
- (def (get k (#PList [eq kvs]))
+ (def (D;get k (#PList [eq kvs]))
(loop [kvs kvs]
(case kvs
#;Nil
@@ -292,7 +292,7 @@
(#;Some v')
(recur kvs')))))
- (def (put k v (#PList [eq kvs]))
+ (def (D;put k v (#PList [eq kvs]))
(#PList [eq (loop [kvs kvs]
(case kvs
#;Nil
@@ -303,7 +303,7 @@
(#;Cons [k v] kvs')
(#;Cons [k' v'] (recur kvs')))))]))
- (def (remove k (#PList [eq kvs]))
+ (def (D;remove k (#PList [eq kvs]))
(#PList [eq (loop [kvs kvs]
(case kvs
#;Nil
@@ -315,18 +315,18 @@
(#;Cons [[k' v'] (recur kvs')]))))])))
(defstruct #export List/Stack (S;Stack List)
- (def empty (list))
- (def (empty? xs)
+ (def S;empty (list))
+ (def (S;empty? xs)
(case xs
#;Nil true
_ false))
- (def (push x xs)
+ (def (S;push x xs)
(#;Cons x xs))
- (def (pop xs)
+ (def (S;pop xs)
(case xs
#;Nil #;None
(#;Cons x xs') (#;Some xs')))
- (def (top xs)
+ (def (S;top xs)
(case xs
#;Nil #;None
(#;Cons x xs') (#;Some x))))
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index e23dbe291..9405c3a60 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -20,26 +20,26 @@
## (#;Some a)))
## [Structures]
-(defstruct #export Maybe/Monoid (Monoid Maybe)
- (def unit #;None)
- (def (++ xs ys)
+(defstruct #export Maybe/Monoid (All [a] (Monoid (Maybe a)))
+ (def m;unit #;None)
+ (def (m;++ xs ys)
(case xs
#;None ys
(#;Some x) (#;Some x))))
(defstruct #export Maybe/Functor (Functor Maybe)
- (def (map f ma)
+ (def (F;map f ma)
(case ma
#;None #;None
(#;Some a) (#;Some (f a)))))
(defstruct #export Maybe/Monad (Monad Maybe)
- (def _functor Maybe/Functor)
+ (def M;_functor Maybe/Functor)
- (def (wrap x)
+ (def (M;wrap x)
(#;Some x))
- (def (join mma)
+ (def (M;join mma)
(case mma
#;None #;None
(#;Some xs) xs)))
diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux
index f3c81ef4e..35c8d34bf 100644
--- a/source/lux/data/number/int.lux
+++ b/source/lux/data/number/int.lux
@@ -18,20 +18,20 @@
## Number
(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
[(defstruct #export <name> (N;Number <type>)
- (def (+ x y) (<+> x y))
- (def (- x y) (<-> x y))
- (def (* x y) (<*> x y))
- (def (/ x y) (</> x y))
- (def (% x y) (<%> x y))
- (def (from-int x)
+ (def (N;+ x y) (<+> x y))
+ (def (N;- x y) (<-> x y))
+ (def (N;* x y) (<*> x y))
+ (def (N;/ x y) (</> x y))
+ (def (N;% x y) (<%> x y))
+ (def (N;from-int x)
(<from> x))
- (def (negate x)
+ (def (N;negate x)
(<*> <-1> x))
- (def (abs x)
+ (def (N;abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (signum x)
+ (def (N;signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
@@ -42,18 +42,18 @@
## Eq
(defstruct #export Int/Eq (E;Eq Int)
- (def (= x y) (_jvm_leq x y)))
+ (def (E;= x y) (_jvm_leq x y)))
## Ord
(do-template [<name> <type> <eq> <=> <lt> <gt>]
[(defstruct #export <name> (O;Ord <type>)
- (def _eq <eq>)
- (def (< x y) (<lt> x y))
- (def (<= x y)
+ (def O;_eq <eq>)
+ (def (O;< x y) (<lt> x y))
+ (def (O;<= x y)
(or (<lt> x y)
(<=> x y)))
- (def (> x y) (<gt> x y))
- (def (>= x y)
+ (def (O;> x y) (<gt> x y))
+ (def (O;>= x y)
(or (<gt> x y)
(<=> x y))))]
@@ -62,16 +62,16 @@
## Bounded
(do-template [<name> <type> <top> <bottom>]
[(defstruct #export <name> (B;Bounded <type>)
- (def top <top>)
- (def bottom <bottom>))]
+ (def B;top <top>)
+ (def B;bottom <bottom>))]
[ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")])
## Monoid
(do-template [<name> <type> <unit> <++>]
[(defstruct #export <name> (m;Monoid <type>)
- (def unit <unit>)
- (def (++ x y) (<++> x y)))]
+ (def m;unit <unit>)
+ (def (m;++ x y) (<++> x y)))]
[ IntAdd/Monoid Int 0 _jvm_ladd]
[ IntMul/Monoid Int 1 _jvm_lmul]
@@ -82,7 +82,7 @@
## Show
(do-template [<name> <type> <body>]
[(defstruct #export <name> (S;Show <type>)
- (def (show x)
+ (def (S;show x)
<body>))]
[ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
diff --git a/source/lux/data/number/real.lux b/source/lux/data/number/real.lux
index 9ba05df62..4f9e4fa5f 100644
--- a/source/lux/data/number/real.lux
+++ b/source/lux/data/number/real.lux
@@ -18,20 +18,20 @@
## Number
(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
[(defstruct #export <name> (N;Number <type>)
- (def (+ x y) (<+> x y))
- (def (- x y) (<-> x y))
- (def (* x y) (<*> x y))
- (def (/ x y) (</> x y))
- (def (% x y) (<%> x y))
- (def (from-int x)
+ (def (N;+ x y) (<+> x y))
+ (def (N;- x y) (<-> x y))
+ (def (N;* x y) (<*> x y))
+ (def (N;/ x y) (</> x y))
+ (def (N;% x y) (<%> x y))
+ (def (N;from-int x)
(<from> x))
- (def (negate x)
+ (def (N;negate x)
(<*> <-1> x))
- (def (abs x)
+ (def (N;abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (signum x)
+ (def (N;signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
@@ -42,18 +42,18 @@
## Eq
(defstruct #export Real/Eq (E;Eq Real)
- (def (= x y) (_jvm_deq x y)))
+ (def (E;= x y) (_jvm_deq x y)))
## Ord
(do-template [<name> <type> <eq> <=> <lt> <gt>]
[(defstruct #export <name> (O;Ord <type>)
- (def _eq <eq>)
- (def (< x y) (<lt> x y))
- (def (<= x y)
+ (def O;_eq <eq>)
+ (def (O;< x y) (<lt> x y))
+ (def (O;<= x y)
(or (<lt> x y)
(<=> x y)))
- (def (> x y) (<gt> x y))
- (def (>= x y)
+ (def (O;> x y) (<gt> x y))
+ (def (O;>= x y)
(or (<gt> x y)
(<=> x y))))]
@@ -62,16 +62,16 @@
## Bounded
(do-template [<name> <type> <top> <bottom>]
[(defstruct #export <name> (B;Bounded <type>)
- (def top <top>)
- (def bottom <bottom>))]
+ (def B;top <top>)
+ (def B;bottom <bottom>))]
[Real/Bounded Real (_jvm_getstatic "java.lang.Double" "MAX_VALUE") (_jvm_getstatic "java.lang.Double" "MIN_VALUE")])
## Monoid
(do-template [<name> <type> <unit> <++>]
[(defstruct #export <name> (m;Monoid <type>)
- (def unit <unit>)
- (def (++ x y) (<++> x y)))]
+ (def m;unit <unit>)
+ (def (m;++ x y) (<++> x y)))]
[RealAdd/Monoid Real 0.0 _jvm_dadd]
[RealMul/Monoid Real 1.0 _jvm_dmul]
@@ -82,7 +82,7 @@
## Show
(do-template [<name> <type> <body>]
[(defstruct #export <name> (S;Show <type>)
- (def (show x)
+ (def (S;show x)
<body>))]
[Real/Show Real (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index 81a642698..d1c06b6a7 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -118,12 +118,12 @@
## [Structures]
(defstruct #export Text/Eq (E;Eq Text)
- (def (= x y)
+ (def (E;= x y)
(_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"]
x [y])))
(defstruct #export Text/Ord (O;Ord Text)
- (def _eq Text/Eq)
+ (def O;_eq Text/Eq)
(do-template [<name> <op>]
[(def (<name> x y)
@@ -131,17 +131,17 @@
x [y]))
0))]
- [< i<]
- [<= i<=]
- [> i>]
- [>= i>=]))
+ [O;< i<]
+ [O;<= i<=]
+ [O;> i>]
+ [O;>= i>=]))
(defstruct #export Text/Show (S;Show Text)
- (def show id))
+ (def S;show id))
(defstruct #export Text/Monoid (m;Monoid Text)
- (def unit "")
- (def (++ x y)
+ (def m;unit "")
+ (def (m;++ x y)
(_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"]
x [y])))
diff --git a/source/lux/data/writer.lux b/source/lux/data/writer.lux
index 7c6831e85..f71492e35 100644
--- a/source/lux/data/writer.lux
+++ b/source/lux/data/writer.lux
@@ -18,17 +18,17 @@
## [Structures]
(defstruct #export Writer/Functor (All [l]
(Functor (Writer l)))
- (def (map f fa)
+ (def (F;map f fa)
(let [[log datum] fa]
[log (f datum)])))
(defstruct #export (Writer/Monad mon) (All [l]
(-> (Monoid l) (Monad (Writer l))))
- (def _functor Writer/Functor)
+ (def M;_functor Writer/Functor)
- (def (wrap x)
+ (def (M;wrap x)
[(:: mon m;unit) x])
- (def (join mma)
+ (def (M;join mma)
(let [[log1 [log2 a]] mma]
[(:: mon (m;++ log1 log2)) a])))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index d1bc4e219..057345622 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -29,7 +29,7 @@
## [Structures]
(defstruct #export Lux/Functor (F;Functor Lux)
- (def (map f fa)
+ (def (F;map f fa)
(lambda [state]
(case (fa state)
(#;Left msg)
@@ -39,11 +39,11 @@
(#;Right [state' (f a)])))))
(defstruct #export Lux/Monad (M;Monad Lux)
- (def _functor Lux/Functor)
- (def (wrap x)
+ (def M;_functor Lux/Functor)
+ (def (M;wrap x)
(lambda [state]
(#;Right [state x])))
- (def (join mma)
+ (def (M;join mma)
(lambda [state]
(case (mma state)
(#;Left msg)
@@ -254,7 +254,7 @@
(let [vname' (ident->text name)]
(case state
{#;source source #;modules modules
- #;envs envs #;types types #;host host
+ #;envs envs #;type-vars types #;host host
#;seed seed #;eval? eval? #;expected expected
#;cursor cursor}
(some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
@@ -275,14 +275,14 @@
(-> Ident Compiler (Maybe Type))
(let [[v-prefix v-name] name
{#;source source #;modules modules
- #;envs envs #;types types #;host host
+ #;envs envs #;type-vars types #;host host
#;seed seed #;eval? eval? #;expected expected
#;cursor cursor} state]
(case (get v-prefix modules)
#;None
#;None
- (#;Some {#;defs defs #;module-aliases _ #;imports _})
+ (#;Some {#;defs defs #;module-aliases _ #;imports _ #;tags _ #;types _})
(case (get v-name defs)
#;None
#;None
@@ -311,7 +311,7 @@
_
(let [{#;source source #;modules modules
- #;envs envs #;types types #;host host
+ #;envs envs #;type-vars types #;host host
#;seed seed #;eval? eval? #;expected expected
#;cursor cursor} state]
(#;Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs))))))))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index f1644cdb5..b9834f972 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -38,7 +38,7 @@
## [Structures]
(defstruct #export Parser/Functor (F;Functor Parser)
- (def (map f ma)
+ (def (F;map f ma)
(lambda [tokens]
(case (ma tokens)
#;None
@@ -48,12 +48,12 @@
(#;Some [tokens' (f a)])))))
(defstruct #export Parser/Monad (M;Monad Parser)
- (def _functor Parser/Functor)
+ (def M;_functor Parser/Functor)
- (def (wrap x tokens)
+ (def (M;wrap x tokens)
(#;Some [tokens x]))
- (def (join mma)
+ (def (M;join mma)
(lambda [tokens]
(case (mma tokens)
#;None
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 12:05:04 +0000