diff options
| -rw-r--r-- | stdlib/source/lux/macro/poly.lux | 39 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/poly/eq.lux | 34 |
2 files changed, 55 insertions, 18 deletions
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 24e9c0be9..ecf5e2019 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,5 +1,5 @@ (;module: - [lux #- list function] + [lux #- function] (lux (control monad [eq]) (data [text] @@ -10,7 +10,8 @@ [product] [bool] [char] - [maybe]) + [maybe] + [ident "Ident/" Eq<Ident>]) [macro #+ Monad<Lux> with-gensyms] (macro [code] ["s" syntax #+ syntax: Syntax] @@ -209,21 +210,29 @@ _ (wrap [:func: (list;reverse :args:)]))))) -(do-template [<combinator> <name>] - [(def: #export <combinator> - (Matcher Type) - (;function [:type:] - (case (type;un-name :type:) - (^=> (#;App :quant: :arg:) - [(type;un-alias :quant:) (#;Named ["lux" <name>] _)]) - (:: macro;Monad<Lux> wrap :arg:) +(def: #export (apply-1 name) + (-> Ident (Matcher Type)) + (;function [:type:] + (case (type;un-name :type:) + (^=> (#;App :quant: :arg:) + [(type;un-alias :quant:) (#;Named actual _)] + (Ident/= name actual)) + (:: macro;Monad<Lux> wrap :arg:) - _ - (macro;fail (format "Not " <name> " type: " (%type :type:))))))] + _ + (macro;fail (format "Not " (%ident name) " type: " (%type :type:)))))) - [maybe "Maybe"] - [list "List"] - ) +(def: #export (apply-2 name) + (-> Ident (Matcher [Type Type])) + (;function [:type:] + (case (type;un-name :type:) + (^=> (#;App (#;App :quant: :arg0:) :arg1:) + [(type;un-alias :quant:) (#;Named actual _)] + (Ident/= name actual)) + (:: macro;Monad<Lux> wrap [:arg0: :arg1:]) + + _ + (macro;fail (format "Not " (%ident name) " type: " (%type :type:)))))) (def: (adjusted-idx env idx) (-> Env Nat Nat) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index f1a184c85..953891e1c 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -5,7 +5,13 @@ (data [text] text/format (coll [list "List/" Monad<List>] - [dict #+ Dict]) + [vector] + [array] + [queue] + [set] + [seq] + [dict #+ Dict] + (tree [rose])) [number] [product] [bool] @@ -46,13 +52,35 @@ [Bool poly;bool bool;Eq<Bool>] [Nat poly;nat number;Eq<Nat>] [Int poly;int number;Eq<Int>] - [Deg poly;deg number;Eq<Deg>] + [Deg poly;deg number;Eq<Deg>] [Real poly;real number;Eq<Real>] [Char poly;char char;Eq<Char>] - [Text poly;text text;Eq<Text>])] + [Text poly;text text;Eq<Text>]) + <composites> (do-template [<name> <eq>] + [(do @ + [:arg: (poly;apply-1 (ident-for <name>) :x:) + g!arg (Eq<?> env :arg:)] + (wrap (` (: (~ (->Eq (type;to-ast :x:))) + (<eq> (~ g!arg))))))] + + [list;List list;Eq<List>] + [vector;Vector vector;Eq<Vector>] + [array;Array array;Eq<Array>] + [queue;Queue queue;Eq<Queue>] + [set;Set set;Eq<Set>] + [seq;Seq seq;Eq<Seq>] + [rose;Tree rose;Eq<Tree>] + )] ($_ macro;either ## Primitive types <basic> + ## Composite types + <composites> + (do @ + [[:key: :val:] (poly;apply-2 (ident-for dict;Dict) :x:) + g!val (Eq<?> env :val:)] + (wrap (` (: (~ (->Eq (type;to-ast :x:))) + (dict;Eq<Dict> (~ g!val)))))) ## Variants (with-gensyms [g!type-fun g!left g!right] (do @ |