aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux789
-rw-r--r--source/lux/control/monad.lux12
-rw-r--r--source/lux/data/io.lux2
-rw-r--r--source/lux/data/list.lux22
-rw-r--r--source/lux/data/maybe.lux5
-rw-r--r--source/lux/host/jvm.lux109
-rw-r--r--source/lux/meta/syntax.lux16
7 files changed, 496 insertions, 459 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 3ba8ec897..0ce03829b 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -880,8 +880,22 @@
_
(fail "Wrong syntax for list&")))
+(defmacro #export (^ tokens)
+ (_lux_case tokens
+ (#Cons [_ (#SymbolS "" class-name)] #Nil)
+ (return (list (form$ (list (tag$ ["lux" "DataT"]) (text$ class-name)))))
+
+ _
+ (fail "Wrong syntax for ^")))
+
+(defmacro #export (, tokens)
+ (return (list (form$ (list (tag$ ["lux" "TupleT"])
+ (foldL (lambda'' [tail head] (form$ (list (tag$ ["lux" "Cons"]) head tail)))
+ (tag$ ["lux" "Nil"])
+ (reverse tokens)))))))
+
(defmacro (lambda' tokens)
- (let'' [name tokens'] (_lux_: (#TupleT (list Text ($' List AST)))
+ (let'' [name tokens'] (_lux_: (, Text ($' List AST))
(_lux_case tokens
(#Cons [[_ (#SymbolS ["" name])] tokens'])
[name tokens']
@@ -953,7 +967,7 @@
))
(def''' (as-pairs xs)
- (All [a] (-> ($' List a) ($' List (#TupleT (list a a)))))
+ (All [a] (-> ($' List a) ($' List (, a a))))
(_lux_case xs
(#Cons x (#Cons y xs'))
(#Cons [x y] (as-pairs xs'))
@@ -964,7 +978,7 @@
(defmacro (let' tokens)
(_lux_case tokens
(#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])])
- (return (list (foldL (_lux_: (-> AST (#TupleT (list AST AST))
+ (return (list (foldL (_lux_: (-> AST (, AST AST)
AST)
(lambda' [body binding]
(_lux_case binding
@@ -1009,8 +1023,7 @@
(_meta (#TagS ["lux" "Nil"]))
(#Cons [token tokens'])
- (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
- (_meta (#TupleS (list token (untemplate-list tokens')))))))))
+ (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) token (untemplate-list tokens'))))))
(def''' #export (list:++ xs ys)
(All [a] (-> ($' List a) ($' List a) ($' List a)))
@@ -1031,140 +1044,12 @@
_
(fail "Wrong syntax for $")))
-(def''' (splice replace? untemplate tag elems)
- (-> Bool (-> AST AST) AST ($' List AST) AST)
- (_lux_case replace?
- true
- (_lux_case (any? spliced? elems)
- true
- (let' [elems' (map (lambda' [elem]
- (_lux_case elem
- [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
- spliced
-
- _
- (form$ (list (symbol$ ["" "_lux_:"])
- (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
- (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
- (tag$ ["lux" "Nil"])))))))))
- 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))))))
- false
- (wrap-meta (form$ (list tag (untemplate-list (map untemplate elems)))))))
-
-(def''' (untemplate replace? subst token)
- (-> Bool Text AST AST)
- (_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token])
- [_ [_ (#BoolS value)]]
- (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
-
- [_ [_ (#IntS value)]]
- (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))
-
- [_ [_ (#RealS value)]]
- (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))
-
- [_ [_ (#CharS value)]]
- (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))
-
- [_ [_ (#TextS value)]]
- (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))
-
- [_ [_ (#TagS [module name])]]
- (let' [module' (_lux_case module
- ""
- subst
-
- _
- module)]
- (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
-
- [_ [_ (#SymbolS [module name])]]
- (let' [module' (_lux_case module
- ""
- subst
-
- _
- module)]
- (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
-
- [_ [_ (#TupleS elems)]]
- (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
-
- [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]]
- unquoted
-
- [_ [meta (#FormS elems)]]
- (let' [[_ form'] (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
- [meta form'])
-
- [_ [_ (#RecordS fields)]]
- (wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
- (untemplate-list (map (_lux_: (-> (#TupleT (list AST AST)) AST)
- (lambda' [kv]
- (let' [[k v] kv]
- (tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
- fields)))))
- ))
-
-(defmacro (`' tokens)
- (_lux_case tokens
- (#Cons [template #Nil])
- (return (list (untemplate true "" template)))
-
- _
- (fail "Wrong syntax for `'")))
-
-(defmacro #export (' tokens)
- (_lux_case tokens
- (#Cons [template #Nil])
- (return (list (untemplate false "" template)))
-
- _
- (fail "Wrong syntax for '")))
-
-(defmacro #export (|> tokens)
- (_lux_case tokens
- (#Cons [init apps])
- (return (list (foldL (_lux_: (-> AST AST AST)
- (lambda' [acc app]
- (_lux_case app
- [_ (#TupleS parts)]
- (tuple$ (list:++ parts (list acc)))
-
- [_ (#FormS parts)]
- (form$ (list:++ parts (list acc)))
-
- _
- (`' ((~ app) (~ acc))))))
- init
- apps)))
-
- _
- (fail "Wrong syntax for |>")))
-
-(defmacro #export (if tokens)
- (_lux_case tokens
- (#Cons [test (#Cons [then (#Cons [else #Nil])])])
- (return (list (`' (_lux_case (~ test)
- true (~ then)
- false (~ else)))))
-
- _
- (fail "Wrong syntax for if")))
-
## (deftype (Lux a)
## (-> Compiler (Either Text (, Compiler a))))
(def''' #export Lux
Type
(All [a]
- (-> Compiler ($' Either Text (#TupleT (list Compiler a))))))
+ (-> Compiler ($' Either Text (, Compiler a)))))
## (defsig (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1175,10 +1060,10 @@
Type
(#NamedT ["lux" "Monad"]
(All [m]
- (#TupleT (list (All [a] (-> a ($' m a)))
- (All [a b] (-> (-> a ($' m b))
- ($' m a)
- ($' m b))))))))
+ (, (All [a] (-> a ($' m a)))
+ (All [a b] (-> (-> a ($' m b))
+ ($' m a)
+ ($' m b)))))))
(_lux_declare-tags [#return #bind] Monad)
(def''' Maybe/Monad
@@ -1210,37 +1095,28 @@
(#Right state' a)
(f a state'))))})
-(defmacro #export (^ tokens)
- (_lux_case tokens
- (#Cons [_ (#SymbolS "" class-name)] #Nil)
- (return (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))
-
- _
- (fail "Wrong syntax for ^")))
-
-(defmacro #export (, tokens)
- (return (list (`' (#;TupleT (~ (untemplate-list tokens)))))))
-
(defmacro (do tokens)
(_lux_case tokens
(#Cons monad (#Cons [_ (#TupleS bindings)] (#Cons body #Nil)))
- (let' [body' (foldL (_lux_: (-> AST (, AST AST) AST)
+ (let' [g!wrap (symbol$ ["" "wrap"])
+ g!bind (symbol$ ["" "12bind34"])
+ body' (foldL (_lux_: (-> AST (, AST AST) AST)
(lambda' [body' binding]
(let' [[var value] binding]
(_lux_case var
[_ (#TagS "" "let")]
- (`' (;let' (~ value) (~ body')))
+ (form$ (list (symbol$ ["lux" "let'"]) value body'))
_
- (`' (bind (_lux_lambda (~ (symbol$ ["" ""]))
- (~ var)
- (~ body'))
- (~ value)))))))
+ (form$ (list g!bind
+ (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body'))
+ value))))))
body
(reverse (as-pairs bindings)))]
- (return (list (`' (_lux_case (~ monad)
- {#;return wrap #;bind bind}
- (~ body'))))))
+ (return (list (form$ (list (symbol$ ["" "_lux_case"])
+ monad
+ (record$ (list [(tag$ ["lux" "return"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
+ body')))))
_
(fail "Wrong syntax for do")))
@@ -1265,6 +1141,232 @@
(wrap (#Cons y ys)))
)))
+(defmacro #export (if tokens)
+ (_lux_case tokens
+ (#Cons test (#Cons then (#Cons else #Nil)))
+ (return (list (form$ (list (symbol$ ["" "_lux_case"]) test
+ (bool$ true) then
+ (bool$ false) else))))
+
+ _
+ (fail "Wrong syntax for if")))
+
+(def''' (get k plist)
+ (All [a]
+ (-> Text ($' List (, Text a)) ($' Maybe a)))
+ (_lux_case plist
+ (#Cons [[k' v] plist'])
+ (if (text:= k k')
+ (#Some v)
+ (get k plist'))
+
+ #Nil
+ #None))
+
+(def''' (put k v dict)
+ (All [a]
+ (-> Text a ($' List (, Text a)) ($' List (, Text a))))
+ (_lux_case dict
+ #Nil
+ (list [k v])
+
+ (#Cons [[k' v'] dict'])
+ (if (text:= k k')
+ (#Cons [[k' v] dict'])
+ (#Cons [[k' v'] (put k v dict')]))))
+
+(def''' (text:++ x y)
+ (-> Text Text Text)
+ (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"]
+ x [y]))
+
+(def''' (ident->text ident)
+ (-> Ident Text)
+ (let' [[module name] ident]
+ ($ text:++ module ";" name)))
+
+(def''' (resolve-global-symbol ident state)
+ (-> Ident ($' Lux Ident))
+ (let' [[module name] ident
+ {#source source #modules modules
+ #envs envs #type-vars types #host host
+ #seed seed #eval? eval? #expected expected
+ #cursor cursor} state]
+ (_lux_case (get module modules)
+ (#Some {#module-aliases _ #defs defs #imports _ #tags tags #types types})
+ (_lux_case (get name defs)
+ (#Some [_ def-data])
+ (_lux_case def-data
+ (#AliasD real-name)
+ (#Right [state real-name])
+
+ _
+ (#Right [state ident]))
+
+ #None
+ (#Left ($ text:++ "Unknown definition: " (ident->text ident))))
+
+ #None
+ (#Left ($ text:++ "Unknown module: " module " @ " (ident->text ident))))))
+
+(def''' (splice replace? untemplate tag elems)
+ (-> Bool (-> AST ($' Lux AST)) AST ($' List AST) ($' Lux AST))
+ (_lux_case replace?
+ true
+ (_lux_case (any? spliced? elems)
+ true
+ (do Lux/Monad
+ [elems' (_lux_: ($' Lux ($' List AST))
+ (map% Lux/Monad
+ (_lux_: (-> AST ($' Lux AST))
+ (lambda' [elem]
+ (_lux_case elem
+ [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))]
+ (wrap spliced)
+
+ _
+ (do Lux/Monad
+ [=elem (untemplate elem)]
+ (wrap (form$ (list (symbol$ ["" "_lux_:"])
+ (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
+ (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"]))))))))))))
+ elems))]
+ (wrap (wrap-meta (form$ (list tag
+ (form$ (list& (symbol$ ["lux" "$"])
+ (symbol$ ["lux" "list:++"])
+ elems')))))))
+
+ false
+ (do Lux/Monad
+ [=elems (map% Lux/Monad untemplate elems)]
+ (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))
+ false
+ (do Lux/Monad
+ [=elems (map% Lux/Monad untemplate elems)]
+ (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))))
+
+(def''' (untemplate replace? subst token)
+ (-> Bool Text AST ($' Lux AST))
+ (_lux_case (_lux_: (, Bool AST) [replace? token])
+ [_ [_ (#BoolS value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value))))))
+
+ [_ [_ (#IntS value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value))))))
+
+ [_ [_ (#RealS value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value))))))
+
+ [_ [_ (#CharS value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value))))))
+
+ [_ [_ (#TextS value)]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value))))))
+
+ [_ [_ (#TagS [module name])]]
+ (let' [module' (_lux_case module
+ ""
+ subst
+
+ _
+ module)]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name))))))))
+
+ [true [_ (#SymbolS [module name])]]
+ (do Lux/Monad
+ [real-name (_lux_case module
+ ""
+ (resolve-global-symbol [subst name])
+
+ _
+ (wrap (_lux_: Ident [module name])))
+ #let [[module name] real-name]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name))))))))
+
+ [false [_ (#SymbolS [module name])]]
+ (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name)))))))
+
+ [_ [_ (#TupleS elems)]]
+ (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
+
+ [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]]
+ (return unquoted)
+
+ [_ [meta (#FormS elems)]]
+ (do Lux/Monad
+ [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)
+ #let [[_ form'] output]]
+ (return (_lux_: AST [meta form'])))
+
+ [_ [_ (#RecordS fields)]]
+ (do Lux/Monad
+ [=fields (map% Lux/Monad
+ (_lux_: (-> (, AST AST) ($' Lux AST))
+ (lambda' [kv]
+ (let' [[k v] kv]
+ (do Lux/Monad
+ [=k (untemplate replace? subst k)
+ =v (untemplate replace? subst v)]
+ (wrap (tuple$ (list =k =v)))))))
+ fields)]
+ (wrap (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) (untemplate-list =fields))))))
+ ))
+
+(def'' (get-module-name state)
+ ($' Lux Text)
+ (_lux_case state
+ {#source source #modules modules
+ #envs envs #type-vars types #host host
+ #seed seed #eval? eval? #expected expected
+ #cursor cursor}
+ (_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]))))
+
+(defmacro #export (` tokens)
+ (_lux_case tokens
+ (#Cons template #Nil)
+ (do Lux/Monad
+ [current-module get-module-name
+ =template (untemplate true current-module template)]
+ (wrap (list =template)))
+
+ _
+ (fail "Wrong syntax for `")))
+
+(defmacro #export (' tokens)
+ (_lux_case tokens
+ (#Cons template #Nil)
+ (do Lux/Monad
+ [=template (untemplate false "" template)]
+ (wrap (list =template)))
+
+ _
+ (fail "Wrong syntax for '")))
+
+(defmacro #export (|> tokens)
+ (_lux_case tokens
+ (#Cons [init apps])
+ (return (list (foldL (_lux_: (-> AST AST AST)
+ (lambda' [acc app]
+ (_lux_case app
+ [_ (#TupleS parts)]
+ (tuple$ (list:++ parts (list acc)))
+
+ [_ (#FormS parts)]
+ (form$ (list:++ parts (list acc)))
+
+ _
+ (` ((~ app) (~ acc))))))
+ init
+ apps)))
+
+ _
+ (fail "Wrong syntax for |>")))
+
(def''' (. f g)
(All [a b c]
(-> (-> b c) (-> a b) (-> a c)))
@@ -1409,58 +1511,10 @@
(-> Bool Bool)
(if x false true))
-(def''' (text:++ x y)
- (-> Text Text Text)
- (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"]
- x [y]))
-
-(def''' (ident->text ident)
- (-> Ident Text)
- (let' [[module name] ident]
- ($ text:++ module ";" name)))
-
-(def''' (get k plist)
- (All [a]
- (-> Text ($' List (, Text a)) ($' Maybe a)))
- (_lux_case plist
- (#Cons [[k' v] plist'])
- (if (text:= k k')
- (#Some v)
- (get k plist'))
-
- #Nil
- #None))
-
-(def''' (put k v dict)
- (All [a]
- (-> Text a ($' List (, Text a)) ($' List (, Text a))))
- (_lux_case dict
- #Nil
- (list [k v])
-
- (#Cons [[k' v'] dict'])
- (if (text:= k k')
- (#Cons [[k' v] dict'])
- (#Cons [[k' v'] (put k v dict')]))))
-
(def''' (->text x)
(-> (^ java.lang.Object) Text)
(_jvm_invokevirtual "java.lang.Object" "toString" [] x []))
-(def''' (get-module-name state)
- ($' Lux Text)
- (_lux_case state
- {#source source #modules modules
- #envs envs #type-vars types #host host
- #seed seed #eval? eval? #expected expected
- #cursor cursor}
- (_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]))))
-
(def''' (find-macro' modules current-module module name)
(-> ($' List (, Text ($' Module Compiler)))
Text Text Text
@@ -1589,7 +1643,7 @@
[_ (#FormS (#Cons [type-fn args]))]
(foldL (_lux_: (-> AST AST AST)
- (lambda' [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))))
+ (lambda' [type-fn arg] (` (#;AppT [(~ type-fn) (~ arg)]))))
(walk-type type-fn)
(map walk-type args))
@@ -1614,7 +1668,7 @@
(defmacro #export (: tokens)
(_lux_case tokens
(#Cons type (#Cons value #Nil))
- (return (list (`' (_lux_: (;type (~ type)) (~ value)))))
+ (return (list (` (;_lux_: (;type (~ type)) (~ value)))))
_
(fail "Wrong syntax for :")))
@@ -1622,7 +1676,7 @@
(defmacro #export (:! tokens)
(_lux_case tokens
(#Cons type (#Cons value #Nil))
- (return (list (`' (_lux_:! (;type (~ type)) (~ value)))))
+ (return (list (` (;_lux_:! (type (~ type)) (~ value)))))
_
(fail "Wrong syntax for :!")))
@@ -1651,7 +1705,7 @@
(lambda' [case]
(_lux_case case
[_ (#TagS "" member-name)]
- (return [member-name (`' Unit)])
+ (return [member-name (` Unit)])
[_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))]
(return [member-name member-type])
@@ -1659,7 +1713,7 @@
_
(fail "Wrong syntax for variant case."))))
cases)]
- (return [(`' (#;VariantT (~ (untemplate-list (map second members)))))
+ (return [(` (#;VariantT (~ (untemplate-list (map second members)))))
(#Some (|> members
(map first)
(map (: (-> Text AST)
@@ -1677,7 +1731,7 @@
_
(fail "Wrong syntax for variant case."))))
(as-pairs pairs))]
- (return [(`' (#TupleT (~ (untemplate-list (map second members)))))
+ (return [(` (#TupleT (~ (untemplate-list (map second members)))))
(#Some (|> members
(map first)
(map (: (-> Text AST)
@@ -1720,12 +1774,12 @@
[type tags??] type+tags??
with-export (: (List AST)
(if export?
- (list (`' (_lux_export (~ type-name))))
+ (list (` (;_lux_export (~ type-name))))
#Nil))
with-tags (: (List AST)
(_lux_case tags??
(#Some tags)
- (list (`' (_lux_declare-tags [(~@ tags)] (~ type-name))))
+ (list (` (;_lux_declare-tags [(~@ tags)] (~ type-name))))
_
(list)))
@@ -1734,21 +1788,21 @@
(if (empty? args)
(let' [g!param (symbol$ ["" ""])
prime-name (symbol$ ["" (text:++ name "'")])
- type+ (replace-syntax (list [name (`' ((~ prime-name) (~ g!param)))]) type)]
- (#Some (`' ((;All (~ prime-name) [(~ g!param)] (~ type+))
- ;Void))))
+ type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)]
+ (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
+ Void))))
#None)
(_lux_case args
#Nil
(#Some type)
_
- (#Some (`' (;All (~ type-name) [(~@ args)] (~ type)))))))]
+ (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))]
(_lux_case type'
(#Some type'')
- (return (list& (`' (_lux_def (~ type-name) (;type (#;NamedT [(~ (text$ module-name))
- (~ (text$ name))]
- (~ type'')))))
+ (return (list& (` (;_lux_def (~ type-name) (type (#;NamedT [(~ (text$ module-name))
+ (~ (text$ name))]
+ (~ type'')))))
(list:++ with-export with-tags)))
#None
@@ -1763,7 +1817,7 @@
(#Cons value actions)
(let' [dummy (symbol$ ["" ""])]
(return (list (foldL (_lux_: (-> AST AST AST)
- (lambda' [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))))
+ (lambda' [post pre] (` (;_lux_case (~ pre) (~ dummy) (~ post)))))
value
actions))))
@@ -1802,17 +1856,17 @@
body
_
- (`' (;lambda' (~ name) [(~@ args)] (~ body)))))
+ (` (lambda' (~ name) [(~@ args)] (~ body)))))
body'' (: AST
(_lux_case ?type
(#Some type)
- (`' (: (~ type) (~ body')))
+ (` (: (~ type) (~ body')))
#None
body'))]
- (return (list& (`' (_lux_def (~ name) (~ body'')))
+ (return (list& (` (;_lux_def (~ name) (~ body'')))
(if export?
- (list (`' (_lux_export (~ name))))
+ (list (` (;_lux_export (~ name))))
#Nil))))
#None
@@ -1841,8 +1895,8 @@
_
(wrap (list branch))))))
(as-pairs branches))]
- (wrap (list (`' (_lux_case (~ value)
- (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
+ (wrap (list (` (;_lux_case (~ value)
+ (~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
_
(fail "Wrong syntax for case")))
@@ -1878,16 +1932,6 @@
_
(fail "Wrong syntax for \\or")))
-(defmacro #export (` tokens)
- (do Lux/Monad
- [module-name get-module-name]
- (case tokens
- (\ (list template))
- (wrap (list (untemplate true module-name template)))
-
- _
- (fail "Wrong syntax for `"))))
-
(def' (symbol? ast)
(-> AST Bool)
(case ast
@@ -1906,7 +1950,7 @@
(lambda' [body' lr]
(let' [[l r] lr]
(if (symbol? l)
- (` (_lux_case (~ r) (~ l) (~ body')))
+ (` (;_lux_case (~ r) (~ l) (~ body')))
(` (case (~ r) (~ l) (~ body')))))))
body)
list
@@ -1969,14 +2013,14 @@
body+ (: AST (foldL (: (-> AST AST AST)
(lambda' [body' arg]
(if (symbol? arg)
- (` (_lux_lambda (~ g!blank) (~ arg) (~ body')))
- (` (_lux_lambda (~ g!blank) (~ g!blank)
- (case (~ g!blank) (~ arg) (~ body')))))))
+ (` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
+ (` (;_lux_lambda (~ g!blank) (~ g!blank)
+ (case (~ g!blank) (~ arg) (~ body')))))))
body
(reverse tail)))]
(return (list (if (symbol? head)
- (` (_lux_lambda (~ g!name) (~ head) (~ body+)))
- (` (_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
+ (` (;_lux_lambda (~ g!name) (~ head) (~ body+)))
+ (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
#None
(fail "Wrong syntax for lambda")))
@@ -2013,7 +2057,7 @@
body
_
- (` (;lambda (~ name) [(~@ args)] (~ body)))))
+ (` (lambda (~ name) [(~@ args)] (~ body)))))
body (: AST
(case ?type
(#Some type)
@@ -2021,9 +2065,9 @@
#None
body))]
- (return (list& (` (_lux_def (~ name) (~ body)))
+ (return (list& (` (;_lux_def (~ name) (~ body)))
(if export?
- (list (` (_lux_export (~ name))))
+ (list (` (;_lux_export (~ name))))
(list)))))
#None
@@ -2079,19 +2123,19 @@
def-name (symbol$ name)
tags (: (List AST) (map (. (: (-> Text AST) (lambda [n] (tag$ ["" n]))) first) members))
types (map second members)
- sig-type (: AST (` (#;TupleT (~ (untemplate-list types)))))
- sig-decl (: AST (` (_lux_declare-tags [(~@ tags)] (~ def-name))))
+ sig-type (: AST (` (#TupleT (~ (untemplate-list types)))))
+ sig-decl (: AST (` (;_lux_declare-tags [(~@ tags)] (~ def-name))))
sig+ (: AST
(case args
#Nil
sig-type
_
- (` (#;NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]]
- (return (list& (` (_lux_def (~ def-name) (~ sig+)))
+ (` (#NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]]
+ (return (list& (` (;_lux_def (~ def-name) (~ sig+)))
sig-decl
(if export?
- (list (` (_lux_export (~ def-name))))
+ (list (` (;_lux_export (~ def-name))))
#Nil))))
#None
@@ -2370,29 +2414,22 @@
#let [tag-mappings (: (List (, Text AST))
(map (lambda [tag] [(second tag) (tag$ tag)])
tags))]
- _ (: (Lux Unit)
- (let [msg ($ text:++ "struct/tag-mappings: " "[" (|> tag-mappings (map first) (interpose " ") (foldL text:++ "")) "]" " " (type:show struct-type))
- _ (_jvm_invokevirtual "java.io.PrintStream" "println" ["java.lang.Object"]
- (_jvm_getstatic "java.lang.System" "out") [msg])]
- (return (: Unit []))))
- ]
- (do Lux/Monad
- [members (map% Lux/Monad
- (: (-> AST (Lux (, AST AST)))
- (lambda [token]
- (case token
- (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))])
- (case (get tag-name tag-mappings)
- (#Some tag)
- (wrap (: (, AST AST) [tag value]))
-
- _
- (fail (text:++ "Unknown structure member: " tag-name)))
+ members (map% Lux/Monad
+ (: (-> AST (Lux (, AST AST)))
+ (lambda [token]
+ (case token
+ (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))])
+ (case (get tag-name tag-mappings)
+ (#Some tag)
+ (wrap (: (, AST AST) [tag value]))
_
- (fail (text:++ "Invalid structure member: " (ast:show token))))))
- (list:join tokens'))]
- (wrap (list (record$ members))))))
+ (fail (text:++ "Unknown structure member: " tag-name)))
+
+ _
+ (fail (text:++ "Invalid structure member: " (ast:show token))))))
+ (list:join tokens'))]
+ (wrap (list (record$ members)))))
(defmacro #export (defstruct tokens)
(let [[export? tokens'] (: (, Bool (List AST))
@@ -2417,13 +2454,13 @@
(let [defs' (: AST
(case args
#Nil
- (` (;struct (~@ defs)))
+ (` (struct (~@ defs)))
_
- (` (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
+ (` (lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
(return (list& (` (def (~ name) (~ type) (~ defs')))
(if export?
- (list (` (_lux_export (~ name))))
+ (list (` (;_lux_export (~ name))))
#Nil))))
#None
@@ -2670,85 +2707,6 @@
cases)]
output))
-(defmacro #export (import tokens)
- (do Lux/Monad
- [imports (parse-imports tokens)
- imports (map% Lux/Monad
- (: (-> Import (Lux Import))
- (lambda [import]
- (case import
- [m-name m-alias m-referrals m-openings]
- (do Lux/Monad
- [m-name (clean-module m-name)]
- (wrap (: Import [m-name m-alias m-referrals m-openings]))))))
- imports)
- unknowns' (map% Lux/Monad
- (: (-> Import (Lux (List Text)))
- (lambda [import]
- (case import
- [m-name _ _ _]
- (do Lux/Monad
- [? (module-exists? m-name)]
- (wrap (if ?
- (list)
- (list m-name)))))))
- imports)
- #let [unknowns (list:join unknowns')]]
- (case unknowns
- #Nil
- (do Lux/Monad
- [output' (map% Lux/Monad
- (: (-> Import (Lux (List AST)))
- (lambda [import]
- (case import
- [m-name m-alias m-referrals m-openings]
- (do Lux/Monad
- [defs (case m-referrals
- #All
- (exported-defs m-name)
-
- (#Only +defs)
- (do Lux/Monad
- [*defs (exported-defs m-name)]
- (wrap (filter (is-member? +defs) *defs)))
-
- (#Exclude -defs)
- (do Lux/Monad
- [*defs (exported-defs m-name)]
- (wrap (filter (. not (is-member? -defs)) *defs)))
-
- #Nothing
- (wrap (list)))
- #let [openings (: (List AST)
- (case m-openings
- #None
- (list)
-
- (#Some prefix structs)
- (map (: (-> Ident AST)
- (lambda [struct]
- (let [[_ name] struct]
- (` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
- structs)))]]
- (wrap ($ list:++
- (: (List AST) (list (` (_lux_import (~ (text$ m-name))))))
- (: (List AST)
- (case m-alias
- #None (list)
- (#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name)))))))
- (map (: (-> Text AST)
- (lambda [def]
- (` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
- defs)
- openings))))))
- imports)]
- (wrap (list:join output')))
-
- _
- (wrap (list:++ (map (: (-> Text AST) (lambda [m-name] (` (_lux_import (~ (text$ m-name))))))
- unknowns)
- (: (List AST) (list (` (import (~@ tokens))))))))))
-
(def (try-both f x1 x2)
(All [a b]
(-> (-> a (Maybe b)) a a (Maybe b)))
@@ -2895,17 +2853,17 @@
(lambda [[sname stype]] (use-field sname stype)))
(zip2 tags members))
#let [pattern (record$ slots)]]
- (return (list (` (_lux_case (~ struct) (~ pattern) (~ body))))))
+ (return (list (` (;_lux_case (~ struct) (~ pattern) (~ body))))))
_
(fail "Can only \"use\" records.")))
_
(let [dummy (symbol$ ["" ""])]
- (return (list (` (_lux_case (~ struct)
- (~ dummy)
- (using (~ dummy)
- (~ body))))))))
+ (return (list (` (;_lux_case (~ struct)
+ (~ dummy)
+ (;using (~ dummy)
+ (~ body))))))))
_
(fail "Wrong syntax for using")))
@@ -2961,7 +2919,7 @@
g!output
g!_)]))
(zip2 tags (enumerate members))))]
- (return (list (` (_lux_case (~ record) (~ pattern) (~ g!output))))))
+ (return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output))))))
_
(fail "get@ can only use records.")))
@@ -2984,7 +2942,7 @@
(return (list:join decls')))
_
- (return (list (` (_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+))))))))
+ (return (list (` (;_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+))))))))
(defmacro #export (open tokens)
(case tokens
@@ -3014,6 +2972,85 @@
_
(fail "Wrong syntax for open")))
+(defmacro #export (import tokens)
+ (do Lux/Monad
+ [imports (parse-imports tokens)
+ imports (map% Lux/Monad
+ (: (-> Import (Lux Import))
+ (lambda [import]
+ (case import
+ [m-name m-alias m-referrals m-openings]
+ (do Lux/Monad
+ [m-name (clean-module m-name)]
+ (wrap (: Import [m-name m-alias m-referrals m-openings]))))))
+ imports)
+ unknowns' (map% Lux/Monad
+ (: (-> Import (Lux (List Text)))
+ (lambda [import]
+ (case import
+ [m-name _ _ _]
+ (do Lux/Monad
+ [? (module-exists? m-name)]
+ (wrap (if ?
+ (list)
+ (list m-name)))))))
+ imports)
+ #let [unknowns (list:join unknowns')]]
+ (case unknowns
+ #Nil
+ (do Lux/Monad
+ [output' (map% Lux/Monad
+ (: (-> Import (Lux (List AST)))
+ (lambda [import]
+ (case import
+ [m-name m-alias m-referrals m-openings]
+ (do Lux/Monad
+ [defs (case m-referrals
+ #All
+ (exported-defs m-name)
+
+ (#Only +defs)
+ (do Lux/Monad
+ [*defs (exported-defs m-name)]
+ (wrap (filter (is-member? +defs) *defs)))
+
+ (#Exclude -defs)
+ (do Lux/Monad
+ [*defs (exported-defs m-name)]
+ (wrap (filter (. not (is-member? -defs)) *defs)))
+
+ #Nothing
+ (wrap (list)))
+ #let [openings (: (List AST)
+ (case m-openings
+ #None
+ (list)
+
+ (#Some prefix structs)
+ (map (: (-> Ident AST)
+ (lambda [struct]
+ (let [[_ name] struct]
+ (` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
+ structs)))]]
+ (wrap ($ list:++
+ (: (List AST) (list (` (;_lux_import (~ (text$ m-name))))))
+ (: (List AST)
+ (case m-alias
+ #None (list)
+ (#Some alias) (list (` (;_lux_alias (~ (text$ alias)) (~ (text$ m-name)))))))
+ (map (: (-> Text AST)
+ (lambda [def]
+ (` (;_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
+ defs)
+ openings))))))
+ imports)]
+ (wrap (list:join output')))
+
+ _
+ (wrap (list:++ (map (: (-> Text AST) (lambda [m-name] (` (;_lux_import (~ (text$ m-name))))))
+ unknowns)
+ (: (List AST) (list (` (;import (~@ tokens))))))))))
+
(def (foldL% M f x ys)
(All [m a b]
(-> (Monad m) (-> a b (m a)) a (List b)
@@ -3077,7 +3114,7 @@
value
r-var)]))
pattern'))]
- (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
+ (return (list (` (;_lux_case (~ record) (~ pattern) (~ output)))))))
_
(fail "set@ can only use records.")))
@@ -3112,7 +3149,7 @@
(` ((~ fun) (~ r-var)))
r-var)]))
pattern'))]
- (return (list (` (_lux_case (~ record) (~ pattern) (~ output)))))))
+ (return (list (` (;_lux_case (~ record) (~ pattern) (~ output)))))))
_
(fail "update@ can only use records.")))
@@ -3169,35 +3206,35 @@
(-> Type AST)
(case type
(#DataT name)
- (` (#;DataT (~ (text$ name))))
+ (` (#DataT (~ (text$ name))))
(#;VariantT cases)
- (` (#;VariantT (~ (untemplate-list (map type->syntax cases)))))
+ (` (#VariantT (~ (untemplate-list (map type->syntax cases)))))
(#TupleT parts)
- (` (#;TupleT (~ (untemplate-list (map type->syntax parts)))))
+ (` (#TupleT (~ (untemplate-list (map type->syntax parts)))))
(#LambdaT in out)
- (` (#;LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
+ (` (#LambdaT (~ (type->syntax in)) (~ (type->syntax out))))
(#BoundT idx)
- (` (#;BoundT (~ (int$ idx))))
+ (` (#BoundT (~ (int$ idx))))
(#VarT id)
- (` (#;VarT (~ (int$ id))))
+ (` (#VarT (~ (int$ id))))
(#ExT id)
- (` (#;ExT (~ (int$ id))))
+ (` (#ExT (~ (int$ id))))
(#UnivQ env type)
(let [env' (untemplate-list (map type->syntax env))]
- (` (#;UnivQ (~ env') (~ (type->syntax type)))))
+ (` (#UnivQ (~ env') (~ (type->syntax type)))))
(#AppT fun arg)
- (` (#;AppT (~ (type->syntax fun)) (~ (type->syntax arg))))
+ (` (#AppT (~ (type->syntax fun)) (~ (type->syntax arg))))
(#NamedT [module name] type)
- (` (#;NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
+ (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
(defmacro #export (loop tokens)
(case tokens
@@ -3224,14 +3261,14 @@
(lambda [_] (gensym "")))
inits)]
(return (list (` (let [(~@ (interleave aliases inits))]
- (loop [(~@ (interleave vars aliases))]
+ (;loop [(~@ (interleave vars aliases))]
(~ body)))))))))
_
(fail "Wrong syntax for loop")))
(defmacro #export (export tokens)
- (return (map (: (-> AST AST) (lambda [token] (` (_lux_export (~ token))))) tokens)))
+ (return (map (: (-> AST AST) (lambda [token] (` (;_lux_export (~ token))))) tokens)))
(defmacro #export (\slots tokens)
(case tokens
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index df48da863..8e59ae941 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -59,18 +59,18 @@
(let [[var value] binding]
(case var
[_ (#;TagS ["" "let"])]
- (` (;let (~ value) (~ body')))
+ (` (let (~ value) (~ body')))
_
- (` (;|> (~ value) ((~ g!map) (;lambda [(~ var)] (~ body'))) (~ g!join)))
+ (` (|> (~ value) ((~ g!map) (lambda [(~ var)] (~ body'))) (~ g!join)))
## (` (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;:: ;;_functor) (;;join)))
))))
body
(reverse (as-pairs bindings)))]
- (#;Right [state (#;Cons [(` (;case (~ monad)
- {#;;_functor {#F;map (~ g!map)} #;;wrap (~ (' wrap)) #;;join (~ g!join)}
- (~ body')))
- #;Nil])]))
+ (#;Right [state (#;Cons (` (case (~ monad)
+ {#_functor {#F;map (~ g!map)} #wrap (~ (' wrap)) #join (~ g!join)}
+ (~ body')))
+ #;Nil)]))
_
(#;Left "Wrong syntax for do")))
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
index 032381404..2d2a2bc35 100644
--- a/source/lux/data/io.lux
+++ b/source/lux/data/io.lux
@@ -20,7 +20,7 @@
(case tokens
(\ (list value))
(let [blank (symbol$ ["" ""])]
- (#;Right [state (list (` (_lux_lambda (~ blank) (~ blank) (~ value))))]))
+ (#;Right [state (list (` (;_lux_lambda (~ blank) (~ blank) (~ value))))]))
_
(#;Left "Wrong syntax for io")))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index c9a4c7598..7df2eb358 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -214,21 +214,19 @@
## [Syntax]
(defmacro #export (list xs state)
- (#;Right [state (#;Cons [(foldL (: (-> AST AST AST)
- (lambda [tail head]
- (` (#;Cons [(~ head) (~ tail)]))))
- (: AST (` #;Nil))
- (reverse xs))
- #;Nil])]))
+ (#;Right state (#;Cons (foldL (: (-> AST AST AST)
+ (lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
+ (: AST (` #;Nil))
+ (reverse xs))
+ #;Nil)))
(defmacro #export (list& xs state)
(case (reverse xs)
- (#;Cons [last init])
- (#;Right [state (list (foldL (: (-> AST AST AST)
- (lambda [tail head]
- (` (#;Cons [(~ head) (~ tail)]))))
- last
- init))])
+ (#;Cons last init)
+ (#;Right state (list (foldL (: (-> AST AST AST)
+ (lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
+ last
+ init)))
_
(#;Left "Wrong syntax for list&")))
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index 5df03f378..77dbec5b1 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -45,12 +45,13 @@
(defmacro #export (? tokens state)
(case tokens
(\ (list maybe else))
- (let [g!value (symbol$ ["" "_"])]
+ (let [g!value (symbol$ ["" "_"])
+ g!_ (symbol$ ["" "12_34"])]
(#;Right state (list (` (case (~ maybe)
(#;Some (~ g!value))
(~ g!value)
- _
+ (~ g!_)
(~ else))))))
_
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 40021d8fa..d7992509a 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -82,21 +82,21 @@
## [Syntax]
(defsyntax #export (throw ex)
- (emit (list (` (_jvm_throw (~ ex))))))
+ (emit (list (` (;_jvm_throw (~ ex))))))
(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)])
- (emit (list (` (_jvm_try (~ body)
- (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
- (lambda [catch]
- (let [[class ex body] catch]
- (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
- catches)
- (case finally
- #;None
- (list)
-
- (#;Some finally)
- (: (List AST) (list (` (_jvm_finally (~ finally))))))))))))))
+ (emit (list (` (;_jvm_try (~ body)
+ (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
+ (lambda [catch]
+ (let [[class ex body] catch]
+ (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
+ catches)
+ (case finally
+ #;None
+ (list)
+
+ (#;Some finally)
+ (: (List AST) (list (` (;_jvm_finally (~ finally))))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
(let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST)
@@ -104,8 +104,8 @@
(let [[modifiers name inputs output] member]
(` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
members)]
- (emit (list (` (_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
- (~@ members')))))))
+ (emit (list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
+ (~@ members')))))))
(defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
[fields (*^ field-decl^)]
@@ -133,36 +133,37 @@
[(~@ (map text$ modifiers))]
(~ body))))))
methods)]]
- (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super))
- [(~@ (map text$ interfaces))]
- [(~@ fields')]
- [(~@ methods')]))))))
+ (emit (list (` (;_jvm_class (~ (text$ name)) (~ (text$ super))
+ [(~@ (map text$ interfaces))]
+ [(~@ fields')]
+ [(~@ methods')]))))))
(defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))])
- (emit (list (` (_jvm_new (~ (text$ class))
- [(~@ (map text$ arg-classes))]
- [(~@ args)])))))
+ (emit (list (` (;_jvm_new (~ (text$ class))
+ [(~@ (map text$ arg-classes))]
+ [(~@ args)])))))
(defsyntax #export (instance? [class local-symbol^] obj)
- (emit (list (` (_jvm_instanceof (~ (text$ class)) (~ obj))))))
+ (emit (list (` (;_jvm_instanceof (~ (text$ class)) (~ obj))))))
(defsyntax #export (locking lock body)
(do Lux/Monad
[g!lock (gensym "")
- g!body (gensym "")]
- (emit (list (` (;let [(~ g!lock) (~ lock)
- _ (_jvm_monitorenter (~ g!lock))
- (~ g!body) (~ body)
- _ (_jvm_monitorexit (~ g!lock))]
- (~ g!body)))))
+ g!body (gensym "")
+ g!_ (gensym "")]
+ (emit (list (` (let [(~ g!lock) (~ lock)
+ (~ g!_) (;_jvm_monitorenter (~ g!lock))
+ (~ g!body) (~ body)
+ (~ g!_) (;_jvm_monitorexit (~ g!lock))]
+ (~ g!body)))))
))
(defsyntax #export (null? obj)
- (emit (list (` (_jvm_null? (~ obj))))))
+ (emit (list (` (;_jvm_null? (~ obj))))))
(defsyntax #export (program [args symbol^] body)
- (emit (list (` (_jvm_program (~ (symbol$ args))
- (~ body))))))
+ (emit (list (` (;_jvm_program (~ (symbol$ args))
+ (~ body))))))
(defsyntax #export (.? [field local-symbol^] obj)
(case obj
@@ -171,7 +172,7 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (_jvm_getfield (~ (text$ class)) (~ (text$ field))))))
+ (emit (list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field))))))
_
(fail "Can only get field from object.")))
@@ -179,8 +180,8 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.? (~ (text$ field)) (~ g!obj)))))))))
+ (emit (list (` (let [(~ g!obj) (~ obj)]
+ (;;.? (~ (text$ field)) (~ g!obj)))))))))
(defsyntax #export (.= [field local-symbol^] value obj)
(case obj
@@ -189,7 +190,7 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value)))))
+ (emit (list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value)))))
_
(fail "Can only set field of object.")))
@@ -197,8 +198,8 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
+ (emit (list (` (let [(~ g!obj) (~ obj)]
+ (;;.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
(defsyntax #export (.! [call method-call^] obj)
(let [[m-name ?m-classes m-args] call]
@@ -208,8 +209,8 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
- (~ obj) [(~@ m-args)]))))
+ (emit (list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
+ (~ obj) [(~@ m-args)]))))
_
(fail "Can only call method on object.")))
@@ -217,31 +218,31 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.! ((~ (symbol$ ["" m-name]))
- [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))]
- [(~@ m-args)])
- (~ g!obj))))))))))
+ (emit (list (` (let [(~ g!obj) (~ obj)]
+ (;;.! ((~ (symbol$ ["" m-name]))
+ [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))]
+ [(~@ m-args)])
+ (~ g!obj))))))))))
(defsyntax #export (..? [field local-symbol^] [class local-symbol^])
- (emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
+ (emit (list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
(defsyntax #export (..= [field local-symbol^] value [class local-symbol^])
- (emit (list (` (_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value))))))
+ (emit (list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value))))))
(defsyntax #export (..! [call method-call^] [class local-symbol^])
(let [[m-name m-classes m-args] call]
- (emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
- [(~@ (map text$ m-classes))]
- [(~@ m-args)]))))))
+ (emit (list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
+ [(~@ (map text$ m-classes))]
+ [(~@ m-args)]))))))
(defsyntax #export (->maybe expr)
(do Lux/Monad
[g!val (gensym "")]
- (emit (list (` (;let [(~ g!val) (~ expr)]
- (;if (null? (~ g!val))
- #;None
- (#;Some (~ g!val)))))))))
+ (emit (list (` (let [(~ g!val) (~ expr)]
+ (if (null? (~ g!val))
+ #;None
+ (#;Some (~ g!val)))))))))
(defsyntax #export (try$ expr)
(emit (list (` (try (#;Right (~ expr))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 7d888f659..df79772c1 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -242,20 +242,20 @@
body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body name+parser]
(let [[name parser] name+parser]
- (` (_lux_case ((~ parser) (~ g!tokens))
- (#;Some [(~ g!tokens) (~ name)])
- (~ body)
+ (` (;_lux_case ((~ parser) (~ g!tokens))
+ (#;Some [(~ g!tokens) (~ name)])
+ (~ body)
- (~ g!_)
- (l;fail (~ error-msg)))))))
+ (~ g!_)
+ (l;fail (~ error-msg)))))))
body
(: (List (, AST AST)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
macro-def (: AST
- (` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
- (~ body'))))]]
+ (` (defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
+ (~ body'))))]]
(wrap (list& macro-def
(if exported?
- (list (` (_lux_export (~ (symbol$ ["" name])))))
+ (list (` (;_lux_export (~ (symbol$ ["" name])))))
(list)))))
_
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 18:25:38 +0000