aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux2069
-rw-r--r--source/program.lux8
-rw-r--r--src/lux.clj5
-rw-r--r--src/lux/analyser.clj1
-rw-r--r--src/lux/analyser/lux.clj86
-rw-r--r--src/lux/base.clj20
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/lux.clj9
-rw-r--r--src/lux/lexer.clj56
-rw-r--r--src/lux/reader.clj75
-rw-r--r--src/lux/type.clj128
11 files changed, 1301 insertions, 1160 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 1385cf8a5..e3f3ba243 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -37,22 +37,22 @@
## (| #Nil
## (#Cons (, a (List a)))))
(_lux_def List
- (#AllT [#None "List" "a"
- (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)]
- (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a")
- (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")])
- #Nil])]))]
- #Nil])]))]))
+ (#AllT [#None "List" "a"
+ (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)]
+ (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a")
+ (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")])
+ #Nil])]))]
+ #Nil])]))]))
(_lux_export List)
## (deftype (Maybe a)
## (| #None
## (#Some a)))
(_lux_def Maybe
- (#AllT [#None "Maybe" "a"
- (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
- (#Cons [["lux;Some" (#BoundT "a")]
- #Nil])]))]))
+ (#AllT [#None "Maybe" "a"
+ (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
+ (#Cons [["lux;Some" (#BoundT "a")]
+ #Nil])]))]))
(_lux_export Maybe)
## (deftype #rec Type
@@ -66,37 +66,37 @@
## (#AllT (, (Maybe (List (, Text Type))) Text Text Type))
## (#AppT (, Type Type))))
(_lux_def Type
- (_lux_case (#AppT [(#BoundT "Type") (#BoundT "_")])
- Type
- (_lux_case (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))])
- TypeEnv
- (#AppT [(#AllT [#None "Type" "_"
- (#VariantT (#Cons [["lux;DataT" Text]
- (#Cons [["lux;TupleT" (#AppT [List Type])]
- (#Cons [["lux;VariantT" TypeEnv]
- (#Cons [["lux;RecordT" TypeEnv]
- (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
- (#Cons [["lux;BoundT" Text]
- (#Cons [["lux;VarT" 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;ExT" Int]
- #Nil])])])])])])])])])]))])
- Void]))))
+ (_lux_case (#AppT [(#BoundT "Type") (#BoundT "_")])
+ Type
+ (_lux_case (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))])
+ TypeEnv
+ (#AppT [(#AllT [#None "Type" "_"
+ (#VariantT (#Cons [["lux;DataT" Text]
+ (#Cons [["lux;TupleT" (#AppT [List Type])]
+ (#Cons [["lux;VariantT" TypeEnv]
+ (#Cons [["lux;RecordT" TypeEnv]
+ (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
+ (#Cons [["lux;BoundT" Text]
+ (#Cons [["lux;VarT" 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;ExT" Int]
+ #Nil])])])])])])])])])]))])
+ Void]))))
(_lux_export Type)
## (deftype (Bindings k v)
## (& #counter Int
## #mappings (List (, k v))))
(_lux_def Bindings
- (#AllT [#None "Bindings" "k"
- (#AllT [#None "" "v"
- (#RecordT (#Cons [["lux;counter" Int]
- (#Cons [["lux;mappings" (#AppT [List
- (#TupleT (#Cons [(#BoundT "k")
- (#Cons [(#BoundT "v")
- #Nil])]))])]
- #Nil])]))])]))
+ (#AllT [#None "Bindings" "k"
+ (#AllT [#None "" "v"
+ (#RecordT (#Cons [["lux;counter" Int]
+ (#Cons [["lux;mappings" (#AppT [List
+ (#TupleT (#Cons [(#BoundT "k")
+ (#Cons [(#BoundT "v")
+ #Nil])]))])]
+ #Nil])]))])]))
## (deftype (Env k v)
## (& #name Text
@@ -104,30 +104,30 @@
## #locals (Bindings k v)
## #closure (Bindings k v)))
(_lux_def Env
- (#AllT [#None "Env" "k"
- (#AllT [#None "" "v"
- (#RecordT (#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])])])]))])]))
+ (#AllT [#None "Env" "k"
+ (#AllT [#None "" "v"
+ (#RecordT (#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])])])]))])]))
## (deftype Cursor
## (, Text Int Int))
(_lux_def Cursor
- (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))
+ (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))
## (deftype (Meta m v)
## (| (#Meta (, m v))))
(_lux_def Meta
- (#AllT [#None "Meta" "m"
- (#AllT [#None "" "v"
- (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
- (#Cons [(#BoundT "v")
- #Nil])]))]
- #Nil]))])]))
+ (#AllT [#None "Meta" "m"
+ (#AllT [#None "" "v"
+ (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
+ (#Cons [(#BoundT "v")
+ #Nil])]))]
+ #Nil]))])]))
(_lux_export Meta)
## (deftype (Syntax' w)
@@ -142,34 +142,34 @@
## (#TupleS (List (w (Syntax' w))))
## (#RecordS (List (, (w (Syntax' w)) (w (Syntax' w)))))))
(_lux_def Syntax'
- (_lux_case (#AppT [(#BoundT "w")
- (#AppT [(#BoundT "Syntax'")
- (#BoundT "w")])])
- Syntax
- (_lux_case (#AppT [List Syntax])
- SyntaxList
- (#AllT [#None "Syntax'" "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" SyntaxList]
- (#Cons [["lux;TupleS" SyntaxList]
- (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
- #Nil])
- ])])])])])])])])])
- )]))))
+ (_lux_case (#AppT [(#BoundT "w")
+ (#AppT [(#BoundT "Syntax'")
+ (#BoundT "w")])])
+ Syntax
+ (_lux_case (#AppT [List Syntax])
+ SyntaxList
+ (#AllT [#None "Syntax'" "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" SyntaxList]
+ (#Cons [["lux;TupleS" SyntaxList]
+ (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
+ #Nil])
+ ])])])])])])])])])
+ )]))))
(_lux_export Syntax')
## (deftype Syntax
## (Meta Cursor (Syntax' (Meta Cursor))))
(_lux_def Syntax
- (_lux_case (#AppT [Meta Cursor])
- w
- (#AppT [w (#AppT [Syntax' w])])))
+ (_lux_case (#AppT [Meta Cursor])
+ w
+ (#AppT [w (#AppT [Syntax' w])])))
(_lux_export Syntax)
(_lux_def SyntaxList (#AppT [List Syntax]))
@@ -178,39 +178,39 @@
## (| (#Left l)
## (#Right r)))
(_lux_def Either
- (#AllT [#None "_" "l"
- (#AllT [#None "" "r"
- (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
- (#Cons [["lux;Right" (#BoundT "r")]
- #Nil])]))])]))
+ (#AllT [#None "_" "l"
+ (#AllT [#None "" "r"
+ (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
+ (#Cons [["lux;Right" (#BoundT "r")]
+ #Nil])]))])]))
(_lux_export Either)
## (deftype (StateE s a)
## (-> s (Either Text (, s a))))
(_lux_def StateE
- (#AllT [#None "StateE" "s"
- (#AllT [#None "" "a"
- (#LambdaT [(#BoundT "s")
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [(#BoundT "s")
- (#Cons [(#BoundT "a")
- #Nil])]))])])])]))
+ (#AllT [#None "StateE" "s"
+ (#AllT [#None "" "a"
+ (#LambdaT [(#BoundT "s")
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [(#BoundT "s")
+ (#Cons [(#BoundT "a")
+ #Nil])]))])])])]))
## (deftype Reader
## (List (Meta Cursor Text)))
(_lux_def Reader
- (#AppT [List
- (#AppT [(#AppT [Meta Cursor])
- Text])]))
+ (#AppT [List
+ (#AppT [(#AppT [Meta Cursor])
+ Text])]))
(_lux_export Reader)
## (deftype HostState
## (& #writer (^ org.objectweb.asm.ClassWriter)
## #loader (^ java.net.URLClassLoader)))
(_lux_def HostState
- (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
- (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
- #Nil])])))
+ (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
+ (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
+ #Nil])])))
## (deftype (DefData' m)
## (| #TypeD
@@ -218,20 +218,20 @@
## (#MacroD m)
## (#AliasD Ident)))
(_lux_def DefData'
- (#AllT [#None "DefData'" ""
- (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
- (#Cons [["lux;ValueD" Type]
- (#Cons [["lux;MacroD" (#BoundT "")]
- (#Cons [["lux;AliasD" Ident]
- #Nil])])])]))]))
+ (#AllT [#None "DefData'" ""
+ (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
+ (#Cons [["lux;ValueD" Type]
+ (#Cons [["lux;MacroD" (#BoundT "")]
+ (#Cons [["lux;AliasD" Ident]
+ #Nil])])])]))]))
## (deftype LuxVar
## (| (#Local Int)
## (#Global Ident)))
(_lux_def LuxVar
- (#VariantT (#Cons [["lux;Local" Int]
- (#Cons [["lux;Global" Ident]
- #Nil])])))
+ (#VariantT (#Cons [["lux;Local" Int]
+ (#Cons [["lux;Global" Ident]
+ #Nil])])))
(_lux_export LuxVar)
## (deftype #rec CompilerState
@@ -242,33 +242,33 @@
## #types (Bindings Int Type)
## #host HostState))
(_lux_def CompilerState
- (#AppT [(#AllT [#None "CompilerState" ""
- (#RecordT (#Cons [["lux;source" Reader]
- (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text
- (#Cons [(#AppT [List (#TupleT (#Cons [Text
- (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
- (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState")
- (#BoundT "")])])
- SyntaxList])])])
- #Nil])]))
- #Nil])]))])
- #Nil])]))])]
- (#Cons [["lux;module-aliases" (#AppT [List Void])]
- (#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;host" HostState]
- (#Cons [["lux;seed" Int]
- #Nil])])])])])])]))])
- Void]))
+ (#AppT [(#AllT [#None "CompilerState" ""
+ (#RecordT (#Cons [["lux;source" Reader]
+ (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text
+ (#Cons [(#AppT [List (#TupleT (#Cons [Text
+ (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
+ (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState")
+ (#BoundT "")])])
+ SyntaxList])])])
+ #Nil])]))
+ #Nil])]))])
+ #Nil])]))])]
+ (#Cons [["lux;module-aliases" (#AppT [List Void])]
+ (#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;host" HostState]
+ (#Cons [["lux;seed" Int]
+ #Nil])])])])])])]))])
+ Void]))
(_lux_export CompilerState)
## (deftype Macro
## (-> (List Syntax) (StateE CompilerState (List Syntax))))
(_lux_def Macro
- (#LambdaT [SyntaxList
- (#AppT [(#AppT [StateE CompilerState])
- SyntaxList])]))
+ (#LambdaT [SyntaxList
+ (#AppT [(#AppT [StateE CompilerState])
+ SyntaxList])]))
(_lux_export Macro)
## Base functions & macros
@@ -276,11 +276,11 @@
## (-> (Syntax' (Meta Cursor)) Syntax)
## (#Meta [["" -1 -1] data]))
(_lux_def _meta
- (_lux_: (#LambdaT [(#AppT [Syntax'
- (#AppT [Meta Cursor])])
- Syntax])
- (_lux_lambda _ data
- (#Meta [["" -1 -1] data]))))
+ (_lux_: (#LambdaT [(#AppT [Syntax'
+ (#AppT [Meta Cursor])])
+ Syntax])
+ (_lux_lambda _ data
+ (#Meta [["" -1 -1] data]))))
## (def (return x)
## (All [a]
@@ -288,16 +288,16 @@
## (Either Text (, CompilerState a))))
## ...)
(_lux_def return
- (_lux_: (#AllT [#None "" "a"
- (#LambdaT [(#BoundT "a")
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [(#BoundT "a")
- #Nil])]))])])])])
- (_lux_lambda _ val
- (_lux_lambda _ state
- (#Right [state val])))))
+ (_lux_: (#AllT [#None "" "a"
+ (#LambdaT [(#BoundT "a")
+ (#LambdaT [CompilerState
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [CompilerState
+ (#Cons [(#BoundT "a")
+ #Nil])]))])])])])
+ (_lux_lambda _ val
+ (_lux_lambda _ state
+ (#Right [state val])))))
## (def (fail msg)
## (All [a]
@@ -305,260 +305,275 @@
## (Either Text (, CompilerState a))))
## ...)
(_lux_def fail
- (_lux_: (#AllT [#None "" "a"
- (#LambdaT [Text
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [(#BoundT "a")
- #Nil])]))])])])])
- (_lux_lambda _ msg
- (_lux_lambda _ state
- (#Left msg)))))
+ (_lux_: (#AllT [#None "" "a"
+ (#LambdaT [Text
+ (#LambdaT [CompilerState
+ (#AppT [(#AppT [Either Text])
+ (#TupleT (#Cons [CompilerState
+ (#Cons [(#BoundT "a")
+ #Nil])]))])])])])
+ (_lux_lambda _ msg
+ (_lux_lambda _ state
+ (#Left msg)))))
(_lux_def $text
- (_lux_: (#LambdaT [Text Syntax])
- (_lux_lambda _ text
- (_meta (#TextS text)))))
+ (_lux_: (#LambdaT [Text Syntax])
+ (_lux_lambda _ text
+ (_meta (#TextS text)))))
(_lux_def $symbol
- (_lux_: (#LambdaT [Ident Syntax])
- (_lux_lambda _ ident
- (_meta (#SymbolS ident)))))
+ (_lux_: (#LambdaT [Ident Syntax])
+ (_lux_lambda _ ident
+ (_meta (#SymbolS ident)))))
(_lux_def $tag
- (_lux_: (#LambdaT [Ident Syntax])
- (_lux_lambda _ ident
- (_meta (#TagS ident)))))
+ (_lux_: (#LambdaT [Ident Syntax])
+ (_lux_lambda _ ident
+ (_meta (#TagS ident)))))
(_lux_def $form
- (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
- (_lux_lambda _ tokens
- (_meta (#FormS tokens)))))
+ (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+ (_lux_lambda _ tokens
+ (_meta (#FormS tokens)))))
(_lux_def $tuple
- (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
- (_lux_lambda _ tokens
- (_meta (#TupleS tokens)))))
+ (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+ (_lux_lambda _ tokens
+ (_meta (#TupleS tokens)))))
(_lux_def $record
- (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
- (_lux_lambda _ tokens
- (_meta (#RecordS tokens)))))
+ (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
+ (_lux_lambda _ tokens
+ (_meta (#RecordS tokens)))))
(_lux_def let'
- (_lux_: Macro
- (_lux_lambda _ tokens
- (_lux_case tokens
- (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
- (return (#Cons [($form (#Cons [($symbol ["" "_lux_case"])
- (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
- #Nil]))
-
- _
- (fail "Wrong syntax for let'")))))
+ (_lux_: Macro
+ (_lux_lambda _ tokens
+ (_lux_case tokens
+ (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
+ (return (_lux_: SyntaxList
+ (#Cons [($form (#Cons [($symbol ["" "_lux_case"])
+ (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
+ #Nil])))
+
+ _
+ (fail "Wrong syntax for let'")))))
(_lux_declare-macro let')
(_lux_def lambda_
- (_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]))
-
- _
- (fail "Wrong syntax for lambda")))))
+ (_lux_: Macro
+ (_lux_lambda _ tokens
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])
+ (return (_lux_: SyntaxList
+ (#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 (_lux_: SyntaxList
+ (#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")))))
(_lux_declare-macro lambda_)
(_lux_def def_
- (_lux_: Macro
- (lambda_ [tokens]
- (_lux_case tokens
- (#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_:"]))
- (#Cons [type
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"]))
- (#Cons [name
- (#Cons [(_meta (#TupleS args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
- #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_:"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
- #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_:"]))
- (#Cons [type
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"]))
- (#Cons [name
- (#Cons [(_meta (#TupleS args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- #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_:"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for def")
- ))))
+ (_lux_: Macro
+ (lambda_ [tokens]
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#TagS ["" "export"])])
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"]))
+ (#Cons [name
+ (#Cons [(_meta (#TupleS args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
+ #Nil])])))
+
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
+ #Nil])])))
+
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"]))
+ (#Cons [name
+ (#Cons [(_meta (#TupleS args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ #Nil])))
+
+ (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ #Nil])))
+
+ _
+ (fail "Wrong syntax for def")
+ ))))
(_lux_declare-macro def_)
(def_ #export (defmacro tokens)
Macro
(_lux_case tokens
- (#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"])
- (#Cons [body
- #Nil])])
- ])]))
- (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
- #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]))
- (#Cons [($symbol ["lux" "Macro"])
- (#Cons [body
- #Nil])])
- ])])]))
- (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
- #Nil])]))
-
- _
- (fail "Wrong syntax for defmacro")))
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
+ (return (_lux_: SyntaxList
+ (#Cons [($form (#Cons [($symbol ["lux" "def_"])
+ (#Cons [($form (#Cons [name args]))
+ (#Cons [($symbol ["lux" "Macro"])
+ (#Cons [body
+ #Nil])])
+ ])]))
+ (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
+ #Nil])])))
+
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])])
+ (return (_lux_: SyntaxList
+ (#Cons [($form (#Cons [($symbol ["lux" "def_"])
+ (#Cons [($tag ["" "export"])
+ (#Cons [($form (#Cons [name args]))
+ (#Cons [($symbol ["lux" "Macro"])
+ (#Cons [body
+ #Nil])])
+ ])])]))
+ (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
+ #Nil])])))
+
+ _
+ (fail "Wrong syntax for defmacro")))
(_lux_declare-macro defmacro)
(defmacro #export (comment tokens)
- (return #Nil))
+ (return (_lux_: SyntaxList #Nil)))
(defmacro (->' tokens)
(_lux_case tokens
- (#Cons [input (#Cons [output #Nil])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"]))
- (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])])))
- #Nil])])))
- #Nil]))
-
- (#Cons [input (#Cons [output others])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"]))
- (#Cons [(_meta (#TupleS (#Cons [input
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"]))
- (#Cons [output others])])))
- #Nil])])))
- #Nil])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for ->'")))
+ (#Cons [input (#Cons [output #Nil])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"]))
+ (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])])))
+ #Nil])])))
+ #Nil])))
+
+ (#Cons [input (#Cons [output others])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"]))
+ (#Cons [(_meta (#TupleS (#Cons [input
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"]))
+ (#Cons [output others])])))
+ #Nil])])))
+ #Nil])])))
+ #Nil])))
+
+ _
+ (fail "Wrong syntax for ->'")))
(defmacro (All' tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS #Nil)])
- (#Cons [body #Nil])])
- (return (#Cons [body
- #Nil]))
-
- (#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"]))
- (#Cons [(_meta (#TextS ""))
- (#Cons [(_meta (#TextS arg-name))
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"]))
- (#Cons [(_meta (#TupleS other-args))
- (#Cons [body
- #Nil])])])))
- #Nil])])])])))
- #Nil])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for All'")))
+ (#Cons [(#Meta [_ (#TupleS #Nil)])
+ (#Cons [body #Nil])])
+ (return (_lux_: SyntaxList
+ (#Cons [body
+ #Nil])))
+
+ (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#SymbolS ["" arg-name])]) other-args]))])
+ (#Cons [body #Nil])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"]))
+ (#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"]))
+ (#Cons [(_meta (#TextS ""))
+ (#Cons [(_meta (#TextS arg-name))
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"]))
+ (#Cons [(_meta (#TupleS other-args))
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])])))
+ #Nil])])))
+ #Nil])))
+
+ _
+ (fail "Wrong syntax for All'")))
(defmacro (B' tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS ["" bound-name])])
- #Nil])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"]))
- (#Cons [(_meta (#TextS bound-name))
- #Nil])])))
- #Nil]))
+ (#Cons [(#Meta [_ (#SymbolS ["" bound-name])])
+ #Nil])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"]))
+ (#Cons [(_meta (#TextS bound-name))
+ #Nil])])))
+ #Nil])))
- _
- (fail "Wrong syntax for B'")))
+ _
+ (fail "Wrong syntax for B'")))
(defmacro ($' tokens)
(_lux_case tokens
- (#Cons [x #Nil])
- (return tokens)
+ (#Cons [x #Nil])
+ (return tokens)
+
+ (#Cons [x (#Cons [y xs])])
+ (return (_lux_: SyntaxList
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"]))
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"]))
+ (#Cons [(_meta (#TupleS (#Cons [x (#Cons [y #Nil])])))
+ #Nil])])))
+ xs])])))
+ #Nil])))
- (#Cons [x (#Cons [y xs])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"]))
- (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"]))
- (#Cons [(_meta (#TupleS (#Cons [x (#Cons [y #Nil])])))
- #Nil])])))
- xs])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for $'")))
+ _
+ (fail "Wrong syntax for $'")))
(def_ #export (fold f init xs)
(All' [a b]
@@ -567,169 +582,182 @@
($' List (B' b))
(B' a)))
(_lux_case xs
- #Nil
- init
+ #Nil
+ init
- (#Cons [x xs'])
- (fold f (f init x) xs')))
+ (#Cons [x xs'])
+ (fold f (f init x) xs')))
(def_ #export (reverse list)
(All' [a]
(->' ($' List (B' a)) ($' List (B' a))))
- (fold (lambda_ [tail head] (#Cons [head tail]))
+ (fold (_lux_: (All' [a]
+ (->' ($' List (B' a)) (B' a) ($' List (B' a))))
+ (lambda_ [tail head]
+ (#Cons [head tail])))
#Nil
list))
(defmacro #export (list xs)
- (return (#Cons [(fold (lambda_ [tail head]
- (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"]))
- (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])])))
- #Nil])]))))
- (_meta (#TagS ["lux" "Nil"]))
- (reverse xs))
- #Nil])))
+ (return (_lux_: SyntaxList
+ (#Cons [(fold (lambda_ [tail head]
+ (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"]))
+ (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])])))
+ #Nil])]))))
+ (_meta (#TagS ["lux" "Nil"]))
+ (reverse xs))
+ #Nil]))))
(defmacro #export (list& xs)
(_lux_case (reverse xs)
- (#Cons [last init])
- (return (list (fold (lambda_ [tail head]
- (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
- (_meta (#TupleS (list head tail)))))))
- last
- init)))
+ (#Cons [last init])
+ (return (_lux_: SyntaxList
+ (list (fold (lambda_ [tail head]
+ (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
+ (_meta (#TupleS (list head tail)))))))
+ last
+ init))))
- _
- (fail "Wrong syntax for list&")))
+ _
+ (fail "Wrong syntax for list&")))
(defmacro #export (lambda tokens)
(let' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax)))
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
- [name tokens']
+ (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
+ [name tokens']
- _
- [["" ""] tokens]))
+ _
+ [["" ""] tokens]))
(_lux_case tokens'
- (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
- (_lux_case args
- #Nil
- (fail "lambda requires a non-empty arguments tuple.")
-
- (#Cons [harg targs])
- (return (list ($form (list ($symbol ["" "_lux_lambda"])
- ($symbol name)
- harg
- (fold (lambda_ [body' arg]
- ($form (list ($symbol ["" "_lux_lambda"])
- ($symbol ["" ""])
- arg
- body')))
- body
- (reverse targs)))))))
-
- _
- (fail "Wrong syntax for lambda"))))
+ (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+ (_lux_case args
+ #Nil
+ (fail "lambda requires a non-empty arguments tuple.")
+
+ (#Cons [harg targs])
+ (return (_lux_: SyntaxList
+ (list ($form (list ($symbol ["" "_lux_lambda"])
+ ($symbol name)
+ harg
+ (fold (lambda_ [body' arg]
+ ($form (list ($symbol ["" "_lux_lambda"])
+ ($symbol ["" ""])
+ arg
+ body')))
+ body
+ (reverse targs))))))))
+
+ _
+ (fail "Wrong syntax for lambda"))))
(defmacro (def__ tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])])
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])])
- (return (list ($form (list ($symbol ["" "_lux_def"])
- name
- ($form (list ($symbol ["" "_lux_:"])
- type
- ($form (list ($symbol ["lux" "lambda"])
- name
- ($tuple args)
- body))))))
- ($form (list ($symbol ["" "_lux_export"]) name))))
-
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
- (return (list ($form (list ($symbol ["" "_lux_def"])
- name
- ($form (list ($symbol ["" "_lux_:"])
- type
- body))))
- ($form (list ($symbol ["" "_lux_export"]) name))))
-
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])
- (return (list ($form (list ($symbol ["" "_lux_def"])
- name
- ($form (list ($symbol ["" "_lux_:"])
- type
- ($form (list ($symbol ["lux" "lambda"])
- name
- ($tuple args)
- body))))))))
-
- (#Cons [name (#Cons [type (#Cons [body #Nil])])])
- (return (list ($form (list ($symbol ["" "_lux_def"])
- name
- ($form (list ($symbol ["" "_lux_:"]) type body))))))
-
- _
- (fail "Wrong syntax for def")
- ))
+ (#Cons [(#Meta [_ (#TagS ["" "export"])])
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])])
+ (return (_lux_: SyntaxList
+ (list ($form (list ($symbol ["" "_lux_def"])
+ name
+ ($form (list ($symbol ["" "_lux_:"])
+ type
+ ($form (list ($symbol ["lux" "lambda"])
+ name
+ ($tuple args)
+ body))))))
+ ($form (list ($symbol ["" "_lux_export"]) name)))))
+
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (return (_lux_: SyntaxList
+ (list ($form (list ($symbol ["" "_lux_def"])
+ name
+ ($form (list ($symbol ["" "_lux_:"])
+ type
+ body))))
+ ($form (list ($symbol ["" "_lux_export"]) name)))))
+
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])
+ (return (_lux_: SyntaxList
+ (list ($form (list ($symbol ["" "_lux_def"])
+ name
+ ($form (list ($symbol ["" "_lux_:"])
+ type
+ ($form (list ($symbol ["lux" "lambda"])
+ name
+ ($tuple args)
+ body)))))))))
+
+ (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (return (_lux_: SyntaxList
+ (list ($form (list ($symbol ["" "_lux_def"])
+ name
+ ($form (list ($symbol ["" "_lux_:"]) type body)))))))
+
+ _
+ (fail "Wrong syntax for def")
+ ))
(def__ (as-pairs xs)
(All' [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')])
+ (#Cons [x (#Cons [y xs'])])
+ (#Cons [[x y] (as-pairs xs')])
- _
- #Nil))
+ _
+ #Nil))
(defmacro #export (let tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
- (return (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax))
- Syntax)
- (lambda [body binding]
- (_lux_case binding
- [label value]
- (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body))))))
- body
- (fold (lambda [tail head] (#Cons [head tail]))
- #Nil
- (as-pairs bindings)))))
-
- _
- (fail "Wrong syntax for let")))
+ (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
+ (return (_lux_: SyntaxList
+ (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax))
+ Syntax)
+ (lambda [body binding]
+ (_lux_case binding
+ [label value]
+ (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body))))))
+ body
+ (fold (_lux_: (All' [a]
+ (->' ($' List (B' a)) (B' a) ($' List (B' a))))
+ (lambda [tail head] (#Cons [head tail])))
+ #Nil
+ (as-pairs bindings))))))
+
+ _
+ (fail "Wrong syntax for let")))
(def__ #export (map f xs)
(All' [a b]
(->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
(_lux_case xs
- #Nil
- #Nil
+ #Nil
+ #Nil
- (#Cons [x xs'])
- (#Cons [(f x) (map f xs')])))
+ (#Cons [x xs'])
+ (#Cons [(f x) (map f xs')])))
(def__ #export (any? p xs)
(All' [a]
(->' (->' (B' a) Bool) ($' List (B' a)) Bool))
(_lux_case xs
- #Nil
- false
+ #Nil
+ false
- (#Cons [x xs'])
- (_lux_case (p x)
- true true
- false (any? p xs'))))
+ (#Cons [x xs'])
+ (_lux_case (p x)
+ true true
+ false (any? p xs'))))
(def__ (spliced? token)
(->' Syntax Bool)
(_lux_case token
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
- true
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
+ true
- _
- false))
+ _
+ false))
(def__ (wrap-meta content)
(->' Syntax Syntax)
@@ -740,141 +768,147 @@
(def__ (untemplate-list tokens)
(->' ($' List Syntax) Syntax)
(_lux_case tokens
- #Nil
- (_meta (#TagS ["lux" "Nil"]))
+ #Nil
+ (_meta (#TagS ["lux" "Nil"]))
- (#Cons [token tokens'])
- (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
- (_meta (#TupleS (list token (untemplate-list tokens')))))))))
+ (#Cons [token tokens'])
+ (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
+ (_meta (#TupleS (list token (untemplate-list tokens')))))))))
(def__ (list:++ xs ys)
(All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
(_lux_case xs
- (#Cons [x xs'])
- (#Cons [x (list:++ xs' ys)])
+ (#Cons [x xs'])
+ (#Cons [x (list:++ xs' ys)])
- #Nil
- ys))
+ #Nil
+ ys))
(defmacro #export ($ tokens)
(_lux_case tokens
- (#Cons [op (#Cons [init args])])
- (return (list (fold (lambda [a1 a2] ($form (list op a1 a2)))
- init
- args)))
-
- _
- (fail "Wrong syntax for $")))
+ (#Cons [op (#Cons [init args])])
+ (return (_lux_: SyntaxList
+ (list (fold (lambda [a1 a2] ($form (list op a1 a2)))
+ init
+ args))))
+
+ _
+ (fail "Wrong syntax for $")))
(def__ (splice untemplate tag elems)
(->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
(_lux_case (any? spliced? elems)
- true
- (let [elems' (map (lambda [elem]
- (_lux_case elem
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
- spliced
-
- _
- ($form (list ($symbol ["" "_lux_:"])
- ($symbol ["lux" "SyntaxList"])
- ($form (list ($symbol ["lux" "list"]) (untemplate elem)))))))
- elems)]
- (wrap-meta ($form (list tag
- ($form (list& ($symbol ["lux" "$"])
- ($symbol ["lux" "list:++"])
- elems'))))))
-
- false
- (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
+ true
+ (let [elems' (map (_lux_: (->' Syntax Syntax)
+ (lambda [elem]
+ (_lux_case elem
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
+ spliced
+
+ _
+ ($form (list ($symbol ["" "_lux_:"])
+ ($symbol ["lux" "SyntaxList"])
+ ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))))
+ elems)]
+ (wrap-meta ($form (list tag
+ ($form (list& ($symbol ["lux" "$"])
+ ($symbol ["lux" "list:++"])
+ elems'))))))
+
+ false
+ (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
(def__ (untemplate subst token)
(->' Text Syntax Syntax)
(_lux_case token
- (#Meta [_ (#BoolS value)])
- (wrap-meta ($form (list ($tag ["lux" "BoolS"]) (_meta (#BoolS value)))))
+ (#Meta [_ (#BoolS value)])
+ (wrap-meta ($form (list ($tag ["lux" "BoolS"]) (_meta (#BoolS value)))))
- (#Meta [_ (#IntS value)])
- (wrap-meta ($form (list ($tag ["lux" "IntS"]) (_meta (#IntS value)))))
+ (#Meta [_ (#IntS value)])
+ (wrap-meta ($form (list ($tag ["lux" "IntS"]) (_meta (#IntS value)))))
- (#Meta [_ (#RealS value)])
- (wrap-meta ($form (list ($tag ["lux" "RealS"]) (_meta (#RealS value)))))
+ (#Meta [_ (#RealS value)])
+ (wrap-meta ($form (list ($tag ["lux" "RealS"]) (_meta (#RealS value)))))
- (#Meta [_ (#CharS value)])
- (wrap-meta ($form (list ($tag ["lux" "CharS"]) (_meta (#CharS value)))))
+ (#Meta [_ (#CharS value)])
+ (wrap-meta ($form (list ($tag ["lux" "CharS"]) (_meta (#CharS value)))))
- (#Meta [_ (#TextS value)])
- (wrap-meta ($form (list ($tag ["lux" "TextS"]) (_meta (#TextS value)))))
+ (#Meta [_ (#TextS value)])
+ (wrap-meta ($form (list ($tag ["lux" "TextS"]) (_meta (#TextS value)))))
- (#Meta [_ (#TagS [module name])])
- (let [module' (_lux_case module
- ""
- subst
+ (#Meta [_ (#TagS [module name])])
+ (let [module' (_lux_case module
+ ""
+ subst
- _
- module)]
- (wrap-meta ($form (list ($tag ["lux" "TagS"]) ($tuple (list ($text module') ($text name)))))))
+ _
+ module)]
+ (wrap-meta ($form (list ($tag ["lux" "TagS"]) ($tuple (list ($text module') ($text name)))))))
- (#Meta [_ (#SymbolS [module name])])
- (let [module' (_lux_case module
- ""
- subst
+ (#Meta [_ (#SymbolS [module name])])
+ (let [module' (_lux_case module
+ ""
+ subst
- _
- module)]
- (wrap-meta ($form (list ($tag ["lux" "SymbolS"]) ($tuple (list ($text module') ($text name)))))))
+ _
+ module)]
+ (wrap-meta ($form (list ($tag ["lux" "SymbolS"]) ($tuple (list ($text module') ($text name)))))))
- (#Meta [_ (#TupleS elems)])
- (splice (untemplate subst) ($tag ["lux" "TupleS"]) elems)
+ (#Meta [_ (#TupleS elems)])
+ (splice (untemplate subst) ($tag ["lux" "TupleS"]) elems)
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])
- unquoted
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])
+ unquoted
- (#Meta [_ (#FormS elems)])
- (splice (untemplate subst) ($tag ["lux" "FormS"]) elems)
+ (#Meta [_ (#FormS elems)])
+ (splice (untemplate subst) ($tag ["lux" "FormS"]) elems)
- (#Meta [_ (#RecordS fields)])
- (wrap-meta ($form (list ($tag ["lux" "RecordS"])
- (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax)
- (lambda [kv]
- (let [[k v] kv]
- ($tuple (list (untemplate subst k) (untemplate subst v))))))
- fields)))))
- ))
+ (#Meta [_ (#RecordS fields)])
+ (wrap-meta ($form (list ($tag ["lux" "RecordS"])
+ (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax)
+ (lambda [kv]
+ (let [[k v] kv]
+ ($tuple (list (untemplate subst k) (untemplate subst v))))))
+ fields)))))
+ ))
(defmacro (`' tokens)
(_lux_case tokens
- (#Cons [template #Nil])
- (return (list (untemplate "" template)))
+ (#Cons [template #Nil])
+ (return (_lux_: SyntaxList
+ (list (untemplate "" template))))
- _
- (fail "Wrong syntax for `'")))
+ _
+ (fail "Wrong syntax for `'")))
(defmacro #export (|> tokens)
(_lux_case tokens
- (#Cons [init apps])
- (return (list (fold (lambda [acc app]
- (_lux_case app
- (#Meta [_ (#FormS parts)])
- ($form (list:++ parts (list acc)))
+ (#Cons [init apps])
+ (return (_lux_: SyntaxList
+ (list (fold (_lux_: (->' Syntax Syntax Syntax)
+ (lambda [acc app]
+ (_lux_case app
+ (#Meta [_ (#FormS parts)])
+ ($form (list:++ parts (list acc)))
- _
- (`' ((~ app) (~ acc)))))
- init
- apps)))
+ _
+ (`' ((~ app) (~ acc))))))
+ init
+ apps))))
- _
- (fail "Wrong syntax for |>")))
+ _
+ (fail "Wrong syntax for |>")))
(defmacro #export (if tokens)
(_lux_case tokens
- (#Cons [test (#Cons [then (#Cons [else #Nil])])])
- (return (list (`' (_lux_case (~ test)
- true (~ then)
- false (~ else)))))
+ (#Cons [test (#Cons [then (#Cons [else #Nil])])])
+ (return (_lux_: SyntaxList
+ (list (`' (_lux_case (~ test)
+ true (~ then)
+ false (~ else))))))
- _
- (fail "Wrong syntax for if")))
+ _
+ (fail "Wrong syntax for if")))
## (deftype (Lux a)
## (-> CompilerState (Either Text (, CompilerState a))))
@@ -905,8 +939,8 @@
#lux;bind
(lambda [f ma]
(_lux_case ma
- #None #None
- (#Some a) (f a)))})
+ #None #None
+ (#Some a) (f a)))})
(def__ Lux:Monad
($' Monad Lux)
@@ -919,56 +953,61 @@
(lambda [f ma]
(lambda [state]
(_lux_case (ma state)
- (#Left msg)
- (#Left msg)
+ (#Left msg)
+ (#Left msg)
- (#Right [state' a])
- (f a state'))))})
+ (#Right [state' a])
+ (f a state'))))})
(defmacro #export (^ tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil])
- (return (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))
+ (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil])
+ (return (_lux_: SyntaxList
+ (list (`' (#;DataT (~ (_meta (#TextS class-name))))))))
- _
- (fail "Wrong syntax for ^")))
+ _
+ (fail "Wrong syntax for ^")))
(defmacro #export (-> tokens)
(_lux_case (reverse tokens)
- (#Cons [output inputs])
- (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))
- output
- inputs)))
-
- _
- (fail "Wrong syntax for ->")))
+ (#Cons [output inputs])
+ (return (_lux_: SyntaxList
+ (list (fold (_lux_: (->' Syntax Syntax Syntax)
+ (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))))
+ output
+ inputs))))
+
+ _
+ (fail "Wrong syntax for ->")))
(defmacro #export (, tokens)
- (return (list (`' (#;TupleT (;list (~@ tokens)))))))
+ (return (_lux_: SyntaxList
+ (list (`' (#;TupleT (;list (~@ tokens))))))))
(defmacro (do tokens)
(_lux_case tokens
- (#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])])
- (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
- (lambda [body' binding]
- (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)
- {#;return ;return #;bind ;bind}
- (~ body'))))))
-
- _
- (fail "Wrong syntax for do")))
+ (#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])])
+ (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
+ (lambda [body' binding]
+ (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 (_lux_: SyntaxList
+ (list (`' (_lux_case (~ monad)
+ {#;return ;return #;bind ;bind}
+ (~ body')))))))
+
+ _
+ (fail "Wrong syntax for do")))
(def__ (map% m f xs)
## (All [m a b]
@@ -980,15 +1019,15 @@
($' (B' m) ($' List (B' b)))))
(let [{#;return ;return #;bind _} m]
(_lux_case xs
- #Nil
- (;return #Nil)
-
- (#Cons [x xs'])
- (do m
- [y (f x)
- ys (map% m f xs')]
- (;return (#Cons [y ys])))
- )))
+ #Nil
+ (;return (_lux_: List #Nil))
+
+ (#Cons [x xs'])
+ (do m
+ [y (f x)
+ ys (map% m f xs')]
+ (;return (_lux_: List (#Cons [y ys]))))
+ )))
(def__ #export (. f g)
(All' [a b c]
@@ -999,20 +1038,20 @@
(def__ (get-ident x)
(-> Syntax ($' Maybe Text))
(_lux_case x
- (#Meta [_ (#SymbolS ["" sname])])
- (#Some sname)
+ (#Meta [_ (#SymbolS ["" sname])])
+ (#Some sname)
- _
- #None))
+ _
+ #None))
(def__ (tuple->list tuple)
(-> Syntax ($' Maybe ($' List Syntax)))
(_lux_case tuple
- (#Meta [_ (#TupleS members)])
- (#Some members)
+ (#Meta [_ (#TupleS members)])
+ (#Some members)
- _
- #None))
+ _
+ #None))
(def__ RepEnv
Type
@@ -1022,11 +1061,11 @@
(-> ($' List Text) ($' List Syntax) RepEnv)
(_lux_case (_lux_: (, ($' List Text) ($' List Syntax))
[xs ys])
- [(#Cons [x xs']) (#Cons [y ys'])]
- (#Cons [[x y] (make-env xs' ys')])
+ [(#Cons [x xs']) (#Cons [y ys'])]
+ (#Cons [[x y] (make-env xs' ys')])
- _
- #Nil))
+ _
+ #Nil))
(def__ (text:= x y)
(-> Text Text Bool)
@@ -1036,69 +1075,69 @@
(def__ (get-rep key env)
(-> Text RepEnv ($' Maybe Syntax))
(_lux_case env
- #Nil
- #None
+ #Nil
+ #None
- (#Cons [[k v] env'])
- (if (text:= k key)
- (#Some v)
- (get-rep key env'))))
+ (#Cons [[k v] env'])
+ (if (text:= k key)
+ (#Some v)
+ (get-rep key env'))))
(def__ (apply-template env template)
(-> RepEnv Syntax Syntax)
(_lux_case template
- (#Meta [_ (#SymbolS ["" sname])])
- (_lux_case (get-rep sname env)
- (#Some subst)
- subst
+ (#Meta [_ (#SymbolS ["" sname])])
+ (_lux_case (get-rep sname env)
+ (#Some subst)
+ subst
- _
- template)
+ _
+ template)
- (#Meta [_ (#TupleS elems)])
- ($tuple (map (apply-template env) elems))
+ (#Meta [_ (#TupleS elems)])
+ ($tuple (map (apply-template env) elems))
- (#Meta [_ (#FormS elems)])
- ($form (map (apply-template env) elems))
+ (#Meta [_ (#FormS elems)])
+ ($form (map (apply-template env) elems))
- (#Meta [_ (#RecordS members)])
- ($record (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
- (lambda [kv]
- (let [[slot value] kv]
- [(apply-template env slot) (apply-template env value)])))
- members))
+ (#Meta [_ (#RecordS members)])
+ ($record (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
+ (lambda [kv]
+ (let [[slot value] kv]
+ [(apply-template env slot) (apply-template env value)])))
+ members))
- _
- template))
+ _
+ template))
(def__ (join-map f xs)
(All' [a b]
(-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b))))
(_lux_case xs
- #Nil
- #Nil
+ #Nil
+ #Nil
- (#Cons [x xs'])
- (list:++ (f x) (join-map f xs'))))
+ (#Cons [x xs'])
+ (list:++ (f x) (join-map f xs'))))
(defmacro #export (do-template tokens)
(_lux_case tokens
- (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])])
- (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax))))
- [(map% Maybe:Monad get-ident bindings)
- (map% Maybe:Monad tuple->list data)])
- [(#Some bindings') (#Some data')]
- (let [apply (_lux_: (-> RepEnv ($' List Syntax))
- (lambda [env] (map (apply-template env) templates)))]
- (|> data'
- (join-map (. apply (make-env bindings')))
- return))
-
- _
- (fail "All the do-template bindigns must be symbols."))
-
- _
- (fail "Wrong syntax for do-template")))
+ (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])])
+ (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax))))
+ [(map% Maybe:Monad get-ident bindings)
+ (map% Maybe:Monad tuple->list data)])
+ [(#Some bindings') (#Some data')]
+ (let [apply (_lux_: (-> RepEnv ($' List Syntax))
+ (lambda [env] (map (apply-template env) templates)))]
+ (|> data'
+ (join-map (. apply (make-env bindings')))
+ return))
+
+ _
+ (fail "All the do-template bindigns must be symbols."))
+
+ _
+ (fail "Wrong syntax for do-template")))
(do-template [<name> <cmp> <type>]
[(def__ #export (<name> x y)
@@ -1155,87 +1194,91 @@
(def__ (replace-syntax reps syntax)
(-> RepEnv Syntax Syntax)
(_lux_case syntax
- (#Meta [_ (#SymbolS ["" name])])
- (_lux_case (get-rep name reps)
- (#Some replacement)
- replacement
+ (#Meta [_ (#SymbolS ["" name])])
+ (_lux_case (get-rep name reps)
+ (#Some replacement)
+ replacement
- #None
- syntax)
-
- (#Meta [_ (#FormS parts)])
- (#Meta [_ (#FormS (map (replace-syntax reps) parts))])
-
- (#Meta [_ (#TupleS members)])
- (#Meta [_ (#TupleS (map (replace-syntax reps) members))])
-
- (#Meta [_ (#RecordS slots)])
- (#Meta [_ (#RecordS (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
- (lambda [slot]
- (let [[k v] slot]
- [(replace-syntax reps k) (replace-syntax reps v)])))
- slots))])
-
- _
- syntax)
+ #None
+ syntax)
+
+ (#Meta [_ (#FormS parts)])
+ (#Meta [_ (#FormS (map (replace-syntax reps) parts))])
+
+ (#Meta [_ (#TupleS members)])
+ (#Meta [_ (#TupleS (map (replace-syntax reps) members))])
+
+ (#Meta [_ (#RecordS slots)])
+ (#Meta [_ (#RecordS (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
+ (lambda [slot]
+ (let [[k v] slot]
+ [(replace-syntax reps k) (replace-syntax reps v)])))
+ slots))])
+
+ _
+ syntax)
)
(defmacro #export (All tokens)
(let [[self-ident tokens'] (_lux_: (, Text SyntaxList)
(_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
- [self-ident tokens']
+ (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
+ [self-ident tokens']
- _
- ["" tokens]))]
+ _
+ ["" tokens]))]
(_lux_case tokens'
- (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
- (_lux_case (map% Maybe:Monad get-ident args)
- (#Some idents)
- (_lux_case idents
- #Nil
- (return (list body))
-
- (#Cons [harg targs])
- (let [replacements (map (_lux_: (-> Text (, Text Syntax))
- (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))]))
- (list& self-ident idents))
- body' (fold (lambda [body' arg'] (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')])))
- (replace-syntax replacements body)
- (reverse targs))]
- (return (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')]))))))
-
- #None
- (fail "'All' arguments must be symbols."))
-
- _
- (fail "Wrong syntax for All"))
+ (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+ (_lux_case (map% Maybe:Monad get-ident args)
+ (#Some idents)
+ (_lux_case idents
+ #Nil
+ (return (_lux_: SyntaxList
+ (list body)))
+
+ (#Cons [harg targs])
+ (let [replacements (map (_lux_: (-> Text (, Text Syntax))
+ (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))]))
+ (list& self-ident idents))
+ body' (fold (_lux_: (-> Syntax Text Syntax)
+ (lambda [body' arg']
+ (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')]))))
+ (replace-syntax replacements body)
+ (reverse targs))]
+ (return (_lux_: SyntaxList
+ (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))))
+
+ #None
+ (fail "'All' arguments must be symbols."))
+
+ _
+ (fail "Wrong syntax for All"))
))
(def__ (get k plist)
(All [a]
(-> Text ($' List (, Text a)) ($' Maybe a)))
(_lux_case plist
- (#Cons [[k' v] plist'])
- (if (text:= k k')
- (#Some v)
- (get k plist'))
+ (#Cons [[k' v] plist'])
+ (if (text:= k k')
+ (#Some v)
+ (get k plist'))
- #Nil
- #None))
+ #Nil
+ #None))
(def__ #export (get-module-name state)
($' Lux Text)
(_lux_case state
- {#source source #modules modules #module-aliases module-aliases
- #envs envs #types types #host host
- #seed seed}
- (_lux_case (reverse envs)
- #Nil
- (#Left "Can't get the module name without a module!")
+ {#source source #modules modules #module-aliases module-aliases
+ #envs envs #types types #host host
+ #seed seed}
+ (_lux_case (reverse envs)
+ #Nil
+ (#Left "Can't get the module name without a module!")
- (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _])
- (#Right [state module-name]))))
+ (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _])
+ (#Right [state module-name]))))
(def__ (find-macro' modules current-module module name)
(-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE CompilerState ($' List Syntax)))))))))
@@ -1245,18 +1288,18 @@
[bindings (get module modules)
gdef (get name bindings)]
(_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef)
- [exported? (#MacroD macro')]
- (if exported?
- (#Some macro')
- (if (text:= module current-module)
- (#Some macro')
- #None))
-
- [_ (#AliasD [r-module r-name])]
- (find-macro' modules current-module r-module r-name)
-
- _
- #None)))
+ [exported? (#MacroD macro')]
+ (if exported?
+ (#Some macro')
+ (if (text:= module current-module)
+ (#Some macro')
+ #None))
+
+ [_ (#AliasD [r-module r-name])]
+ (find-macro' modules current-module r-module r-name)
+
+ _
+ #None)))
(def__ #export (find-macro ident)
(-> Ident ($' Lux ($' Maybe Macro)))
@@ -1265,10 +1308,10 @@
(let [[module name] ident]
(lambda [state]
(_lux_case state
- {#source source #modules modules #module-aliases module-aliases
- #envs envs #types types #host host
- #seed seed}
- (#Right [state (find-macro' modules current-module module name)]))))))
+ {#source source #modules modules #module-aliases module-aliases
+ #envs envs #types types #host host
+ #seed seed}
+ (#Right [state (find-macro' modules current-module module name)]))))))
(def__ (list:join xs)
(All [a]
@@ -1288,20 +1331,20 @@
(def__ #export (normalize ident state)
(-> Ident ($' Lux Ident))
(_lux_case ident
- ["" name]
- (_lux_case state
- {#source source #modules modules #module-aliases module-aliases
- #envs envs #types types #host host
- #seed seed}
- (_lux_case (reverse envs)
- #Nil
- (#Left "Can't normalize Ident without a global environment.")
-
- (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _])
- (#Right [state [prefix name]])))
-
- _
- (#Right [state ident])))
+ ["" name]
+ (_lux_case state
+ {#source source #modules modules #module-aliases module-aliases
+ #envs envs #types types #host host
+ #seed seed}
+ (_lux_case (reverse envs)
+ #Nil
+ (#Left "Can't normalize Ident without a global environment.")
+
+ (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _])
+ (#Right [state [prefix name]])))
+
+ _
+ (#Right [state ident])))
(defmacro #export (| tokens)
(do Lux:Monad
@@ -1309,20 +1352,21 @@
(_lux_: (-> Syntax ($' Lux Syntax))
(lambda [token]
(_lux_case token
- (#Meta [_ (#TagS ident)])
- (do Lux:Monad
- [ident (normalize ident)]
- (;return (`' [(~ ($text (ident->text ident))) (;,)])))
-
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))])
- (do Lux:Monad
- [ident (normalize ident)]
- (;return (`' [(~ ($text (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for |"))))
+ (#Meta [_ (#TagS ident)])
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (;,)]))))
+
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))])
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
+
+ _
+ (fail "Wrong syntax for |"))))
tokens)]
- (;return (list (`' (#;VariantT (;list (~@ pairs))))))))
+ (;return (_lux_: SyntaxList
+ (list (`' (#;VariantT (;list (~@ pairs)))))))))
(defmacro #export (& tokens)
(if (not (multiple? 2 (length tokens)))
@@ -1332,15 +1376,16 @@
(_lux_: (-> (, Syntax Syntax) ($' Lux Syntax))
(lambda [pair]
(_lux_case pair
- [(#Meta [_ (#TagS ident)]) value]
- (do Lux:Monad
- [ident (normalize ident)]
- (;return (`' [(~ ($text (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for &"))))
+ [(#Meta [_ (#TagS ident)]) value]
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
+
+ _
+ (fail "Wrong syntax for &"))))
(as-pairs tokens))]
- (;return (list (`' (#;RecordT (;list (~@ pairs)))))))))
+ (;return (_lux_: SyntaxList
+ (list (`' (#;RecordT (;list (~@ pairs))))))))))
(def__ #export (->text x)
(-> (^ java.lang.Object) Text)
@@ -1350,174 +1395,179 @@
(All [a]
(-> a ($' List a) ($' List a)))
(_lux_case xs
- #Nil
- xs
+ #Nil
+ xs
- (#Cons [x #Nil])
- xs
+ (#Cons [x #Nil])
+ xs
- (#Cons [x xs'])
- (list& x sep (interpose sep xs'))))
+ (#Cons [x xs'])
+ (list& x sep (interpose sep xs'))))
(def__ #export (syntax:show syntax)
(-> Syntax Text)
(_lux_case syntax
- (#Meta [_ (#BoolS value)])
- (->text value)
+ (#Meta [_ (#BoolS value)])
+ (->text value)
- (#Meta [_ (#IntS value)])
- (->text value)
+ (#Meta [_ (#IntS value)])
+ (->text value)
- (#Meta [_ (#RealS value)])
- (->text value)
+ (#Meta [_ (#RealS value)])
+ (->text value)
- (#Meta [_ (#CharS value)])
- ($ text:++ "#\"" (->text value) "\"")
+ (#Meta [_ (#CharS value)])
+ ($ text:++ "#\"" (->text value) "\"")
- (#Meta [_ (#TextS value)])
- value
+ (#Meta [_ (#TextS value)])
+ value
- (#Meta [_ (#SymbolS ident)])
- (ident->text ident)
+ (#Meta [_ (#SymbolS ident)])
+ (ident->text ident)
- (#Meta [_ (#TagS ident)])
- (text:++ "#" (ident->text ident))
+ (#Meta [_ (#TagS ident)])
+ (text:++ "#" (ident->text ident))
- (#Meta [_ (#TupleS members)])
- ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
+ (#Meta [_ (#TupleS members)])
+ ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
- (#Meta [_ (#FormS members)])
- ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
+ (#Meta [_ (#FormS members)])
+ ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
- (#Meta [_ (#RecordS slots)])
- ($ text:++ "{"
- (|> slots
- (map (_lux_: (-> (, Syntax Syntax) Text)
- (lambda [slot]
- (let [[k v] slot]
- ($ text:++ (syntax:show k) " " (syntax:show v))))))
- (interpose " ")
- (fold text:++ ""))
- "}")
- ))
+ (#Meta [_ (#RecordS slots)])
+ ($ text:++ "{"
+ (|> slots
+ (map (_lux_: (-> (, Syntax Syntax) Text)
+ (lambda [slot]
+ (let [[k v] slot]
+ ($ text:++ (syntax:show k) " " (syntax:show v))))))
+ (interpose " ")
+ (fold text:++ ""))
+ "}")
+ ))
(def__ #export (macro-expand syntax)
(-> Syntax ($' Lux ($' List Syntax)))
(_lux_case syntax
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
- (do Lux:Monad
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- (_lux_case ?macro
- (#Some macro)
- (do Lux:Monad
- [expansion (macro args)
- expansion' (map% Lux:Monad macro-expand expansion)]
- (;return (list:join expansion')))
-
- #None
- (do Lux:Monad
- [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
- (;return (list ($form (list:join parts')))))))
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
+ (do Lux:Monad
+ [macro-name' (normalize macro-name)
+ ?macro (find-macro (_lux_: Ident macro-name'))]
+ (_lux_case (_lux_: ($' Maybe Macro) ?macro)
+ (#Some macro)
+ (do Lux:Monad
+ [expansion (macro args)
+ expansion' (map% Lux:Monad macro-expand (_lux_: SyntaxList expansion))]
+ (;return (_lux_: SyntaxList (list:join (_lux_: ($' List SyntaxList) expansion')))))
+
+ #None
+ (do Lux:Monad
+ [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
+ (;return (_lux_: SyntaxList (list ($form (list:join (_lux_: ($' List SyntaxList) parts')))))))))
- (#Meta [_ (#FormS (#Cons [harg targs]))])
- (do Lux:Monad
- [harg+ (macro-expand harg)
- targs+ (map% Lux:Monad macro-expand targs)]
- (;return (list ($form (list:++ harg+ (list:join targs+))))))
+ (#Meta [_ (#FormS (#Cons [harg targs]))])
+ (do Lux:Monad
+ [harg+ (macro-expand harg)
+ targs+ (map% Lux:Monad macro-expand (_lux_: SyntaxList targs))]
+ (;return (_lux_: SyntaxList (list ($form (list:++ harg+ (list:join (_lux_: ($' List SyntaxList) targs+))))))))
- (#Meta [_ (#TupleS members)])
- (do Lux:Monad
- [members' (map% Lux:Monad macro-expand members)]
- (;return (list ($tuple (list:join members')))))
+ (#Meta [_ (#TupleS members)])
+ (do Lux:Monad
+ [members' (map% Lux:Monad macro-expand members)]
+ (;return (_lux_: SyntaxList (list ($tuple (list:join (_lux_: ($' List SyntaxList) members')))))))
- _
- (return (list syntax))))
+ _
+ (return (_lux_: SyntaxList (list syntax)))))
(def__ (walk-type type)
(-> Syntax Syntax)
(_lux_case type
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#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)]))
- (#Meta [_ (#TupleS members)])
- ($tuple (map walk-type members))
+ (#Meta [_ (#TupleS members)])
+ ($tuple (map walk-type members))
- (#Meta [_ (#FormS (#Cons [type-fn args]))])
- (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))
- (walk-type type-fn)
- (map walk-type args))
-
- _
- type))
+ (#Meta [_ (#FormS (#Cons [type-fn args]))])
+ (fold (_lux_: (-> Syntax Syntax Syntax)
+ (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))))
+ (walk-type type-fn)
+ (map walk-type args))
+
+ _
+ type))
(defmacro #export (type` tokens)
(_lux_case tokens
- (#Cons [type #Nil])
- (do Lux:Monad
- [type+ (macro-expand type)]
- (_lux_case type+
- (#Cons [type' #Nil])
- (;return (list (walk-type type')))
-
- _
- (fail "type`: The expansion of the type-syntax had to yield a single element.")))
+ (#Cons [type #Nil])
+ (do Lux:Monad
+ [type+ (macro-expand type)]
+ (_lux_case (_lux_: SyntaxList type+)
+ (#Cons [type' #Nil])
+ (;return (_lux_: SyntaxList
+ (list (walk-type type'))))
+
+ _
+ (fail "type`: The expansion of the type-syntax had to yield a single element.")))
- _
- (fail "Wrong syntax for type`")))
+ _
+ (fail "Wrong syntax for type`")))
(defmacro #export (: tokens)
(_lux_case tokens
- (#Cons [type (#Cons [value #Nil])])
- (return (list (`' (_lux_: (;type` (~ type)) (~ value)))))
+ (#Cons [type (#Cons [value #Nil])])
+ (return (_lux_: SyntaxList
+ (list (`' (_lux_: (;type` (~ type)) (~ value))))))
- _
- (fail "Wrong syntax for :")))
+ _
+ (fail "Wrong syntax for :")))
(defmacro #export (:! tokens)
(_lux_case tokens
- (#Cons [type (#Cons [value #Nil])])
- (return (list (`' (_lux_:! (;type` (~ type)) (~ value)))))
+ (#Cons [type (#Cons [value #Nil])])
+ (return (_lux_: SyntaxList
+ (list (`' (_lux_:! (;type` (~ type)) (~ value))))))
- _
- (fail "Wrong syntax for :!")))
+ _
+ (fail "Wrong syntax for :!")))
(defmacro #export (deftype tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
(_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
- [true tokens']
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens]))
parts (: (Maybe (, Syntax (List Syntax) Syntax))
(_lux_case tokens'
- (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
- (#Some [($symbol name) #Nil type])
+ (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
+ (#Some [($symbol name) #Nil type])
- (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
- (#Some [($symbol name) args type])
+ (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
+ (#Some [($symbol name) args type])
- _
- #None))]
+ _
+ #None))]
(_lux_case parts
- (#Some [name args type])
- (let [with-export (: (List Syntax)
- (if export?
- (list (`' (_lux_export (~ name))))
- #Nil))
- type' (: Syntax
- (_lux_case args
- #Nil
- type
-
- _
- (`' (;All (~ name) [(~@ args)] (~ type)))))]
- (return (list& (`' (_lux_def (~ name) (;type` (~ type'))))
- with-export)))
-
- #None
- (fail "Wrong syntax for deftype"))
+ (#Some [name args type])
+ (let [with-export (: (List Syntax)
+ (if export?
+ (list (`' (_lux_export (~ name))))
+ #Nil))
+ type' (: Syntax
+ (_lux_case args
+ #Nil
+ type
+
+ _
+ (`' (;All (~ name) [(~@ args)] (~ type)))))]
+ (return (_lux_: SyntaxList
+ (list& (`' (_lux_def (~ name) (;type` (~ type'))))
+ with-export))))
+
+ #None
+ (fail "Wrong syntax for deftype"))
))
(deftype #export (IO a)
@@ -1525,71 +1575,75 @@
(defmacro #export (io tokens)
(_lux_case tokens
- (#Cons [value #Nil])
- (let [blank ($symbol ["" ""])]
- (return (list (`' (_lux_lambda (~ blank) (~ blank) (~ value))))))
+ (#Cons [value #Nil])
+ (let [blank ($symbol ["" ""])]
+ (return (_lux_: SyntaxList
+ (list (`' (_lux_lambda (~ blank) (~ blank) (~ value)))))))
- _
- (fail "Wrong syntax for io")))
+ _
+ (fail "Wrong syntax for io")))
(defmacro #export (exec tokens)
(_lux_case (reverse tokens)
- (#Cons [value actions])
- (let [dummy ($symbol ["" ""])]
- (return (list (fold (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))
- value
- actions))))
+ (#Cons [value actions])
+ (let [dummy ($symbol ["" ""])]
+ (return (_lux_: SyntaxList
+ (list (fold (: (-> Syntax Syntax Syntax)
+ (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))))
+ value
+ actions)))))
- _
- (fail "Wrong syntax for exec")))
+ _
+ (fail "Wrong syntax for exec")))
(defmacro #export (def tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
(_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
- [true tokens']
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens]))
parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
(_lux_case tokens'
- (#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 [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
- (#Some [name args #None body])
-
- (#Cons [name (#Cons [body #Nil])])
- (#Some [name #Nil #None body])
-
- _
- #None))]
+ (#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 [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
+ (#Some [name args #None body])
+
+ (#Cons [name (#Cons [body #Nil])])
+ (#Some [name #Nil #None body])
+
+ _
+ #None))]
(_lux_case parts
- (#Some [name args ?type body])
- (let [body' (: Syntax
- (_lux_case args
- #Nil
- body
-
- _
- (`' (;lambda (~ name) [(~@ args)] (~ body)))))
- body'' (: Syntax
- (_lux_case ?type
- (#Some type)
- (`' (: (~ type) (~ body')))
-
- #None
- body'))]
- (return (list& (`' (_lux_def (~ name) (~ body'')))
- (if export?
- (list (`' (_lux_export (~ name))))
- #Nil))))
-
- #None
- (fail "Wrong syntax for def"))))
+ (#Some [name args ?type body])
+ (let [body' (: Syntax
+ (_lux_case args
+ #Nil
+ body
+
+ _
+ (`' (;lambda (~ name) [(~@ args)] (~ body)))))
+ body'' (: Syntax
+ (_lux_case ?type
+ (#Some type)
+ (`' (: (~ type) (~ body')))
+
+ #None
+ body'))]
+ (return (_lux_: SyntaxList
+ (list& (`' (_lux_def (~ name) (~ body'')))
+ (if export?
+ (list (`' (_lux_export (~ name))))
+ #Nil)))))
+
+ #None
+ (fail "Wrong syntax for def"))))
(def (rejoin-pair pair)
(-> (, Syntax Syntax) (List Syntax))
@@ -1598,36 +1652,39 @@
(defmacro #export (case tokens)
(_lux_case tokens
- (#Cons [value branches])
- (do Lux:Monad
- [expansions (map% Lux:Monad
- (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
- (lambda expander [branch]
- (let [[pattern body] branch]
- (_lux_case pattern
- (#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))]
- (;return (list:join expansions)))
-
- _
- (;return (list branch))))))
- (as-pairs branches))]
- (;return (list (`' (_lux_case (~ value)
- (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
-
- _
- (fail "Wrong syntax for case")))
+ (#Cons [value branches])
+ (do Lux:Monad
+ [expansions (map% Lux:Monad
+ (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
+ (lambda expander [branch]
+ (let [[pattern body] branch]
+ (_lux_case pattern
+ (#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 (: (List Syntax) expansion)))]
+ (;return (: (List (, Syntax Syntax)) (list:join (: (List (List (, Syntax Syntax))) expansions)))))
+
+ _
+ (;return (: (List (, Syntax Syntax)) (list branch)))))))
+ (as-pairs branches))]
+ (;return (_lux_: SyntaxList
+ (list (`' (_lux_case (~ value)
+ (~@ (|> (: (List (List (, Syntax Syntax))) expansions)
+ list:join (map rejoin-pair) list:join))))))))
+
+ _
+ (fail "Wrong syntax for case")))
(defmacro #export (\ tokens)
(case tokens
(#Cons [body (#Cons [pattern #Nil])])
(do Lux:Monad
[pattern+ (macro-expand pattern)]
- (case pattern+
+ (case (: (List Syntax) pattern+)
(#Cons [pattern' #Nil])
- (;return (list pattern' body))
+ (;return (: (List Syntax)
+ (list pattern' body)))
_
(fail "\\ can only expand to 1 pattern.")))
@@ -1645,8 +1702,10 @@
_
(do Lux:Monad
[patterns' (map% Lux:Monad macro-expand patterns)]
- (;return (list:join (map (lambda [pattern] (list pattern body))
- (list:join patterns'))))))
+ (;return (_lux_: SyntaxList
+ (list:join (map (: (-> Syntax (List Syntax))
+ (lambda [pattern] (list pattern body)))
+ (list:join patterns')))))))
_
(fail "Wrong syntax for \\or")))
@@ -1667,7 +1726,8 @@
[module-name get-module-name]
(case tokens
(\ (list template))
- (;return (list (untemplate module-name template)))
+ (;return (_lux_: SyntaxList
+ (list (untemplate module-name template))))
_
(fail "Wrong syntax for `"))))
@@ -1687,7 +1747,7 @@
(-> Syntax (Lux Syntax))
(do Lux:Monad
[token+ (macro-expand token)]
- (case token+
+ (case (: (List Syntax) token+)
(\ (list token'))
(;return token')
@@ -1709,12 +1769,13 @@
_
(fail "Signatures require typed members!"))))
tokens')]
- (;return (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax)
- (lambda [pair]
- (let [[name type] pair]
- (`' [(~ (|> name ident->text $text))
- (~ type)]))))
- members)))))))))
+ (;return (: (List Syntax)
+ (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax)
+ (lambda [pair]
+ (let [[name type] pair]
+ (`' [(~ (|> name ident->text $text))
+ (~ type)]))))
+ members))))))))))
(defmacro #export (defsig tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
@@ -1743,10 +1804,11 @@
_
(`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))]
- (return (list& (`' (_lux_def (~ name) (~ sigs')))
- (if export?
- (list (`' (_lux_export (~ name))))
- #Nil))))
+ (return (_lux_: SyntaxList
+ (list& (`' (_lux_def (~ name) (~ sigs')))
+ (if export?
+ (list (`' (_lux_export (~ name))))
+ #Nil)))))
#None
(fail "Wrong syntax for defsig"))))
@@ -1766,7 +1828,8 @@
_
(fail "Structures require defined members!"))))
tokens')]
- (;return (list ($record members)))))
+ (;return (_lux_: SyntaxList
+ (list ($record members))))))
(defmacro #export (defstruct tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
@@ -1795,10 +1858,11 @@
_
(`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
- (return (list& (`' (def (~ name) (~ type) (~ defs')))
- (if export?
- (list (`' (_lux_export (~ name))))
- #Nil))))
+ (return (_lux_: SyntaxList
+ (list& (`' (def (~ name) (~ type) (~ defs')))
+ (if export?
+ (list (`' (_lux_export (~ name))))
+ #Nil)))))
#None
(fail "Wrong syntax for defsig"))))
@@ -1847,9 +1911,11 @@
[(defmacro #export (<name> tokens)
(case (reverse tokens)
(\ (list& last init))
- (return (list (fold (lambda [post pre] (` <form>))
- last
- init)))
+ (return (: (List Syntax)
+ (list (fold (: (-> Syntax Syntax Syntax)
+ (lambda [post pre] (` <form>)))
+ last
+ init))))
_
(fail <message>)))]
@@ -1891,9 +1957,11 @@
(list name)
(list)))))
lux)]
- (#Right [state (map (lambda [name]
- (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name])))))
- (list:join to-alias))]))
+ (#Right [state (_lux_: SyntaxList
+ (map (: (-> Text Syntax)
+ (lambda [name]
+ (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name]))))))
+ (list:join to-alias)))]))
#None
(#Left "Uh, oh... The universe is not working properly..."))
@@ -1997,16 +2065,18 @@
[($tag [module name]) ($symbol ["" name])])))
slots))
_ (println (text:++ "Using pattern: " (syntax:show pattern)))]
- (#Right [state (list (` (_lux_case (~ struct) (~ pattern) (~ body))))]))
+ (#Right [state (_lux_: SyntaxList
+ (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))]))
_
(#Left "Can only \"use\" records."))))))
_
(let [dummy ($symbol ["" ""])]
- (#Right [state (list (` (_lux_case (~ struct)
- (~ dummy)
- (using (~ dummy) (~ body)))))])))
+ (#Right [state (_lux_: SyntaxList
+ (list (` (_lux_case (~ struct)
+ (~ dummy)
+ (using (~ dummy) (~ body))))))])))
_
(#Left "Wrong syntax for defsig")))
@@ -2014,9 +2084,10 @@
(defmacro #export (when tokens)
(case tokens
(\ (list test body))
- (return (list (` (if (~ test)
- (#Some (~ body))
- #None))))
+ (return (_lux_: SyntaxList
+ (list (` (if (~ test)
+ (#Some (~ body))
+ #None)))))
_
(fail "Wrong syntax for when")))
diff --git a/source/program.lux b/source/program.lux
index a9451580f..cefec07d4 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -12,7 +12,7 @@
(filter p xs'))))
(_jvm_program _
- (exec (println "Hello, world!")
- (|> (int:+ 2 2) ->text ($ text:++ "2 + 2 = ") println)
- (println (->text (using Int:Ord
- (< 5 10))))))
+ (exec (println "Hello, world!")
+ (|> (int:+ 2 2) ->text ($ text:++ "2 + 2 = ") println)
+ (println (->text (using Int:Ord
+ (< 5 10))))))
diff --git a/src/lux.clj b/src/lux.clj
index 5b32955a3..eb025f55e 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -2,10 +2,13 @@
(:gen-class)
(:require [lux.base :as &]
[lux.compiler :as &compiler]
+ [lux.type :as &type]
:reload-all))
(defn -main [& _]
- (time (&compiler/compile-all (&/|list "program")))
+ (do (time (&compiler/compile-all (&/|list "program")))
+ ;; (prn @&type/counter)
+ )
(System/exit 0))
(comment
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index c37c1acde..3c5c5c956 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -454,6 +454,7 @@
(fail "")))
(defn ^:private analyse-basic-ast [analyse eval! exo-type token]
+ ;; (prn 'analyse-basic-ast (&/show-ast token))
(fn [state]
(matchv ::M/objects [((aba1 analyse eval! exo-type token) state)]
[["lux;Right" [state* output]]]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 1b0c70f77..7600f34ff 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -151,7 +151,7 @@
[_]
(fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))
- (fail* ""))
+ (fail* "_{_ analyse-symbol _}_"))
[["lux;Cons" [top-outer _]]]
(|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
@@ -172,39 +172,42 @@
)))
))
-(defn ^:private analyse-apply* [analyse exo-type fun-type args]
- (matchv ::M/objects [args]
- [["lux;Nil" _]]
- (|do [_ (&type/check exo-type fun-type)]
- (return (&/T (&/|list) fun-type)))
-
- [["lux;Cons" [?arg ?args*]]]
- (|do [?fun-type* (&type/actual-type fun-type)]
- (matchv ::M/objects [?fun-type*]
- [["lux;AllT" _]]
- (&type/with-var
- (fn [$var]
- (|do [type* (&type/apply-type ?fun-type* $var)
- [?args** ?type**] (analyse-apply* analyse exo-type type* args)]
- (matchv ::M/objects [$var]
- [["lux;VarT" ?id]]
- (|do [? (&type/bound? ?id)
- _ (if ?
- (return nil)
- (|do [ex &type/existential]
- (&type/set-var ?id ex)))
- type*** (&type/clean $var ?type**)]
- (return (&/T ?args** type***)))
- ))))
-
- [["lux;LambdaT" [?input-t ?output-t]]]
- (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*)
- =arg (&&/analyse-1 analyse ?input-t ?arg)]
- (return (&/T (&/|cons =arg =args) ?output-t*)))
+(defn ^:private analyse-apply* [analyse exo-type =fn ?args]
+ (matchv ::M/objects [=fn]
+ [[?fun-expr ?fun-type]]
+ (matchv ::M/objects [?args]
+ [["lux;Nil" _]]
+ (|do [_ (&type/check exo-type ?fun-type)]
+ (return =fn))
+
+ [["lux;Cons" [?arg ?args*]]]
+ (|do [?fun-type* (&type/actual-type ?fun-type)]
+ (matchv ::M/objects [?fun-type*]
+ [["lux;AllT" _]]
+ (&type/with-var
+ (fn [$var]
+ (|do [type* (&type/apply-type ?fun-type* $var)
+ output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)]
+ (matchv ::M/objects [output $var]
+ [[?expr* ?type*] ["lux;VarT" ?id]]
+ (|do [? (&type/bound? ?id)
+ _ (if ?
+ (return nil)
+ (|do [ex &type/existential]
+ (&type/set-var ?id ex)))
+ type** (&type/clean $var ?type*)]
+ (return (&/T ?expr* type**)))
+ ))))
+
+ [["lux;LambdaT" [?input-t ?output-t]]]
+ (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
+ (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg))
+ ?output-t)
+ ?args*))
- [_]
- (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
- ))
+ [_]
+ (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
+ )))
(defn analyse-apply [analyse exo-type =fn ?args]
(|do [loader &/loader]
@@ -219,14 +222,12 @@
(&/flat-map% (partial analyse exo-type) macro-expansion))
[_]
- (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)]
- (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
- =app-type))))))
+ (|do [output (analyse-apply* analyse exo-type =fn ?args)]
+ (return (&/|list output)))))
[_]
- (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)]
- (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
- =app-type)))))
+ (|do [output (analyse-apply* analyse exo-type =fn ?args)]
+ (return (&/|list output))))
)))
(defn analyse-case [analyse exo-type ?value ?branches]
@@ -263,7 +264,12 @@
(|do [? (&type/bound? ?id)]
(if ?
(|do [dtype (&type/deref ?id)]
- (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
+ (matchv ::M/objects [dtype]
+ [["lux;ExT" _]]
+ (return (&/T _expr exo-type))
+
+ [_]
+ (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))))
(return (&/T _expr exo-type))))))))
[_]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 9ea255132..edf6781ea 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -551,40 +551,40 @@
(defn show-ast [ast]
(matchv ::M/objects [ast]
- [["lux;Meta" [_ ["lux;Bool" ?value]]]]
+ [["lux;Meta" [_ ["lux;BoolS" ?value]]]]
(pr-str ?value)
- [["lux;Meta" [_ ["lux;Int" ?value]]]]
+ [["lux;Meta" [_ ["lux;IntS" ?value]]]]
(pr-str ?value)
- [["lux;Meta" [_ ["lux;Real" ?value]]]]
+ [["lux;Meta" [_ ["lux;RealS" ?value]]]]
(pr-str ?value)
- [["lux;Meta" [_ ["lux;Char" ?value]]]]
+ [["lux;Meta" [_ ["lux;CharS" ?value]]]]
(pr-str ?value)
- [["lux;Meta" [_ ["lux;Text" ?value]]]]
+ [["lux;Meta" [_ ["lux;TextS" ?value]]]]
(str "\"" ?value "\"")
- [["lux;Meta" [_ ["lux;Tag" [?module ?tag]]]]]
+ [["lux;Meta" [_ ["lux;TagS" [?module ?tag]]]]]
(str "#" ?module ";" ?tag)
- [["lux;Meta" [_ ["lux;Symbol" [?module ?ident]]]]]
+ [["lux;Meta" [_ ["lux;SymbolS" [?module ?ident]]]]]
(if (= "" ?module)
?ident
(str ?module ";" ?ident))
- [["lux;Meta" [_ ["lux;Tuple" ?elems]]]]
+ [["lux;Meta" [_ ["lux;TupleS" ?elems]]]]
(str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]")
- [["lux;Meta" [_ ["lux;Record" ?elems]]]]
+ [["lux;Meta" [_ ["lux;RecordS" ?elems]]]]
(str "{" (->> ?elems
(|map (fn [elem]
(|let [[k v] elem]
(str (show-ast k) " " (show-ast v)))))
(|interpose " ") (fold str "")) "}")
- [["lux;Meta" [_ ["lux;Form" ?elems]]]]
+ [["lux;Meta" [_ ["lux;FormS" ?elems]]]]
(str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")")
))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 26b75bec3..6fb9e2c6d 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -60,8 +60,8 @@
[["lux;Global" [?owner-class ?name]]]
(&&lux/compile-global compile-expression ?type ?owner-class ?name)
- [["apply" [?fn ?args]]]
- (&&lux/compile-apply compile-expression ?type ?fn ?args)
+ [["apply" [?fn ?arg]]]
+ (&&lux/compile-apply compile-expression ?type ?fn ?arg)
[["variant" [?tag ?members]]]
(&&lux/compile-variant compile-expression ?type ?tag ?members)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 2c5073a4d..cf4a65f04 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -117,14 +117,11 @@
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
(return nil)))
-(defn compile-apply [compile *type* ?fn ?args]
+(defn compile-apply [compile *type* ?fn ?arg]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?fn)
- _ (&/map% (fn [?arg]
- (|do [_ (compile ?arg)
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
- (return nil)))
- ?args)]
+ _ (compile ?arg)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
(return nil)))
(defn compile-def [compile ?name ?body ?def-data]
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 2ee8088d3..d2ab4a5d7 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -18,11 +18,11 @@
(fail (str "[Lexer Error] Unknown escape character: " escaped))))
(defn ^:private lex-text-body [_]
- (&/try-all% (&/|list (|do [[_ [_ [prefix escaped]]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)")
+ (&/try-all% (&/|list (|do [[_ [prefix escaped]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)")
unescaped (escape-char escaped)
postfix (lex-text-body nil)]
(return (str prefix unescaped postfix)))
- (|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")]
+ (|do [[_ body] (&reader/read-regex #"(?s)^([^\"\\]*)")]
(return body)))))
(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)"
@@ -31,26 +31,26 @@
;; [Lexers]
(def ^:private lex-white-space
- (|do [[_ [meta white-space]] (&reader/read-regex #"^(\s+)")]
+ (|do [[meta white-space] (&reader/read-regex #"^(\s+)")]
(return (&/V "lux;Meta" (&/T meta (&/V "White_Space" white-space))))))
(def ^:private lex-single-line-comment
(|do [_ (&reader/read-text "##")
- [_ [meta comment]] (&reader/read-regex #"^(.*)$")]
+ [meta comment] (&reader/read-regex #"^(.*)$")]
(return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment))))))
(defn ^:private lex-multi-line-comment [_]
(|do [_ (&reader/read-text "#(")
- [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))")
+ [meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))")
;; :let [_ (prn 'immediate comment)]
_ (&reader/read-text ")#")]
(return (&/T meta comment)))
(|do [;; :let [_ (prn 'pre/_0)]
- [_ [meta pre]] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)")
+ [meta pre] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)")
;; :let [_ (prn 'pre pre)]
- [_ [_ [_ inner]]] (lex-multi-line-comment nil)
+ [_ inner] (lex-multi-line-comment nil)
;; :let [_ (prn 'inner inner)]
- [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))")
+ [_ post] (&reader/read-regex #"(?is)^(.+?(?=\)#))")
;; :let [_ (prn 'post post (str pre "#(" inner ")#" post))]
]
(return (&/T meta (str pre "#(" inner ")#" post))))))
@@ -64,7 +64,7 @@
(do-template [<name> <tag> <regex>]
(def <name>
- (|do [[_ [meta token]] (&reader/read-regex <regex>)]
+ (|do [[meta token] (&reader/read-regex <regex>)]
(return (&/V "lux;Meta" (&/T meta (&/V <tag> token))))))
^:private lex-bool "Bool" #"^(true|false)"
@@ -73,54 +73,54 @@
)
(def ^:private lex-char
- (|do [[_ [meta _]] (&reader/read-text "#\"")
- token (&/try-all% (&/|list (|do [[_ [_ escaped]] (&reader/read-regex #"^(\\.)")]
+ (|do [[meta _] (&reader/read-text "#\"")
+ token (&/try-all% (&/|list (|do [[_ escaped] (&reader/read-regex #"^(\\.)")]
(escape-char escaped))
- (|do [[_ [_ char]] (&reader/read-regex #"^(.)")]
+ (|do [[_ char] (&reader/read-regex #"^(.)")]
(return char))))
_ (&reader/read-text "\"")]
(return (&/V "lux;Meta" (&/T meta (&/V "Char" token))))))
(def ^:private lex-text
- (|do [[_ [meta _]] (&reader/read-text "\"")
+ (|do [[meta _] (&reader/read-text "\"")
token (lex-text-body nil)
_ (&reader/read-text "\"")]
(return (&/V "lux;Meta" (&/T meta (&/V "Text" token))))))
(def ^:private lex-ident
- (&/try-all% (&/|list (|do [[_ [meta token]] (&reader/read-regex +ident-re+)]
+ (&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (|do [_ (&reader/read-text ";")
- [_ [_ local-token]] (&reader/read-regex +ident-re+)]
+ [_ local-token] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (|do [unaliased (&module/dealias token)]
- (return (&/V "lux;Meta" (&/T meta (&/T unaliased local-token)))))
+ (return (&/T meta (&/T unaliased local-token))))
(|do [? (&module/exists? token)]
(if ?
- (return (&/V "lux;Meta" (&/T meta (&/T token local-token))))
+ (return (&/T meta (&/T token local-token)))
(fail (str "[Lexer Error] Unknown module: " token))))
)))
- (return (&/V "lux;Meta" (&/T meta (&/T "" token))))
+ (return (&/T meta (&/T "" token)))
)))
- (|do [[_ [meta _]] (&reader/read-text ";;")
- [_ [_ token]] (&reader/read-regex +ident-re+)
+ (|do [[meta _] (&reader/read-text ";;")
+ [_ token] (&reader/read-regex +ident-re+)
module-name &/get-module-name]
- (return (&/V "lux;Meta" (&/T meta (&/T module-name token)))))
- (|do [[_ [meta _]] (&reader/read-text ";")
- [_ [_ token]] (&reader/read-regex +ident-re+)]
- (return (&/V "lux;Meta" (&/T meta (&/T "lux" token)))))
+ (return (&/T meta (&/T module-name token))))
+ (|do [[meta _] (&reader/read-text ";")
+ [_ token] (&reader/read-regex +ident-re+)]
+ (return (&/T meta (&/T "lux" token))))
)))
(def ^:private lex-symbol
- (|do [[_ [meta ident]] lex-ident]
+ (|do [[meta ident] lex-ident]
(return (&/V "lux;Meta" (&/T meta (&/V "Symbol" ident))))))
(def ^:private lex-tag
- (|do [[_ [meta _]] (&reader/read-text "#")
- [_ [_ ident]] lex-ident]
+ (|do [[meta _] (&reader/read-text "#")
+ [_ ident] lex-ident]
(return (&/V "lux;Meta" (&/T meta (&/V "Tag" ident))))))
(do-template [<name> <text> <tag>]
(def <name>
- (|do [[_ [meta _]] (&reader/read-text <text>)]
+ (|do [[meta _] (&reader/read-text <text>)]
(return (&/V "lux;Meta" (&/T meta (&/V <tag> nil))))))
^:private lex-open-paren "(" "Open_Paren"
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index c25870168..b1fcc4740 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -11,7 +11,7 @@
[["lux;Nil" _]]
(fail* "[Reader Error] EOF")
- [["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]]
+ [["lux;Cons" [[[file-name line-num column-num] line]
more]]]
(matchv ::M/objects [(body file-name line-num column-num line)]
[["No" msg]]
@@ -38,18 +38,24 @@
)))
;; [Exports]
-(defn ^:private re-find! [^java.util.regex.Pattern regex line]
- (let [matcher (.matcher regex line)]
+(defn ^:private re-find! [^java.util.regex.Pattern regex column ^String line]
+ (let [matcher (doto (.matcher regex line)
+ (.region column (.length line))
+ (.useAnchoringBounds true))]
(when (.find matcher)
(.group matcher 0))))
-(defn ^:private re-find1! [^java.util.regex.Pattern regex line]
- (let [matcher (.matcher regex line)]
+(defn ^:private re-find1! [^java.util.regex.Pattern regex column ^String line]
+ (let [matcher (doto (.matcher regex line)
+ (.region column (.length line))
+ (.useAnchoringBounds true))]
(when (.find matcher)
(.group matcher 1))))
-(defn ^:private re-find3! [^java.util.regex.Pattern regex line]
- (let [matcher (.matcher regex line)]
+(defn ^:private re-find3! [^java.util.regex.Pattern regex column ^String line]
+ (let [matcher (doto (.matcher regex line)
+ (.region column (.length line))
+ (.useAnchoringBounds true))]
(when (.find matcher)
(list (.group matcher 0)
(.group matcher 1)
@@ -58,27 +64,29 @@
(defn read-regex [regex]
(with-line
(fn [file-name line-num column-num ^String line]
+ ;; (prn 'read-regex [file-name line-num column-num regex line])
(if-let [^String match (do ;; (prn '[regex line] [regex line])
- (re-find! regex line))]
+ (re-find! regex column-num line))]
(let [;; _ (prn 'match match)
match-length (.length match)
- line* (.substring line match-length)]
- (if (.isEmpty line*)
- (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)))
- (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))
- (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))
+ column-num* (+ column-num match-length)]
+ (if (= column-num* (.length line))
+ (&/V "Done" (&/T (&/T file-name line-num column-num) match))
+ (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) match)
+ (&/T (&/T file-name line-num column-num*) line)))))
(&/V "No" (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex2 [regex]
(with-line
(fn [file-name line-num column-num ^String line]
- (if-let [[^String match tok1 tok2] (re-find3! regex line)]
+ ;; (prn 'read-regex2 [file-name line-num column-num regex line])
+ (if-let [[^String match tok1 tok2] (re-find3! regex column-num line)]
(let [match-length (.length match)
- line* (.substring line match-length)]
- (if (.isEmpty line*)
- (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))))
- (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
- (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))
+ column-num* (+ column-num match-length)]
+ (if (= column-num* (.length line))
+ (&/V "Done" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
+ (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))
+ (&/T (&/T file-name line-num column-num*) line)))))
(&/V "No" (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex+ [regex]
@@ -90,37 +98,38 @@
[["lux;Nil" _]]
(&/V "lux;Left" "[Reader Error] EOF")
- [["lux;Cons" [[_ [[file-name line-num column-num] ^String line]]
+ [["lux;Cons" [[[file-name line-num column-num] ^String line]
reader**]]]
(if-let [^String match (do ;; (prn 'read-regex+ regex line)
- (re-find1! regex line))]
+ (re-find1! regex column-num line))]
(let [match-length (.length match)
- line* (.substring line match-length)]
- (if (.isEmpty line*)
+ column-num* (+ column-num match-length)]
+ (if (= column-num* (.length line))
(recur (str prefix match "\n") reader**)
- (&/V "lux;Right" (&/T (&/|cons (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))
+ (&/V "lux;Right" (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line)
reader**)
- (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (str prefix match)))))))
+ (&/T (&/T file-name line-num column-num) (str prefix match))))))
(&/V "lux;Left" (str "[Reader Error] Pattern failed: " regex))))))))
(defn read-text [^String text]
(with-line
(fn [file-name line-num column-num ^String line]
- (if (.startsWith line text)
+ ;; (prn 'read-text [file-name line-num column-num text line])
+ (if (.startsWith line text column-num)
(let [match-length (.length text)
- line* (.substring line match-length)]
- (if (empty? line*)
- (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)))
- (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text))
- (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))
+ column-num* (+ column-num match-length)]
+ (if (= column-num* (.length line))
+ (&/V "Done" (&/T (&/T file-name line-num column-num) text))
+ (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) text)
+ (&/T (&/T file-name line-num column-num*) line)))))
(&/V "No" (str "[Reader Error] Text failed: " text))))))
(defn from [file-name]
(let [lines (&/->list (string/split-lines (slurp file-name)))]
(&/|map (fn [line+line-num]
(|let [[line-num line] line+line-num]
- (&/V "lux;Meta" (&/T (&/T file-name line-num 0)
- line))))
+ (&/T (&/T file-name line-num 0)
+ line)))
(&/|filter (fn [line+line-num]
(|let [[line-num line] line+line-num]
(not= "" line)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 97b7c1bde..105528b8a 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -547,17 +547,28 @@
(def init-fixpoints (&/|list))
+(def counter (atom {}))
(defn ^:private check* [fixpoints expected actual]
+ ;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]]
+ ;; #(inc (or % 0)))
(matchv ::M/objects [expected actual]
[["lux;VarT" ?eid] ["lux;VarT" ?aid]]
(if (= ?eid ?aid)
(return (&/T fixpoints nil))
- (|do [ebound (&/try-all% (&/|list (|do [ebound (deref ?eid)]
- (return (&/V "lux;Some" ebound)))
- (return (&/V "lux;None" nil))))
- abound (&/try-all% (&/|list (|do [abound (deref ?aid)]
- (return (&/V "lux;Some" abound)))
- (return (&/V "lux;None" nil))))]
+ (|do [ebound (fn [state]
+ (matchv ::M/objects [((deref ?eid) state)]
+ [["lux;Right" [state* ebound]]]
+ (return* state* (&/V "lux;Some" ebound))
+
+ [["lux;Left" _]]
+ (return* state (&/V "lux;None" nil))))
+ abound (fn [state]
+ (matchv ::M/objects [((deref ?aid) state)]
+ [["lux;Right" [state* abound]]]
+ (return* state* (&/V "lux;Some" abound))
+
+ [["lux;Left" _]]
+ (return* state (&/V "lux;None" nil))))]
(matchv ::M/objects [ebound abound]
[["lux;None" _] ["lux;None" _]]
(|do [_ (set-var ?eid actual)]
@@ -573,39 +584,75 @@
(check* fixpoints etype atype))))
[["lux;VarT" ?id] _]
- (&/try-all% (&/|list (|do [_ (set-var ?id actual)]
- (return (&/T fixpoints nil)))
- (|do [bound (deref ?id)]
- (check* fixpoints bound actual))))
+ (fn [state]
+ (matchv ::M/objects [((set-var ?id actual) state)]
+ [["lux;Right" [state* _]]]
+ (return* state* (&/T fixpoints nil))
+
+ [["lux;Left" _]]
+ ((|do [bound (deref ?id)]
+ (check* fixpoints bound actual))
+ state)))
[_ ["lux;VarT" ?id]]
- (&/try-all% (&/|list (|do [_ (set-var ?id expected)]
- (return (&/T fixpoints nil)))
- (|do [bound (deref ?id)]
- (check* fixpoints expected bound))))
+ (fn [state]
+ (matchv ::M/objects [((set-var ?id expected) state)]
+ [["lux;Right" [state* _]]]
+ (return* state* (&/T fixpoints nil))
+
+ [["lux;Left" _]]
+ ((|do [bound (deref ?id)]
+ (check* fixpoints expected bound))
+ state)))
[["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
- (&/try-all% (&/|list (|do [F1 (deref ?eid)]
- (&/try-all% (&/|list (|do [F2 (deref ?aid)]
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))))
- (|do [F2 (deref ?aid)]
- (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
- (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
- [fixpoints** _] (check* fixpoints* A1 A2)]
- (return (&/T fixpoints** nil)))))
+ (fn [state]
+ (matchv ::M/objects [((|do [F1 (deref ?eid)]
+ (fn [state]
+ (matchv ::M/objects [((|do [F2 (deref ?aid)]
+ (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
+ state))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ (matchv ::M/objects [((|do [F2 (deref ?aid)]
+ (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ [fixpoints** _] (check* fixpoints* A1 A2)]
+ (return (&/T fixpoints** nil)))
+ state))))
;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
;; _ (check* fixpoints A1 A2)]
;; (return (&/T fixpoints nil)))
[["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
- (&/try-all% (&/|list (|do [F1 (deref ?id)]
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
- (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
- e* (apply-type F2 A1)
- a* (apply-type F2 A2)
- [fixpoints** _] (check* fixpoints* e* a*)]
- (return (&/T fixpoints** nil)))))
+ (fn [state]
+ (matchv ::M/objects [((|do [F1 (deref ?id)]
+ (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+ e* (apply-type F2 A1)
+ a* (apply-type F2 A2)
+ [fixpoints** _] (check* fixpoints* e* a*)]
+ (return (&/T fixpoints** nil)))
+ state)))
;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
;; e* (apply-type F2 A1)
@@ -614,13 +661,20 @@
;; (return (&/T fixpoints** nil)))
[["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
- (&/try-all% (&/|list (|do [F2 (deref ?id)]
- (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
- (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
- e* (apply-type F1 A1)
- a* (apply-type F1 A2)
- [fixpoints** _] (check* fixpoints* e* a*)]
- (return (&/T fixpoints** nil)))))
+ (fn [state]
+ (matchv ::M/objects [((|do [F2 (deref ?id)]
+ (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+ e* (apply-type F1 A1)
+ a* (apply-type F1 A2)
+ [fixpoints** _] (check* fixpoints* e* a*)]
+ (return (&/T fixpoints** nil)))
+ state)))
;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
;; e* (apply-type F1 A1)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 23:32:00 +0000