aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2020-06-01 20:16:32 -0400
committerEduardo Julian2020-06-01 20:16:32 -0400
commita6987ad82f107df49853e1601b73076d030d6fc8 (patch)
treeb5562ec12fcee4a87b0c6ca4d485e7ac82ffbfec /stdlib/source/test
parent1546feb83e8e821ee8bbf3dea736a49a072bcd52 (diff)
Implemented an optimization for getting fields/slots from records in the new compiler.
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control.lux2
-rw-r--r--stdlib/source/test/lux/control/parser/analysis.lux146
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux159
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux19
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux22
5 files changed, 287 insertions, 61 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 56be46610..7fc1c428d 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -20,6 +20,7 @@
["#." try]
["#." io]
["#." parser
+ ["#/." analysis]
["#/." text]
["#/." cli]]
["#." pipe]
@@ -57,6 +58,7 @@
Test
($_ _.and
/parser.test
+ /parser/analysis.test
/parser/text.test
/parser/cli.test
))
diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux
new file mode 100644
index 000000000..397b2c779
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/analysis.lux
@@ -0,0 +1,146 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]
+ ["." try]
+ ["." exception]
+ ["<>" parser]]
+ [data
+ ["." name ("#@." equivalence)]
+ ["." bit ("#@." equivalence)]
+ ["." text ("#@." equivalence)]
+ [number
+ ["n" nat]
+ ["i" int]
+ ["f" frac]
+ ["r" rev]]
+ [collection
+ ["." list]]]
+ [math
+ ["." random (#+ Random)]]
+ [tool
+ [compiler
+ [reference (#+ Constant)]
+ [language
+ [lux
+ ["." analysis]]]]]]
+ {1
+ ["." /]})
+
+(template: (!expect <expectation> <computation>)
+ (case <computation>
+ <expectation>
+ true
+
+ _
+ false))
+
+(def: constant
+ (Random Constant)
+ (random.and (random.unicode 10)
+ (random.unicode 10)))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
+ (do {@ random.monad}
+ []
+ (`` ($_ _.and
+ (do {@ random.monad}
+ [expected (:: @ map (|>> analysis.bit) random.bit)]
+ (_.cover [/.run /.any]
+ (|> (list expected)
+ (/.run /.any)
+ (case> (#try.Success actual)
+ (:: analysis.equivalence = expected actual)
+
+ (#try.Failure _)
+ false))))
+ (~~ (template [<query> <check> <random> <analysis> <=>]
+ [(do {@ random.monad}
+ [expected <random>]
+ (_.cover [<query>]
+ (|> (list (<analysis> expected))
+ (/.run <query>)
+ (case> (#try.Success actual)
+ (<=> expected actual)
+
+ (#try.Failure _)
+ false))))
+ (do {@ random.monad}
+ [expected <random>]
+ (_.cover [<check>]
+ (|> (list (<analysis> expected))
+ (/.run (<check> expected))
+ (!expect (#try.Success _)))))]
+
+ [/.bit /.bit! random.bit analysis.bit bit@=]
+ [/.nat /.nat! random.nat analysis.nat n.=]
+ [/.int /.int! random.int analysis.int i.=]
+ [/.frac /.frac! random.frac analysis.frac f.=]
+ [/.rev /.rev! random.rev analysis.rev r.=]
+ [/.text /.text! (random.unicode 10) analysis.text text@=]
+ [/.local /.local! random.nat analysis.variable/local n.=]
+ [/.foreign /.foreign! random.nat analysis.variable/foreign n.=]
+ [/.constant /.constant! ..constant analysis.constant name@=]
+ ))
+ (do {@ random.monad}
+ [expected random.bit]
+ (_.cover [/.tuple]
+ (|> (list (analysis.tuple (list (analysis.bit expected))))
+ (/.run (/.tuple /.bit))
+ (case> (#try.Success actual)
+ (bit@= expected actual)
+
+ (#try.Failure _)
+ false))))
+ (do {@ random.monad}
+ [dummy random.bit]
+ (_.cover [/.end?]
+ (and (|> (/.run /.end? (list))
+ (!expect (#try.Success #1)))
+ (|> (/.run (do <>.monad
+ [verdict /.end?
+ _ /.bit]
+ (wrap verdict))
+ (list (analysis.bit dummy)))
+ (!expect (#try.Success #0))))))
+ (do {@ random.monad}
+ [dummy random.bit]
+ (_.cover [/.end!]
+ (and (|> (/.run /.end! (list))
+ (!expect (#try.Success _)))
+ (|> (/.run /.end! (list (analysis.bit dummy)))
+ (!expect (#try.Failure _))))))
+ (do {@ random.monad}
+ [expected random.bit]
+ (_.cover [/.cannot-parse]
+ (and (|> (list (analysis.bit expected))
+ (/.run /.nat)
+ (case> (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.cannot-parse error)))
+ (|> (list)
+ (/.run /.bit)
+ (case> (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.cannot-parse error))))))
+ (do {@ random.monad}
+ [expected random.bit]
+ (_.cover [/.unconsumed-input]
+ (|> (list (analysis.bit expected) (analysis.bit expected))
+ (/.run /.bit)
+ (case> (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.unconsumed-input error)))))
+ )))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 5f9f14321..d084e0210 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -1,15 +1,19 @@
(.module:
[lux #*
- [abstract ["." monad (#+ do)]]
- [data
- ["." name]
- [number
- ["n" nat]]]
- ["r" math/random (#+ Random) ("#@." monad)]
["_" test (#+ Test)]
+ [abstract
+ ["." monad (#+ do)]]
[control
pipe
- ["." try ("#@." functor)]]]
+ ["." try ("#@." functor)]]
+ [data
+ ["." sum]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list ("#@." fold monoid)]]]
+ [math
+ ["." random (#+ Random) ("#@." monad)]]]
["." // #_
["#." primitive]]
{1
@@ -22,32 +26,33 @@
["#." analysis (#+ Branch Analysis)]
["#." synthesis (#+ Synthesis)]
[///
- ["#." reference]
+ ["#." reference
+ [variable (#+ Register)]]
["." phase]
[meta
["." archive]]]]]]]})
-(def: dummy-vars
+(def: masking-test
Test
- (do {@ r.monad}
+ (do {@ random.monad}
[maskedA //primitive.primitive
- temp (|> r.nat (:: @ map (n.% 100)))
+ temp (|> random.nat (:: @ map (n.% 100)))
#let [maskA (////analysis.control/case
[maskedA
[[(#////analysis.Bind temp)
(#////analysis.Reference (////reference.local temp))]
(list)]])]]
- (_.test "Dummy variables created to mask expressions get eliminated during synthesis."
- (|> maskA
- (//.phase archive.empty)
- (phase.run [///bundle.empty ////synthesis.init])
- (try@map (//primitive.corresponds? maskedA))
- (try.default false)))))
+ (_.cover [/.synthesize-masking]
+ (|> maskA
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
+ (try@map (//primitive.corresponds? maskedA))
+ (try.default false)))))
-(def: let-expr
+(def: let-test
Test
- (do r.monad
- [registerA r.nat
+ (do random.monad
+ [registerA random.nat
inputA //primitive.primitive
outputA //primitive.primitive
#let [letA (////analysis.control/case
@@ -55,22 +60,22 @@
[[(#////analysis.Bind registerA)
outputA]
(list)]])]]
- (_.test "Can detect and reify simple 'let' expressions."
- (|> letA
- (//.phase archive.empty)
- (phase.run [///bundle.empty ////synthesis.init])
- (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
- (and (n.= registerA registerS)
- (//primitive.corresponds? inputA inputS)
- (//primitive.corresponds? outputA outputS))
+ (_.cover [/.synthesize-let]
+ (|> letA
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
+ (and (n.= registerA registerS)
+ (//primitive.corresponds? inputA inputS)
+ (//primitive.corresponds? outputA outputS))
- _
- false)))))
+ _
+ false)))))
-(def: if-expr
+(def: if-test
Test
- (do r.monad
- [then|else r.bit
+ (do random.monad
+ [then|else random.bit
inputA //primitive.primitive
thenA //primitive.primitive
elseA //primitive.primitive
@@ -83,23 +88,83 @@
ifA (if then|else
(////analysis.control/case [inputA [thenB (list elseB)]])
(////analysis.control/case [inputA [elseB (list thenB)]]))]]
- (_.test "Can detect and reify simple 'if' expressions."
- (|> ifA
- (//.phase archive.empty)
- (phase.run [///bundle.empty ////synthesis.init])
- (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
- (and (//primitive.corresponds? inputA inputS)
- (//primitive.corresponds? thenA thenS)
- (//primitive.corresponds? elseA elseS))
+ (_.cover [/.synthesize-if]
+ (|> ifA
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
+ (and (//primitive.corresponds? inputA inputS)
+ (//primitive.corresponds? thenA thenS)
+ (//primitive.corresponds? elseA elseS))
+
+ _
+ false)))))
+
+(def: random-member
+ (Random ////synthesis.Member)
+ (do {@ random.monad}
+ [lefts (|> random.nat (:: @ map (n.% 10)))
+ right? random.bit]
+ (wrap (if right?
+ (#.Right lefts)
+ (#.Left lefts)))))
+
+(def: random-path
+ (Random (////analysis.Tuple ////synthesis.Member))
+ (do {@ random.monad}
+ [size-1 (|> random.nat (:: @ map (|>> (n.% 10) inc)))]
+ (random.list size-1 ..random-member)))
+
+(def: (get-pattern path)
+ (-> (////analysis.Tuple ////synthesis.Member)
+ (Random [////analysis.Pattern Register]))
+ (do random.monad
+ [@member random.nat]
+ (wrap [(list@fold (function (_ member inner)
+ (case member
+ (#.Left lefts)
+ (////analysis.pattern/tuple
+ (list@compose (list.repeat lefts (////analysis.pattern/unit))
+ (list inner (////analysis.pattern/unit))))
+
+ (#.Right lefts)
+ (////analysis.pattern/tuple
+ (list@compose (list.repeat (inc lefts) (////analysis.pattern/unit))
+ (list inner)))))
+ (#////analysis.Bind @member)
+ (list.reverse path))
+ @member])))
+
+(def: get-test
+ Test
+ (do {@ random.monad}
+ [recordA (|> random.nat
+ (:: @ map (|>> ////analysis.nat))
+ (random.list 10)
+ (:: @ map (|>> ////analysis.tuple)))
+ pathA ..random-path
+ [pattern @member] (get-pattern pathA)
+ #let [getA (////analysis.control/case [recordA [[pattern
+ (#////analysis.Reference (////reference.local @member))]
+ (list)]])]]
+ (_.cover [/.synthesize-get]
+ (|> getA
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#try.Success (////synthesis.branch/get [pathS recordS])))
+ (and (:: (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS)
+ (//primitive.corresponds? recordA recordS))
- _
- false)))))
+ _
+ false)))))
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.synthesize])
($_ _.and
- ..dummy-vars
- ..let-expr
- ..if-expr
+ ..masking-test
+ ..let-test
+ ..if-test
+ ..get-test
)))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index 799a8a526..7350881b1 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -16,7 +16,7 @@
["n" nat]]
[collection
["." list ("#@." functor fold)]
- ["dict" dictionary (#+ Dictionary)]
+ ["." dictionary (#+ Dictionary)]
["." set]]]]
["." // #_
["#." primitive]]
@@ -31,7 +31,8 @@
["#." synthesis (#+ Synthesis)]
[///
[arity (#+ Arity)]
- ["#." reference (#+ Variable) ("variable@." equivalence)]
+ ["#." reference
+ ["." variable (#+ Variable) ("#@." equivalence)]]
["." phase]
[meta
["." archive]]]]]]]})
@@ -61,16 +62,16 @@
(do {@ r.monad}
[num-locals (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))
#let [indices (list.n/range 0 (dec num-locals))
- local-env (list@map (|>> #////reference.Local) indices)
- foreign-env (list@map (|>> #////reference.Foreign) indices)]
+ local-env (list@map (|>> #variable.Local) indices)
+ foreign-env (list@map (|>> #variable.Foreign) indices)]
[arity bodyA predictionA] (: (Random [Arity Analysis Variable])
(loop [arity 1
current-env foreign-env]
(let [current-env/size (list.size current-env)
resolver (list@fold (function (_ [idx var] resolver)
- (dict.put idx var resolver))
+ (dictionary.put idx var resolver))
(: (Dictionary Nat Variable)
- (dict.new n.hash))
+ (dictionary.new n.hash))
(list.enumerate current-env))]
(do @
[nest? r.bit]
@@ -83,7 +84,7 @@
(list@map (function (_ pick)
(maybe.assume (list.nth pick current-env)))
picks))
- #let [picked-env (list@map (|>> #////reference.Foreign) picks)]]
+ #let [picked-env (list@map (|>> #variable.Foreign) picks)]]
(wrap [arity
(#////analysis.Function picked-env bodyA)
predictionA]))
@@ -91,7 +92,7 @@
[chosen (pick (list.size current-env))]
(wrap [arity
(#////analysis.Reference (////reference.foreign chosen))
- (maybe.assume (dict.get chosen resolver))])))))))]
+ (maybe.assume (dictionary.get chosen resolver))])))))))]
(wrap [arity
(#////analysis.Function local-env bodyA)
predictionA])))
@@ -111,7 +112,7 @@
[chosen (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2))))]
(wrap [arity
(#////analysis.Reference (////reference.local chosen))
- (|> chosen (n.+ (dec arity)) #////reference.Local)])))))
+ (|> chosen (n.+ (dec arity)) #variable.Local)])))))
(def: abstraction
Test
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
index cd7fe54eb..40f9efad4 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
@@ -1,14 +1,18 @@
(.module:
[lux (#- primitive)
[abstract ["." monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]
+ ["." try]]
[data
["%" text/format (#+ format)]
- ["." name]]
+ ["." name]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list]]]
["r" math/random (#+ Random) ("#@." monad)]
- ["_" test (#+ Test)]
- [control
- pipe
- ["." try]]]
+ ["_" test (#+ Test)]]
{1
["." / #_
["/#" //
@@ -54,6 +58,14 @@
[#////analysis.Frac (|>) #////synthesis.F64 (|>)]
[#////analysis.Text (|>) #////synthesis.Text (|>)]
))
+
+ (^ [(////analysis.tuple expected)
+ (////synthesis.tuple actual)])
+ (and (n.= (list.size expected)
+ (list.size actual))
+ (list.every? (function (_ [expected actual])
+ (corresponds? expected actual))
+ (list.zip2 expected actual)))
_
false)))