From 0a0fab3581eedbc13df2af40e3db8bc2d2fd8178 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 30 Aug 2015 01:20:08 -0400 Subject: - Removed the (now obsolete) `' macro. - Implemented hygienic macros by adding global symbol resolution inside the ` macro. --- source/lux.lux | 789 ++++++++++++++++++++++--------------------- source/lux/control/monad.lux | 12 +- source/lux/data/io.lux | 2 +- source/lux/data/list.lux | 22 +- source/lux/data/maybe.lux | 5 +- source/lux/host/jvm.lux | 109 +++--- source/lux/meta/syntax.lux | 16 +- 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))))) _ -- cgit v1.2.3