aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--source/lux.lux2317
-rw-r--r--source/program.lux10
-rw-r--r--src/lux/analyser.clj202
-rw-r--r--src/lux/analyser/host.clj2
-rw-r--r--src/lux/analyser/lux.clj81
-rw-r--r--src/lux/analyser/module.clj30
-rw-r--r--src/lux/base.clj6
-rw-r--r--src/lux/compiler.clj15
-rw-r--r--src/lux/reader.clj4
-rw-r--r--src/lux/type.clj109
10 files changed, 1407 insertions, 1369 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 26425e7b8..f2a6f70da 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -7,53 +7,53 @@
## You must not remove this notice, or any other, from this software.
## First things first, must define functions
-(jvm-interface Function
- (:' (-> [java.lang.Object] java.lang.Object)
+(_jvm_interface Function
+ (: (-> [java.lang.Object] java.lang.Object)
apply))
## Basic types
-(def' Bool (#DataT "java.lang.Boolean"))
-(export' Bool)
+(_lux_def Bool (#DataT "java.lang.Boolean"))
+(_lux_export Bool)
-(def' Int (#DataT "java.lang.Long"))
-(export' Int)
+(_lux_def Int (#DataT "java.lang.Long"))
+(_lux_export Int)
-(def' Real (#DataT "java.lang.Double"))
-(export' Real)
+(_lux_def Real (#DataT "java.lang.Double"))
+(_lux_export Real)
-(def' Char (#DataT "java.lang.Character"))
-(export' Char)
+(_lux_def Char (#DataT "java.lang.Character"))
+(_lux_export Char)
-(def' Text (#DataT "java.lang.String"))
-(export' Text)
+(_lux_def Text (#DataT "java.lang.String"))
+(_lux_export Text)
-(def' Void (#VariantT #Nil))
-(export' Void)
+(_lux_def Void (#VariantT #Nil))
+(_lux_export Void)
-(def' Ident (#TupleT (#Cons [Text (#Cons [Text #Nil])])))
-(export' Ident)
+(_lux_def Ident (#TupleT (#Cons [Text (#Cons [Text #Nil])])))
+(_lux_export Ident)
## (deftype (List a)
## (| #Nil
## (#Cons (, a (List a)))))
-(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])]))]))
-(export' List)
+(_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])]))]))
+(_lux_export List)
## (deftype (Maybe a)
## (| #None
## (#Some a)))
-(def' Maybe
- (#AllT [#None "Maybe" "a"
- (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
- (#Cons [["lux;Some" (#BoundT "a")]
- #Nil])]))]))
-(export' Maybe)
+(_lux_def Maybe
+ (#AllT [#None "Maybe" "a"
+ (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
+ (#Cons [["lux;Some" (#BoundT "a")]
+ #Nil])]))]))
+(_lux_export Maybe)
## (deftype #rec Type
## (| (#DataT Text)
@@ -65,70 +65,70 @@
## (#VarT Int)
## (#AllT (, (Maybe (List (, Text Type))) Text Text Type))
## (#AppT (, Type Type))))
-(def' Type
- (case' (#AppT [(#BoundT "Type") (#BoundT "_")])
- Type
- (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]))))
-(export' 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_export Type)
## (deftype (Bindings k v)
## (& #counter Int
## #mappings (List (, k v))))
-(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])]))])]))
+(_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])]))])]))
## (deftype (Env k v)
## (& #name Text
## #inner-closures Int
## #locals (Bindings k v)
## #closure (Bindings k v)))
-(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])])])]))])]))
+(_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])])])]))])]))
## (deftype Cursor
## (, Text Int Int))
-(def' Cursor
- (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))
+(_lux_def Cursor
+ (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))
## (deftype (Meta m v)
## (| (#Meta (, m v))))
-(def' Meta
- (#AllT [#None "Meta" "m"
- (#AllT [#None "" "v"
- (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
- (#Cons [(#BoundT "v")
- #Nil])]))]
- #Nil]))])]))
-(export' Meta)
+(_lux_def Meta
+ (#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)
## (| (#Bool Bool)
@@ -141,98 +141,98 @@
## (#Form (List (w (Syntax' w))))
## (#Tuple (List (w (Syntax' w))))
## (#Record (List (, (w (Syntax' w)) (w (Syntax' w)))))))
-(def' Syntax'
- (case' (#AppT [(#BoundT "w")
- (#AppT [(#BoundT "Syntax'")
- (#BoundT "w")])])
- Syntax
- (case' (#AppT [List Syntax])
- SyntaxList
- (#AllT [#None "Syntax'" "w"
- (#VariantT (#Cons [["lux;Bool" Bool]
- (#Cons [["lux;Int" Int]
- (#Cons [["lux;Real" Real]
- (#Cons [["lux;Char" Char]
- (#Cons [["lux;Text" Text]
- (#Cons [["lux;Symbol" Ident]
- (#Cons [["lux;Tag" Ident]
- (#Cons [["lux;Form" SyntaxList]
- (#Cons [["lux;Tuple" SyntaxList]
- (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
- #Nil])
- ])])])])])])])])])
- )]))))
-(export' Syntax')
+(_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;Bool" Bool]
+ (#Cons [["lux;Int" Int]
+ (#Cons [["lux;Real" Real]
+ (#Cons [["lux;Char" Char]
+ (#Cons [["lux;Text" Text]
+ (#Cons [["lux;Symbol" Ident]
+ (#Cons [["lux;Tag" Ident]
+ (#Cons [["lux;Form" SyntaxList]
+ (#Cons [["lux;Tuple" SyntaxList]
+ (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
+ #Nil])
+ ])])])])])])])])])
+ )]))))
+(_lux_export Syntax')
## (deftype Syntax
## (Meta Cursor (Syntax' (Meta Cursor))))
-(def' Syntax
- (case' (#AppT [Meta Cursor])
- w
- (#AppT [w (#AppT [Syntax' w])])))
-(export' Syntax)
+(_lux_def Syntax
+ (_lux_case (#AppT [Meta Cursor])
+ w
+ (#AppT [w (#AppT [Syntax' w])])))
+(_lux_export Syntax)
-(def' SyntaxList (#AppT [List Syntax]))
+(_lux_def SyntaxList (#AppT [List Syntax]))
## (deftype (Either l r)
## (| (#Left l)
## (#Right r)))
-(def' Either
- (#AllT [#None "_" "l"
- (#AllT [#None "" "r"
- (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
- (#Cons [["lux;Right" (#BoundT "r")]
- #Nil])]))])]))
-(export' Either)
+(_lux_def Either
+ (#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))))
-(def' StateE
- (#AllT [#None "StateE" "s"
- (#AllT [#None "" "a"
- (#LambdaT [(#BoundT "s")
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [(#BoundT "s")
- (#Cons [(#BoundT "a")
- #Nil])]))])])])]))
-
-## (def' Reader
+(_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])]))])])])]))
+
+## (deftype Reader
## (List (Meta Cursor Text)))
-(def' Reader
- (#AppT [List
- (#AppT [(#AppT [Meta Cursor])
- Text])]))
-(export' Reader)
+(_lux_def Reader
+ (#AppT [List
+ (#AppT [(#AppT [Meta Cursor])
+ Text])]))
+(_lux_export Reader)
## (deftype HostState
## (& #writer (^ org.objectweb.asm.ClassWriter)
## #loader (^ java.net.URLClassLoader)))
-(def' HostState
- (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
- (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
- #Nil])])))
+(_lux_def HostState
+ (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
+ (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
+ #Nil])])))
## (deftype (DefData' m)
## (| #TypeD
## (#ValueD Type)
## (#MacroD m)
## (#AliasD Ident)))
-(def' DefData'
- (#AllT [#None "DefData'" ""
- (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
- (#Cons [["lux;ValueD" Type]
- (#Cons [["lux;MacroD" (#BoundT "")]
- (#Cons [["lux;AliasD" Ident]
- #Nil])])])]))]))
+(_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])])])]))]))
## (deftype LuxVar
## (| (#Local Int)
## (#Global Ident)))
-(def' LuxVar
- (#VariantT (#Cons [["lux;Local" Int]
- (#Cons [["lux;Global" Ident]
- #Nil])])))
-(export' LuxVar)
+(_lux_def LuxVar
+ (#VariantT (#Cons [["lux;Local" Int]
+ (#Cons [["lux;Global" Ident]
+ #Nil])])))
+(_lux_export LuxVar)
## (deftype #rec CompilerState
## (& #source Reader
@@ -241,324 +241,324 @@
## #envs (List (Env Text (, LuxVar Type)))
## #types (Bindings Int Type)
## #host HostState))
-(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]))
-(export' CompilerState)
+(_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]))
+(_lux_export CompilerState)
## (deftype Macro
## (-> (List Syntax) (StateE CompilerState (List Syntax))))
-(def' Macro
- (#LambdaT [SyntaxList
- (#AppT [(#AppT [StateE CompilerState])
- SyntaxList])]))
-(export' Macro)
+(_lux_def Macro
+ (#LambdaT [SyntaxList
+ (#AppT [(#AppT [StateE CompilerState])
+ SyntaxList])]))
+(_lux_export Macro)
## Base functions & macros
## (def (_meta data)
## (-> (Syntax' (Meta Cursor)) Syntax)
## (#Meta [["" -1 -1] data]))
-(def' _meta
- (:' (#LambdaT [(#AppT [Syntax'
- (#AppT [Meta Cursor])])
- Syntax])
- (lambda' _ data
- (#Meta [["" -1 -1] data]))))
+(_lux_def _meta
+ (_lux_: (#LambdaT [(#AppT [Syntax'
+ (#AppT [Meta Cursor])])
+ Syntax])
+ (_lux_lambda _ data
+ (#Meta [["" -1 -1] data]))))
## (def (return x)
## (All [a]
## (-> a CompilerState
## (Either Text (, CompilerState a))))
## ...)
-(def' return
- (:' (#AllT [#None "" "a"
- (#LambdaT [(#BoundT "a")
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [(#BoundT "a")
- #Nil])]))])])])])
- (lambda' _ val
- (lambda' _ state
- (#Right [state val])))))
+(_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])))))
## (def (fail msg)
## (All [a]
## (-> Text CompilerState
## (Either Text (, CompilerState a))))
## ...)
-(def' fail
- (:' (#AllT [#None "" "a"
- (#LambdaT [Text
- (#LambdaT [CompilerState
- (#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
- (#Cons [(#BoundT "a")
- #Nil])]))])])])])
- (lambda' _ msg
- (lambda' _ state
- (#Left msg)))))
-
-(def' $text
- (:' (#LambdaT [Text Syntax])
- (lambda' _ text
- (_meta (#Text text)))))
-
-(def' $symbol
- (:' (#LambdaT [Ident Syntax])
- (lambda' _ ident
- (_meta (#Symbol ident)))))
-
-(def' $tag
- (:' (#LambdaT [Ident Syntax])
- (lambda' _ ident
- (_meta (#Tag ident)))))
-
-(def' $form
- (:' (#LambdaT [(#AppT [List Syntax]) Syntax])
- (lambda' _ tokens
- (_meta (#Form tokens)))))
-
-(def' $tuple
- (:' (#LambdaT [(#AppT [List Syntax]) Syntax])
- (lambda' _ tokens
- (_meta (#Tuple tokens)))))
-
-(def' $record
- (:' (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
- (lambda' _ tokens
- (_meta (#Record tokens)))))
-
-(def' let'
- (:' Macro
- (lambda' _ tokens
- (case' tokens
- (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
- (return (#Cons [($form (#Cons [($symbol ["" "case'"])
- (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
- #Nil]))
-
- _
- (fail "Wrong syntax for let'")))))
-(declare-macro' let')
-
-(def' lambda_
- (:' Macro
- (lambda' _ tokens
- (case' tokens
- (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
- (#Cons [(_meta (#Symbol ["" ""]))
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
- (#Cons [(_meta (#Tuple args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil]))
-
- (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"]))
- (#Cons [(_meta (#Symbol self))
- (#Cons [arg
- (#Cons [(case' args'
- #Nil
- body
-
- _
- (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
- (#Cons [(_meta (#Tuple args'))
- (#Cons [body #Nil])])]))))
- #Nil])])])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for lambda")))))
-(declare-macro' lambda_)
-
-(def' def_
- (:' Macro
- (lambda_ [tokens]
- (case' tokens
- (#Cons [(#Meta [_ (#Tag ["" "export"])])
- (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [name
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
- (#Cons [type
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
- (#Cons [name
- (#Cons [(_meta (#Tuple args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])])))
- #Nil])]))
-
- (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [name
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])])))
- #Nil])]))
-
- (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [name
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
- (#Cons [type
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
- (#Cons [name
- (#Cons [(_meta (#Tuple args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- #Nil]))
-
- (#Cons [name (#Cons [type (#Cons [body #Nil])])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
- (#Cons [name
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for def")
- ))))
-(declare-macro' def_)
+(_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_def $text
+ (_lux_: (#LambdaT [Text Syntax])
+ (_lux_lambda _ text
+ (_meta (#Text text)))))
+
+(_lux_def $symbol
+ (_lux_: (#LambdaT [Ident Syntax])
+ (_lux_lambda _ ident
+ (_meta (#Symbol ident)))))
+
+(_lux_def $tag
+ (_lux_: (#LambdaT [Ident Syntax])
+ (_lux_lambda _ ident
+ (_meta (#Tag ident)))))
+
+(_lux_def $form
+ (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+ (_lux_lambda _ tokens
+ (_meta (#Form tokens)))))
+
+(_lux_def $tuple
+ (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+ (_lux_lambda _ tokens
+ (_meta (#Tuple tokens)))))
+
+(_lux_def $record
+ (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
+ (_lux_lambda _ tokens
+ (_meta (#Record 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_declare-macro let')
+
+(_lux_def lambda_
+ (_lux_: Macro
+ (_lux_lambda _ tokens
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_lambda"]))
+ (#Cons [(_meta (#Symbol ["" ""]))
+ (#Cons [arg
+ (#Cons [(_lux_case args'
+ #Nil
+ body
+
+ _
+ (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
+ (#Cons [(_meta (#Tuple args'))
+ (#Cons [body #Nil])])]))))
+ #Nil])])])])))
+ #Nil]))
+
+ (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_lambda"]))
+ (#Cons [(_meta (#Symbol self))
+ (#Cons [arg
+ (#Cons [(_lux_case args'
+ #Nil
+ body
+
+ _
+ (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
+ (#Cons [(_meta (#Tuple 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 [_ (#Tag ["" "export"])])
+ (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
+ (#Cons [name
+ (#Cons [(_meta (#Tuple args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ (#Cons [(_meta (#Form (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
+ #Nil])]))
+
+ (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ (#Cons [(_meta (#Form (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
+ #Nil])]))
+
+ (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
+ (#Cons [name
+ (#Cons [(_meta (#Tuple args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ #Nil]))
+
+ (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ #Nil]))
+
+ _
+ (fail "Wrong syntax for def")
+ ))))
+(_lux_declare-macro def_)
(def_ #export (defmacro tokens)
Macro
- (case' tokens
- (#Cons [(#Meta [_ (#Form (#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 ["" "declare-macro'"]) (#Cons [name #Nil])]))
- #Nil])]))
-
- (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#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 ["" "declare-macro'"]) (#Cons [name #Nil])]))
- #Nil])]))
-
- _
- (fail "Wrong syntax for defmacro")))
-(declare-macro' defmacro)
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Form (#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 [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#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")))
+(_lux_declare-macro defmacro)
(defmacro #export (comment tokens)
(return #Nil))
(defmacro (->' tokens)
- (case' tokens
- (#Cons [input (#Cons [output #Nil])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
- (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])])))
- #Nil])])))
- #Nil]))
-
- (#Cons [input (#Cons [output others])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
- (#Cons [(_meta (#Tuple (#Cons [input
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"]))
- (#Cons [output others])])))
- #Nil])])))
- #Nil])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for ->'")))
+ (_lux_case tokens
+ (#Cons [input (#Cons [output #Nil])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
+ (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])])))
+ #Nil])])))
+ #Nil]))
+
+ (#Cons [input (#Cons [output others])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
+ (#Cons [(_meta (#Tuple (#Cons [input
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"]))
+ (#Cons [output others])])))
+ #Nil])])))
+ #Nil])])))
+ #Nil]))
+
+ _
+ (fail "Wrong syntax for ->'")))
(defmacro (All' tokens)
- (case' tokens
- (#Cons [(#Meta [_ (#Tuple #Nil)])
- (#Cons [body #Nil])])
- (return (#Cons [body
- #Nil]))
-
- (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))])
- (#Cons [body #Nil])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"]))
- (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"]))
- (#Cons [(_meta (#Text ""))
- (#Cons [(_meta (#Text arg-name))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"]))
- (#Cons [(_meta (#Tuple other-args))
- (#Cons [body
- #Nil])])])))
- #Nil])])])])))
- #Nil])])))
- #Nil]))
-
- _
- (fail "Wrong syntax for All'")))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tuple #Nil)])
+ (#Cons [body #Nil])])
+ (return (#Cons [body
+ #Nil]))
+
+ (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))])
+ (#Cons [body #Nil])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"]))
+ (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"]))
+ (#Cons [(_meta (#Text ""))
+ (#Cons [(_meta (#Text arg-name))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"]))
+ (#Cons [(_meta (#Tuple other-args))
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])])))
+ #Nil])])))
+ #Nil]))
+
+ _
+ (fail "Wrong syntax for All'")))
(defmacro (B' tokens)
- (case' tokens
- (#Cons [(#Meta [_ (#Symbol ["" bound-name])])
- #Nil])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"]))
- (#Cons [(_meta (#Text bound-name))
- #Nil])])))
- #Nil]))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Symbol ["" bound-name])])
+ #Nil])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"]))
+ (#Cons [(_meta (#Text bound-name))
+ #Nil])])))
+ #Nil]))
- _
- (fail "Wrong syntax for B'")))
+ _
+ (fail "Wrong syntax for B'")))
(defmacro ($' tokens)
- (case' tokens
- (#Cons [x #Nil])
- (return tokens)
+ (_lux_case tokens
+ (#Cons [x #Nil])
+ (return tokens)
- (#Cons [x (#Cons [y xs])])
- (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"]))
- (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"]))
- (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])])))
- #Nil])])))
- xs])])))
- #Nil]))
+ (#Cons [x (#Cons [y xs])])
+ (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"]))
+ (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"]))
+ (#Cons [(_meta (#Tuple (#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]
@@ -566,12 +566,12 @@
(B' a)
($' List (B' b))
(B' a)))
- (case' xs
- #Nil
- init
+ (_lux_case xs
+ #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]
@@ -590,149 +590,146 @@
#Nil])))
(defmacro #export (list& xs)
- (case' (reverse xs)
- (#Cons [last init])
- (return (list (fold (lambda_ [tail head]
- (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
- (_meta (#Tuple (list head tail)))))))
- last
- init)))
+ (_lux_case (reverse xs)
+ (#Cons [last init])
+ (return (list (fold (lambda_ [tail head]
+ (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
+ (_meta (#Tuple (list head tail)))))))
+ last
+ init)))
- _
- (fail "Wrong syntax for list&")))
+ _
+ (fail "Wrong syntax for list&")))
(defmacro #export (lambda tokens)
- (let' [name tokens'] (:' (#TupleT (list Ident ($' List Syntax)))
- (case' tokens
- (#Cons [(#Meta [_ (#Symbol name)]) tokens'])
- [name tokens']
-
- _
- [["" ""] tokens]))
- (case' tokens'
- (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])
- (case' args
- #Nil
- (fail "lambda requires a non-empty arguments tuple.")
-
- (#Cons [harg targs])
- (return (list ($form (list ($symbol ["" "lambda'"])
- ($symbol name)
- harg
- (fold (lambda_ [body' arg]
- ($form (list ($symbol ["" "lambda'"])
- ($symbol ["" ""])
- arg
- body')))
- body
- (reverse targs)))))))
+ (let' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax)))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Symbol name)]) tokens'])
+ [name tokens']
- _
- (fail "Wrong syntax for lambda"))))
+ _
+ [["" ""] tokens]))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#Tuple 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"))))
(defmacro (def__ tokens)
- (case' tokens
- (#Cons [(#Meta [_ (#Tag ["" "export"])])
- (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])])
- (return (list ($form (list ($symbol ["" "def'"])
- name
- ($form (list ($symbol ["" ":'"])
- type
- ($form (list ($symbol ["lux" "lambda"])
- name
- ($tuple args)
- body))))))
- ($form (list ($symbol ["" "export'"]) name))))
-
- (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
- (return (list ($form (list ($symbol ["" "def'"])
- name
- ($form (list ($symbol ["" ":'"])
- type
- body))))
- ($form (list ($symbol ["" "export'"]) name))))
-
- (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])
- (return (list ($form (list ($symbol ["" "def'"])
- name
- ($form (list ($symbol ["" ":'"])
- type
- ($form (list ($symbol ["lux" "lambda"])
- name
- ($tuple args)
- body))))))))
-
- (#Cons [name (#Cons [type (#Cons [body #Nil])])])
- (return (list ($form (list ($symbol ["" "def'"])
- name
- ($form (list ($symbol ["" ":'"]) type body))))))
-
- _
- (fail "Wrong syntax for def")
- ))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tag ["" "export"])])
+ (#Cons [(#Meta [_ (#Form (#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 [_ (#Tag ["" "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 [_ (#Form (#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")
+ ))
(def__ (as-pairs xs)
(All' [a]
(->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
- (case' xs
- (#Cons [x (#Cons [y xs'])])
- (#Cons [[x y] (as-pairs xs')])
+ (_lux_case xs
+ (#Cons [x (#Cons [y xs'])])
+ (#Cons [[x y] (as-pairs xs')])
- _
- #Nil))
+ _
+ #Nil))
(defmacro #export (let tokens)
- (case' tokens
- (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])
- (return (list (fold (:' (->' Syntax (#TupleT (list Syntax Syntax))
- Syntax)
- (lambda [body binding]
- (case' binding
- [label value]
- (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))))
- body
- (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax))
- ($' List (#TupleT (list Syntax Syntax))))
- (lambda [tail head]
- (#Cons [head tail])))
- #Nil
- (as-pairs bindings)))))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])
+ (return (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax))
+ Syntax)
+ (lambda [body binding]
+ (_lux_case binding
+ [label value]
+ (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))))
+ body
+ (fold (lambda [tail head] (#Cons [head tail]))
+ #Nil
+ (as-pairs bindings)))))
- _
- (fail "Wrong syntax for let")))
+ _
+ (fail "Wrong syntax for let")))
(def__ #export (map f xs)
(All' [a b]
(->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
- (case' xs
- #Nil
- #Nil
+ (_lux_case xs
+ #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))
- (case' xs
- #Nil
- false
+ (_lux_case xs
+ #Nil
+ false
- (#Cons [x xs'])
- (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)
- (case' token
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))])
- true
+ (_lux_case token
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))])
+ true
- _
- false))
+ _
+ false))
(def__ (wrap-meta content)
(->' Syntax Syntax)
@@ -742,143 +739,142 @@
(def__ (untemplate-list tokens)
(->' ($' List Syntax) Syntax)
- (case' tokens
- #Nil
- (_meta (#Tag ["lux" "Nil"]))
+ (_lux_case tokens
+ #Nil
+ (_meta (#Tag ["lux" "Nil"]))
- (#Cons [token tokens'])
- (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
- (_meta (#Tuple (list token (untemplate-list tokens')))))))))
+ (#Cons [token tokens'])
+ (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
+ (_meta (#Tuple (list token (untemplate-list tokens')))))))))
(def__ (list:++ xs ys)
(All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
- (case' xs
- (#Cons [x xs'])
- (#Cons [x (list:++ xs' ys)])
+ (_lux_case xs
+ (#Cons [x xs'])
+ (#Cons [x (list:++ xs' ys)])
- #Nil
- ys))
+ #Nil
+ ys))
(defmacro #export ($ tokens)
- (case' tokens
- (#Cons [op (#Cons [init args])])
- (return (list (fold (lambda [a1 a2] ($form (list op a1 a2)))
- init
- args)))
-
- _
- (fail "Wrong syntax for $")))
+ (_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 $")))
(def__ (splice untemplate tag elems)
(->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
- (case' (any? spliced? elems)
- true
- (let [elems' (map (:' (->' Syntax Syntax)
- (lambda [elem]
- (case' elem
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))])
- spliced
+ (_lux_case (any? spliced? elems)
+ true
+ (let [elems' (map (lambda [elem]
+ (_lux_case elem
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))])
+ spliced
- _
- ($form (list ($symbol ["" ":'"])
- ($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)))))))
+ _
+ ($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)
- (case' token
- (#Meta [_ (#Bool value)])
- (wrap-meta ($form (list ($tag ["lux" "Bool"]) (_meta (#Bool value)))))
+ (_lux_case token
+ (#Meta [_ (#Bool value)])
+ (wrap-meta ($form (list ($tag ["lux" "Bool"]) (_meta (#Bool value)))))
- (#Meta [_ (#Int value)])
- (wrap-meta ($form (list ($tag ["lux" "Int"]) (_meta (#Int value)))))
+ (#Meta [_ (#Int value)])
+ (wrap-meta ($form (list ($tag ["lux" "Int"]) (_meta (#Int value)))))
- (#Meta [_ (#Real value)])
- (wrap-meta ($form (list ($tag ["lux" "Real"]) (_meta (#Real value)))))
+ (#Meta [_ (#Real value)])
+ (wrap-meta ($form (list ($tag ["lux" "Real"]) (_meta (#Real value)))))
- (#Meta [_ (#Char value)])
- (wrap-meta ($form (list ($tag ["lux" "Char"]) (_meta (#Char value)))))
+ (#Meta [_ (#Char value)])
+ (wrap-meta ($form (list ($tag ["lux" "Char"]) (_meta (#Char value)))))
- (#Meta [_ (#Text value)])
- (wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value)))))
+ (#Meta [_ (#Text value)])
+ (wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value)))))
- (#Meta [_ (#Tag [module name])])
- (let [module' (case' module
- ""
- subst
+ (#Meta [_ (#Tag [module name])])
+ (let [module' (_lux_case module
+ ""
+ subst
- _
- module)]
- (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list ($text module') ($text name)))))))
+ _
+ module)]
+ (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list ($text module') ($text name)))))))
- (#Meta [_ (#Symbol [module name])])
- (let [module' (case' module
- ""
- subst
+ (#Meta [_ (#Symbol [module name])])
+ (let [module' (_lux_case module
+ ""
+ subst
- _
- module)]
- (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list ($text module') ($text name)))))))
+ _
+ module)]
+ (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list ($text module') ($text name)))))))
- (#Meta [_ (#Tuple elems)])
- (splice (untemplate subst) ($tag ["lux" "Tuple"]) elems)
+ (#Meta [_ (#Tuple elems)])
+ (splice (untemplate subst) ($tag ["lux" "Tuple"]) elems)
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [unquoted #Nil])]))])
- unquoted
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [unquoted #Nil])]))])
+ unquoted
- (#Meta [_ (#Form elems)])
- (splice (untemplate subst) ($tag ["lux" "Form"]) elems)
+ (#Meta [_ (#Form elems)])
+ (splice (untemplate subst) ($tag ["lux" "Form"]) elems)
- (#Meta [_ (#Record fields)])
- (wrap-meta ($form (list ($tag ["lux" "Record"])
- (untemplate-list (map (:' (->' (#TupleT (list Syntax Syntax)) Syntax)
- (lambda [kv]
- (let [[k v] kv]
- ($tuple (list (untemplate subst k) (untemplate subst v))))))
- fields)))))
- ))
+ (#Meta [_ (#Record fields)])
+ (wrap-meta ($form (list ($tag ["lux" "Record"])
+ (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)
- (case' tokens
- (#Cons [template #Nil])
- (return (list (untemplate "" template)))
+ (_lux_case tokens
+ (#Cons [template #Nil])
+ (return (list (untemplate "" template)))
- _
- (fail "Wrong syntax for `'")))
+ _
+ (fail "Wrong syntax for `'")))
(defmacro #export (|> tokens)
- (case' tokens
- (#Cons [init apps])
- (return (list (fold (lambda [acc app]
- (case' app
- (#Meta [_ (#Form parts)])
- ($form (list:++ parts (list acc)))
+ (_lux_case tokens
+ (#Cons [init apps])
+ (return (list (fold (lambda [acc app]
+ (_lux_case app
+ (#Meta [_ (#Form 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)
- (case' tokens
- (#Cons [test (#Cons [then (#Cons [else #Nil])])])
- (return (list (`' (case' (~ test)
- true (~ then)
- false (~ else)))))
+ (_lux_case tokens
+ (#Cons [test (#Cons [then (#Cons [else #Nil])])])
+ (return (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))))
@@ -908,71 +904,71 @@
#lux;bind
(lambda [f ma]
- (case' ma
- #None #None
- (#Some a) (f a)))})
+ (_lux_case ma
+ #None #None
+ (#Some a) (f a)))})
(def__ Lux:Monad
($' Monad Lux)
{#lux;return
- (lambda return [x]
- (lambda [state]
- (#Right [state x])))
+ (lambda [x]
+ (lambda [state]
+ (#Right [state x])))
#lux;bind
(lambda [f ma]
(lambda [state]
- (case' (ma state)
- (#Left msg)
- (#Left msg)
+ (_lux_case (ma state)
+ (#Left msg)
+ (#Left msg)
- (#Right [state' a])
- (f a state'))))})
+ (#Right [state' a])
+ (f a state'))))})
(defmacro #export (^ tokens)
- (case' tokens
- (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
- (return (list (`' (#;DataT (~ (_meta (#Text class-name)))))))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
+ (return (list (`' (#;DataT (~ (_meta (#Text class-name)))))))
- _
- (fail "Wrong syntax for ^")))
+ _
+ (fail "Wrong syntax for ^")))
(defmacro #export (-> tokens)
- (case' (reverse tokens)
- (#Cons [output inputs])
- (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))
- output
- inputs)))
-
- _
- (fail "Wrong syntax for ->")))
+ (_lux_case (reverse tokens)
+ (#Cons [output inputs])
+ (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))
+ output
+ inputs)))
+
+ _
+ (fail "Wrong syntax for ->")))
(defmacro #export (, tokens)
(return (list (`' (#;TupleT (;list (~@ tokens)))))))
(defmacro (do tokens)
- (case' tokens
- (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
- (let [body' (fold (:' (-> Syntax (, Syntax Syntax) Syntax)
- (lambda [body' binding]
- (let [[var value] binding]
- (case' var
- (#Meta [_ (#Tag ["" "let"])])
- (`' (;let (~ value) (~ body')))
-
- _
- (`' (;bind (lambda' (~ ($symbol ["" ""]))
- (~ var)
- (~ body'))
- (~ value)))))))
- body
- (reverse (as-pairs bindings)))]
- (return (list (`' (case' (~ monad)
- {#;return ;return #;bind ;bind}
- (~ body'))))))
-
- _
- (fail "Wrong syntax for do")))
+ (_lux_case tokens
+ (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
+ (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
+ (lambda [body' binding]
+ (let [[var value] binding]
+ (_lux_case var
+ (#Meta [_ (#Tag ["" "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")))
(def__ (map% m f xs)
## (All [m a b]
@@ -983,16 +979,16 @@
($' List (B' a))
($' (B' m) ($' List (B' b)))))
(let [{#;return ;return #;bind _} m]
- (case' xs
- #Nil
- (;return #Nil)
-
- (#Cons [x xs'])
- (do m
- [y (f x)
- ys (map% m f xs')]
- (;return (#Cons [y ys])))
- )))
+ (_lux_case xs
+ #Nil
+ (;return #Nil)
+
+ (#Cons [x xs'])
+ (do m
+ [y (f x)
+ ys (map% m f xs')]
+ (;return (#Cons [y ys])))
+ )))
(def__ #export (. f g)
(All' [a b c]
@@ -1002,21 +998,21 @@
(def__ (get-ident x)
(-> Syntax ($' Maybe Text))
- (case' x
- (#Meta [_ (#Symbol ["" sname])])
- (#Some sname)
+ (_lux_case x
+ (#Meta [_ (#Symbol ["" sname])])
+ (#Some sname)
- _
- #None))
+ _
+ #None))
(def__ (tuple->list tuple)
(-> Syntax ($' Maybe ($' List Syntax)))
- (case' tuple
- (#Meta [_ (#Tuple members)])
- (#Some members)
+ (_lux_case tuple
+ (#Meta [_ (#Tuple members)])
+ (#Some members)
- _
- #None))
+ _
+ #None))
(def__ RepEnv
Type
@@ -1024,97 +1020,97 @@
(def__ (make-env xs ys)
(-> ($' List Text) ($' List Syntax) RepEnv)
- (case' (:' (, ($' List Text) ($' List Syntax))
- [xs ys])
- [(#Cons [x xs']) (#Cons [y ys'])]
- (#Cons [[x y] (make-env xs' ys')])
+ (_lux_case (_lux_: (, ($' List Text) ($' List Syntax))
+ [xs ys])
+ [(#Cons [x xs']) (#Cons [y ys'])]
+ (#Cons [[x y] (make-env xs' ys')])
- _
- #Nil))
+ _
+ #Nil))
(def__ (text:= x y)
(-> Text Text Bool)
- (jvm-invokevirtual java.lang.Object equals [java.lang.Object]
- x [y]))
+ (_jvm_invokevirtual java.lang.Object equals [java.lang.Object]
+ x [y]))
(def__ (get-rep key env)
(-> Text RepEnv ($' Maybe Syntax))
- (case' env
- #Nil
- #None
+ (_lux_case env
+ #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)
- (case' template
- (#Meta [_ (#Symbol ["" sname])])
- (case' (get-rep sname env)
- (#Some subst)
- subst
+ (_lux_case template
+ (#Meta [_ (#Symbol ["" sname])])
+ (_lux_case (get-rep sname env)
+ (#Some subst)
+ subst
- _
- template)
+ _
+ template)
- (#Meta [_ (#Tuple elems)])
- ($tuple (map (apply-template env) elems))
+ (#Meta [_ (#Tuple elems)])
+ ($tuple (map (apply-template env) elems))
- (#Meta [_ (#Form elems)])
- ($form (map (apply-template env) elems))
+ (#Meta [_ (#Form elems)])
+ ($form (map (apply-template env) elems))
- (#Meta [_ (#Record members)])
- ($record (map (:' (-> (, Syntax Syntax) (, Syntax Syntax))
- (lambda [kv]
- (let [[slot value] kv]
- [(apply-template env slot) (apply-template env value)])))
- members))
+ (#Meta [_ (#Record 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))))
- (case' xs
- #Nil
- #Nil
-
- (#Cons [x xs'])
- (list:++ (f x) (join-map f xs'))))
-
-(defmacro (do-template tokens)
- (case' tokens
- (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [(#Meta [_ (#Tuple templates)]) data])])
- (case' (:' (, ($' 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 (:' (-> RepEnv ($' List Syntax))
- (lambda [env] (map (apply-template env) templates)))]
- (|> data'
- (join-map (. apply (make-env bindings')))
- return))
+ (_lux_case xs
+ #Nil
+ #Nil
+
+ (#Cons [x xs'])
+ (list:++ (f x) (join-map f xs'))))
+
+(defmacro #export (do-template tokens)
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [(#Meta [_ (#Tuple 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 "All the do-template bindigns must be symbols."))
- _
- (fail "Wrong syntax for do-template")))
+ _
+ (fail "Wrong syntax for do-template")))
(do-template [<name> <cmp> <type>]
[(def__ #export (<name> x y)
(-> <type> <type> Bool)
(<cmp> x y))]
- [int:= jvm-leq Int]
- [int:> jvm-lgt Int]
- [int:< jvm-llt Int]
- [real:= jvm-deq Real]
- [real:> jvm-dgt Real]
- [real:< jvm-dlt Real]
+ [int:= _jvm_leq Int]
+ [int:> _jvm_lgt Int]
+ [int:< _jvm_llt Int]
+ [real:= _jvm_deq Real]
+ [real:> _jvm_dgt Real]
+ [real:< _jvm_dlt Real]
)
(do-template [<name> <cmp> <type>]
@@ -1122,16 +1118,16 @@
(-> <type> <type> <type>)
(<cmp> x y))]
- [int:+ jvm-ladd Int]
- [int:- jvm-lsub Int]
- [int:* jvm-lmul Int]
- [int:/ jvm-ldiv Int]
- [int:% jvm-lrem Int]
- [real:+ jvm-dadd Real]
- [real:- jvm-dsub Real]
- [real:* jvm-dmul Real]
- [real:/ jvm-ddiv Real]
- [real:% jvm-drem Real]
+ [int:+ _jvm_ladd Int]
+ [int:- _jvm_lsub Int]
+ [int:* _jvm_lmul Int]
+ [int:/ _jvm_ldiv Int]
+ [int:% _jvm_lrem Int]
+ [real:+ _jvm_dadd Real]
+ [real:- _jvm_dsub Real]
+ [real:* _jvm_dmul Real]
+ [real:/ _jvm_ddiv Real]
+ [real:% _jvm_drem Real]
)
(def__ (multiple? div n)
@@ -1148,8 +1144,8 @@
(def__ #export (text:++ x y)
(-> Text Text Text)
- (jvm-invokevirtual java.lang.String concat [java.lang.String]
- x [y]))
+ (_jvm_invokevirtual java.lang.String concat [java.lang.String]
+ x [y]))
(def__ (ident->text ident)
(-> Ident Text)
@@ -1158,88 +1154,88 @@
(def__ (replace-syntax reps syntax)
(-> RepEnv Syntax Syntax)
- (case' syntax
- (#Meta [_ (#Symbol ["" name])])
- (case' (get-rep name reps)
- (#Some replacement)
- replacement
-
- #None
- syntax)
-
- (#Meta [_ (#Form parts)])
- (#Meta [_ (#Form (map (replace-syntax reps) parts))])
-
- (#Meta [_ (#Tuple members)])
- (#Meta [_ (#Tuple (map (replace-syntax reps) members))])
-
- (#Meta [_ (#Record slots)])
- (#Meta [_ (#Record (map (:' (-> (, Syntax Syntax) (, Syntax Syntax))
- (lambda [slot]
- (let [[k v] slot]
- [(replace-syntax reps k) (replace-syntax reps v)])))
- slots))])
-
- _
- syntax)
+ (_lux_case syntax
+ (#Meta [_ (#Symbol ["" name])])
+ (_lux_case (get-rep name reps)
+ (#Some replacement)
+ replacement
+
+ #None
+ syntax)
+
+ (#Meta [_ (#Form parts)])
+ (#Meta [_ (#Form (map (replace-syntax reps) parts))])
+
+ (#Meta [_ (#Tuple members)])
+ (#Meta [_ (#Tuple (map (replace-syntax reps) members))])
+
+ (#Meta [_ (#Record slots)])
+ (#Meta [_ (#Record (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'] (:' (, Text SyntaxList)
- (case' tokens
- (#Cons [(#Meta [_ (#Symbol ["" self-ident])]) tokens'])
- [self-ident tokens']
-
- _
- ["" tokens]))]
- (case' tokens'
- (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])
- (case' (map% Maybe:Monad get-ident args)
- (#Some idents)
- (case' idents
- #Nil
- (return (list body))
-
- (#Cons [harg targs])
- (let [replacements (map (:' (-> 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"))
+ (let [[self-ident tokens'] (_lux_: (, Text SyntaxList)
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Symbol ["" self-ident])]) tokens'])
+ [self-ident tokens']
+
+ _
+ ["" tokens]))]
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#Tuple 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"))
))
(def__ (get k plist)
(All [a]
(-> Text ($' List (, Text a)) ($' Maybe a)))
- (case' plist
- (#Cons [[k' v] plist'])
- (if (text:= k k')
- (#Some v)
- (get k plist'))
+ (_lux_case 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)
- (case' state
- {#source source #modules modules #module-aliases module-aliases
- #envs envs #types types #host host
- #seed seed}
- (case' (reverse envs)
- #Nil
- (#Left "Can't get the module name without a module!")
+ (_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!")
- (#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)))))))))
@@ -1248,19 +1244,19 @@
(do Maybe:Monad
[bindings (get module modules)
gdef (get name bindings)]
- (case' (:' (, 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)))
+ (_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)))
(def__ #export (find-macro ident)
(-> Ident ($' Lux ($' Maybe Macro)))
@@ -1268,53 +1264,63 @@
[current-module get-module-name]
(let [[module name] ident]
(lambda [state]
- (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)]))))))
+ (_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)]))))))
(def__ (list:join xs)
(All [a]
(-> ($' List ($' List a)) ($' List a)))
(fold list:++ #Nil xs))
+## (def__ #export (normalize ident)
+## (-> Ident ($' Lux Ident))
+## (_lux_case ident
+## ["" name]
+## (do Lux:Monad
+## [module-name get-module-name]
+## (;return (: Ident [module-name name])))
+
+## _
+## (return ident)))
(def__ #export (normalize ident state)
(-> Ident ($' Lux Ident))
- (case' ident
- ["" name]
- (case' state
- {#source source #modules modules #module-aliases module-aliases
- #envs envs #types types #host host
- #seed seed}
- (case' (reverse envs)
- #Nil
- (#Left "Can't normalize Ident without a global environment.")
+ (_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])))
+ (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _])
+ (#Right [state [prefix name]])))
+
+ _
+ (#Right [state ident])))
(defmacro #export (| tokens)
(do Lux:Monad
[pairs (map% Lux:Monad
- (:' (-> Syntax ($' Lux Syntax))
- (lambda [token]
- (case' token
- (#Meta [_ (#Tag ident)])
- (do Lux:Monad
- [ident (normalize ident)]
- (;return (`' [(~ ($text (ident->text ident))) (;,)])))
-
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
- (do Lux:Monad
- [ident (normalize ident)]
- (;return (`' [(~ ($text (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for |"))))
+ (_lux_: (-> Syntax ($' Lux Syntax))
+ (lambda [token]
+ (_lux_case token
+ (#Meta [_ (#Tag ident)])
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (`' [(~ ($text (ident->text ident))) (;,)])))
+
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (`' [(~ ($text (ident->text ident))) (~ value)])))
+
+ _
+ (fail "Wrong syntax for |"))))
tokens)]
(;return (list (`' (#;VariantT (;list (~@ pairs))))))))
@@ -1323,264 +1329,267 @@
(fail "& expects an even number of arguments.")
(do Lux:Monad
[pairs (map% Lux:Monad
- (:' (-> (, Syntax Syntax) ($' Lux Syntax))
- (lambda [pair]
- (case' pair
- [(#Meta [_ (#Tag ident)]) value]
- (do Lux:Monad
- [ident (normalize ident)]
- (;return (`' [(~ ($text (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for &"))))
+ (_lux_: (-> (, Syntax Syntax) ($' Lux Syntax))
+ (lambda [pair]
+ (_lux_case pair
+ [(#Meta [_ (#Tag ident)]) value]
+ (do Lux:Monad
+ [ident (normalize ident)]
+ (;return (`' [(~ ($text (ident->text ident))) (~ value)])))
+
+ _
+ (fail "Wrong syntax for &"))))
(as-pairs tokens))]
(;return (list (`' (#;RecordT (;list (~@ pairs)))))))))
(def__ #export (->text x)
(-> (^ java.lang.Object) Text)
- (jvm-invokevirtual java.lang.Object toString [] x []))
+ (_jvm_invokevirtual java.lang.Object toString [] x []))
(def__ #export (interpose sep xs)
(All [a]
(-> a ($' List a) ($' List a)))
- (case' xs
- #Nil
- xs
+ (_lux_case 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)
- (case' syntax
- (#Meta [_ (#Bool value)])
- (->text value)
+ (_lux_case syntax
+ (#Meta [_ (#Bool value)])
+ (->text value)
- (#Meta [_ (#Int value)])
- (->text value)
+ (#Meta [_ (#Int value)])
+ (->text value)
- (#Meta [_ (#Real value)])
- (->text value)
+ (#Meta [_ (#Real value)])
+ (->text value)
- (#Meta [_ (#Char value)])
- ($ text:++ "#\"" (->text value) "\"")
+ (#Meta [_ (#Char value)])
+ ($ text:++ "#\"" (->text value) "\"")
- (#Meta [_ (#Text value)])
- value
+ (#Meta [_ (#Text value)])
+ value
- (#Meta [_ (#Symbol ident)])
- (ident->text ident)
+ (#Meta [_ (#Symbol ident)])
+ (ident->text ident)
- (#Meta [_ (#Tag ident)])
- (text:++ "#" (ident->text ident))
+ (#Meta [_ (#Tag ident)])
+ (text:++ "#" (ident->text ident))
- (#Meta [_ (#Tuple members)])
- ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
+ (#Meta [_ (#Tuple members)])
+ ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
- (#Meta [_ (#Form members)])
- ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
+ (#Meta [_ (#Form members)])
+ ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
- (#Meta [_ (#Record slots)])
- ($ text:++ "{" (|> slots
- (map (:' (-> (, Syntax Syntax) Text)
- (lambda [slot]
- (let [[k v] slot]
- ($ text:++ (syntax:show k) " " (syntax:show v))))))
- (interpose " ") (fold text:++ "")) "}")
- ))
+ (#Meta [_ (#Record 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)))
- (case' syntax
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
- (do Lux:Monad
- [macro-name' (normalize macro-name)
- ?macro (find-macro macro-name')]
- (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 [_ (#Form (#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 [_ (#Tuple members)])
- (do Lux:Monad
- [members' (map% Lux:Monad macro-expand members)]
- (;return (list ($tuple (list:join members')))))
-
- _
- (return (list syntax))))
+ (_lux_case syntax
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol 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 [_ (#Form (#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 [_ (#Tuple members)])
+ (do Lux:Monad
+ [members' (map% Lux:Monad macro-expand members)]
+ (;return (list ($tuple (list:join members')))))
+
+ _
+ (return (list syntax))))
(def__ (walk-type type)
(-> Syntax Syntax)
- (case' type
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
- ($form (#Cons [($tag tag) (map walk-type parts)]))
+ (_lux_case type
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
+ ($form (#Cons [($tag tag) (map walk-type parts)]))
- (#Meta [_ (#Tuple members)])
- ($tuple (map walk-type members))
+ (#Meta [_ (#Tuple members)])
+ ($tuple (map walk-type members))
- (#Meta [_ (#Form (#Cons [type-fn args]))])
- (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))
- (walk-type type-fn)
- (map walk-type args))
-
- _
- type))
+ (#Meta [_ (#Form (#Cons [type-fn args]))])
+ (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))
+ (walk-type type-fn)
+ (map walk-type args))
+
+ _
+ type))
(defmacro #export (type` tokens)
- (case' tokens
- (#Cons [type #Nil])
- (do Lux:Monad
- [type+ (macro-expand type)]
- (case' type+
- (#Cons [type' #Nil])
- (;return (list (walk-type type')))
-
- _
- (fail "type`: The expansion of the type-syntax had to yield a single element.")))
-
- _
- (fail "Wrong syntax for type`")))
+ (_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.")))
+
+ _
+ (fail "Wrong syntax for type`")))
(defmacro #export (: tokens)
- (case' tokens
- (#Cons [type (#Cons [value #Nil])])
- (return (list (`' (:' (;type` (~ type)) (~ value)))))
+ (_lux_case tokens
+ (#Cons [type (#Cons [value #Nil])])
+ (return (list (`' (_lux_: (;type` (~ type)) (~ value)))))
- _
- (fail "Wrong syntax for :")))
+ _
+ (fail "Wrong syntax for :")))
(defmacro #export (:! tokens)
- (case' tokens
- (#Cons [type (#Cons [value #Nil])])
- (return (list (`' (:!' (;type` (~ type)) (~ value)))))
+ (_lux_case tokens
+ (#Cons [type (#Cons [value #Nil])])
+ (return (list (`' (_lux_:! (;type` (~ type)) (~ value)))))
- _
- (fail "Wrong syntax for :!")))
+ _
+ (fail "Wrong syntax for :!")))
(defmacro #export (deftype tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
- (case' tokens
- (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
- [true tokens']
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens]))
parts (: (Maybe (, Syntax (List Syntax) Syntax))
- (case' tokens'
- (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
- (#Some [($symbol name) #Nil type])
-
- (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
- (#Some [($symbol name) args type])
-
- _
- #None))]
- (case' parts
- (#Some [name args type])
- (let [with-export (: (List Syntax)
- (if export?
- (list (`' (export' (~ name))))
- #Nil))
- type' (: Syntax
- (case' args
- #Nil
- type
-
- _
- (`' (;All (~ name) [(~@ args)] (~ type)))))]
- (return (list& (`' (def' (~ name) (;type` (~ type'))))
- with-export)))
-
- #None
- (fail "Wrong syntax for deftype"))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
+ (#Some [($symbol name) #Nil type])
+
+ (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
+ (#Some [($symbol name) args type])
+
+ _
+ #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"))
))
(deftype #export (IO a)
(-> (,) a))
(defmacro #export (io tokens)
- (case' tokens
- (#Cons [value #Nil])
- (let [blank ($symbol ["" ""])]
- (return (list (`' (lambda' (~ blank) (~ blank) (~ value))))))
+ (_lux_case tokens
+ (#Cons [value #Nil])
+ (let [blank ($symbol ["" ""])]
+ (return (list (`' (_lux_lambda (~ blank) (~ blank) (~ value))))))
- _
- (fail "Wrong syntax for io")))
+ _
+ (fail "Wrong syntax for io")))
(defmacro #export (exec tokens)
- (case' (reverse tokens)
- (#Cons [value actions])
- (let [dummy ($symbol ["" ""])]
- (return (list (fold (lambda [post pre] (`' (case' (~ pre) (~ dummy) (~ post))))
- value
- actions))))
+ (_lux_case (reverse tokens)
+ (#Cons [value actions])
+ (let [dummy ($symbol ["" ""])]
+ (return (list (fold (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))
- (case' tokens
- (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
- [true tokens']
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
+ [true tokens']
- _
- [false tokens]))
+ _
+ [false tokens]))
parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
- (case' tokens'
- (#Cons [(#Meta [_ (#Form (#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 [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])
- (#Some [name args #None body])
-
- (#Cons [name (#Cons [body #Nil])])
- (#Some [name #Nil #None body])
-
- _
- #None))]
- (case' parts
- (#Some [name args ?type body])
- (let [body' (: Syntax
- (case' args
- #Nil
- body
-
- _
- (`' (;lambda (~ name) [(~@ args)] (~ body)))))
- body'' (: Syntax
- (case' ?type
- (#Some type)
- (`' (: (~ type) (~ body')))
-
- #None
- body'))]
- (return (list& (`' (def' (~ name) (~ body'')))
- (if export?
- (list (`' (export' (~ name))))
- #Nil))))
-
- #None
- (fail "Wrong syntax for def"))))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#Form (#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 [_ (#Form (#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"))))
(def (rejoin-pair pair)
(-> (, Syntax Syntax) (List Syntax))
@@ -1588,28 +1597,28 @@
(list left right)))
(defmacro #export (case tokens)
- (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]
- (case' pattern
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol 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 (`' (case' (~ value)
- (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
-
- _
- (fail "Wrong syntax for case")))
+ (_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 [_ (#Form (#Cons [(#Meta [_ (#Symbol 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")))
(defmacro #export (\ tokens)
(case tokens
@@ -1650,8 +1659,8 @@
(def (int:show int)
(-> Int Text)
- (jvm-invokevirtual java.lang.Object toString []
- int []))
+ (_jvm_invokevirtual java.lang.Object toString []
+ int []))
(defmacro #export (` tokens)
(do Lux:Monad
@@ -1692,7 +1701,7 @@
(: (-> Syntax (Lux (, Ident Syntax)))
(lambda [token]
(case token
- (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" ":'"])]) type (#Meta [_ (#Symbol name)])))]))
+ (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "_lux_:"])]) type (#Meta [_ (#Symbol name)])))]))
(do Lux:Monad
[name' (normalize name)]
(;return (: (, Ident Syntax) [name' type])))
@@ -1734,9 +1743,9 @@
_
(`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))]
- (return (list& (`' (def' (~ name) (~ sigs')))
+ (return (list& (`' (_lux_def (~ name) (~ sigs')))
(if export?
- (list (`' (export' (~ name))))
+ (list (`' (_lux_export (~ name))))
#Nil))))
#None
@@ -1749,7 +1758,7 @@
(: (-> Syntax (Lux (, Syntax Syntax)))
(lambda [token]
(case token
- (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "def'"])]) (#Meta [_ (#Symbol name)]) value))]))
+ (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "_lux_def"])]) (#Meta [_ (#Symbol name)]) value))]))
(do Lux:Monad
[name' (normalize name)]
(;return (: (, Syntax Syntax) [($tag name') value])))
@@ -1788,7 +1797,7 @@
(`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
(return (list& (`' (def (~ name) (~ type) (~ defs')))
(if export?
- (list (`' (export' (~ name))))
+ (list (`' (_lux_export (~ name))))
#Nil))))
#None
@@ -1803,8 +1812,8 @@
(def (= x y)
(<test> x y)))]
- [Int:Eq Int jvm-leq]
- [Real:Eq Real jvm-deq])
+ [Int:Eq Int _jvm_leq]
+ [Real:Eq Real _jvm_deq])
(def #export (id x)
(All [a] (-> a a))
@@ -1852,17 +1861,20 @@
[(defstruct #export <name> (Ord <type>)
(def (< x y)
(<lt> x y))
+
(def (<= x y)
(or (<lt> x y)
(<eq> x y)))
+
(def (> x y)
(<gt> x y))
+
(def (>= x y)
(or (<gt> x y)
(<eq> x y))))]
- [Int:Ord Int jvm-llt jvm-lgt jvm-leq]
- [Real:Ord Real jvm-dlt jvm-dgt jvm-deq])
+ [Int:Ord Int _jvm_llt _jvm_lgt _jvm_leq]
+ [Real:Ord Real _jvm_dlt _jvm_dgt _jvm_deq])
(defmacro #export (alias-lux tokens state)
(case state
@@ -1880,8 +1892,7 @@
(list)))))
lux)]
(#Right [state (map (lambda [name]
- (` ((~ ($symbol ["" "def'"])) (~ ($symbol ["" name]))
- (~ ($symbol ["lux" name])))))
+ (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name])))))
(list:join to-alias))]))
#None
@@ -1890,8 +1901,8 @@
(def #export (print x)
(-> Text (,))
- (jvm-invokevirtual java.io.PrintStream print [java.lang.Object]
- (jvm-getstatic java.lang.System out) [x]))
+ (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object]
+ (_jvm_getstatic java.lang.System out) [x]))
(def #export (println x)
(-> Text (,))
@@ -1915,18 +1926,18 @@
(def (index-of part text)
(-> Text Text Int)
- (jvm-i2l (jvm-invokevirtual java.lang.String indexOf [java.lang.String]
- text [part])))
+ (_jvm_i2l (_jvm_invokevirtual java.lang.String indexOf [java.lang.String]
+ text [part])))
(def (substring1 idx text)
(-> Int Text Text)
- (jvm-invokevirtual java.lang.String substring [int]
- text [(jvm-l2i idx)]))
+ (_jvm_invokevirtual java.lang.String substring [int]
+ text [(_jvm_l2i idx)]))
(def (substring2 idx1 idx2 text)
(-> Int Int Text Text)
- (jvm-invokevirtual java.lang.String substring [int int]
- text [(jvm-l2i idx1) (jvm-l2i idx2)]))
+ (_jvm_invokevirtual java.lang.String substring [int int]
+ text [(_jvm_l2i idx1) (_jvm_l2i idx2)]))
(def (split-slot slot)
(-> Text (, Text Text))
@@ -1986,22 +1997,22 @@
[($tag [module name]) ($symbol ["" name])])))
slots))
_ (println (text:++ "Using pattern: " (syntax:show pattern)))]
- (#Right [state (list (` (case' (~ struct) (~ pattern) (~ body))))]))
+ (#Right [state (list (` (_lux_case (~ struct) (~ pattern) (~ body))))]))
_
(#Left "Can only \"use\" records."))))))
_
(let [dummy ($symbol ["" ""])]
- (#Right [state (list (` (case' (~ struct)
- (~ dummy)
- (using (~ dummy) (~ body)))))])))
+ (#Right [state (list (` (_lux_case (~ struct)
+ (~ dummy)
+ (using (~ dummy) (~ body)))))])))
_
(#Left "Wrong syntax for defsig")))
## (defmacro (loop tokens)
-## (case' tokens
+## (_lux_case tokens
## (#Cons [bindings (#Cons [body #Nil])])
## (let [pairs (as-pairs bindings)]
## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["" "recur"])) (~ (#Tuple (map first pairs)))
@@ -2009,7 +2020,7 @@
## (map second pairs)])))))))
## (defmacro (get@ tokens)
-## (let [output (case' tokens
+## (let [output (_lux_case tokens
## (#Cons [tag (#Cons [record #Nil])])
## (` (get@' (~ tag) (~ record)))
@@ -2018,7 +2029,7 @@
## (return (list output))))
## (defmacro (set@ tokens)
-## (let [output (case' tokens
+## (let [output (_lux_case tokens
## (#Cons [tag (#Cons [value (#Cons [record #Nil])])])
## (` (set@' (~ tag) (~ value) (~ record)))
@@ -2030,7 +2041,7 @@
## (return (list output))))
## (defmacro (update@ tokens)
-## (let [output (case' tokens
+## (let [output (_lux_case tokens
## (#Cons [tag (#Cons [func (#Cons [record #Nil])])])
## (` (let [_record_ (~ record)]
## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_)))
diff --git a/source/program.lux b/source/program.lux
index 2bbf3fd4f..20f7863ab 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -11,8 +11,8 @@
(list& x (filter p xs'))
(filter p xs'))))
-(jvm-program _
- (exec (println "Hello, world!")
- (|> (int:+ 2 2) ->text ($ text:++ "2 + 2 = ") println)
- (println (->text (using Int:Ord
- (< 5 10))))))
+(_jvm_program _
+ (exec (println "Hello, world!")
+ (|> (int:+ 2 2) ->text ($ text:++ "2 + 2 = ") println)
+ (println (->text (using Int:Ord
+ (< 5 10))))))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 939a3ea0a..a47360ffb 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -14,14 +14,14 @@
;; [Utils]
(defn ^:private parse-handler [[catch+ finally+] token]
(matchv ::M/objects [token]
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-catch"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_catch"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-arg]]]]
["lux;Cons" [?catch-body
["lux;Nil" _]]]]]]]]]]]]]
(&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-finally"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_finally"]]]]
["lux;Cons" [?finally-body
["lux;Nil" _]]]]]]]]]
(&/T catch+ ?finally-body)))
@@ -59,7 +59,7 @@
[["lux;Meta" [meta ["lux;Tag" ?ident]]]]
(&&lux/analyse-variant analyse exo-type ?ident unit)
- [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]]
+ [["lux;Meta" [meta ["lux;Symbol" [_ "_jvm_null"]]]]]
(return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))
[_]
@@ -71,46 +71,46 @@
[["lux;Meta" [meta ["lux;Symbol" ?ident]]]]
(&&lux/analyse-symbol analyse exo-type ?ident)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "case'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_case"]]]]
["lux;Cons" [?value ?branches]]]]]]]]
(&&lux/analyse-case analyse exo-type ?value ?branches)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "lambda'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_lambda"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?self]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?arg]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]]]]]
(&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "def'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_def"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]]
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-def analyse ?name ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "declare-macro'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_declare-macro"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]]
["lux;Nil" _]]]]]]]]]
(&&lux/analyse-declare-macro analyse ?name)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "import'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_import"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]]
["lux;Nil" _]]]]]]]]]
(&&lux/analyse-import analyse ?path)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ":'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_:"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-check analyse eval! exo-type ?type ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ":!'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_:!"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-coerce analyse eval! ?type ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "export'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_lux_export"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?ident]]]]
["lux;Nil" _]]]]]]]]]
(&&lux/analyse-export analyse ?ident)
@@ -122,53 +122,53 @@
(matchv ::M/objects [token]
;; Host special forms
;; Integer arithmetic
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-iadd analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-isub analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-imul analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-idiv analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-irem analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-ieq analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-ilt analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-igt analyse ?x ?y)
;; Long arithmetic
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-ladd analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lsub analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lmul analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-ldiv analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lrem analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-leq analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-llt analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lgt analyse ?x ?y)
[_]
@@ -177,53 +177,53 @@
(defn ^:private aba4 [analyse eval! exo-type token]
(matchv ::M/objects [token]
;; Float arithmetic
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-fadd analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-fsub analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-fmul analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-fdiv analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-frem analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-feq analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-flt analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-fgt analyse ?x ?y)
;; Double arithmetic
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-dadd analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-dsub analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-dmul analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-ddiv analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-drem analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-deq analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-dlt analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-dgt analyse ?x ?y)
[_]
@@ -232,39 +232,39 @@
(defn ^:private aba5 [analyse eval! exo-type token]
(matchv ::M/objects [token]
;; Objects
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-null?"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_null?"]]]]
["lux;Cons" [?object
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-null? analyse ?object)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-new"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_new"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-new analyse ?class ?classes ?args)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-getstatic"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_getstatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-getstatic analyse ?class ?field)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-getfield"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_getfield"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Cons" [?object
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-getfield analyse ?class ?field ?object)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-putstatic"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_putstatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-putstatic analyse ?class ?field ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-putfield"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_putfield"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Cons" [?object
@@ -272,7 +272,7 @@
["lux;Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokestatic"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokestatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
@@ -280,7 +280,7 @@
["lux;Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokevirtual"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokevirtual"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
@@ -289,7 +289,7 @@
["lux;Nil" _]]]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokeinterface"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokeinterface"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
@@ -298,7 +298,7 @@
["lux;Nil" _]]]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokespecial"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_invokespecial"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
@@ -308,23 +308,23 @@
(&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args)
;; Exceptions
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-try"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_try"]]]]
["lux;Cons" [?body
?handlers]]]]]]]]
(&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers))
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-throw"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_throw"]]]]
["lux;Cons" [?ex
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-throw analyse ?ex)
;; Syncronization/monitos
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-monitorenter"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_monitorenter"]]]]
["lux;Cons" [?monitor
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-monitorenter analyse ?monitor)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-monitorexit"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_monitorexit"]]]]
["lux;Cons" [?monitor
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-monitorexit analyse ?monitor)
@@ -335,74 +335,74 @@
(defn ^:private aba6 [analyse eval! exo-type token]
(matchv ::M/objects [token]
;; Primitive conversions
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-d2f analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-d2i analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-d2l analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-f2d analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-f2i analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-f2l analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-i2b analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-i2c analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-i2d analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-i2f analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-i2l analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-i2s analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-l2d analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-l2f analyse ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-l2i analyse ?value)
;; Bitwise operators
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-iand analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-ior analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-land analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lor analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lxor analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lshl analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lshr analyse ?x ?y)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-lushr analyse ?x ?y)
[_]
@@ -411,40 +411,40 @@
(defn ^:private aba7 [analyse eval! exo-type token]
(matchv ::M/objects [token]
;; Arrays
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-new-array"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_new-array"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?length]]]
["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-new-array analyse ?class ?length)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-aastore"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_aastore"]]]]
["lux;Cons" [?array
["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]]
["lux;Cons" [?elem
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-aastore analyse ?array ?idx ?elem)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-aaload"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_aaload"]]]]
["lux;Cons" [?array
["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]]
["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-aaload analyse ?array ?idx)
;; Classes & interfaces
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-class"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_class"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?super-class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?fields]]]
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-class analyse ?name ?super-class ?fields)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-interface"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_interface"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]]
?members]]]]]]]]
(&&host/analyse-jvm-interface analyse ?name ?members)
;; Programs
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-program"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "_jvm_program"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?args]]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]]]
@@ -459,7 +459,7 @@
[["lux;Right" [state* output]]]
(return* state* output)
- [_]
+ [["lux;Left" ""]]
(matchv ::M/objects [((aba2 analyse eval! exo-type token) state)]
[["lux;Right" [state* output]]]
(return* state* output)
@@ -489,26 +489,26 @@
[["lux;Right" [state* output]]]
(return* state* output)
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))
+ [["lux;Left" msg]]
+ (fail* msg))
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))
+ [["lux;Left" msg]]
+ (fail* msg))
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))
+ [["lux;Left" msg]]
+ (fail* msg))
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))
+ [["lux;Left" msg]]
+ (fail* msg))
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))
+ [["lux;Left" msg]]
+ (fail* msg))
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))
+ [["lux;Left" msg]]
+ (fail* msg))
- [_]
- (fail* (str "[Analyser Error] Unmatched token: " (&/show-ast token))))))
+ [["lux;Left" msg]]
+ (fail* msg))))
(defn ^:private analyse-ast [eval! exo-type token]
(matchv ::M/objects [token]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 3631bddb2..527c69dc7 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -159,7 +159,7 @@
(defn analyse-jvm-interface [analyse ?name ?members]
(|do [=members (&/map% (fn [member]
(matchv ::M/objects [member]
- [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]]
+ [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index e4237d8dd..b65963e4a 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -110,44 +110,44 @@
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
- (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module)
- ?name)
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" ?type]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (= &type/Type endo-type) (= &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state)
+ ((|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module)
+ ?name)
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (= &type/Type endo-type) (= &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type))))
+ state)
[["lux;Cons" [?genv ["lux;Nil" _]]]]
(if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
(matchv ::M/objects [global]
[[["lux;Global" [?module* ?name*]] _]]
- (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" ?type]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (= &type/Type endo-type) (= &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state)
+ ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (= &type/Type endo-type) (= &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type))))
+ state)
[_]
(fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))
@@ -165,10 +165,10 @@
(->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
(&/|list))
(&/|reverse inner) scopes)]
- (&/run-state (|do [btype (&&/expr-type =local)
- _ (&type/check exo-type btype)]
- (return (&/|list =local)))
- (&/set$ &/$ENVS (&/|++ inner* outer) state)))
+ ((|do [btype (&&/expr-type =local)
+ _ (&type/check exo-type btype)]
+ (return (&/|list =local)))
+ (&/set$ &/$ENVS (&/|++ inner* outer) state)))
)))
))
@@ -263,12 +263,7 @@
(|do [? (&type/bound? ?id)]
(if ?
(|do [dtype (&type/deref ?id)]
- (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)))))
+ (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/analyser/module.clj b/src/lux/analyser/module.clj
index 5960d3080..f36dc044a 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -71,8 +71,8 @@
(if (or exported? (= current-module module))
(matchv ::M/objects [$$def]
[["lux;AliasD" [?r-module ?r-name]]]
- (&/run-state (find-def ?r-module ?r-name)
- state)
+ ((find-def ?r-module ?r-name)
+ state)
[_]
(return* state (&/T (&/T module name) $$def)))
@@ -94,19 +94,19 @@
(if-let [$def (&/|get name $module)]
(matchv ::M/objects [$def]
[[exported? ["lux;ValueD" ?type]]]
- (&/run-state (|do [_ (&type/check &type/Macro ?type)
- ^ClassLoader loader &/loader
- :let [macro (-> (.loadClass loader (&host/location (&/|list module name)))
- (.getField "_datum")
- (.get nil))]]
- (fn [state*]
- (return* (&/update$ &/$MODULES
- (fn [$modules]
- (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module)
- $modules))
- state*)
- nil)))
- state)
+ ((|do [_ (&type/check &type/Macro ?type)
+ ^ClassLoader loader &/loader
+ :let [macro (-> (.loadClass loader (&host/location (&/|list module name)))
+ (.getField "_datum")
+ (.get nil))]]
+ (fn [state*]
+ (return* (&/update$ &/$MODULES
+ (fn [$modules]
+ (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module)
+ $modules))
+ state*)
+ nil)))
+ state)
[[_ ["lux;MacroD" _]]]
(fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name)))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 9ea255132..3ac994043 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -32,12 +32,18 @@
(defn T [& elems]
(to-array elems))
+;; (definline T [& elems]
+;; `(to-array (list ~@elems)))
(defn V [tag value]
(to-array [tag value]))
+;; (definline V [tag value]
+;; `(to-array [~tag ~value]))
(defn R [& kvs]
(to-array kvs))
+;; (definline R [& kvs]
+;; `(to-array (list ~@kvs)))
(defn get$ [slot ^objects record]
(aget record slot))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 6739c5529..26b75bec3 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -352,14 +352,15 @@
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
- (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state
- (&/set$ &/$SOURCE (&reader/from (str "source/" name ".lux")))
- (&/set$ &/$ENVS (&/|list (&/env name)))
- (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
- (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))]
+ (matchv ::M/objects [((&/exhaust% compiler-step)
+ (->> state
+ (&/set$ &/$SOURCE (&reader/from (str "source/" name ".lux")))
+ (&/set$ &/$ENVS (&/|list (&/env name)))
+ (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
+ (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))]
[["lux;Right" [?state _]]]
(do (.visitEnd =class)
- (&/run-state (&&/save-class! name (.toByteArray =class)) ?state))
+ ((&&/save-class! name (.toByteArray =class)) ?state))
[["lux;Left" ?message]]
(fail* ?message)))))))
@@ -367,7 +368,7 @@
;; [Resources]
(defn compile-all [modules]
(.mkdir (java.io.File. "output"))
- (matchv ::M/objects [(&/run-state (&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))]
+ (matchv ::M/objects [((&/map% compile-module (&/|cons "lux" modules)) (&/init-state nil))]
[["lux;Right" [?state _]]]
(println (str "Compilation complete! " (str "[" (->> modules
(&/|interpose " ")
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 6a954d5ff..69c95ea6a 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -27,12 +27,12 @@
)))
;; [Exports]
-(defn ^:private re-find! [regex line]
+(defn ^:private re-find! [^java.util.regex.Pattern regex line]
(let [matcher (.matcher regex line)]
(when (.find matcher)
(.group matcher 0))))
-(defn ^:private re-find3! [regex line]
+(defn ^:private re-find3! [^java.util.regex.Pattern regex line]
(let [matcher (.matcher regex line)]
(when (.find matcher)
(list (.group matcher 0)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index b2ea0ff0d..494d8ebbc 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -226,33 +226,33 @@
(|do [ex existential]
(set-var id ex)))]
(fn [state]
- (&/run-state (|do [mappings* (&/map% (fn [binding]
- (|let [[?id ?type] binding]
- (if (= id ?id)
- (return binding)
- (matchv ::M/objects [?type]
- [["lux;None" _]]
- (return binding)
-
- [["lux;Some" ?type*]]
- (matchv ::M/objects [?type*]
- [["lux;VarT" ?id*]]
- (if (= id ?id*)
- (return (&/T ?id (&/V "lux;None" nil)))
- (return binding))
-
- [_]
- (|do [?type** (clean* id ?type*)]
- (return (&/T ?id (&/V "lux;Some" ?type**)))))
- ))))
- (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
- (fn [state]
- (return* (&/update$ &/$TYPES #(->> %
- (&/update$ &/$COUNTER dec)
- (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
- state)
- nil)))
- state))))
+ ((|do [mappings* (&/map% (fn [binding]
+ (|let [[?id ?type] binding]
+ (if (= id ?id)
+ (return binding)
+ (matchv ::M/objects [?type]
+ [["lux;None" _]]
+ (return binding)
+
+ [["lux;Some" ?type*]]
+ (matchv ::M/objects [?type*]
+ [["lux;VarT" ?id*]]
+ (if (= id ?id*)
+ (return (&/T ?id (&/V "lux;None" nil)))
+ (return binding))
+
+ [_]
+ (|do [?type** (clean* id ?type*)]
+ (return (&/T ?id (&/V "lux;Some" ?type**)))))
+ ))))
+ (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
+ (fn [state]
+ (return* (&/update$ &/$TYPES #(->> %
+ (&/update$ &/$COUNTER dec)
+ (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
+ state)
+ nil)))
+ state))))
(defn with-var [k]
(|do [id create-var
@@ -585,24 +585,49 @@
(check* fixpoints expected bound))))
[["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
- (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
- _ (check* fixpoints A1 A2)]
- (return (&/T fixpoints nil)))
+ (&/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)))))
+ ;; (|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]]]
- (|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)))
-
- [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] 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)))
+ (&/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)))))
+ ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
+ ;; (|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)))
+ [["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)))))
+ ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] 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)))
+
[["lux;AppT" [F A]] _]
(let [fp-pair (&/T expected actual)
_ (when (> (&/|length fixpoints) 40)