diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/case.lux | 9 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/function.lux | 23 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux | 11 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/reference.lux | 10 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/structure.lux | 91 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/case.lux | 1 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/function.lux | 23 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/procedure/common.jvm.lux | 1 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/structure.lux | 9 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/parser.lux | 8 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/function.lux | 37 |
11 files changed, 114 insertions, 109 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux index 983dff6f5..f75ebce00 100644 --- a/new-luxc/test/test/luxc/analyser/case.lux +++ b/new-luxc/test/test/luxc/analyser/case.lux @@ -6,6 +6,7 @@ (data [bool "B/" Eq<Bool>] ["R" result] [product] + [maybe] [text "T/" Eq<Text>] text/format (coll [list "L/" Monad<List>] @@ -111,8 +112,8 @@ (r/map product;right gen-primitive) (do r;Monad<Random> [choice (|> r;nat (:: @ map (n.% (list;size variant-tags)))) - #let [choiceT (assume (list;nth choice variant-tags)) - choiceC (assume (list;nth choice primitivesC))]] + #let [choiceT (maybe;assume (list;nth choice variant-tags)) + choiceC (maybe;assume (list;nth choice primitivesC))]] (wrap (` ((~ choiceT) (~ choiceC))))) (do r;Monad<Random> [size (|> r;nat (:: @ map (n.% +3))) @@ -156,10 +157,10 @@ redundant-branchesC (<| (L/map (branch outputC)) list;concat (list (list;take redundancy-idx redundant-patterns) - (list (assume (list;nth redundancy-idx redundant-patterns))) + (list (maybe;assume (list;nth redundancy-idx redundant-patterns))) (list;drop redundancy-idx redundant-patterns))) heterogeneous-branchesC (list;concat (list (list;take heterogeneous-idx exhaustive-branchesC) - (list (let [[_pattern _body] (assume (list;nth heterogeneous-idx exhaustive-branchesC))] + (list (let [[_pattern _body] (maybe;assume (list;nth heterogeneous-idx exhaustive-branchesC))] [_pattern heterogeneousC])) (list;drop (n.inc heterogeneous-idx) exhaustive-branchesC))) ]] diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux index 827e9a245..f26025034 100644 --- a/new-luxc/test/test/luxc/analyser/function.lux +++ b/new-luxc/test/test/luxc/analyser/function.lux @@ -4,15 +4,14 @@ (control [monad #+ do] pipe) (data ["R" result] + [maybe] [product] - [text "T/" Eq<Text>] + [text "text/" Eq<Text>] text/format - (coll [list "L/" Functor<List>] - ["S" set])) + (coll [list "list/" Functor<List>])) ["r" math/random "r/" Monad<Random>] - [type "Type/" Eq<Type>] - (type ["TC" check]) - [macro #+ Monad<Lux>] + [type "type/" Eq<Type>] + [macro] (macro [code]) test) (luxc ["&" base] @@ -28,7 +27,7 @@ (-> Type (R;Result [Type la;Analysis]) Bool) (case result (#R;Success [exprT exprA]) - (Type/= expectedT exprT) + (type/= expectedT exprT) _ false)) @@ -58,7 +57,7 @@ (macro;run (init-compiler [])) (case> (#R;Success [applyT applyA]) (let [[funcA argsA] (flatten-apply applyA)] - (and (Type/= expectedT applyT) + (and (type/= expectedT applyT) (n.= num-args (list;size argsA)))) (#R;Error error) @@ -66,7 +65,7 @@ (context: "Function definition." [func-name (r;text +5) - arg-name (|> (r;text +5) (r;filter (|>. (T/= func-name) not))) + arg-name (|> (r;text +5) (r;filter (|>. (text/= func-name) not))) [outputT outputC] gen-primitive [inputT _] gen-primitive] ($_ seq @@ -111,8 +110,8 @@ partial-args (|> r;nat (:: @ map (n.% full-args))) var-idx (|> r;nat (:: @ map (|>. (n.% full-args) (n.max +1)))) inputsTC (r;list full-args gen-primitive) - #let [inputsT (L/map product;left inputsTC) - inputsC (L/map product;right inputsTC)] + #let [inputsT (list/map product;left inputsTC) + inputsC (list/map product;right inputsTC)] [outputT outputC] gen-primitive #let [funcT (type;function inputsT outputT) partialT (type;function (list;drop partial-args inputsT) outputT) @@ -122,7 +121,7 @@ (list varT) (list;drop (n.inc var-idx) inputsT)))) varT) - poly-inputT (assume (list;nth var-idx inputsT)) + poly-inputT (maybe;assume (list;nth var-idx inputsT)) partial-poly-inputsT (list;drop (n.inc var-idx) inputsT) partial-polyT1 (<| (type;function partial-poly-inputsT) poly-inputT) diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux index 87c315750..c45143d5b 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux @@ -4,10 +4,11 @@ (control [monad #+ do] pipe) (concurrency [atom]) - (data text/format - [text "text/" Eq<Text>] - ["R" result] + (data ["R" result] [product] + [maybe] + [text "text/" Eq<Text>] + text/format (coll [array] [list "list/" Fold<List>] [dict])) @@ -247,7 +248,7 @@ #let [[unboxed boxed] (: [Text Text] (|> entries (list;nth choice) - (default ["java.lang.Object" "java.lang.Object"])))]] + (maybe;default ["java.lang.Object" "java.lang.Object"])))]] (wrap [unboxed boxed])))) (context: "Array." @@ -320,7 +321,7 @@ (:: @ map (function [idx] (|> throwables (list;nth idx) - (default "java.lang.Object"))))) + (maybe;default "java.lang.Object"))))) #let [throwableC (`' (_lux_check (+0 (~ (code;text throwable)) (+0)) ("jvm object null")))]] ($_ seq diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux index 5601318aa..5cc607080 100644 --- a/new-luxc/test/test/luxc/analyser/reference.lux +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -4,8 +4,8 @@ (control [monad #+ do] pipe) (data ["R" result]) - ["r" math/random "R/" Monad<Random>] - [type "Type/" Eq<Type>] + ["r" math/random] + [type "type/" Eq<Type>] [macro #+ Monad<Lux>] test) (luxc ["&;" scope] @@ -30,7 +30,7 @@ (@;analyse-reference ["" var-name])))) (macro;run (init-compiler [])) (case> (#R;Success [_type (#~;Variable idx)]) - (Type/= ref-type _type) + (type/= ref-type _type) _ false))) @@ -38,12 +38,12 @@ (|> (do Monad<Lux> [_ (&module;create +0 module-name) _ (&module;define [module-name var-name] - [ref-type (list) (:! Void [])])] + [ref-type (' {}) (:! Void [])])] (@common;with-unknown-type (@;analyse-reference [module-name var-name]))) (macro;run (init-compiler [])) (case> (#R;Success [_type (#~;Definition idx)]) - (Type/= ref-type _type) + (type/= ref-type _type) _ false))) diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux index d9595492e..d4d915364 100644 --- a/new-luxc/test/test/luxc/analyser/structure.lux +++ b/new-luxc/test/test/luxc/analyser/structure.lux @@ -3,17 +3,18 @@ (lux [io] (control [monad #+ do] pipe) - (data [bool "B/" Eq<Bool>] + (data [bool "bool/" Eq<Bool>] ["R" result] [product] + [maybe] [text] text/format - (coll [list "L/" Functor<List>] + (coll [list "list/" Functor<List>] ["S" set])) ["r" math/random "r/" Monad<Random>] - [type "Type/" Eq<Type>] - (type ["TC" check]) - [macro #+ Monad<Lux>] + [type "type/" Eq<Type>] + (type ["tc" check]) + [macro] (macro [code]) test) (luxc ["&" base] @@ -61,14 +62,14 @@ primitives (r;list size gen-primitive) +choice (|> r;nat (:: @ map (n.% (n.inc size)))) [_ +valueC] gen-primitive - #let [variantT (type;variant (L/map product;left primitives)) - [valueT valueC] (assume (list;nth choice primitives)) + #let [variantT (type;variant (list/map product;left primitives)) + [valueT valueC] (maybe;assume (list;nth choice primitives)) +size (n.inc size) +primitives (list;concat (list (list;take choice primitives) (list [(#;Bound +1) +valueC]) (list;drop choice primitives))) - [+valueT +valueC] (assume (list;nth +choice +primitives)) - +variantT (type;variant (L/map product;left +primitives))]] + [+valueT +valueC] (maybe;assume (list;nth +choice +primitives)) + +variantT (type;variant (list/map product;left +primitives))]] ($_ seq (test "Can analyse sum." (|> (&;with-scope @@ -79,7 +80,7 @@ [(flatten-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (bool/= last? (n.= (n.dec size) choice))) _ false))) @@ -87,9 +88,9 @@ (|> (&;with-scope (@common;with-var (function [[var-id varT]] - (do Monad<Lux> - [_ (&;within-type-env - (TC;check varT variantT))] + (do macro;Monad<Lux> + [_ (&;with-type-env + (tc;check varT variantT))] (&;with-expected-type varT (@;analyse-sum analyse choice valueC)))))) (macro;run (init-compiler [])) @@ -97,7 +98,7 @@ [(flatten-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (bool/= last? (n.= (n.dec size) choice))) _ false))) @@ -140,15 +141,15 @@ primitives (r;list size gen-primitive) choice (|> r;nat (:: @ map (n.% size))) [_ +valueC] gen-primitive - #let [[singletonT singletonC] (|> primitives (list;nth choice) assume) + #let [[singletonT singletonC] (|> primitives (list;nth choice) maybe;assume) +primitives (list;concat (list (list;take choice primitives) (list [(#;Bound +1) +valueC]) (list;drop choice primitives))) - +tupleT (type;tuple (L/map product;left +primitives))]] + +tupleT (type;tuple (list/map product;left +primitives))]] ($_ seq (test "Can analyse product." - (|> (&;with-expected-type (type;tuple (L/map product;left primitives)) - (@;analyse-product analyse (L/map product;right primitives))) + (|> (&;with-expected-type (type;tuple (list/map product;left primitives)) + (@;analyse-product analyse (list/map product;right primitives))) (macro;run (init-compiler [])) (case> (#R;Success tupleA) (n.= size (list;size (flatten-tuple tupleA))) @@ -157,10 +158,10 @@ false))) (test "Can infer product." (|> (@common;with-unknown-type - (@;analyse-product analyse (L/map product;right primitives))) + (@;analyse-product analyse (list/map product;right primitives))) (macro;run (init-compiler [])) (case> (#R;Success [_type tupleA]) - (and (Type/= (type;tuple (L/map product;left primitives)) + (and (type/= (type;tuple (list/map product;left primitives)) _type) (n.= size (list;size (flatten-tuple tupleA)))) @@ -179,11 +180,11 @@ (|> (&;with-scope (@common;with-var (function [[var-id varT]] - (do Monad<Lux> - [_ (&;within-type-env - (TC;check varT (type;tuple (L/map product;left primitives))))] + (do macro;Monad<Lux> + [_ (&;with-type-env + (tc;check varT (type;tuple (list/map product;left primitives))))] (&;with-expected-type varT - (@;analyse-product analyse (L/map product;right primitives))))))) + (@;analyse-product analyse (list/map product;right primitives))))))) (macro;run (init-compiler [])) (case> (#R;Success [_ tupleA]) (n.= size (list;size (flatten-tuple tupleA))) @@ -193,7 +194,7 @@ (test "Can analyse product through existential quantification." (|> (&;with-scope (&;with-expected-type (type;ex-q +1 +tupleT) - (@;analyse-product analyse (L/map product;right +primitives)))) + (@;analyse-product analyse (list/map product;right +primitives)))) (macro;run (init-compiler [])) (case> (#R;Success _) true @@ -203,7 +204,7 @@ (test "Cannot analyse product through universal quantification." (|> (&;with-scope (&;with-expected-type (type;univ-q +1 +tupleT) - (@;analyse-product analyse (L/map product;right +primitives)))) + (@;analyse-product analyse (list/map product;right +primitives)))) (macro;run (init-compiler [])) (case> (#R;Success _) false @@ -219,9 +220,9 @@ (case> (^multi (#R;Success [_ _ sumT sumA]) [(flatten-variant sumA) (#;Some [tag last? valueA])]) - (and (Type/= variantT sumT) + (and (type/= variantT sumT) (n.= tag choice) - (B/= last? (n.= (n.dec size) choice))) + (bool/= last? (n.= (n.dec size) choice))) _ false))) @@ -233,7 +234,7 @@ (case> (^multi (#R;Success [_ _ productT productA]) [(flatten-tuple productA) membersA]) - (and (Type/= tupleT productT) + (and (type/= tupleT productT) (n.= size (list;size membersA))) _ @@ -248,9 +249,9 @@ module-name (r;text +5) type-name (r;text +5) #let [varT (#;Bound +1) - primitivesT (L/map product;left primitives) - [choiceT choiceC] (assume (list;nth choice primitives)) - [other-choiceT other-choiceC] (assume (list;nth other-choice primitives)) + primitivesT (list/map product;left primitives) + [choiceT choiceC] (maybe;assume (list;nth choice primitives)) + [other-choiceT other-choiceC] (maybe;assume (list;nth other-choice primitives)) variantT (type;variant primitivesT) namedT (#;Named [module-name type-name] variantT) polyT (|> (type;variant (list;concat (list (list;take choice primitivesT) @@ -258,12 +259,12 @@ (list;drop (n.inc choice) primitivesT)))) (type;univ-q +1)) named-polyT (#;Named [module-name type-name] polyT) - choice-tag (assume (list;nth choice tags)) - other-choice-tag (assume (list;nth other-choice tags))]] + choice-tag (maybe;assume (list;nth choice tags)) + other-choice-tag (maybe;assume (list;nth other-choice tags))]] ($_ seq (test "Can infer tagged sum." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false namedT)] (&;with-scope (@common;with-unknown-type @@ -271,7 +272,7 @@ (check-variant-inference variantT choice size))) (test "Tagged sums specialize when type-vars get bound." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (@common;with-unknown-type @@ -279,7 +280,7 @@ (check-variant-inference variantT choice size))) (test "Tagged sum inference retains universal quantification when type-vars are not bound." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (@common;with-unknown-type @@ -287,7 +288,7 @@ (check-variant-inference polyT other-choice size))) (test "Can specialize generic tagged sums." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (&;with-expected-type variantT @@ -297,7 +298,7 @@ [(flatten-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag other-choice) - (B/= last? (n.= (n.dec size) other-choice))) + (bool/= last? (n.= (n.dec size) other-choice))) _ false))) @@ -311,9 +312,9 @@ type-name (r;text +5) choice (|> r;nat (:: @ map (n.% size))) #let [varT (#;Bound +1) - tagsC (L/map (|>. [module-name] code;tag) tags) - primitivesT (L/map product;left primitives) - primitivesC (L/map product;right primitives) + tagsC (list/map (|>. [module-name] code;tag) tags) + primitivesT (list/map product;left primitives) + primitivesC (list/map product;right primitives) tupleT (type;tuple primitivesT) namedT (#;Named [module-name type-name] tupleT) recordC (list;zip2 tagsC primitivesC) @@ -325,7 +326,7 @@ ($_ seq (test "Can infer record." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false namedT)] (&;with-scope (@common;with-unknown-type @@ -333,7 +334,7 @@ (check-record-inference tupleT size))) (test "Records specialize when type-vars get bound." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (@common;with-unknown-type @@ -341,7 +342,7 @@ (check-record-inference tupleT size))) (test "Can specialize generic records." (|> (@module;with-module +0 module-name - (do Monad<Lux> + (do macro;Monad<Lux> [_ (@module;declare-tags tags false named-polyT)] (&;with-scope (&;with-expected-type tupleT diff --git a/new-luxc/test/test/luxc/generator/case.lux b/new-luxc/test/test/luxc/generator/case.lux index 9fec0d501..4aff49779 100644 --- a/new-luxc/test/test/luxc/generator/case.lux +++ b/new-luxc/test/test/luxc/generator/case.lux @@ -74,6 +74,7 @@ )))) (context: "Pattern-matching." + #seed +17952275935008918762 [[valueS path] gen-case to-bind r;nat] ($_ seq diff --git a/new-luxc/test/test/luxc/generator/function.lux b/new-luxc/test/test/luxc/generator/function.lux index 3f938d9df..3757c0937 100644 --- a/new-luxc/test/test/luxc/generator/function.lux +++ b/new-luxc/test/test/luxc/generator/function.lux @@ -3,16 +3,13 @@ (lux [io] (control [monad #+ do] pipe) - (data text/format - [product] + (data [product] + [maybe] ["R" result] - [bool "B/" Eq<Bool>] - [text "T/" Eq<Text>] (coll ["a" array] - [list "L/" Functor<List>] - ["S" set])) + [list "list/" Functor<List>])) ["r" math/random "r/" Monad<Random>] - [macro #+ Monad<Lux>] + [macro] (macro [code]) [host] test) @@ -43,13 +40,13 @@ [[arity arg functionS] gen-function cut-off (|> r;nat (:: @ map (n.% arity))) args (r;list arity r;nat) - #let [arg-value (assume (list;nth arg args)) - argsS (L/map (|>. #ls;Nat) args) + #let [arg-value (maybe;assume (list;nth arg args)) + argsS (list/map (|>. #ls;Nat) args) last-arg (n.dec arity) cut-off (|> cut-off (n.min (n.dec last-arg)))]] ($_ seq (test "Can read arguments." - (|> (do Monad<Lux> + (|> (do macro;Monad<Lux> [runtime-bytecode @runtime;generate sampleI (@expr;generate (#ls;Call argsS functionS))] (@eval;eval sampleI)) @@ -61,7 +58,7 @@ false))) (test "Can partially apply functions." (or (n.= +1 arity) - (|> (do Monad<Lux> + (|> (do macro;Monad<Lux> [#let [partial-arity (n.inc cut-off) preS (list;take partial-arity argsS) postS (list;drop partial-arity argsS)] @@ -76,9 +73,9 @@ false)))) (test "Can read environment." (or (n.= +1 arity) - (|> (do Monad<Lux> + (|> (do macro;Monad<Lux> [#let [env (|> (list;n.range +0 cut-off) - (L/map (|>. n.inc nat-to-int))) + (list/map (|>. n.inc nat-to-int))) super-arity (n.inc cut-off) arg-var (if (n.<= cut-off arg) (|> arg n.inc nat-to-int (i.* -1)) diff --git a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux index 1016d4957..20e19fb5f 100644 --- a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux @@ -287,6 +287,7 @@ ))) (context: "Deg procedures" + #seed +1021167468900 [param (|> r;deg (r;filter (|>. (d.= .0) not))) special r;nat subject r;deg] diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux index 9fec0e078..fb15588ea 100644 --- a/new-luxc/test/test/luxc/generator/structure.lux +++ b/new-luxc/test/test/luxc/generator/structure.lux @@ -3,10 +3,11 @@ (lux [io] (control [monad #+ do] pipe) - (data text/format - ["R" result] + (data ["R" result] + [maybe] [bool "bool/" Eq<Bool>] [text "text/" Eq<Text>] + text/format (coll ["a" array] [list])) ["r" math/random "r/" Monad<Random>] @@ -89,9 +90,9 @@ (case> (#R;Success valueG) (let [valueG (:! (a;Array Top) valueG)] (and (n.= +3 (a;size valueG)) - (let [_tag (:! Integer (assume (a;get +0 valueG))) + (let [_tag (:! Integer (maybe;assume (a;get +0 valueG))) _last? (a;get +1 valueG) - _value (:! Top (assume (a;get +2 valueG)))] + _value (:! Top (maybe;assume (a;get +2 valueG)))] (and (n.= tag (|> _tag host;i2l int-to-nat)) (case _last? (#;Some _last?') diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index 247850e2b..a7708e1e5 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -2,11 +2,11 @@ lux (lux [io] (control [monad #+ do]) - (data [text "T/" Eq<Text>] + (data [number] + ["R" result] + [text] (text format ["l" lexer]) - [number] - ["R" result] (coll [list])) ["r" math/random "r/" Monad<Random>] (macro [code]) @@ -74,6 +74,7 @@ composite^)))))) (context: "Lux code parser." + #seed +15545773516740647407 [sample code^] (test "Can parse Lux code." (case (&;parse [default-cursor (code;to-text sample)]) @@ -107,6 +108,7 @@ )) (context: "Nat special syntax." + #seed +8051810494442953019 [expected (|> r;nat (:: @ map (n.% +1_000)))] (test "Can parse nat char syntax." (case (&;parse [default-cursor diff --git a/new-luxc/test/test/luxc/synthesizer/function.lux b/new-luxc/test/test/luxc/synthesizer/function.lux index 6791eceb4..c97f2f0fc 100644 --- a/new-luxc/test/test/luxc/synthesizer/function.lux +++ b/new-luxc/test/test/luxc/synthesizer/function.lux @@ -4,11 +4,12 @@ (control [monad #+ do] pipe) (data [product] + [maybe] [number] text/format - (coll [list "L/" Functor<List> Fold<List>] - ["D" dict] - ["s" set])) + (coll [list "list/" Functor<List> Fold<List>] + [dict #+ Dict] + [set])) ["r" math/random "r/" Monad<Random>] test) (luxc (lang ["la" analysis] @@ -29,8 +30,8 @@ #;inner +0 #;locals {#;counter +0 #;mappings (list)} #;captured {#;counter +0 - #;mappings (L/map (|>. reference [Void] [""]) - env)}}) + #;mappings (list/map (|>. reference [Void] [""]) + env)}}) (def: gen-function//constant (r;Random [Nat la;Analysis la;Analysis]) @@ -57,34 +58,34 @@ (do r;Monad<Random> [num-locals (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10)))) #let [indices (list;n.range +0 (n.dec num-locals)) - absolute-env (L/map &&function;to-local indices) - relative-env (L/map &&function;to-captured indices)] + absolute-env (list/map &&function;to-local indices) + relative-env (list/map &&function;to-captured indices)] [total-args prediction bodyA] (: (r;Random [Nat Int la;Analysis]) (loop [num-args +1 global-env relative-env] (let [env-size (list;size global-env) - resolver (L/fold (function [[idx var] resolver] - (D;put idx var resolver)) - (: (D;Dict Nat Int) - (D;new number;Hash<Nat>)) - (list;zip2 (list;n.range +0 (n.dec env-size)) - global-env))] + resolver (list/fold (function [[idx var] resolver] + (dict;put idx var resolver)) + (: (Dict Nat Int) + (dict;new number;Hash<Nat>)) + (list;zip2 (list;n.range +0 (n.dec env-size)) + global-env))] (do @ [nest? r;bool] (if nest? (do @ [num-picks (:: @ map (n.max +1) (pick (n.inc env-size))) picks (|> (r;set number;Hash<Nat> num-picks (pick env-size)) - (:: @ map s;to-list)) + (:: @ map set;to-list)) [total-args prediction bodyA] (recur (n.inc num-args) - (L/map (function [pick] (assume (list;nth pick global-env))) - picks))] - (wrap [total-args prediction (#la;Function (make-scope (L/map &&function;to-captured picks)) + (list/map (function [pick] (maybe;assume (list;nth pick global-env))) + picks))] + (wrap [total-args prediction (#la;Function (make-scope (list/map &&function;to-captured picks)) bodyA)])) (do @ [chosen (pick (list;size global-env))] (wrap [num-args - (assume (D;get chosen resolver)) + (maybe;assume (dict;get chosen resolver)) (#la;Variable (#;Captured chosen))])))))))] (wrap [total-args prediction (#la;Function (make-scope absolute-env) bodyA)]) )) |