aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--commands.md4
-rw-r--r--documentation/research/Optimization.md4
-rw-r--r--documentation/research/distributed_programming.md1
-rw-r--r--documentation/research/math.md5
-rw-r--r--documentation/research/paradigm/probabilistic_programming.md1
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux54
-rw-r--r--stdlib/source/lux/control/parser/code.lux58
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux83
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/parser/code.lux135
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux255
11 files changed, 476 insertions, 128 deletions
diff --git a/commands.md b/commands.md
index 2108bb873..acb180eef 100644
--- a/commands.md
+++ b/commands.md
@@ -26,7 +26,7 @@ cd ~/lux/lux-scheme/ && lein clean
# Read generated bytecode
```
-cd ~/lux/luxc/jbe/ && ./jbe.sh
+cd ~/lux/jbe/ && ./jbe.sh
```
---
@@ -42,7 +42,7 @@ cd ~/lux/luxc/ && lein clean && lein install
## Run JBE
```
-cd ~/lux/luxc/jbe/ && ./jbe.sh
+cd ~/lux/jbe/ && ./jbe.sh
```
---
diff --git a/documentation/research/Optimization.md b/documentation/research/Optimization.md
index b0a7861a7..e31686963 100644
--- a/documentation/research/Optimization.md
+++ b/documentation/research/Optimization.md
@@ -1,3 +1,7 @@
+# Pre-fetching
+
+1. [Prefetching in Functional Languages](https://www.cl.cam.ac.uk/~tmj32/papers/docs/ainsworth20-ismm.pdf)
+
# Partial evaluation
1. [AnyDSL - A Partial Evaluation Framework for Programming High-Performance Libraries](https://anydsl.github.io/)
diff --git a/documentation/research/distributed_programming.md b/documentation/research/distributed_programming.md
index ef4003e18..49ff324fe 100644
--- a/documentation/research/distributed_programming.md
+++ b/documentation/research/distributed_programming.md
@@ -5,6 +5,7 @@
# Reference
+1. [Ambients: Peer-to-Peer Programs and Data](https://ipfs.io/ipfs/QmPhPJE55GvqSz7Pwvkc8n9dbKmqGw6tUGTE1MgfNQvzsf)
1. [Bastion: Highly-available Distributed Fault-tolerant Runtime](https://bastion.rs/)
1. [DDD and Messaging Architectures: An overview of my different series on patterns in distributed systems.](http://verraes.net/2019/05/ddd-msg-arch/)
1. https://replicated.cc/
diff --git a/documentation/research/math.md b/documentation/research/math.md
index 5c4363680..21916064d 100644
--- a/documentation/research/math.md
+++ b/documentation/research/math.md
@@ -1,3 +1,7 @@
+# Tensor calculus
+
+1. [Introduction to Tensor Calculus](http://www.ita.uni-heidelberg.de/~dullemond/lectures/tensor/tensor.pdf)
+
# Geometry
1. [Perspectives on Projective Geometry: A Guided Tour through Real and Complex Geometry](https://www-m10.ma.tum.de/foswiki/pub/Lehre/WS0910/ProjektiveGeometrieWS0910/GeomBook.pdf)
@@ -145,6 +149,7 @@
# Category Theory
+1. [Programming with Categories](https://www.youtube.com/watch?v=Y5YCE_mVjvg&list=PLhgq-BqyZ7i7MTGhUROZy3BOICnVixETS&index=1)
1. [Awesome Applied Category Theory](https://github.com/statebox/awesome-applied-ct)
1. [Categorical Query Language](https://www.categoricaldata.net/)
1. [Abstract and Concrete Categories: The Joy of Cats](http://katmat.math.uni-bremen.de/acc/acc.pdf)
diff --git a/documentation/research/paradigm/probabilistic_programming.md b/documentation/research/paradigm/probabilistic_programming.md
index aeb4bf827..d1450f794 100644
--- a/documentation/research/paradigm/probabilistic_programming.md
+++ b/documentation/research/paradigm/probabilistic_programming.md
@@ -15,6 +15,7 @@
# Reference
+1. [The Distribution Monad](http://blog.russelldmatt.com/2018/10/15/the-distribution-monad.html)
1. ["New programming constructs for probabilistic AI" by Marco Cusumano-Towner](https://www.youtube.com/watch?v=xNutxms6SH4)
1. [A tour of probabilistic programming language APIs](https://colcarroll.github.io/ppl-api/)
1. [Paradigms of Probabilistic Programming](https://www.youtube.com/watch?v=CmH1xxKRbiE)
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index 421f413a0..e21cf9aec 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -57,22 +57,35 @@
_.AALOAD
(_.CHECKCAST runtime.$Stack)))
+(def: (leftsI value)
+ (-> Nat Inst)
+ (.case value
+ 0 _.ICONST_0
+ 1 _.ICONST_1
+ 2 _.ICONST_2
+ 3 _.ICONST_3
+ 4 _.ICONST_4
+ 5 _.ICONST_5
+ _ (_.int (.int value))))
+
(def: (left-projection lefts)
(-> Nat Inst)
- (.let [accessI (.case lefts
- 0
- _.AALOAD
-
- lefts
- (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
+ (.let [[indexI accessI] (.case lefts
+ 0
+ [_.ICONST_0
+ _.AALOAD]
+
+ lefts
+ [(leftsI lefts)
+ (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))])]
(|>> (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
+ indexI
accessI)))
(def: (right-projection lefts)
(-> Nat Inst)
(|>> (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
+ (leftsI lefts)
(_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))))
(def: (path' stack-depth @else @end phase archive path)
@@ -151,33 +164,18 @@
pushI))
## Extra optimization
- (^ (synthesis.path/seq
- (synthesis.member/left 0)
- (synthesis.!bind-top register thenP)))
- (do phase.monad
- [then! (path' stack-depth @else @end phase archive thenP)]
- (wrap (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int +0)
- _.AALOAD
- (_.ASTORE register)
- then!)))
-
- ## Extra optimization
- (^template [<pm> <getter>]
+ (^template [<path> <projection>]
(^ (synthesis.path/seq
- (<pm> lefts)
+ (<path> lefts)
(synthesis.!bind-top register thenP)))
(do phase.monad
[then! (path' stack-depth @else @end phase archive thenP)]
(wrap (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
- (_.INVOKESTATIC //.$Runtime <getter> (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
+ (<projection> lefts)
(_.ASTORE register)
then!))))
- ([synthesis.member/left "tuple_left"]
- [synthesis.member/right "tuple_right"])
+ ([synthesis.member/left ..left-projection]
+ [synthesis.member/right ..right-projection])
(#synthesis.Alt leftP rightP)
(do phase.monad
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 30344aaa0..ca0df7c9f 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -39,11 +39,14 @@
(Parser Code)
(function (_ tokens)
(case tokens
- #.Nil (#try.Failure "There are no tokens to parse!")
- (#.Cons [t tokens']) (#try.Success [tokens' t]))))
+ #.Nil
+ (#try.Failure "There are no tokens to parse!")
+
+ (#.Cons [t tokens'])
+ (#try.Success [tokens' t]))))
-(template [<query> <assertion> <type> <tag> <eq> <desc>]
- [(with-expansions [<error> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+(template [<query> <check> <type> <tag> <eq> <desc>]
+ [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
(def: #export <query>
{#.doc (code.text ($_ text@compose "Parses the next " <desc> " input."))}
(Parser <type>)
@@ -53,19 +56,19 @@
(#try.Success [tokens' x])
_
- <error>)))
+ <failure>)))
- (def: #export (<assertion> expected)
+ (def: #export (<check> expected)
(-> <type> (Parser Any))
(function (_ tokens)
(case tokens
(#.Cons [[_ (<tag> actual)] tokens'])
(if (:: <eq> = expected actual)
(#try.Success [tokens' []])
- <error>)
+ <failure>)
_
- <error>))))]
+ <failure>))))]
[bit bit! Bit #.Bit bit.equivalence "bit"]
[nat nat! Nat #.Nat nat.equivalence "nat"]
@@ -91,20 +94,33 @@
_
(#try.Failure "There are no tokens to parse!"))))
-(template [<name> <tag> <desc>]
- [(def: #export <name>
- {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
- (Parser Text)
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> ["" x])] tokens'])
- (#try.Success [tokens' x])
+(template [<query> <check> <tag> <eq> <desc>]
+ [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+ (def: #export <query>
+ {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
+ (Parser Text)
+ (function (_ tokens)
+ (case tokens
+ (#.Cons [[_ (<tag> ["" x])] tokens'])
+ (#try.Success [tokens' x])
- _
- (#try.Failure ($_ text@compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+ _
+ <failure>)))
+
+ (def: #export (<check> expected)
+ (-> Text (Parser Any))
+ (function (_ tokens)
+ (case tokens
+ (#.Cons [[_ (<tag> ["" actual])] tokens'])
+ (if (:: <eq> = expected actual)
+ (#try.Success [tokens' []])
+ <failure>)
+
+ _
+ <failure>))))]
- [local-identifier #.Identifier "identifier"]
- [ local-tag #.Tag "tag"]
+ [local-identifier local-identifier! #.Identifier text.equivalence "local identifier"]
+ [ local-tag local-tag! #.Tag text.equivalence "local tag"]
)
(template [<name> <tag> <desc>]
@@ -177,5 +193,5 @@
(All [a] (-> (List Code) (Parser a) (Parser a)))
(function (_ real)
(do try.monad
- [value (run syntax inputs)]
+ [value (..run syntax inputs)]
(wrap [real value]))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 8d3b7b2d5..3e2bbd321 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -65,14 +65,19 @@
(#///analysis.Complex (#///analysis.Tuple tuple))
(let [tuple::last (dec (list.size tuple))]
(list@fold (function (_ [tuple::lefts tuple::member] nextC)
- (let [right? (n.= tuple::last tuple::lefts)
- end?' (and end? right?)]
- (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right?
- (#.Right (dec tuple::lefts))
- (#.Left tuple::lefts)))))))
- (path' tuple::member end?')
- (when> [(new> (not end?') [])] [(///@map ..clean-up)])
- nextC)))
+ (.case tuple::member
+ (#///analysis.Simple #///analysis.Unit)
+ nextC
+
+ _
+ (let [right? (n.= tuple::last tuple::lefts)
+ end?' (and end? right?)]
+ (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right?
+ (#.Right (dec tuple::lefts))
+ (#.Left tuple::lefts)))))))
+ (path' tuple::member end?')
+ (when> [(new> (not end?') [])] [(///@map ..clean-up)])
+ nextC))))
thenC
(list.reverse (list.enumerate tuple))))
))
@@ -81,27 +86,32 @@
(-> Archive Phase Pattern Analysis (Operation Path))
(path' pattern true (///@map (|>> #/.Then) (synthesize archive bodyA))))
-(def: (weave leftP rightP)
+(def: (weave new old)
(-> Path Path Path)
- (with-expansions [<default> (as-is (#/.Alt leftP rightP))]
- (case [leftP rightP]
- [(#/.Seq preL postL)
- (#/.Seq preR postR)]
- (case (weave preL preR)
+ (with-expansions [<default> (as-is (#/.Alt old new))]
+ (case [new old]
+ [_
+ (#/.Alt old-left old-right)]
+ (#/.Alt old-left
+ (weave new old-right))
+
+ [(#/.Seq preN postN)
+ (#/.Seq preO postO)]
+ (case (weave preN preO)
(#/.Alt _)
<default>
- weavedP
- (#/.Seq weavedP (weave postL postR)))
+ woven
+ (#/.Seq woven (weave postN postO)))
[#/.Pop #/.Pop]
- rightP
+ old
(^template [<tag> <eq>]
- [(#/.Test (<tag> leftV))
- (#/.Test (<tag> rightV))]
- (if (<eq> leftV rightV)
- rightP
+ [(#/.Test (<tag> newV))
+ (#/.Test (<tag> oldV))]
+ (if (<eq> newV oldV)
+ old
<default>))
([#/.Bit bit@=]
[#/.I64 "lux i64 ="]
@@ -109,19 +119,19 @@
[#/.Text text@=])
(^template [<access> <side>]
- [(#/.Access (<access> (<side> leftL)))
- (#/.Access (<access> (<side> rightL)))]
- (if (n.= leftL rightL)
- rightP
+ [(#/.Access (<access> (<side> newL)))
+ (#/.Access (<access> (<side> oldL)))]
+ (if (n.= newL oldL)
+ old
<default>))
([#/.Side #.Left]
[#/.Side #.Right]
[#/.Member #.Left]
[#/.Member #.Right])
- [(#/.Bind leftR) (#/.Bind rightR)]
- (if (n.= leftR rightR)
- rightP
+ [(#/.Bind newR) (#/.Bind oldR)]
+ (if (n.= newR oldR)
+ old
<default>)
_
@@ -162,19 +172,12 @@
_
<failure>)))))
-(def: #export (synthesize-case synthesize archive input [headB tailB+])
+(def: #export (synthesize-case synthesize archive input [[headP headA] tailPA+])
(-> Phase Archive Synthesis Match (Operation Synthesis))
- (let [[[lastP lastA] prevsPA] (|> (#.Cons headB tailB+)
- list.reverse
- (case> (#.Cons [lastP lastA] prevsPA)
- [[lastP lastA] prevsPA]
-
- _
- (undefined)))]
- (do {@ ///.monad}
- [lastSP (path archive synthesize lastP lastA)
- prevsSP+ (monad.map @ (product.uncurry (path archive synthesize)) prevsPA)]
- (wrap (/.branch/case [input (list@fold weave lastSP prevsSP+)])))))
+ (do {@ ///.monad}
+ [headSP (path archive synthesize headP headA)
+ tailSP+ (monad.map @ (product.uncurry (path archive synthesize)) tailPA+)]
+ (wrap (/.branch/case [input (list@fold weave headSP tailSP+)]))))
(template: (!masking <variable> <output>)
[[(#///analysis.Bind <variable>)
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 29c34b430..bad67d90a 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -23,7 +23,8 @@
["#/." analysis]
["#/." binary]
["#/." text]
- ["#/." cli]]
+ ["#/." cli]
+ ["#/." code]]
["#." pipe]
["#." reader]
["#." region]
@@ -63,6 +64,7 @@
/parser/binary.test
/parser/text.test
/parser/cli.test
+ /parser/code.test
))
(def: security
diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux
new file mode 100644
index 000000000..696f70265
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/code.lux
@@ -0,0 +1,135 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." function]
+ ["." try]
+ ["<>" parser]]
+ [data
+ ["." bit]
+ ["." name]
+ ["." text ("#@." equivalence)]
+ [number
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
+ [collection
+ ["." list]]]
+ [macro
+ ["." code ("#@." equivalence)]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]})
+
+(template: (!expect <pattern> <value>)
+ (case <value>
+ <pattern>
+ true
+
+ _
+ false))
+
+(def: random-name
+ (Random Name)
+ (random.and (random.unicode 1)
+ (random.unicode 1)))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
+ (`` ($_ _.and
+ (do {@ random.monad}
+ [expected (:: @ map code.bit random.bit)]
+ (_.cover [/.run]
+ (and (|> (/.run /.any (list expected))
+ (!expect (#try.Success _)))
+ (|> (/.run /.any (list))
+ (!expect (#try.Failure _))))))
+ (~~ (template [<query> <check> <random> <code> <equivalence>]
+ [(do {@ random.monad}
+ [expected <random>
+ dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))]
+ ($_ _.and
+ (_.cover [<query>]
+ (|> (/.run <query> (list (<code> expected)))
+ (!expect (^multi (#try.Success actual)
+ (:: <equivalence> = expected actual)))))
+ (_.cover [<check>]
+ (and (|> (/.run (<check> expected) (list (<code> expected)))
+ (!expect (#try.Success [])))
+ (|> (/.run (<check> expected) (list (<code> dummy)))
+ (!expect (#try.Failure _)))))
+ ))]
+
+ [/.any /.this! (:: @ map code.bit random.bit) function.identity code.equivalence]
+ [/.bit /.bit! random.bit code.bit bit.equivalence]
+ [/.nat /.nat! random.nat code.nat nat.equivalence]
+ [/.int /.int! random.int code.int int.equivalence]
+ [/.rev /.rev! random.rev code.rev rev.equivalence]
+ [/.frac /.frac! random.frac code.frac frac.equivalence]
+ [/.text /.text! (random.unicode 1) code.text text.equivalence]
+ [/.identifier /.identifier! ..random-name code.identifier name.equivalence]
+ [/.tag /.tag! ..random-name code.tag name.equivalence]
+ [/.local-identifier /.local-identifier! (random.unicode 1) code.local-identifier text.equivalence]
+ [/.local-tag /.local-tag! (random.unicode 1) code.local-tag text.equivalence]
+ ))
+ (~~ (template [<query> <code>]
+ [(do {@ random.monad}
+ [expected-left random.nat
+ expected-right random.int]
+ (_.cover [<query>]
+ (|> (/.run (<query> (<>.and /.nat /.int))
+ (list (<code> (list (code.nat expected-left)
+ (code.int expected-right)))))
+ (!expect (^multi (#try.Success [actual-left actual-right])
+ (and (:: nat.equivalence = expected-left actual-left)
+ (:: int.equivalence = expected-right actual-right)))))))]
+
+ [/.form code.form]
+ [/.tuple code.tuple]
+ ))
+ (do {@ random.monad}
+ [expected-left random.nat
+ expected-right random.int]
+ (_.cover [/.record]
+ (|> (/.run (/.record (<>.and /.nat /.int))
+ (list (code.record (list [(code.nat expected-left)
+ (code.int expected-right)]))))
+ (!expect (^multi (#try.Success [actual-left actual-right])
+ (and (:: nat.equivalence = expected-left actual-left)
+ (:: int.equivalence = expected-right actual-right)))))))
+ (do {@ random.monad}
+ [expected-local random.nat
+ expected-global random.int]
+ (_.cover [/.local]
+ (|> (/.run (<>.and (/.local (list (code.nat expected-local)) /.nat)
+ /.int)
+ (list (code.int expected-global)))
+ (!expect (^multi (#try.Success [actual-local actual-global])
+ (and (:: nat.equivalence = expected-local actual-local)
+ (:: int.equivalence = expected-global actual-global)))))))
+ (do {@ random.monad}
+ [dummy (:: @ map code.bit random.bit)]
+ (_.cover [/.end?]
+ (|> (/.run (do <>.monad
+ [pre /.end?
+ _ /.any
+ post /.end?]
+ (wrap (and (not pre)
+ post)))
+ (list dummy))
+ (!expect (^multi (#try.Success verdict)
+ verdict)))))
+ (do {@ random.monad}
+ [dummy (:: @ map code.bit random.bit)]
+ (_.cover [/.end!]
+ (and (|> (/.run /.end! (list))
+ (!expect (#try.Success [])))
+ (|> (/.run /.end! (list dummy))
+ (!expect (#try.Failure _))))))
+ ))))
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 d084e0210..2209bf366 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
@@ -2,16 +2,23 @@
[lux #*
["_" test (#+ Test)]
[abstract
+ [hash (#+ Hash)]
["." monad (#+ do)]]
[control
- pipe
+ [pipe (#+ case>)]
["." try ("#@." functor)]]
[data
["." sum]
+ ["." text
+ ["%" format (#+ format)]]
[number
- ["n" nat]]
+ ["n" nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
[collection
- ["." list ("#@." fold monoid)]]]
+ ["." list ("#@." functor fold monoid)]
+ ["." set]]]
[math
["." random (#+ Random) ("#@." monad)]]]
["." // #_
@@ -23,8 +30,8 @@
[extension
["#." bundle]]
["/#" //
- ["#." analysis (#+ Branch Analysis)]
- ["#." synthesis (#+ Synthesis)]
+ ["." analysis (#+ Branch Match Analysis)]
+ ["." synthesis (#+ Path Synthesis)]
[///
["#." reference
[variable (#+ Register)]]
@@ -37,15 +44,15 @@
(do {@ random.monad}
[maskedA //primitive.primitive
temp (|> random.nat (:: @ map (n.% 100)))
- #let [maskA (////analysis.control/case
+ #let [maskA (analysis.control/case
[maskedA
- [[(#////analysis.Bind temp)
- (#////analysis.Reference (////reference.local temp))]
+ [[(#analysis.Bind temp)
+ (#analysis.Reference (////reference.local temp))]
(list)]])]]
(_.cover [/.synthesize-masking]
(|> maskA
(//.phase archive.empty)
- (phase.run [///bundle.empty ////synthesis.init])
+ (phase.run [///bundle.empty synthesis.init])
(try@map (//primitive.corresponds? maskedA))
(try.default false)))))
@@ -55,16 +62,16 @@
[registerA random.nat
inputA //primitive.primitive
outputA //primitive.primitive
- #let [letA (////analysis.control/case
+ #let [letA (analysis.control/case
[inputA
- [[(#////analysis.Bind registerA)
+ [[(#analysis.Bind registerA)
outputA]
(list)]])]]
(_.cover [/.synthesize-let]
(|> letA
(//.phase archive.empty)
- (phase.run [///bundle.empty ////synthesis.init])
- (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
+ (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))
@@ -80,19 +87,19 @@
thenA //primitive.primitive
elseA //primitive.primitive
#let [thenB (: Branch
- [(#////analysis.Simple (#////analysis.Bit true))
+ [(#analysis.Simple (#analysis.Bit true))
thenA])
elseB (: Branch
- [(#////analysis.Simple (#////analysis.Bit false))
+ [(#analysis.Simple (#analysis.Bit false))
elseA])
ifA (if then|else
- (////analysis.control/case [inputA [thenB (list elseB)]])
- (////analysis.control/case [inputA [elseB (list thenB)]]))]]
+ (analysis.control/case [inputA [thenB (list elseB)]])
+ (analysis.control/case [inputA [elseB (list thenB)]]))]]
(_.cover [/.synthesize-if]
(|> ifA
(//.phase archive.empty)
- (phase.run [///bundle.empty ////synthesis.init])
- (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
+ (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))
@@ -101,7 +108,7 @@
false)))))
(def: random-member
- (Random ////synthesis.Member)
+ (Random synthesis.Member)
(do {@ random.monad}
[lefts (|> random.nat (:: @ map (n.% 10)))
right? random.bit]
@@ -110,28 +117,28 @@
(#.Left lefts)))))
(def: random-path
- (Random (////analysis.Tuple ////synthesis.Member))
+ (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]))
+ (-> (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))))
+ (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))
+ (analysis.pattern/tuple
+ (list@compose (list.repeat (inc lefts) (analysis.pattern/unit))
(list inner)))))
- (#////analysis.Bind @member)
+ (#analysis.Bind @member)
(list.reverse path))
@member])))
@@ -139,25 +146,200 @@
Test
(do {@ random.monad}
[recordA (|> random.nat
- (:: @ map (|>> ////analysis.nat))
+ (:: @ map (|>> analysis.nat))
(random.list 10)
- (:: @ map (|>> ////analysis.tuple)))
+ (:: @ map (|>> analysis.tuple)))
pathA ..random-path
[pattern @member] (get-pattern pathA)
- #let [getA (////analysis.control/case [recordA [[pattern
- (#////analysis.Reference (////reference.local @member))]
- (list)]])]]
+ #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])))
+ (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)))))
+(def: random-bit
+ (Random [Path Match])
+ (do {@ random.monad}
+ [test random.bit
+ then random.nat
+ else random.nat]
+ (wrap [(#synthesis.Alt (#synthesis.Seq (synthesis.path/bit test)
+ (#synthesis.Then (synthesis.i64 (.i64 then))))
+ (#synthesis.Seq (synthesis.path/bit (not test))
+ (#synthesis.Then (synthesis.i64 (.i64 else)))))
+ [{#analysis.when (analysis.pattern/bit test)
+ #analysis.then (analysis.nat then)}
+ (list {#analysis.when (analysis.pattern/bit (not test))
+ #analysis.then (analysis.nat else)})]])))
+
+(def: (random-five hash random-element)
+ (All [a] (-> (Hash a) (Random a) (Random [a a a a a])))
+ (|> random-element
+ (random.set hash 5)
+ (:: random.monad map (|>> set.to-list
+ (case> (^ (list s0 s1 s2 s3 s4))
+ [s0 s1 s2 s3 s4]
+
+ _
+ (undefined))))))
+
+(template [<name> <hash> <random> <path> <synthesis> <pattern> <analysis>]
+ [(def: <name>
+ (Random [Path Match])
+ (do {@ random.monad}
+ [[test/0 test/1 test/2 test/3 test/4] (random-five <hash> <random>)
+ [body/0 body/1 body/2 body/3 body/4] (random-five <hash> <random>)]
+ (wrap [($_ #synthesis.Alt
+ (#synthesis.Seq (<path> test/0) (#synthesis.Then (<synthesis> body/0)))
+ (#synthesis.Seq (<path> test/1) (#synthesis.Then (<synthesis> body/1)))
+ (#synthesis.Seq (<path> test/2) (#synthesis.Then (<synthesis> body/2)))
+ (#synthesis.Seq (<path> test/3) (#synthesis.Then (<synthesis> body/3)))
+ (#synthesis.Seq (<path> test/4) (#synthesis.Then (<synthesis> body/4))))
+ [{#analysis.when (<pattern> test/0) #analysis.then (<analysis> body/0)}
+ (list {#analysis.when (<pattern> test/1) #analysis.then (<analysis> body/1)}
+ {#analysis.when (<pattern> test/2) #analysis.then (<analysis> body/2)}
+ {#analysis.when (<pattern> test/3) #analysis.then (<analysis> body/3)}
+ {#analysis.when (<pattern> test/4) #analysis.then (<analysis> body/4)})]])))]
+
+ [random-nat n.hash random.nat (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/nat analysis.nat]
+ [random-int int.hash random.int (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/int analysis.int]
+ [random-rev rev.hash random.rev (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/rev analysis.rev]
+ [random-frac frac.hash random.frac synthesis.path/f64 synthesis.f64 analysis.pattern/frac analysis.frac]
+ [random-text text.hash (random.unicode 1) synthesis.path/text synthesis.text analysis.pattern/text analysis.text]
+ )
+
+(def: random-simple
+ ($_ random.either
+ ..random-bit
+ ..random-nat
+ ..random-int
+ ..random-rev
+ ..random-frac
+ ..random-text
+ ))
+
+(def: random-variant
+ (Random [Path Match])
+ (do {@ random.monad}
+ [[lefts/0 lefts/1 lefts/2 lefts/3 lefts/4] (random-five n.hash random.nat)
+ [value/0 value/1 value/2 value/3 value/4] (random-five text.hash (random.unicode 1))
+ last-is-right? random.bit
+ [body/0 body/1 body/2 body/3 body/4] (random-five frac.hash random.frac)
+ #let [path (: (-> Nat Bit Text Frac Path)
+ (function (_ lefts right? value body)
+ ($_ #synthesis.Seq
+ (synthesis.path/side (if right?
+ (#.Right lefts)
+ (#.Left lefts)))
+ (synthesis.path/text value)
+ (#synthesis.Then (synthesis.f64 body)))))
+ branch (: (-> Nat Bit Text Frac Branch)
+ (function (_ lefts right? value body)
+ {#analysis.when (analysis.pattern/variant {#analysis.lefts lefts
+ #analysis.right? right?
+ #analysis.value (analysis.pattern/text value)})
+ #analysis.then (analysis.frac body)}))]]
+ (wrap [($_ #synthesis.Alt
+ (path lefts/0 false value/0 body/0)
+ (path lefts/1 false value/1 body/1)
+ (path lefts/2 false value/2 body/2)
+ (path lefts/3 false value/3 body/3)
+ (path lefts/4 last-is-right? value/4 body/4))
+ [(branch lefts/0 false value/0 body/0)
+ (list (branch lefts/1 false value/1 body/1)
+ (branch lefts/2 false value/2 body/2)
+ (branch lefts/3 false value/3 body/3)
+ (branch lefts/4 last-is-right? value/4 body/4))]])))
+
+(def: random-tuple
+ (Random [Path Match])
+ (do {@ random.monad}
+ [mid-size (:: @ map (n.% 4) random.nat)
+
+ value/first (random.unicode 1)
+ value/mid (random.list mid-size (random.unicode 1))
+ value/last (random.unicode 1)
+
+ body/first random.frac
+ body/mid (random.list mid-size random.frac)
+ body/last random.frac
+ #let [path (: (-> Nat Bit Text Frac Path)
+ (function (_ lefts right? value body)
+ (if right?
+ ($_ #synthesis.Seq
+ (synthesis.path/member (if right?
+ (#.Right lefts)
+ (#.Left lefts)))
+ (synthesis.path/text value)
+ (#synthesis.Then (synthesis.f64 body)))
+ ($_ #synthesis.Seq
+ (synthesis.path/member (if right?
+ (#.Right lefts)
+ (#.Left lefts)))
+ (synthesis.path/text value)
+ #synthesis.Pop
+ (#synthesis.Then (synthesis.f64 body))))))
+ branch (: (-> Nat Bit Text Frac Branch)
+ (function (_ lefts right? value body)
+ {#analysis.when (if right?
+ (analysis.pattern/tuple (list@compose (list.repeat (inc lefts) (analysis.pattern/unit))
+ (list (analysis.pattern/text value))))
+ (analysis.pattern/tuple ($_ list@compose
+ (list.repeat lefts (analysis.pattern/unit))
+ (list (analysis.pattern/text value)
+ (analysis.pattern/unit)))))
+ #analysis.then (analysis.frac body)}))]]
+ (wrap [(list@fold (function (_ left right)
+ (#synthesis.Alt left right))
+ (path (inc mid-size) true value/last body/last)
+ (|> (list.zip2 value/mid body/mid)
+ (#.Cons [value/first body/first])
+ list.enumerate
+ (list@map (function (_ [lefts' [value body]])
+ (path lefts' false value body)))
+ list.reverse))
+ [(branch 0 false value/first body/first)
+ (list@compose (|> (list.zip2 value/mid body/mid)
+ list.enumerate
+ (list@map (function (_ [lefts' [value body]])
+ (branch (inc lefts') false value body))))
+ (list (branch (inc mid-size) true value/last body/last)))]])))
+
+(def: random-complex
+ ($_ random.either
+ ..random-variant
+ ..random-tuple
+ ))
+
+(def: random-case
+ ($_ random.either
+ ..random-simple
+ ..random-complex
+ ))
+
+(def: case-test
+ Test
+ (do {@ random.monad}
+ [expected-input (:: @ map (|>> .i64 synthesis.i64) random.nat)
+ [expected-path match] ..random-case]
+ (_.cover [/.synthesize-case]
+ (|> (/.synthesize-case //.phase archive.empty expected-input match)
+ (phase.run [///bundle.empty synthesis.init])
+ (case> (^ (#try.Success (synthesis.branch/case [actual-input actual-path])))
+ (and (:: synthesis.equivalence = expected-input actual-input)
+ (:: synthesis.path-equivalence = expected-path actual-path))
+
+ _
+ false)))))
+
(def: #export test
Test
(<| (_.covering /._)
@@ -167,4 +349,5 @@
..let-test
..if-test
..get-test
+ ..case-test
)))