- Added tests for lux/macro/poly/*

10 files changed, 376 insertions, 119 deletions

diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux
index fd438b1a3..437389717 100644
--- a/stdlib/source/lux/compiler.lux
+++ b/stdlib/source/lux/compiler.lux
@@ -98,8 +98,8 @@
       (#;Right [compiler' output])
       (#;Right [compiler' output]))))
 
-(def: #export (assert test message)
-  (-> Bool Text (Lux Unit))
+(def: #export (assert message test)
+  (-> Text Bool (Lux Unit))
   (lambda [compiler]
     (if test
       (#;Right [compiler []])
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index e8189a594..1b2c65f97 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -744,7 +744,10 @@
 
                        _
                        (compiler;fail ""))
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices)
+                                                           g!vars)
+                                                *env*)]
                .val. (Codec<JSON,?>//encode new-*env* :val:)
                #let [:x:+ (case g!vars
                             #;Nil
@@ -777,8 +780,10 @@
                         (|>. (_map_ (~ .sub.)) vector;from-list ;;gen-array)))))
           (with-gensyms [g!type-fun g!case g!input]
             (do @
-              [[g!vars cases] (poly;variant :x:)
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+              [[g!vars members] (poly;variant :x:)
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                pattern-matching (mapM @
                                       (lambda [[name :case:]]
                                         (do @
@@ -787,7 +792,7 @@
                                           (wrap (list (` ((~ tag) (~ g!case)))
                                                       (` (;;json [(~ (ast;text (product;right name)))
                                                                   ((~ encoder) (~ g!case))]))))))
-                                      cases)
+                                      members)
                #let [:x:+ (case g!vars
                             #;Nil
                             (->Codec//encode (type;to-ast :x:))
@@ -803,15 +808,17 @@
                           )))))
           (with-gensyms [g!type-fun g!case g!input]
             (do @
-              [[g!vars slots] (poly;record :x:)
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+              [[g!vars members] (poly;record :x:)
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                synthesis (mapM @
                                (lambda [[name :slot:]]
                                  (do @
                                    [encoder (Codec<JSON,?>//encode new-*env* :slot:)]
                                    (wrap [(` (~ (ast;text (product;right name))))
                                           (` ((~ encoder) (get@ (~ (ast;tag name)) (~ g!input))))])))
-                               slots)
+                               members)
                #let [:x:+ (case g!vars
                             #;Nil
                             (->Codec//encode (type;to-ast :x:))
@@ -827,7 +834,9 @@
           (with-gensyms [g!type-fun g!case]
             (do @
               [[g!vars members] (poly;tuple :x:)
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                pattern-matching (mapM @
                                       (lambda [:member:]
                                         (do @
@@ -895,7 +904,9 @@
 
                        _
                        (compiler;fail ""))
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                .val. (Codec<JSON,?>//decode new-*env* :val:)
                #let [:x:+ (case g!vars
                             #;Nil
@@ -921,8 +932,10 @@
           <complex>
           (with-gensyms [g!type-fun g!_]
             (do @
-              [[g!vars cases] (poly;variant :x:)
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+              [[g!vars members] (poly;variant :x:)
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                pattern-matching (mapM @
                                       (lambda [[name :case:]]
                                         (do @
@@ -932,7 +945,7 @@
                                                            [(~ g!_) (;;at +0 (;;text! (~ (ast;text (product;right name)))))
                                                             (~ g!_) (;;at +1 (~ decoder))]
                                                            ((~ (' wrap)) ((~ tag) (~ g!_)))))))))
-                                      cases)
+                                      members)
                #let [:x:+ (case g!vars
                             #;Nil
                             (->Codec//decode (type;to-ast :x:))
@@ -953,8 +966,10 @@
               ))
           (with-gensyms [g!type-fun g!case g!input]
             (do @
-              [[g!vars slots] (poly;record :x:)
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+              [[g!vars members] (poly;record :x:)
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                extraction (mapM @
                                 (lambda [[name :slot:]]
                                   (do @
@@ -964,7 +979,7 @@
                                                 (` (;;get (~ (ast;text (product;right name))) (~ g!input)))
                                                 g!member
                                                 (` ((~ decoder) (~ g!member)))))))
-                                slots)
+                                members)
                #let [:x:+ (case g!vars
                             #;Nil
                             (->Codec//decode (type;to-ast :x:))
@@ -979,12 +994,14 @@
                               [(~@ (List/join extraction))]
                               ((~ (' wrap)) (~ (ast;record (List/map (lambda [[name :slot:]]
                                                                        [(ast;tag name) (ast;symbol ["" (product;right name)])])
-                                                                     slots))))))
+                                                                     members))))))
                           )))))
           (with-gensyms [g!type-fun g!case g!input]
             (do @
               [[g!vars members] (poly;tuple :x:)
-               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               #let [new-*env* (poly;extend-env [:x: g!type-fun]
+                                                (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                                *env*)]
                pattern-matching (mapM @
                                       (lambda [:member:]
                                         (do @
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 0cf0e64f1..ea2d722ae 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -27,7 +27,7 @@
 (type: #export (Matcher a)
   (-> Type (Lux a)))
 
-(type: #export Env (Dict Nat AST))
+(type: #export Env (Dict Nat [Type AST]))
 
 ## [Combinators]
 (do-template [<combinator> <name> <type>]
@@ -73,6 +73,8 @@
                              [_ (<parser> :type:)]
                              (wrap <type>))]
 
+                          [void Void]
+                          [unit Unit]
                           [bool Bool]
                           [nat  Nat]
                           [int  Int]
@@ -160,7 +162,8 @@
      (lambda [:type:]
        (do compiler;Monad<Lux>
          [[tags :type:] (tagged :type:)
-          _ (compiler;assert (n.> +0 (list;size tags)) "Records and variants must have tags.")
+          _ (compiler;assert "Records and variants must have tags."
+                             (n.> +0 (list;size tags)))
           [vars :type:] (polymorphic :type:)
           members (<sub-comb> :type:)
           #let [num-tags (list;size tags)
@@ -239,8 +242,8 @@
     (case :type:
       (#;BoundT idx)
       (case (dict;get (adjusted-idx env idx) env)
-        (#;Some poly-val)
-        (:: compiler;Monad<Lux> wrap poly-val)
+        (#;Some [poly-type poly-ast])
+        (:: compiler;Monad<Lux> wrap poly-ast)
 
         #;None
         (compiler;fail (format "Unknown bound type: " (%type :type:))))
@@ -266,7 +269,7 @@
                                    _
                                    #;None))
                              t-args)]
-                (wrap (` ((~ =func) (~@ =args)))))
+                (wrap (` ((~ (product;right =func)) (~@ (List/map product;right =args))))))
               (#;Some call)])
         (wrap call)
 
@@ -274,19 +277,32 @@
         (compiler;fail (format "Type is not a recursive instance: " (%type :type:))))
       )))
 
+(def: #export (var env var-id)
+  (-> Env Nat (Matcher Unit))
+  (lambda [:type:]
+    (case :type:
+      (^=> (#;BoundT idx)
+           (exec (log! (format "poly;var " (%n idx) " => " (%n (adjusted-idx env idx))))
+             (n.= var-id (adjusted-idx env idx))))
+      (:: compiler;Monad<Lux> wrap [])
+
+      _
+      (compiler;fail (format "Not a bound type: " (%type :type:))))))
+
 ## [Syntax]
-(def: #export (extend-env type-func type-vars env)
-  (-> AST (List AST) Env Env)
+(def: #export (extend-env [funcT funcA] type-vars env)
+  (-> [Type AST] (List [Type AST]) Env Env)
   (case type-vars
     #;Nil
     env
     
-    (#;Cons tvar type-vars')
+    (#;Cons [varT varA] type-vars')
     (let [current-size (dict;size env)]
       (|> env
-          (dict;put current-size type-func)
-          (dict;put (n.inc current-size) tvar)
-          (extend-env (` (#;AppT (~ type-func) (~ tvar))) type-vars')
+          (dict;put current-size [funcT funcA])
+          (dict;put (n.inc current-size) [varT varA])
+          (extend-env [(#;AppT funcT varT) (` (#;AppT (~ funcA) (~ varA)))]
+                      type-vars')
           ))))
 
 (syntax: #export (poly: [_ex-lev common;export-level]
@@ -351,35 +367,54 @@
                       (~ impl)))))))
 
 ## [Derivers]
-(def: #export (contains-bound-types? type)
-  (-> Type Bool)
+(def: (to-ast env type)
+  (-> Env Type AST)
   (case type
     (#;HostT name params)
-    (list;any? contains-bound-types? params)
+    (` (#;HostT (~ (ast;text name))
+                (list (~@ (List/map (to-ast env) params)))))
 
     (^template [<tag>]
-      (<tag> _)
-      false)
-    ([#;VoidT] [#;UnitT]
-     [#;VarT] [#;ExT]
-     [#;UnivQ] [#;ExQ])
+      <tag>
+      (` <tag>))
+    ([#;VoidT] [#;UnitT])
+
+    (^template [<tag>]
+      (<tag> idx)
+      (` (<tag> (~ (ast;nat idx)))))
+    ([#;VarT] [#;ExT])
 
     (#;BoundT idx)
-    true
+    (let [idx (adjusted-idx env idx)]
+      (if (n.= +0 idx)
+        (|> (dict;get idx env) (default (undefined)) product;left (to-ast env))
+        (` (;$ (~ (ast;nat (n.dec idx)))))))
 
     (^template [<tag>]
       (<tag> left right)
-      (or (contains-bound-types? left)
-          (contains-bound-types? right)))
-    ([#;LambdaT] [#;AppT] [#;SumT] [#;ProdT])
+      (` (<tag> (~ (to-ast env left))
+                (~ (to-ast env right)))))
+    ([#;LambdaT] [#;AppT])
+
+    (^template [<tag> <macro> <flattener>]
+      (<tag> left right)
+      (` (<macro> (~@ (List/map (to-ast env) (<flattener> type))))))
+    ([#;SumT  | type;flatten-variant]
+     [#;ProdT & type;flatten-tuple])
 
     (#;NamedT name sub-type)
-    (contains-bound-types? sub-type)
+    (ast;symbol name)
+
+    (^template [<tag>]
+      (<tag> scope body)
+      (` (<tag> (list (~@ (List/map (to-ast env) scope)))
+                (~ (to-ast env body)))))
+    ([#;UnivQ] [#;ExQ])
     ))
 
-(def: #export (gen-type converter type-fun tvars type)
-  (-> (-> AST AST) AST (List AST) Type AST)
-  (let [type' (type;to-ast type)]
+(def: #export (gen-type env converter type-fun tvars type)
+  (-> Env (-> AST AST) AST (List AST) Type AST)
+  (let [type' (to-ast env type)]
     (case tvars
       #;Nil
       (converter type')
@@ -388,3 +423,7 @@
       (` (All (~ type-fun) [(~@ tvars)]
            (-> (~@ (List/map converter tvars))
                (~ (converter (` ((~ type') (~@ tvars)))))))))))
+
+(def: #export (type-var-indices num-vars)
+  (-> Nat (List Type))
+  (|> num-vars list;indices (List/map (|>. #;BoundT))))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index ce42c2eab..dc37e0c9f 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -60,8 +60,10 @@
           ## Variants
           (with-gensyms [g!type-fun g!left g!right]
             (do @
-              [[g!vars cases] (poly;variant :x:)
-               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+              [[g!vars members] (poly;variant :x:)
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
                pattern-matching (mapM @
                                       (lambda [[name :case:]]
                                         (do @
@@ -69,20 +71,20 @@
                                           (wrap (list (` [((~ (ast;tag name)) (~ g!left))
                                                           ((~ (ast;tag name)) (~ g!right))])
                                                       (` ((~ g!eq) (~ g!left) (~ g!right)))))))
-                                      cases)
+                                      members)
                #let [base (function$ g!type-fun g!vars
                                      (` (lambda [(~ g!left) (~ g!right)]
                                           (case [(~ g!left) (~ g!right)]
                                             (~@ (List/join pattern-matching))))))]]
-              (wrap (if (and false (poly;contains-bound-types? :x:))
-                      base
-                      (` (: (~ (poly;gen-type ->Eq g!type-fun g!vars :x:))
-                            (~ base)))))))
+              (wrap (` (: (~ (poly;gen-type new-env ->Eq g!type-fun g!vars :x:))
+                          (~ base))))))
           ## Tuples
           (with-gensyms [g!type-fun]
             (do @
               [[g!vars members] (poly;tuple :x:)
-               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
                pattern-matching (mapM @
                                       (lambda [:member:]
                                         (do @
@@ -98,10 +100,8 @@
                                           (and (~@ (List/map (lambda [[g!left g!right g!eq]]
                                                                (` ((~ g!eq) (~ g!left) (~ g!right))))
                                                              pattern-matching))))))]]
-              (wrap (if (and false (poly;contains-bound-types? :x:))
-                      base
-                      (` (: (~ (poly;gen-type ->Eq g!type-fun g!vars :x:))
-                            (~ base)))))))
+              (wrap (` (: (~ (poly;gen-type new-env ->Eq g!type-fun g!vars :x:))
+                          (~ base))))))
           ## Type recursion
           (poly;recur env :x:)
           ## Type applications
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
index 17fd7808f..e659bb41d 100644
--- a/stdlib/source/lux/macro/poly/functor.lux
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -27,19 +27,25 @@
        ))
 
 ## [Derivers]
-(poly: #export (|Functor| env :x:)
+(poly: #export (Functor<?> env :x:)
   (with-gensyms [g!type-fun g!func g!input]
     (do @
       [#let [g!map (' map)]
        [g!vars _] (poly;polymorphic :x:)
        #let [num-vars (list;size g!vars)
-             new-env (poly;extend-env g!type-fun g!vars env)]
-       _ (compiler;assert (n.> +0 num-vars)
-                      "Functors must have at least 1 type-variable.")]
+             new-env (poly;extend-env [:x: g!type-fun]
+                                      (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                      env)]
+       _ (compiler;assert "Functors must have at least 1 type-variable."
+                          (n.> +0 num-vars))]
       (let [->Functor (: (-> AST AST)
-                         (lambda [.type.] (` (functor;Functor (~ .type.)))))
-            |elem| (: (-> AST (poly;Matcher AST))
-                      (lambda |elem| [value :type:]
+                         (lambda [.type.]
+                           (if (n.= +1 num-vars)
+                             (` (functor;Functor (~ .type.)))
+                             (let [type-params (|> num-vars n.dec list;indices (List/map (|>. %n ast;local-symbol)))]
+                               (` (All [(~@ type-params)] (functor;Functor ((~ .type.) (~@ type-params)))))))))
+            Arg<?> (: (-> AST (poly;Matcher AST))
+                      (lambda Arg<?> [value :type:]
                         ($_ compiler;either
                             ## Nothing to do.
                             (do @
@@ -47,19 +53,23 @@
                               (wrap value))
                             ## Type-var
                             (do @
-                              [_ (poly;var new-env (n.dec num-vars) :type:)]
+                              [_ (poly;var new-env (|> num-vars (n.* +2) n.dec) :type:)]
                               (wrap (` ((~ g!func) (~ value)))))
+                            ## Bound type-variables
+                            (do @
+                              [_ (poly;bound new-env :type:)]
+                              (wrap value))
                             ## Tuples/records
                             (do @
-                              [[g!vars members] (poly;tuple :x:)
+                              [[g!vars members] (poly;tuple :type:)
                                pm (mapM @
                                         (lambda [:slot:]
                                           (do @
                                             [g!slot (compiler;gensym "g!slot")
-                                             body (|elem| g!slot :slot:)]
+                                             body (Arg<?> g!slot :slot:)]
                                             (wrap [g!slot body])))
                                         members)]
-                              (wrap (` (case (~ g!input)
+                              (wrap (` (case (~ value)
                                          [(~@ (List/map product;left pm))]
                                          [(~@ (List/map product;right pm))])
                                        )))
@@ -76,9 +86,9 @@
                                       (lambda [[name :case:]]
                                         (do @
                                           [#let [analysis (` ((~ (ast;tag name)) (~ g!input)))]
-                                           synthesis (|elem| g!input :case:)]
+                                           synthesis (Arg<?> g!input :case:)]
                                           (wrap (list analysis
-                                                      synthesis))))
+                                                      (` ((~ (ast;tag name)) (~ synthesis)))))))
                                       cases)]
               (wrap (` (: (~ (->Functor (type;to-ast :x:)))
                           (struct (def: ((~ g!map) (~ g!func) (~ g!input))
@@ -92,7 +102,7 @@
                         (lambda [:slot:]
                           (do @
                             [g!slot (compiler;gensym "g!slot")
-                             body (|elem| g!slot :slot:)]
+                             body (Arg<?> g!slot :slot:)]
                             (wrap [g!slot body])))
                         members)]
               (wrap (` (: (~ (->Functor (type;to-ast :x:)))
@@ -105,18 +115,18 @@
             (with-gensyms [g!out]
               (do @
                 [[g!vars [:ins: :out:]] (poly;function :x:)
-                 .out. (|elem| g!out :out:)
-                 g!ins (seqM @
-                             (list;repeat (list;size :ins:)
-                                          (compiler;gensym "g!arg")))]
+                 .out. (Arg<?> g!out :out:)
+                 g!envs (seqM @
+                              (list;repeat (list;size :ins:)
+                                           (compiler;gensym "g!envs")))]
                 (wrap (` (: (~ (->Functor (type;to-ast :x:)))
                             (struct (def: ((~ g!map) (~ g!func) (~ g!input))
-                                      (lambda [(~@ g!ins)]
-                                        (let [(~ g!out) ((~ g!input) (~@ g!ins))]
+                                      (lambda [(~@ g!envs)]
+                                        (let [(~ g!out) ((~ g!input) (~@ g!envs))]
                                           (~ .out.))))))))))
             ## No structure (as you'd expect from Identity)
             (do @
-              [_ (poly;var new-env (n.dec num-vars) :x:)]
+              [_ (poly;var new-env num-vars :x:)]
               (wrap (` (: (~ (->Functor (type;to-ast :x:)))
                           (struct (def: ((~ g!map) (~ g!func) (~ g!input))
                                     ((~ g!func) (~ g!input))))))))
diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux
index c2ab30d7f..858abc208 100644
--- a/stdlib/source/lux/macro/poly/text-encoder.lux
+++ b/stdlib/source/lux/macro/poly/text-encoder.lux
@@ -26,14 +26,25 @@
        [type]
        ))
 
+(def: (function$ func inputs output)
+  (-> AST (List AST) AST AST)
+  (case inputs
+    #;Nil
+    output
+
+    _
+    (` (lambda (~@ (if (list;empty? inputs) (list) (list func)))
+         [(~@ inputs)]
+         (~ output)))))
+
 ## [Derivers]
-(poly: #export (|Codec@Text//encode| env :x:)
-  (let [->Codec//encode (: (-> AST AST)
+(poly: #export (Codec<Text,?>::encode env :x:)
+  (let [->Codec::encode (: (-> AST AST)
                            (lambda [.type.] (` (-> (~ .type.) Text))))]
     (let% [<basic> (do-template [<type> <matcher> <encoder>]
                      [(do @
                         [_ (<matcher> :x:)]
-                        (wrap (` (: (~ (->Codec//encode (` <type>)))
+                        (wrap (` (: (~ (->Codec::encode (` <type>)))
                                     (~' <encoder>)))))]
 
                      [Unit poly;unit (lambda [_0] "[]")]
@@ -51,73 +62,83 @@
           (with-gensyms [g!type-fun g!case g!input]
             (do @
               [[g!vars cases] (poly;variant :x:)
-               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
                pattern-matching (mapM @
                                       (lambda [[name :case:]]
                                         (do @
-                                          [encoder (|Codec@Text//encode| new-env :case:)]
+                                          [encoder (Codec<Text,?>::encode new-env :case:)]
                                           (wrap (list (` ((~ (ast;tag name)) (~ g!case)))
                                                       (` (format "(#"
                                                                  (~ (ast;text (Ident/encode name)))
                                                                  " "
                                                                  ((~ encoder) (~ g!case))
                                                                  ")"))))))
-                                      cases)]
-              (wrap (` (: (~ (poly;gen-type ->Codec//encode g!type-fun g!vars :x:))
-                          (lambda [(~@ g!vars)]
-                            (lambda [(~ g!input)]
-                              (case (~ g!input)
-                                (~@ (List/join pattern-matching)))))
+                                      cases)
+               #let [base (function$ g!type-fun g!vars
+                                     (` (lambda [(~ g!input)]
+                                          (case (~ g!input)
+                                            (~@ (List/join pattern-matching))))))]]
+              (wrap (` (: (~ (poly;gen-type env ->Codec::encode g!type-fun g!vars :x:))
+                          (~ base)
                           )))))
           ## Records
           (with-gensyms [g!type-fun g!case g!input]
             (do @
               [[g!vars slots] (poly;record :x:)
-               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
                synthesis (mapM @
                                (lambda [[name :slot:]]
                                  (do @
-                                   [encoder (|Codec@Text//encode| new-env :slot:)]
+                                   [encoder (Codec<Text,?>::encode new-env :slot:)]
                                    (wrap (` (format "#"
                                                     (~ (ast;text (Ident/encode name)))
                                                     " "
                                                     ((~ encoder) (get@ (~ (ast;tag name)) (~ g!input))))))))
-                               slots)]
-              (wrap (` (: (~ (poly;gen-type ->Codec//encode g!type-fun g!vars :x:))
-                          (lambda [(~@ g!vars)]
-                            (lambda [(~ g!input)]
-                              (format "{" (~@ (list;interpose (' " ") synthesis)) "}")))
+                               slots)
+               #let [base (function$ g!type-fun g!vars
+                                     (` (lambda [(~ g!input)]
+                                          (format "{" (~@ (list;interpose (' " ") synthesis)) "}"))))]]
+              (wrap (` (: (~ (poly;gen-type env ->Codec::encode g!type-fun g!vars :x:))
+                          (~ base)
                           )))))
           ## Tuples
           (with-gensyms [g!type-fun g!case g!input]
             (do @
               [[g!vars members] (poly;tuple :x:)
-               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               #let [new-env (poly;extend-env [:x: g!type-fun]
+                                              (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
+                                              env)]
                parts (mapM @
                            (lambda [:member:]
                              (do @
                                [g!member (compiler;gensym "g!member")
-                                encoder (|Codec@Text//encode| new-env :member:)]
+                                encoder (Codec<Text,?>::encode new-env :member:)]
                                (wrap [g!member encoder])))
                            members)
                #let [analysis (` [(~@ (List/map product;left parts))])
                      synthesis (List/map (lambda [[g!member g!encoder]]
                                            (` ((~ g!encoder) (~ g!member))))
-                                         parts)]]
-              (wrap (` (: (~ (poly;gen-type ->Codec//encode g!type-fun g!vars :x:))
-                          (lambda [(~@ g!vars)]
-                            (lambda [(~ g!input)]
-                              (case (~ g!input)
-                                (~ analysis)
-                                (format "[" (~@ (list;interpose (' " ") synthesis)) "]"))))
-                          )))
-              ))
+                                         parts)
+                     base (function$ g!type-fun g!vars
+                                     (` (lambda [(~ g!input)]
+                                          (case (~ g!input)
+                                            (~ analysis)
+                                            (format "[" (~@ (list;interpose (' " ") synthesis)) "]")))))]]
+              (wrap (` (: (~ (poly;gen-type env ->Codec::encode g!type-fun g!vars :x:))
+                          (~ base)
+                          )))))
+          ## Type recursion
+          (poly;recur env :x:)
           ## Type applications
           (do @
             [[:func: :args:] (poly;apply :x:)
-             .func. (|Codec@Text//encode| env :func:)
-             .args. (mapM @ (|Codec@Text//encode| env) :args:)]
-            (wrap (` (: (~ (->Codec//encode (type;to-ast :x:)))
+             .func. (Codec<Text,?>::encode env :func:)
+             .args. (mapM @ (Codec<Text,?>::encode env) :args:)]
+            (wrap (` (: (~ (->Codec::encode (type;to-ast :x:)))
                         ((~ .func.) (~@ .args.))))))
           ## Bound type-variables
           (poly;bound env :x:)
diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux
new file mode 100644
index 000000000..983d2da69
--- /dev/null
+++ b/stdlib/test/test/lux/macro/poly/eq.lux
@@ -0,0 +1,66 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad
+                eq)
+       (data text/format
+             [bool]
+             [number "i/" Number<Int>]
+             [char]
+             [text])
+       (math ["R" random])
+       pipe
+       [macro]
+       (macro [poly #+ derived:]
+              ["&" poly/eq]))
+  lux/test)
+
+## [Utils]
+(type: Variant
+  (#Case0 Bool)
+  (#Case1 Int)
+  (#Case2 Real))
+
+(type: Record
+  {#unit Unit
+   #bool Bool
+   #int Int
+   #real Real
+   #char Char
+   #text Text
+   #maybe (Maybe Int)
+   #list (List Int)
+   #variant Variant
+   #tuple [Int Real Char]})
+
+(def: gen-record
+  (R;Random Record)
+  (do R;Monad<Random>
+    [size (:: @ map (n.% +2) R;nat)
+     #let [gen-int (|> R;int (:: @ map (|>. i/abs (i.% 1_000_000))))]]
+    ($_ R;seq
+        (:: @ wrap [])
+        R;bool
+        gen-int
+        R;real
+        R;char
+        (R;text size)
+        (R;maybe gen-int)
+        (R;list size gen-int)
+        ($_ R;alt R;bool gen-int R;real)
+        ($_ R;seq gen-int R;real R;char)
+        )))
+
+(derived: (&;Eq<?> Record))
+
+## [Tests]
+(test: "Eq polytypism"
+  [sample gen-record
+   #let [(^open "&/") Eq<Record>]]
+  (assert "Every instance equals itself."
+          (&/= sample sample)))
diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux
new file mode 100644
index 000000000..c25f536e9
--- /dev/null
+++ b/stdlib/test/test/lux/macro/poly/functor.lux
@@ -0,0 +1,44 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad
+                [functor]
+                eq)
+       (data text/format
+             [bool]
+             [number "i/" Number<Int>]
+             [char]
+             [text])
+       (math ["R" random])
+       pipe
+       [macro]
+       (macro [poly #+ derived:]
+              ["&" poly/functor]))
+  lux/test)
+
+## [Utils]
+(type: (My-Maybe a)
+  #My-None
+  (#My-Some a))
+
+(type: (My-List a)
+  #My-Nil
+  (#My-Cons [a (My-List a)]))
+
+(type: (My-State s a)
+  (-> s [s a]))
+
+(derived: (&;Functor<?> My-Maybe))
+
+(derived: (&;Functor<?> My-List))
+
+(derived: (&;Functor<?> My-State))
+
+## [Tests]
+(test: "Functor polytypism"
+  (assert "" true))
diff --git a/stdlib/test/test/lux/macro/poly/text-encoder.lux b/stdlib/test/test/lux/macro/poly/text-encoder.lux
new file mode 100644
index 000000000..e106162a3
--- /dev/null
+++ b/stdlib/test/test/lux/macro/poly/text-encoder.lux
@@ -0,0 +1,63 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad
+                eq)
+       (data text/format
+             [bool]
+             [number "i/" Number<Int>]
+             [char]
+             [text])
+       (math ["R" random])
+       pipe
+       [macro]
+       (macro [poly #+ derived:]
+              ["&" poly/text-encoder]))
+  lux/test)
+
+## [Utils]
+(type: Variant
+  (#Case0 Bool)
+  (#Case1 Int)
+  (#Case2 Real))
+
+(type: Record
+  {#unit Unit
+   #bool Bool
+   #int Int
+   #real Real
+   #char Char
+   #text Text
+   #maybe (Maybe Int)
+   #list (List Int)
+   #variant Variant
+   #tuple [Int Real Char]})
+
+(def: gen-record
+  (R;Random Record)
+  (do R;Monad<Random>
+    [size (:: @ map (n.% +2) R;nat)
+     #let [gen-int (|> R;int (:: @ map (|>. i/abs (i.% 1_000_000))))]]
+    ($_ R;seq
+        (:: @ wrap [])
+        R;bool
+        gen-int
+        R;real
+        R;char
+        (R;text size)
+        (R;maybe gen-int)
+        (R;list size gen-int)
+        ($_ R;alt R;bool gen-int R;real)
+        ($_ R;seq gen-int R;real R;char)
+        )))
+
+(derived: (&;Codec<Text,?>::encode Record))
+
+## [Tests]
+(test: "Text-encoding polytypism"
+  (assert "" true))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 85cce3d9f..ebb6c6999 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -26,7 +26,6 @@
                           [frp]
                           ["_;" promise]
                           [stm])
-             
              (data [bit]
                    [bool]
                    [char]
@@ -60,18 +59,16 @@
              ## [macro]
              (macro ["_;" ast]
                     ["_;" syntax]
-                    ["_;" template])
+                    ["_;" template]
+                    (poly ["poly_;" eq]
+                          ["poly_;" text-encoder]
+                          ["poly_;" functor]))
              ["_;" type]
              (type ["_;" check]
                    ["_;" auto])
              ## (control [effect])
              )
-        )
-  ## (lux (macro [poly]
-  ##             (poly ["poly_;" eq]
-  ##                   ["poly_;" text-encoder]
-  ##                   ["poly_;" functor])))
-  )
+        ))
 
 ## [Program]
 (program: args