diff options
Diffstat (limited to '')
36 files changed, 182 insertions, 122 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 76db92f2f..30f38897b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3721,9 +3721,9 @@ (if (empty? args) (let [g!param (symbol$ ["" ""]) prime-name (symbol$ ["" name]) - type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)] + type+ (replace-syntax (list [name (` ((~ prime-name) #;Void))]) type)] (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) - Void)))) + #;Void)))) #None) (case args #Nil diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index a646f2b6e..54e7c957b 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -3,7 +3,7 @@ (lux (control functor applicative monad - eq + [eq #+ Eq] ["p" parser]) [io #- run] (data (coll [list "L/" Monoid<List>]) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index 63ef0526b..535201954 100644 --- a/stdlib/source/lux/control/codec.lux +++ b/stdlib/source/lux/control/codec.lux @@ -12,7 +12,7 @@ decode)) ## [Values] -(struct: #export (compC Codec<c,b> Codec<b,a>) +(struct: #export (compose Codec<c,b> Codec<b,a>) {#;doc "Codec composition."} (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) (def: encode (|>. (:: Codec<b,a> encode) (:: Codec<c,b> encode))) diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux index 7a2fb3d3a..b69292daa 100644 --- a/stdlib/source/lux/control/eq.lux +++ b/stdlib/source/lux/control/eq.lux @@ -5,13 +5,13 @@ (: (-> a a Bool) =)) -(def: #export (conj left right) +(def: #export (seq left right) (All [l r] (-> (Eq l) (Eq r) (Eq [l r]))) (struct (def: (= [a b] [x y]) (and (:: left = a x) (:: right = b y))))) -(def: #export (disj left right) +(def: #export (alt left right) (All [l r] (-> (Eq l) (Eq r) (Eq (| l r)))) (struct (def: (= a|b x|y) (case [a|b x|y] @@ -23,3 +23,8 @@ _ false)))) + +(def: #export (rec sub) + (All [a] (-> (-> (Eq a) (Eq a)) (Eq a))) + (struct (def: (= left right) + (sub (rec sub) left right)))) diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux index da24575a4..3472098c1 100644 --- a/stdlib/source/lux/control/hash.lux +++ b/stdlib/source/lux/control/hash.lux @@ -1,6 +1,6 @@ (;module: lux - (.. eq)) + (.. [eq #+ Eq])) ## [Signatures] (sig: #export (Hash a) diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux index 673ad630f..95a23c378 100644 --- a/stdlib/source/lux/control/interval.lux +++ b/stdlib/source/lux/control/interval.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control eq + (lux (control [eq #+ Eq] [order] [enum #+ Enum]))) diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux index eb2a6f81b..89708d986 100644 --- a/stdlib/source/lux/control/order.lux +++ b/stdlib/source/lux/control/order.lux @@ -1,7 +1,7 @@ (;module: lux (lux function) - (.. eq)) + (.. [eq #+ Eq])) ## [Signatures] (sig: #export (Order a) diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux index 35c00477f..e292c0ede 100644 --- a/stdlib/source/lux/data/bool.lux +++ b/stdlib/source/lux/data/bool.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control monoid - eq + [eq #+ Eq] hash codec))) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index a8f8d9f00..4ab94fae8 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -4,7 +4,7 @@ functor applicative monad - eq + [eq #+ Eq] fold) (data (coll [list "List/" Fold<List>]) [product]) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index 4ebb9a746..e54aaf5cc 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control hash - eq) + [eq #+ Eq]) (data maybe (coll [list "List/" Fold<List> Functor<List> Monoid<List>] [array #+ Array "Array/" Functor<Array> Fold<Array>]) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 5d21585a4..41f1cddaf 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -4,7 +4,7 @@ functor applicative ["M" monad #*] - eq + [eq #+ Eq] [fold]) (data [number "Nat/" Codec<Text,Nat>] bool diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux index f02b4de57..00c655d8e 100644 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ b/stdlib/source/lux/data/coll/priority-queue.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control eq + (lux (control [eq #+ Eq] monad) (data (coll (tree ["F" finger])) [number] diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index 520211dca..c1e7ae6a9 100644 --- a/stdlib/source/lux/data/coll/queue.lux +++ b/stdlib/source/lux/data/coll/queue.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control eq) + (lux (control [eq #+ Eq]) (data (coll [list "List/" Monoid<List>])))) ## [Types] diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux index 84795f91f..9c981b6aa 100644 --- a/stdlib/source/lux/data/coll/seq.lux +++ b/stdlib/source/lux/data/coll/seq.lux @@ -3,7 +3,7 @@ (lux (control functor applicative monad - eq + [eq #+ Eq] fold ["p" parser]) (data (coll ["L" list "L/" Monoid<List> Fold<List>] diff --git a/stdlib/source/lux/data/coll/set.lux b/stdlib/source/lux/data/coll/set.lux index 8d075a961..06953ef23 100644 --- a/stdlib/source/lux/data/coll/set.lux +++ b/stdlib/source/lux/data/coll/set.lux @@ -3,7 +3,7 @@ (lux (control functor applicative monad - eq + [eq #+ Eq] [hash #*]) (data (coll [dict] [list "List/" Fold<List> Functor<List>])))) diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux index 69a7a9822..5f7a91640 100644 --- a/stdlib/source/lux/data/coll/vector.lux +++ b/stdlib/source/lux/data/coll/vector.lux @@ -3,7 +3,7 @@ (lux (control functor applicative monad - eq + [eq #+ Eq] monoid fold ["p" parser]) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 2e31a3924..865e92b8c 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -5,7 +5,7 @@ (lux (control functor applicative monad - eq + [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) (data [bool] @@ -387,11 +387,11 @@ _ (#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))] - [unit Unit #Null "unit" id] + [unit Unit #Null "unit" id] [bool Bool #Boolean "bool" id] [int Int #Number "int" real-to-int] - [real Real #Number "real" id] - [text Text #String "text" id] + [real Real #Number "real" id] + [text Text #String "text" id] ) (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] @@ -524,79 +524,85 @@ =b pb] (wrap [=a =b]))) -(def: #export (alt pa pb json) +(def: #export (alt pa pb) {#;doc "Heterogeneous alternative combinator."} (All [a b] (-> (Parser a) (Parser b) (Parser (| a b)))) - (case (pa json) - (#R;Success a) - (sum;right (sum;left a)) + (function [json] + (case (pa json) + (#R;Success a) + (sum;right (sum;left a)) - (#R;Error message0) - (case (pb json) - (#R;Success b) - (sum;right (sum;right b)) + (#R;Error message0) + (case (pb json) + (#R;Success b) + (sum;right (sum;right b)) - (#R;Error message1) - (#R;Error message0)))) + (#R;Error message1) + (#R;Error message0))))) -(def: #export (either pl pr json) +(def: #export (either pl pr) {#;doc "Homogeneous alternative combinator."} (All [a] (-> (Parser a) (Parser a) (Parser a))) - (case (pl json) - (#R;Success x) - (#R;Success x) + (function [json] + (case (pl json) + (#R;Success x) + (#R;Success x) - _ - (pr json))) + _ + (pr json)))) -(def: #export (opt p json) +(def: #export (opt p) {#;doc "Optionality combinator."} (All [a] (-> (Parser a) (Parser (Maybe a)))) - (case (p json) - (#R;Error _) (#R;Success #;None) - (#R;Success x) (#R;Success (#;Some x)))) + (function [json] + (case (p json) + (#R;Error _) (#R;Success #;None) + (#R;Success x) (#R;Success (#;Some x))))) (def: #export (run json parser) (All [a] (-> JSON (Parser a) (R;Result a))) (parser json)) -(def: #export (ensure test parser json) +(def: #export (ensure test parser) {#;doc "Only parses a JSON if it passes a test (which is also a parser)."} (All [a] (-> (Parser Unit) (Parser a) (Parser a))) - (case (test json) - (#R;Success _) - (parser json) + (function [json] + (case (test json) + (#R;Success _) + (parser json) - (#R;Error error) - (#R;Error error))) + (#R;Error error) + (#R;Error error)))) -(def: #export (array-size! size json) +(def: #export (array-size! size) {#;doc "Ensures a JSON array has the specified size."} (-> Nat (Parser Unit)) - (case json - (#Array parts) - (if (n.= size (vector;size parts)) - (#R;Success []) - (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json)))) + (function [json] + (case json + (#Array parts) + (if (n.= size (vector;size parts)) + (#R;Success []) + (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json)))) - _ - (#R;Error (format "JSON value is not an array: " (show-json json))))) + _ + (#R;Error (format "JSON value is not an array: " (show-json json)))))) -(def: #export (object-fields! wanted-fields json) +(def: #export (object-fields! wanted-fields) {#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."} (-> (List String) (Parser Unit)) - (case json - (#Object kvs) - (let [actual-fields (d;keys kvs)] - (if (and (n.= (list;size wanted-fields) (list;size actual-fields)) - (list;every? (list;member? text;Eq<Text> wanted-fields) - actual-fields)) - (#R;Success []) - (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]")))) + (function [json] + (case json + (#Object kvs) + (let [actual-fields (d;keys kvs)] + (if (and (n.= (list;size wanted-fields) (list;size actual-fields)) + (list;every? (list;member? text;Eq<Text> wanted-fields) + actual-fields)) + (#R;Success []) + (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]")))) - _ - (#R;Error (format "JSON value is not an object: " (show-json json))))) + _ + (#R;Error (format "JSON value is not an object: " (show-json json)))))) ## [Structures] (struct: #export _ (Eq JSON) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index b95c60ed4..94bb19089 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -1,7 +1,7 @@ (;module: {#;doc "Functionality for reading, generating and processing values in the XML format."} lux (lux (control monad - eq + [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) (data [text "t/" Eq<Text>] diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux index 62b678ee4..174712b33 100644 --- a/stdlib/source/lux/data/ident.lux +++ b/stdlib/source/lux/data/ident.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control eq + (lux (control [eq #+ Eq] codec hash) (data [text "Text/" Monoid<Text> Eq<Text>]))) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index d0c2c8441..e8404544f 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -4,7 +4,7 @@ (functor #as F #refer #all) (applicative #as A #refer #all) (monad #as M #refer #all) - eq))) + [eq #+ Eq]))) ## [Types] ## (type: (Maybe a) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 238cc139a..783e9bc55 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -2,7 +2,7 @@ lux (lux (control number monoid - eq + [eq #+ Eq] hash [order] enum diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 852498e28..09d596bc3 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -1,7 +1,7 @@ (;module: {#;doc "Complex arithmetic."} lux (lux [math] - (control eq + (control [eq #+ Eq] number codec monad diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index d9b20cb97..3352fd02d 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -1,7 +1,7 @@ (;module: {#;doc "Rational arithmetic."} lux (lux [math] - (control eq + (control [eq #+ Eq] [order] number codec diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index ac1994130..13e57aa21 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control monoid - eq + [eq #+ Eq] [order] monad codec diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index efd28d052..2755ae6f5 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control eq) + (lux (control [eq #+ Eq]) (data bool number [text #+ Eq<Text> "Text/" Monoid<Text>] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index fe49553a5..4ff1b3012 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -12,7 +12,7 @@ [bool] [maybe] [ident "Ident/" Eq<Ident>]) - [macro #+ Monad<Lux> with-gensyms] + [macro #+ with-gensyms "Lux/" Monad<Lux>] (macro [code] ["s" syntax #+ syntax: Syntax] (syntax ["cs" common] @@ -34,7 +34,7 @@ (;function [:type:] (case (type;un-name :type:) <type> - (:: macro;Monad<Lux> wrap []) + (Lux/wrap []) _ (macro;fail (format "Not " <name> " type: " (%type :type:))))))] @@ -49,7 +49,7 @@ (;function [:type:] (case (type;un-alias :type:) (#;Named ["lux" <name>] _) - (:: macro;Monad<Lux> wrap []) + (Lux/wrap []) _ (macro;fail (format "Not " <name> " type: " (%type :type:))))))] @@ -67,7 +67,7 @@ (;function [:type:] (with-expansions [<primitives> (do-template [<parser> <type>] - [(do Monad<Lux> + [(do macro;Monad<Lux> [_ (<parser> :type:)] (wrap <type>))] @@ -91,7 +91,7 @@ (;function [:type:] (case (type;un-name :type:) (<tag> :left: :right:) - (:: macro;Monad<Lux> wrap [:left: :right:]) + (Lux/wrap [:left: :right:]) _ (macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))) @@ -101,31 +101,13 @@ (;function [:type:] (let [members (<flattener> (type;un-name :type:))] (if (n.> +1 (list;size members)) - (:: macro;Monad<Lux> wrap members) + (Lux/wrap members) (macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))))] [sum sum+ type;flatten-variant #;Sum] [prod prod+ type;flatten-tuple #;Product] ) -(def: #export func - (Matcher [Type Type]) - (;function [:type:] - (case (type;un-name :type:) - (#;Function :left: :right:) - (:: macro;Monad<Lux> wrap [:left: :right:]) - - _ - (macro;fail (format "Not a Function type: " (%type :type:)))))) - -(def: #export func+ - (Matcher [(List Type) Type]) - (;function [:type:] - (let [[ins out] (type;flatten-function (type;un-name :type:))] - (if (n.> +0 (list;size ins)) - (:: macro;Monad<Lux> wrap [ins out]) - (macro;fail (format "Not a Function type: " (%type :type:))))))) - (def: #export tagged (Matcher [(List Ident) Type]) (;function [:type:] @@ -151,7 +133,7 @@ :type:''])) _ - (:: macro;Monad<Lux> wrap [(;list) :type:]))))) + (Lux/wrap [(;list) :type:]))))) (do-template [<combinator> <sub-comb> <build>] [(def: #export <combinator> @@ -184,12 +166,12 @@ (wrap [vars members])))) (def: #export function - (Matcher [(List Code) [(List Type) Type]]) + (Matcher [(List Code) (List Type) Type]) (;function [:type:] (do macro;Monad<Lux> [[vars :type:] (polymorphic :type:) - ins+out (func+ :type:)] - (wrap [vars ins+out])))) + #let [[ins out] (type;flatten-function (type;un-name :type:))]] + (wrap [vars ins out])))) (def: #export apply (Matcher [Type (List Type)]) @@ -217,7 +199,7 @@ (^multi (#;Apply :arg: :quant:) [(type;un-alias :quant:) (#;Named actual _)] (Ident/= name actual)) - (:: macro;Monad<Lux> wrap :arg:) + (Lux/wrap :arg:) _ (macro;fail (format "Not " (%ident name) " type: " (%type :type:)))))) @@ -229,11 +211,21 @@ (^multi (#;Apply :arg1: (#;Apply :arg0: :quant:)) [(type;un-alias :quant:) (#;Named actual _)] (Ident/= name actual)) - (:: macro;Monad<Lux> wrap [:arg0: :arg1:]) + (Lux/wrap [:arg0: :arg1:]) _ (macro;fail (format "Not " (%ident name) " type: " (%type :type:)))))) +(def: #export recursive + (Matcher Type) + (;function [:type:] + (case (type;un-name :type:) + (#;Apply #;Void (#;UnivQ _ :type:')) + (Lux/wrap :type:') + + _ + (macro;fail (format "Not a recursive type: " (%type :type:)))))) + (def: (adjusted-idx env idx) (-> Env Nat Nat) (let [env-level (n./ +2 (dict;size env)) @@ -248,7 +240,7 @@ (#;Bound idx) (case (dict;get (adjusted-idx env idx) env) (#;Some [poly-type poly-ast]) - (:: macro;Monad<Lux> wrap poly-ast) + (Lux/wrap poly-ast) #;None (macro;fail (format "Unknown bound type: " (%type :type:)))) @@ -256,10 +248,10 @@ _ (macro;fail (format "Not a bound type: " (%type :type:)))))) -(def: #export (recur env) +(def: #export (recursion env) (-> Env (Matcher Code)) (;function [:type:] - (do Monad<Lux> + (do macro;Monad<Lux> [[t-func t-args] (apply :type:)] (case t-func (^multi (#;Bound t-func-idx) @@ -282,13 +274,26 @@ (macro;fail (format "Type is not a recursive instance: " (%type :type:)))) ))) +(def: #export (self env) + (-> Env (Matcher Code)) + (;function [:type:] + (case :type: + (^multi (#;Apply #;Void (#;Bound t-func-idx)) + (n.= +0 (adjusted-idx env t-func-idx)) + [(dict;get +0 env) + (#;Some [self-type self-call])]) + (Lux/wrap self-call) + + _ + (macro;fail (format "Type is not a recursive self-call: " (%type :type:)))))) + (def: #export (var env var-id) (-> Env Nat (Matcher Unit)) (;function [:type:] (case :type: (^multi (#;Bound idx) (n.= var-id (adjusted-idx env idx))) - (:: macro;Monad<Lux> wrap []) + (Lux/wrap []) _ (macro;fail (format "Not a bound type: " (%type :type:)))))) @@ -321,7 +326,7 @@ g!env (code;symbol ["" env])] (wrap (;list (` (syntax: (~@ (csw;export _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol])) g!inputs))) - (do Monad<Lux> + (do macro;Monad<Lux> [(~@ (List/join (List/map (;function [g!input] (;list g!input (` (macro;find-type-def (~ g!input))))) g!inputs))) (~' #let) [(~ g!env) (: Env (dict;new number;Hash<Nat>))] @@ -395,6 +400,12 @@ (|> (dict;get idx env) (default (undefined)) product;left (to-ast env)) (` (;$ (~ (code;nat (n.dec idx))))))) + (#;Apply #;Void (#;Bound idx)) + (let [idx (adjusted-idx env idx)] + (if (n.= +0 idx) + (|> (dict;get idx env) (default (undefined)) product;left (to-ast env)) + (undefined))) + (^template [<tag>] (<tag> left right) (` (<tag> (~ (to-ast env left)) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 31359a6c3..c9a58a6f5 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -82,6 +82,22 @@ ## Variants (with-gensyms [g!type-fun g!left g!right] (do @ + [members (poly;sum+ :x:) + pattern-matching (mapM @ + (function [[tag :case:]] + (do @ + [g!eq (Eq<?> env :case:)] + (wrap (list (` [((~ (code;nat tag)) (~ g!left)) + ((~ (code;nat tag)) (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))) + (list;enumerate members)) + #let [base (` (function [(~ g!left) (~ g!right)] + (case [(~ g!left) (~ g!right)] + (~@ (List/join pattern-matching)))))]] + (wrap (` (: (~ (poly;gen-type env ->Eq g!type-fun (list) :x:)) + (~ base)))))) + (with-gensyms [g!type-fun g!left g!right] + (do @ [[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) @@ -125,7 +141,16 @@ (wrap (` (: (~ (poly;gen-type new-env ->Eq g!type-fun g!vars :x:)) (~ base)))))) ## Type recursion - (poly;recur env :x:) + (with-gensyms [g!rec] + (do @ + [:non-rec: (poly;recursive :x:) + #let [new-env (poly;extend-env [:x: g!rec] (list [:x: (` (;undefined))]) env)] + .non-rec. (Eq<?> new-env :non-rec:)] + (wrap (` (: (~ (poly;gen-type new-env ->Eq g!rec (list) :x:)) + (eq;rec (;function [(~ g!rec)] + (~ .non-rec.)))))))) + (poly;self env :x:) + (poly;recursion env :x:) ## Type applications (do @ [[:func: :args:] (poly;apply :x:) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index a1b84cdec..4838e16b1 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -4,7 +4,7 @@ (control functor applicative monad - eq + [eq #+ Eq] ["p" parser]) (data [bool] [number] diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 48f6c3bd7..618416c33 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -1,6 +1,6 @@ (;module: {#;doc "Basic functionality for working with types."} [lux #- function] - (lux (control eq + (lux (control [eq #+ Eq] monad) (data [text "Text/" Monoid<Text> Eq<Text>] [ident "Ident/" Eq<Ident>] diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index 4580dca1e..ad5a57a1c 100644 --- a/stdlib/test/test/lux/control/parser.lux +++ b/stdlib/test/test/lux/control/parser.lux @@ -2,7 +2,7 @@ lux (lux [io] (control monad - eq + [eq #+ Eq] ["&" parser] pipe) (data [text "Text/" Monoid<Text>] diff --git a/stdlib/test/test/lux/data/coll/ordered/dict.lux b/stdlib/test/test/lux/data/coll/ordered/dict.lux index 8793be9c2..76e9083eb 100644 --- a/stdlib/test/test/lux/data/coll/ordered/dict.lux +++ b/stdlib/test/test/lux/data/coll/ordered/dict.lux @@ -2,7 +2,7 @@ lux (lux [io] (control monad - eq) + [eq #+ Eq]) (data [product] [number] (coll (ordered ["&" dict]) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index c61429b87..fc533e4c1 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -3,7 +3,7 @@ (lux [io] (control monad codec - eq + [eq #+ Eq] pipe) (data [text "Text/" Monoid<Text>] text/format diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index e3c059ddd..9bd6fc5e6 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -2,7 +2,7 @@ lux (lux [io] (control monad - eq) + [eq #+ Eq]) (data text/format [bool] [number "i/" Number<Int>] @@ -19,6 +19,10 @@ (#Case1 Int) (#Case2 Real)) +(type: #rec Recursive + (#Number Real) + (#Addition Real Recursive)) + (type: Record {#unit Unit #bool Bool @@ -28,7 +32,16 @@ #maybe (Maybe Int) #list (List Int) #variant Variant - #tuple [Int Real Text]}) + #tuple [Int Real Text] + #recursive Recursive}) + +(def: gen-recursive + (r;Random Recursive) + (r;rec (function [gen-recursive] + (r;alt r;real + (r;seq r;real gen-recursive))))) + +(derived: (&;Eq<?> Recursive)) (def: gen-record (r;Random Record) @@ -45,7 +58,7 @@ (r;list size gen-int) ($_ r;alt r;bool gen-int r;real) ($_ r;seq gen-int r;real (r;text size)) - ))) + gen-recursive))) (derived: (&;Eq<?> Record)) diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux index 34d0d1a82..e97093d81 100644 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ b/stdlib/test/test/lux/macro/poly/functor.lux @@ -3,7 +3,7 @@ (lux [io] (control monad [functor] - eq) + [eq #+ Eq]) (data text/format [bool] [number "i/" Number<Int>] diff --git a/stdlib/test/test/lux/macro/poly/text-encoder.lux b/stdlib/test/test/lux/macro/poly/text-encoder.lux index a98b8801d..1b38aa9b9 100644 --- a/stdlib/test/test/lux/macro/poly/text-encoder.lux +++ b/stdlib/test/test/lux/macro/poly/text-encoder.lux @@ -2,7 +2,7 @@ lux (lux [io] (control monad - eq) + [eq #+ Eq]) (data text/format [bool] [number "i/" Number<Int>] diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index ff8befbda..f99385521 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -2,7 +2,7 @@ lux (lux [io] (control monad - eq + [eq #+ Eq] ["p" parser]) (data [text "Text/" Monoid<Text>] text/format |