From c4e142d74afaad72f1cc1c8f08ac1cb0d347fe91 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 21 Jul 2018 22:03:01 -0400 Subject: Added macros for specifying implicits either at the module level, or at the local-scope level. --- stdlib/source/lux/type/implicit.lux | 64 ++++++++++++++++++++++++++----------- 1 file changed, 45 insertions(+), 19 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 1deb21c60..b38ade514 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -13,9 +13,9 @@ [collection ["." list ("list/." Monad Fold)] ["dict" dictionary (#+ Dictionary)]]] - ["." macro (#+ Monad) + ["." macro ["." code] - ["s" syntax (#+ syntax: Syntax)]] + ["s" syntax (#+ Syntax syntax:)]] ["." type ["." check (#+ Check)]]]) @@ -29,7 +29,7 @@ (find-type-var id' env) _ - (:: Monad wrap type)) + (:: macro.Monad wrap type)) (#.Some [_ #.None]) (macro.fail (format "Unbound type-var " (%n id))) @@ -40,7 +40,7 @@ (def: (resolve-type var-name) (-> Name (Meta Type)) - (do Monad + (do macro.Monad [raw-type (macro.find-type var-name) compiler macro.get-compiler] (case raw-type @@ -78,11 +78,11 @@ (-> Name (Meta Name)) (case member ["" simple-name] - (macro.either (do Monad + (macro.either (do macro.Monad [member (macro.normalize member) _ (macro.resolve-tag member)] (wrap member)) - (do Monad + (do macro.Monad [this-module-name macro.current-module-name imp-mods (macro.imported-modules this-module-name) tag-lists (monad.map @ macro.tag-lists imp-mods) @@ -100,11 +100,11 @@ (macro.fail (format "Too many candidate tags: " (%list %name candidates)))))) _ - (:: Monad wrap member))) + (:: macro.Monad wrap member))) (def: (resolve-member member) (-> Name (Meta [Nat Type])) - (do Monad + (do macro.Monad [member (find-member-name member) [idx tag-list sig-type] (macro.resolve-tag member)] (wrap [idx sig-type]))) @@ -119,7 +119,7 @@ (def: local-env (Meta (List [Name Type])) - (do Monad + (do macro.Monad [local-batches macro.locals #let [total-locals (list/fold (function (_ [name type] table) (dict.put~ name type table)) @@ -132,14 +132,14 @@ (def: local-structs (Meta (List [Name Type])) - (do Monad + (do macro.Monad [this-module-name macro.current-module-name definitions (macro.definitions this-module-name)] (wrap (prepare-definitions this-module-name definitions)))) (def: import-structs (Meta (List [Name Type])) - (do Monad + (do macro.Monad [this-module-name macro.current-module-name imp-mods (macro.imported-modules this-module-name) export-batches (monad.map @ (function (_ imp-mod) @@ -200,7 +200,7 @@ (-> (-> Lux Type-Context Type (Check Instance)) Type-Context Type (List [Name Type]) (Meta (List Instance))) - (do Monad + (do macro.Monad [compiler macro.get-compiler] (case (|> alts (list/map (function (_ [alt-name alt-type]) @@ -228,9 +228,9 @@ (-> Lux Type-Context Type (Check Instance)) (case (macro.run compiler ($_ macro.either - (do Monad [alts local-env] (test-provision provision context dep alts)) - (do Monad [alts local-structs] (test-provision provision context dep alts)) - (do Monad [alts import-structs] (test-provision provision context dep alts)))) + (do macro.Monad [alts local-env] (test-provision provision context dep alts)) + (do macro.Monad [alts local-structs] (test-provision provision context dep alts)) + (do macro.Monad [alts import-structs] (test-provision provision context dep alts)))) (#.Left error) (check.fail error) @@ -248,7 +248,7 @@ (def: (test-alternatives sig-type member-idx input-types output-type alts) (-> Type Nat (List Type) Type (List [Name Type]) (Meta (List Instance))) - (do Monad + (do macro.Monad [compiler macro.get-compiler context macro.type-context] (case (|> alts @@ -279,9 +279,9 @@ (-> Type Nat (List Type) Type (Meta (List Instance))) (let [test (test-alternatives sig-type member-idx input-types output-type)] ($_ macro.either - (do Monad [alts local-env] (test alts)) - (do Monad [alts local-structs] (test alts)) - (do Monad [alts import-structs] (test alts))))) + (do macro.Monad [alts local-env] (test alts)) + (do macro.Monad [alts local-structs] (test alts)) + (do macro.Monad [alts import-structs] (test alts))))) (def: (var? input) (-> Code Bit) @@ -361,3 +361,29 @@ (wrap (list (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))] (..::: (~ (code.symbol member)) (~+ labels))))))) )) + +(def: (implicit-bindings amount) + (-> Nat (Meta (List Code))) + (|> (macro.gensym "g!implicit") + (list.repeat amount) + (monad.seq macro.Monad))) + +(def: implicits + (Syntax (List Code)) + (s.tuple (p.many s.any))) + +(syntax: #export (implicit {structures ..implicits} body) + (do @ + [g!implicit+ (implicit-bindings (list.size structures))] + (wrap (list (` (let [(~+ (|> (list.zip2 g!implicit+ structures) + (list/map (function (_ [g!implicit structure]) + (list g!implicit structure))) + list/join))] + (~ body))))))) + +(syntax: #export (implicit: {structures ..implicits}) + (do @ + [g!implicit+ (implicit-bindings (list.size structures))] + (wrap (|> (list.zip2 g!implicit+ structures) + (list/map (function (_ [g!implicit structure]) + (` (def: (~ g!implicit) (~ structure))))))))) -- cgit v1.2.3