diff options
| author | Eduardo Julian | 2016-12-17 15:28:36 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2016-12-17 15:28:36 -0400 |
| commit | a60af2d673ef6b3c7090e454a1edc59838f3540d (patch) | |
| tree | b30b2893426a606e93c7bca1ca5e91a3f2012c68 /stdlib/source/lux/data/format/json.lux | |
| parent | e0c21be8ded9924bb0fde7ae5b7bd422d77a6b03 (diff) | |
- Added tests for lux/macro/poly/*
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 51 |
1 files changed, 34 insertions, 17 deletions
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 @ |