packages feed

code-conjure 0.6.8 → 0.6.10

raw patch · 91 files changed

+791/−297 lines, 91 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Conjure: [maxPatternDepth] :: Args -> Int
+ Conjure.Conjurable: conjureArgumentPatterns :: Conjurable f => Int -> [Expr] -> f -> [[[[Expr]]]]
+ Conjure.Conjurable: conjurePatternsDebug :: Conjurable a => [Expr] -> a -> [[[Expr]]]
+ Conjure.Conjurable: conjurePatternsFor :: Conjurable f => Int -> [Expr] -> f -> Expr -> [[[Expr]]]
+ Conjure.Engine: [maxPatternDepth] :: Args -> Int
+ Conjure.Utils: prods :: [[a]] -> [[a]]
- Conjure: Args :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Args
+ Conjure: Args :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Args
- Conjure.Conjurable: conjurePats :: Conjurable f => [Expr] -> String -> f -> [[[Expr]]]
+ Conjure.Conjurable: conjurePats :: Conjurable f => Int -> [Expr] -> String -> f -> [[[Expr]]]
- Conjure.Engine: Args :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Args
+ Conjure.Engine: Args :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Args

Files

.gitignore view
@@ -62,6 +62,7 @@ eg/bits eg/peano eg/these+eg/tuple bench/carry-on bench/strategies bench/self
Makefile view
@@ -49,6 +49,7 @@   eg/bits \   eg/peano \   eg/these \+  eg/tuple \   bench/candidates \   bench/redundants \   bench/erroneous \
TODO.md view
@@ -3,119 +3,92 @@  A non-exhaustive list of things TO DO for Conjure. -* Better error reporting when `Listable` is out-of-scope when using `deriveConjurable`.-  This needs to be implemented on LeanCheck itself.+* Warn when there are no tests!+  Test this on high order functions.+  Encode `error "could not reify specification"` -* forbid recursion into negatives+* change cannot conjure to "search exhausted",+  to indicate that Conjure has _shown_ that+  there is no way to build the given function+  with the given ingredients up to the given size. -* consider the size of patterns to thin-out each size partition+* Expand tests on `conjurableOK`? -* consider non top-level cases+* Add `test/conjure.hs` with some basic conjuring... +* Fix bug with pairwise in eg/tuple -## Forbid recursion into negatives+* Allow timeout setting? -Instead of reporting:+* Rethink Conjurable typeclass? -	tri 1  =  1-	tri x  =  x + tri (x - 1)+* Rename primitives to ingredients? -Report:+* Allow chains of guards (see below). -	tri 1          =  1-	tri x | x > 1  =  x + tri (x - 1)+* Move `Args` into `[Prim]`? -This is not trivial to implement.-Tentative steps:+* Better error reporting when `Listable` is out-of-scope when using `deriveConjurable`.+  This needs to be implemented on LeanCheck itself. -1. create a `descents` function, similar to `descends`,-   that is able to list the groups of variable that have recursive descents.-   This will somehow need a dummy `isDecOf` function.-   This may require changing the format definitions themselves...-2. use this on `showDefn` somehow-3. use this on `toDynamicWithDefn` somehow+* forbid recursion into negatives (see below) +* Warn when no tests are present somehow? -## Thin-out size partitions -Consider the following two candidates:+## Allow chains of guards -	fib01 x y z  =  dec x+With the use of `guard` right now,+Conjure can generate functions such as the following: -	fib01 x y 0  =  x-	fib01 x y z  =  y+	function x y z+	  | x < 123    =  ...+	  | otherwise  =  ... -They both currently have size 2.-Perhaps the second should be bigger than the first?-"Simple" solution:-consider the number of (extra) patterns as part of the size.+We should probably allow chains of guards such as the following: -See the following two candidates of size 3:+	function x y z+	  | x < 123    =  ...+	  | x == 321   =  ...+	  | y == 12    =  ...+	  | otherwise  =  ... -	fib01 x y z  =  x + x+Internally, these are just chains of if-then-else applications: -	fib01 x y 0  =  x-	fib01 x y z  =  dec x+	function x y z  =  if x < 123+	                   then ...+					   else if x == 321+					   then ...+					   else if y == 12+					   then ...+					   else ... -The same thing can be said.+This change shouldn't be so complicated to introduce+requiring a change in `enumerateAppsFor` relaxing `ufor hx`+depending on what we have on the left... -Now a little bit more complex...-The following two candidates appear at size 3 for fib01: -	fib01 x 0 y  =  x-	fib01 x y 0  =  y-	fib01 x y z  =  0--	fib01 x 0 0  =  x-	fib01 x 0 y  =  y-	fib01 x y z  =  0--Shouldn't these two have different size?-The second feels bigger than the first.-Maybe the size of non-variable patterns should be taken into account.--This relates to the eg/fib01 example.--Also:-see the allowed patterns on the Int functions of two arguments-in bench/candidates.txt.  Search for "allowed patterns".--There are two levels here:--1. considering the number of patterns as part of the size-2. considering the number of non-variable LHS arguments as part of the size--Level 2. is not addressed at all.  But it turns out that level 1. is already-handled at the conjurePatterns function.  The patterns reported with showPatterns-and on bench/candidates already seem to be divided considering the number of-lines...--Something to keep in mind: tiers enumerations have size "0".-If one wants to increase size, one needs to push things to size "1".-So the size is actually being considered.  One would need a delayedProducts to-complete "1.".  Maybe it is better to start investigating from "2."--The enumeration currently works like so:-the size of patterns is defined by the number of patterns that are allowed to-have _another_ option other than a simple variable.-Perhaps these should be thinned-out in post processing to achieve "2."?+## Forbid recursion into negatives +Instead of reporting: -## Non top-level cases+	tri 1  =  1+	tri x  =  x + tri (x - 1) -Consider allowing non top-level cases,-so that functions like the following are reachable:+Report: -	last []  =  undefined-	last [x]  =  x-	last (x:y:xs)  =  last (y:xs)+	tri 1          =  1+	tri x | x > 1  =  x + tri (x - 1) -Perhaps the negative runtime impact would not be so great-given the delayed tiers enumeration,-and we would avoid some `prif` hacks-needed to conjure some functions.+This is not trivial to implement.+Tentative steps: -The one downside is that this would take a few days of work to implement.+1. create a `descents` function, similar to `descends`,+   that is able to list the groups of variable that have recursive descents.+   This will somehow need a dummy `isDecOf` function.+   This may require changing the format definitions themselves...+2. use this on `showDefn` somehow+3. use this on `toDynamicWithDefn` somehow   This file is part of Conjure,
bench/gps.txt view
@@ -339,7 +339,7 @@ gps18 xs ys  =  zipWith (+) xs ys  gps19 :: Int -> [Char] -> [Char]--- testing 2 combinations of argument values+-- testing 3 combinations of argument values -- pruning with 0/0 rules -- 1 candidates of size 1 -- 0 candidates of size 2
bench/gps2.hs view
@@ -3,10 +3,6 @@ -- Copyright (C) 2021-2025 Rudy Matela -- Distributed under the 3-Clause BSD licence (see the file LICENSE). {-# LANGUAGE CPP, TemplateHaskell #-}-#if __GLASGOW_HASKELL__ <= 710-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}-import Data.Typeable-#endif import Conjure import System.Environment (getArgs) @@ -665,15 +661,7 @@               |  Empty               deriving (Eq, Show) -#if __GLASGOW_HASKELL__ <= 710-deriving instance Typeable Twitter--instance Express Twitter where-  expr (Tweet n)  =  value "Tweet" Tweet :$ expr n-  expr t  =  val t-#else deriveExpress  ''Twitter-#endif deriveListable ''Twitter deriveName     ''Twitter
bench/ill-hit.hs view
@@ -2,7 +2,7 @@ -- -- Based on an example sent by Colin Runciman ----- Even though sum' is defined for 6 prims,+-- Even though sum' is defined with 6 equations, -- Conjure only ever hits 4 of them. import Conjure
bench/runtime/lapmatrud/bench/candidates.runtime view
@@ -1,1 +1,1 @@-9.4+9.2
bench/runtime/lapmatrud/bench/erroneous.runtime view
@@ -1,1 +1,1 @@-2.8+2.9
bench/runtime/lapmatrud/bench/gps.runtime view
@@ -1,1 +1,1 @@-14.2+14.7
bench/runtime/lapmatrud/bench/gps2.runtime view
@@ -1,1 +1,1 @@-12.1+11.8
bench/runtime/lapmatrud/bench/ill-hit.runtime view
@@ -1,1 +1,1 @@-0.4+0.5
bench/runtime/lapmatrud/bench/lowtests.runtime view
@@ -1,1 +1,1 @@-0.3+0.4
bench/runtime/lapmatrud/bench/redundants.runtime view
@@ -1,1 +1,1 @@-2.9+3.0
bench/runtime/lapmatrud/bench/strategies.runtime view
@@ -1,1 +1,1 @@-4.4+4.6
bench/runtime/lapmatrud/bench/terpret.runtime view
@@ -1,1 +1,1 @@-7.5+7.3
bench/runtime/lapmatrud/bench/unique.runtime view
@@ -1,1 +1,1 @@-2.1+2.4
bench/runtime/lapmatrud/bench/weird.runtime view
@@ -1,1 +1,1 @@-2.6+2.5
bench/runtime/lapmatrud/eg/bits.runtime view
@@ -1,1 +1,1 @@-3.1+3.0
bench/runtime/lapmatrud/eg/bools.runtime view
@@ -1,1 +1,1 @@-1.3+1.6
bench/runtime/lapmatrud/eg/bst.runtime view
@@ -1,1 +1,1 @@-7.4+4.3
bench/runtime/lapmatrud/eg/count.runtime view
@@ -1,1 +1,1 @@-0.2+0.5
bench/runtime/lapmatrud/eg/dupos.runtime view
@@ -1,1 +1,1 @@-3.1+1.9
bench/runtime/lapmatrud/eg/factorial.runtime view
@@ -1,1 +1,1 @@-1.2+1.4
bench/runtime/lapmatrud/eg/fib01.runtime view
@@ -1,1 +1,1 @@-0.7+0.5
bench/runtime/lapmatrud/eg/fibonacci.runtime view
@@ -1,1 +1,1 @@-2.9+3.2
bench/runtime/lapmatrud/eg/gcd.runtime view
@@ -1,1 +1,1 @@-0.1+0.2
bench/runtime/lapmatrud/eg/higher.runtime view
@@ -1,1 +1,1 @@-0.6+0.8
bench/runtime/lapmatrud/eg/list.runtime view
@@ -1,1 +1,1 @@-0.5+0.6
bench/runtime/lapmatrud/eg/maybe.runtime view
@@ -1,1 +1,1 @@-0.2+0.3
bench/runtime/lapmatrud/eg/oddeven.runtime view
@@ -1,1 +1,1 @@-1.4+1.5
bench/runtime/lapmatrud/eg/pow.runtime view
@@ -1,1 +1,1 @@-3.8+2.8
bench/runtime/lapmatrud/eg/setelem.runtime view
@@ -1,1 +1,1 @@-0.7+0.8
bench/runtime/lapmatrud/eg/sort.runtime view
@@ -1,1 +1,1 @@-3.3+3.1
bench/runtime/lapmatrud/eg/spec.runtime view
@@ -1,1 +1,1 @@-0.6+0.8
bench/runtime/lapmatrud/eg/subset.runtime view
@@ -1,1 +1,1 @@-0.4+0.6
bench/runtime/lapmatrud/eg/take-drop.runtime view
@@ -1,1 +1,1 @@-0.2+0.3
bench/runtime/lapmatrud/eg/these.runtime view
@@ -1,1 +1,1 @@-1.1+1.7
bench/runtime/lapmatrud/eg/tree.runtime view
@@ -1,1 +1,1 @@-1.3+1.4
bench/runtime/lapmatrud/eg/tri.runtime view
@@ -1,1 +1,1 @@-0.3+0.2
+ bench/runtime/lapmatrud/eg/tuple.runtime view
@@ -0,0 +1,1 @@+0.5
bench/runtime/zero/bench/candidates.runtime view
@@ -1,1 +1,1 @@-18.1+17.8
bench/runtime/zero/bench/carry-on.runtime view
@@ -1,1 +1,1 @@-4.9+4.6
bench/runtime/zero/bench/erroneous.runtime view
@@ -1,1 +1,1 @@-6.1+5.7
bench/runtime/zero/bench/gps.runtime view
@@ -1,1 +1,1 @@-28.1+28.7
bench/runtime/zero/bench/gps2.runtime view
@@ -1,1 +1,1 @@-23.2+23.6
bench/runtime/zero/bench/ill-hit.runtime view
@@ -1,1 +1,1 @@-0.9+1.0
bench/runtime/zero/bench/p30.runtime view
@@ -1,1 +1,1 @@-0.1+0.0
bench/runtime/zero/bench/redundants.runtime view
@@ -1,1 +1,1 @@-6.6+6.3
bench/runtime/zero/bench/strategies.runtime view
@@ -1,1 +1,1 @@-9.4+8.9
bench/runtime/zero/bench/unique.runtime view
@@ -1,1 +1,1 @@-4.9+4.8
bench/runtime/zero/bench/weird.runtime view
@@ -1,1 +1,1 @@-4.8+4.9
bench/runtime/zero/eg/arith.runtime view
@@ -1,1 +1,1 @@-1.9+2.0
bench/runtime/zero/eg/bools.runtime view
@@ -1,1 +1,1 @@-3.0+3.3
bench/runtime/zero/eg/bst.runtime view
@@ -1,1 +1,1 @@-9.0+8.6
bench/runtime/zero/eg/count.runtime view
@@ -1,1 +1,1 @@-1.0+1.1
bench/runtime/zero/eg/dupos.runtime view
@@ -1,1 +1,1 @@-3.6+3.8
bench/runtime/zero/eg/fib01.runtime view
@@ -1,1 +1,1 @@-1.0+1.1
bench/runtime/zero/eg/fibonacci.runtime view
@@ -1,1 +1,1 @@-6.1+6.3
bench/runtime/zero/eg/higher.runtime view
@@ -1,1 +1,1 @@-1.6+1.8
bench/runtime/zero/eg/ints.runtime view
@@ -1,1 +1,1 @@-1.0+1.1
bench/runtime/zero/eg/maybe.runtime view
@@ -1,1 +1,1 @@-0.6+0.8
bench/runtime/zero/eg/oddeven.runtime view
@@ -1,1 +1,1 @@-2.8+2.9
bench/runtime/zero/eg/peano.runtime view
@@ -1,1 +1,1 @@-0.5+0.6
bench/runtime/zero/eg/pow.runtime view
@@ -1,1 +1,1 @@-5.0+5.2
bench/runtime/zero/eg/setelem.runtime view
@@ -1,1 +1,1 @@-1.4+1.5
bench/runtime/zero/eg/spec.runtime view
@@ -1,1 +1,1 @@-1.7+1.6
bench/runtime/zero/eg/these.runtime view
@@ -1,1 +1,1 @@-1.6+3.5
bench/runtime/zero/eg/tree.runtime view
@@ -1,1 +1,1 @@-2.8+2.7
+ bench/runtime/zero/eg/tuple.runtime view
@@ -0,0 +1,1 @@+0.9
changelog.md view
@@ -2,6 +2,18 @@ ============================  +v0.6.10 (February 2025)+-----------------------++* fix bug preventing Conjure to work in the presence of argument types+  whose tiers enumeration would have no values of the first tier+* allow configuring `maxPatternDepth`.  Default 1, interesting 2.+* slightly increase default `maxSearchTests`+* slight improvements in performance by improve memo tables+* improve internal tests+* add `eg/tuple`++ v0.6.8 (February 2025) ----------------------
code-conjure.cabal view
@@ -3,7 +3,7 @@ -- Copyright (C) 2021-2025 Rudy Matela -- Distributed under the 3-Clause BSD licence (see the file LICENSE). name:                code-conjure-version:             0.6.8+version:             0.6.10 synopsis:            synthesize Haskell functions out of partial definitions description:   Conjure is a tool that synthesizes Haskell functions out of partial definitions.@@ -69,7 +69,7 @@ source-repository this   type:            git   location:        https://github.com/rudymatela/conjure-  tag:             v0.6.8+  tag:             v0.6.10  library   exposed-modules: Conjure
eg/bst.hs view
@@ -71,11 +71,12 @@ mem y (Node l x r)  =  y == x || (if y < x then mem y l else mem y r)  insert :: Int -> Tree -> Tree-insert x Leaf  =  unit x-insert x (Node l y r)  =  case compare x y of-  LT -> Node (insert x l) y r-  EQ -> Node l y r-  GT -> Node l y (insert x r)+insert x Leaf          =  unit x  -- 2+insert x (Node l y r)  =+  case compare x y of             -- 6+  LT -> Node (insert x l) y r     -- 12+  EQ -> Node l y r                -- 16+  GT -> Node l y (insert x r)     -- 22  before :: Int -> Tree -> Tree before _ Leaf  =  Leaf@@ -145,11 +146,9 @@     , primOrdCaseFor (undefined :: Tree)     ] -  -- reachable in 15s after 32878 at size 14.-  -- out of reach performance-wise (reaching 16 but need 19)-  -- cf. the primOrdCaseFor version below+  -- reachable in 15s, candidate #32878 at size 14.   -- increase target to 50400 to reach...-  conjureFromSpecWith args{target=10080} "before" beforeSpec+  conjureFromSpecWith args{target=5040} "before" beforeSpec     [ pr Leaf     , prim "Node" Node     , prim "==" ((==) :: Int -> Int -> Bool)@@ -157,6 +156,16 @@     , guard     ] +  -- reachable in 14s, candidate #32747 at size 14.+  -- increase target to 50400 to reach...+  conjureFromSpecWith args{target=5040} "beyond" beyondSpec+    [ pr Leaf+    , prim "Node" Node+    , prim "==" ((==) :: Int -> Int -> Bool)+    , prim "<=" ((<) :: Int -> Int -> Bool)+    , guard+    ]+   -- with 15, this reaches the solution, using 12 for shorter runtime   -- using maxEquationSize = 7 reduces runtime from 13s to 11s   conjureFromSpecWith args{maxSize = 12, maxEquationSize = 7} "before" beforeSpec@@ -175,8 +184,9 @@     , primOrdCaseFor (undefined :: Tree)     ] -  -- out of reach (reaching 12 but need 13)-  conjureWith args{maxSize = 9} "union" union+  -- reachable in 55s, candidate #173109 at size 13.+  -- increase to 554400 to reach+  conjureWith args{target=5544} "union" union     [ pr Leaf     , prim "Node" Node     , prim "before" before
eg/bst.txt view
@@ -70,11 +70,25 @@ -- 104 candidates of size 9 -- 1342 candidates of size 10 -- 3543 candidates of size 11--- 2552 candidates of size 12--- 23874 candidates of size 13--- tested 31769 candidates+-- tested 5343 candidates cannot conjure +beyond :: Int -> Tree -> Tree+-- pruning with 5/6 rules+-- 2 candidates of size 1+-- 2 candidates of size 2+-- 0 candidates of size 3+-- 4 candidates of size 4+-- 21 candidates of size 5+-- 0 candidates of size 6+-- 86 candidates of size 7+-- 239 candidates of size 8+-- 104 candidates of size 9+-- 1342 candidates of size 10+-- 3543 candidates of size 11+-- tested 5343 candidates+cannot conjure+ before :: Int -> Tree -> Tree -- pruning with 2/4 rules -- 2 candidates of size 1@@ -121,6 +135,7 @@ -- 240 candidates of size 7 -- 82 candidates of size 8 -- 3018 candidates of size 9--- tested 3433 candidates+-- 8098 candidates of size 10+-- tested 11531 candidates cannot conjure
eg/count.hs view
@@ -1,4 +1,6 @@--- count.hs: elem and set functions+-- count.hs: conjuring an element count function+--+-- 2021-2025 Rudy Matela import Conjure  -- an idiomatic count without using filter
eg/list.hs view
@@ -86,6 +86,12 @@     , prim "undefined" (undefined :: Int)     ] +  conjureWith args{maxPatternDepth=2} "last" last'+    [ pr ([] :: [Int])+    , prim ":" ((:) :: Int -> [Int] -> [Int])+    , prim "undefined" (undefined :: Int)+    ]+   conjure "zip" (zip')     [ pr ([] :: [(Int,Int)])     , prim ":" ((:) :: (Int,Int) -> [(Int,Int)] -> [(Int,Int)])
eg/list.txt view
@@ -63,6 +63,20 @@   | null xs  =  x   | otherwise  =  last xs +last :: [Int] -> Int+-- testing 360 combinations of argument values+-- pruning with 0/0 rules+-- 1 candidates of size 1+-- 0 candidates of size 2+-- 0 candidates of size 3+-- 1 candidates of size 4+-- 2 candidates of size 5+-- 2 candidates of size 6+-- tested 5 candidates+last []  =  undefined+last [x]  =  x+last (x:y:xs)  =  last (y:xs)+ zip :: [Int] -> [Int] -> [(Int,Int)] -- testing 360 combinations of argument values -- pruning with 0/0 rules
eg/maybe.hs view
@@ -56,7 +56,7 @@   conjure "maybeToList"   maybeToList' primitives    -- only top-level break downs, so would need morePrimitives-  conjure "catMaybes"     catMaybes'   primitives+  conjureWith args{maxPatternDepth=2} "catMaybes"     catMaybes'   primitives   -- conjure "mapMaybe" mapMaybe' primitives  -- same  primitives :: [Prim]
eg/maybe.txt view
@@ -60,6 +60,13 @@ -- pruning with 0/0 rules -- 1 candidates of size 1 -- 0 candidates of size 2--- tested 1 candidates-cannot conjure+-- 0 candidates of size 3+-- 0 candidates of size 4+-- 0 candidates of size 5+-- 1 candidates of size 6+-- 2 candidates of size 7+-- tested 3 candidates+catMaybes []  =  []+catMaybes (Nothing:mxs)  =  catMaybes mxs+catMaybes (Just x:mxs)  =  x:catMaybes mxs
eg/these.hs view
@@ -7,8 +7,8 @@  -- This was inspired by the These datatype from the cathis package. -- https://hackage.haskell.org/package/cathis--- This is an extension of the type there with the added None constructor.-data These a b  =  None | This a | That b | These a b+-- This is an extension of the type there with the added Neither constructor.+data These a b  =  Neither | This a | That b | These a b   deriving (Eq, Ord, Show, Read)  isThis :: These a b -> Bool@@ -34,7 +34,7 @@   fromThese' :: A -> B -> These A B -> (A, B)-fromThese' 0 1 None  =  (0, 1)+fromThese' 0 1 Neither  =  (0, 1) fromThese' 0 1 (This 2)  =  (2,1) fromThese' 0 1 (That 2)  =  (0,2) fromThese' 0 1 (These 1 0)  =  (1,0)@@ -45,22 +45,29 @@ listhese' (That 2)  =  [2]  cathis' :: [These A B] -> [A]+cathis' []  =  [] cathis' [This 0, This 1]  =  [0,1]-cathis' [None, That 0]  =  []-cathis' [This 0, None, That 1]  =  [0]+cathis' [Neither, That 0]  =  []+cathis' [That 0, This 1]  =  [1]+cathis' [This 0, Neither, That 1]  =  [0] cathis' [This 0, These 0 1]  =  [0,0]-cathis' [These 0 1, None, This 0]  =  [0,0]+cathis' [These 0 1, Neither, This 0]  =  [0,0]+cathis' [These 0 1, This 2]  =  [0,2]  cathat' :: [These A B] -> [B]+cathat' []  =  [] cathat' [This 0, This 1]  =  []-cathat' [None, That 0]  =  [0]-cathat' [This 0, None, That 1]  =  [1]+cathat' [Neither, That 0]  =  [0]+cathat' [This 0, Neither, That 1]  =  [1] cathat' [That 0, These 0 1]  =  [0,1]+cathat' [These 0 1, That 0]  =  [1,0]  cathese' :: [These A A] -> [A]+cathese' []  =  [] cathese' [This 0, This 1]  =  [0,1]-cathese' [None, That 0]  =  [0]-cathese' [This 0, None, That 1]  =  [0,1]+cathese' [Neither, That 0]  =  [0]+cathese' [That 0, This 1]  =  [0,1]+cathese' [This 0, Neither, That 1]  =  [0,1] cathese' [This 0, These 0 1]  =  [0,0,1] cathese' [These 0 1, That 2]  =  [0,1,2] @@ -91,21 +98,22 @@     , guard     ] -  -- couldn't make this reachable, I didn't try much...-  conjureWith args{target = 1080} "cathese" cathese'+  conjureWith args{maxPatternDepth = 2} "cathis" cathis'     [ pr ([] :: [A])     , prim ":" ((:) :: A -> [A] -> [A])-    , prim "++" ((++) :: [A] -> [A] -> [A])-    , prim "isThis" (isThis :: These A A -> Bool)-    , prim "fromThis" (fromThis :: These A A -> A)-    , prim "isThat" (isThat :: These A A -> Bool)-    , prim "fromThat" (fromThat :: These A A -> A)-    -- , prif (undefined :: A)-    -- , prif (undefined :: [A])-    , guard     ]-  -- expected functionality-  -- these []  =  []-  -- these (This x : ts)  =  x : these ts-  -- these (That y : ts)  =  y : these ts-  -- these (These x y : ts)  =  x : y : these ts++  conjureWith args{maxPatternDepth = 2} "cathat" cathat'+    [ pr ([] :: [B])+    , prim ":" ((:) :: B -> [B] -> [B])+    ]++  conjureWith args{maxPatternDepth = 2} "cathese" cathese'+    [ pr ([] :: [A])+    , prim ":" ((:) :: A -> [A] -> [A])+    ]+  -- cathese []  =  []+  -- cathese (Neither : ts)  =  cathese ts+  -- cathese (This x : ts)  =  x : these ts+  -- cathese (That y : ts)  =  y : these ts+  -- cathese (These x y : ts)  =  x : y : these ts
eg/these.txt view
@@ -12,7 +12,7 @@ -- 0 candidates of size 9 -- 1 candidates of size 10 -- tested 2 candidates-fromThese x y None  =  (x,y)+fromThese x y Neither  =  (x,y) fromThese x y (This z)  =  (z,y) fromThese x y (That z)  =  (x,z) fromThese x y (These z x')  =  (z,x')@@ -31,13 +31,13 @@ -- 0 candidates of size 9 -- 1 candidates of size 10 -- tested 2 candidates-listhese None  =  []-listhese (This x)  =  [x]+listhese Neither  =  [] listhese (That x)  =  [x]+listhese (This x)  =  [x] listhese (These x y)  =  [x,y]  cathis :: [These A B] -> [A]--- testing 5 combinations of argument values+-- testing 8 combinations of argument values -- pruning with 3/3 rules -- 1 candidates of size 1 -- 0 candidates of size 2@@ -57,7 +57,7 @@   | otherwise  =  cathis ts  cathat :: [These A B] -> [B]--- testing 4 combinations of argument values+-- testing 6 combinations of argument values -- pruning with 3/3 rules -- 1 candidates of size 1 -- 0 candidates of size 2@@ -76,27 +76,70 @@   | isThat t  =  fromThat t:cathat ts   | otherwise  =  cathat ts -cathese :: [These A A] -> [A]--- testing 5 combinations of argument values--- pruning with 7/7 rules+cathis :: [These A B] -> [A]+-- testing 8 combinations of argument values+-- pruning with 0/0 rules -- 1 candidates of size 1 -- 0 candidates of size 2 -- 0 candidates of size 3 -- 0 candidates of size 4 -- 0 candidates of size 5--- 3 candidates of size 6--- 4 candidates of size 7+-- 0 candidates of size 6+-- 0 candidates of size 7 -- 2 candidates of size 8--- 9 candidates of size 9--- 20 candidates of size 10--- 22 candidates of size 11--- 35 candidates of size 12--- 84 candidates of size 13--- 86 candidates of size 14--- 137 candidates of size 15--- 324 candidates of size 16--- 346 candidates of size 17--- 511 candidates of size 18--- tested 1584 candidates-cannot conjure+-- 6 candidates of size 9+-- 7 candidates of size 10+-- 13 candidates of size 11+-- tested 18 candidates+cathis []  =  []+cathis (Neither:ts)  =  cathis ts+cathis (This x:ts)  =  x:cathis ts+cathis (That x:ts)  =  cathis ts+cathis (These x y:ts)  =  x:cathis ts++cathat :: [These A B] -> [B]+-- testing 6 combinations of argument values+-- pruning with 0/0 rules+-- 1 candidates of size 1+-- 0 candidates of size 2+-- 0 candidates of size 3+-- 0 candidates of size 4+-- 0 candidates of size 5+-- 0 candidates of size 6+-- 0 candidates of size 7+-- 0 candidates of size 8+-- 2 candidates of size 9+-- 4 candidates of size 10+-- 3 candidates of size 11+-- tested 9 candidates+cathat []  =  []+cathat (Neither:ts)  =  cathat ts+cathat (This x:ts)  =  cathat ts+cathat (That x:ts)  =  x:cathat ts+cathat (These x y:ts)  =  y:cathat ts++cathese :: [These A A] -> [A]+-- testing 7 combinations of argument values+-- pruning with 0/0 rules+-- 1 candidates of size 1+-- 0 candidates of size 2+-- 0 candidates of size 3+-- 0 candidates of size 4+-- 0 candidates of size 5+-- 0 candidates of size 6+-- 0 candidates of size 7+-- 0 candidates of size 8+-- 4 candidates of size 9+-- 8 candidates of size 10+-- 11 candidates of size 11+-- 38 candidates of size 12+-- 26 candidates of size 13+-- 140 candidates of size 14+-- 57 candidates of size 15+-- tested 269 candidates+cathese []  =  []+cathese (Neither:ts)  =  cathese ts+cathese (That x:ts)  =  x:cathese ts+cathese (This x:ts)  =  x:cathese ts+cathese (These x y:ts)  =  x:y:cathese ts
+ eg/tuple.hs view
@@ -0,0 +1,116 @@+-- tuple.hs: conjuring functions involving tuples+--+-- 2025 Rudy Matela+-- Distributed under a 3-Clause BSD licence (see the file LICENSE).+import Conjure+import Test.LeanCheck+++-- First, all functions from Data.Tuple+-- Though their types have been simplified to (A, A),+-- they might as well have had (A, B), (B, A), etc in types.+-- This makes it to use a single background primitives list for everything.++fst' :: (A,A) -> A+fst' (0,1)  =  0+fst' (1,0)  =  1+fst' (0,2)  =  0+fst' (2,1)  =  2++snd' :: (A,A) -> A+snd' (0,1)  =  1+snd' (1,0)  =  0+snd' (0,2)  =  2+snd' (2,1)  =  1++swap' :: (A,A) -> (A,A)+swap' (0,1)  =  (1,0)+swap' (1,0)  =  (0,1)+swap' (2,1)  =  (1,2)+swap' (1,2)  =  (2,1)++type Curry a b c  =  ((a,b) -> c) -> (a -> b -> c)++currySpec :: Curry A A A -> Bool+currySpec curry  =  and+  [ holds n $ \x y -> curry fst x y == x+  , holds n $ \x y -> curry snd x y == y+  , holds n $ \x y -> curry (\(i,j) -> i + j) x y == x + y+  ]+  where+  n = 360++type Uncurry a b c  =  (a -> b -> c) -> ((a,b) -> c)++uncurrySpec :: Uncurry A A A -> Bool+uncurrySpec uncurry  =  and+  [ holds n $ \x y -> uncurry (+) (x,y) == x + y+  , holds n $ \x y -> uncurry (*) (x,y) == x * y+  ]+  where+  n = 360+++-- now two functions that are a bit more interesting:++pairwise :: [A] -> [(A,A)]+pairwise []  =  []+-- pairwise [x]  =  []+pairwise [x,y]  =  [(x,y)]+-- pairwise [x,y,z]  =  [] -- TODO: why this does not work+pairwise [x,y,z,w]  =  [(x,y), (z,w)]+-- pairwise [0,1,2,3]  =  [(0,1), (2,3)]+-- pairwise [0,1,0,1]  =  [(0,1), (0,1)]+-- pairwise [0,0,0,0,0]  =  [(0,0), (0,0)]+-- pairwise [0,0,0,0,0,0]  =  [(0,0), (0,0), (0,0)]++catpairs :: [(A,A)] -> [A]+catpairs [(x,y)]  =  [x,y]+catpairs [(x,y), (z,w)]  =  [x,y,z,w]++main :: IO ()+main = do+  -- the following 5 are pretty easy to Conjure:+  conjure "fst"  fst'   []+  conjure "snd"  snd'   []+  conjure "swap" swap'  primitives+  conjureFromSpec "curry"     currySpec primitives+  conjureFromSpec "uncurry" uncurrySpec primitives++  -- these are more interesting:+  conjure "pairwise" pairwise primitives+  conjure "catpairs" catpairs primitives++  -- by increasing the pattern depth, we find shorter versions:+  conjureWith args{maxPatternDepth=2} "pairwise" pairwise primitives+  conjureWith args{maxPatternDepth=2} "catpairs" catpairs primitives++primitives :: [Prim]+primitives  =+  -- pairs+  [ prim "," ((,) :: A -> A -> (A,A))+  , prim "fst" (fst :: (A,A) -> A)+  , prim "snd" (snd :: (A,A) -> A)++  -- lists+  , prim "[]" ([] :: [A])+  , prim ":" ((:) :: A -> [A] -> [A])+  , prim "null" (null :: [A] -> Bool)+  , prim "head" (head :: [A] -> A)+  , prim "tail" (tail :: [A] -> [A])++  -- lists of pairs+  , prim "[]" ([] :: [(A,A)])+  , prim ":" ((:) :: (A,A) -> [(A,A)] -> [(A,A)])++  -- allow guards+  , guard+  ]++-- expected pairwise+-- TODO: this appears in showCandidates but is not selected for some reason...+pw :: [A] -> [(A,A)]+pw []  =  []+pw (x:xs)+  | null xs  =  []+  | otherwise  =  (x,head xs) : pw (tail xs)
+ eg/tuple.txt view
@@ -0,0 +1,107 @@+fst :: (A,A) -> A+-- testing 4 combinations of argument values+-- pruning with 0/0 rules+-- 0 candidates of size 1+-- 1 candidates of size 2+-- tested 1 candidates+fst (x,y)  =  x++snd :: (A,A) -> A+-- testing 4 combinations of argument values+-- pruning with 0/0 rules+-- 0 candidates of size 1+-- 1 candidates of size 2+-- tested 1 candidates+snd (x,y)  =  y++swap :: (A,A) -> (A,A)+-- testing 4 combinations of argument values+-- pruning with 10/10 rules+-- 1 candidates of size 1+-- 0 candidates of size 2+-- 0 candidates of size 3+-- 1 candidates of size 4+-- tested 2 candidates+swap (x,y)  =  (y,x)++curry :: ((A,A) -> A) -> A -> A -> A+-- pruning with 10/10 rules+-- 2 candidates of size 1+-- 2 candidates of size 2+-- 2 candidates of size 3+-- 6 candidates of size 4+-- tested 8 candidates+curry f x y  =  f (x,y)++uncurry :: (A -> A -> A) -> (A,A) -> A+-- pruning with 10/10 rules+-- 0 candidates of size 1+-- 4 candidates of size 2+-- 0 candidates of size 3+-- 4 candidates of size 4+-- tested 6 candidates+uncurry f (x,y)  =  f x y++pairwise :: [A] -> [(A,A)]+-- testing 360 combinations of argument values+-- pruning with 10/10 rules+-- 1 candidates of size 1+-- 0 candidates of size 2+-- 0 candidates of size 3+-- 0 candidates of size 4+-- 0 candidates of size 5+-- 0 candidates of size 6+-- 7 candidates of size 7+-- 19 candidates of size 8+-- 34 candidates of size 9+-- tested 36 candidates+pairwise []  =  []+pairwise (x:xs)  =  (x,head xs):pairwise (tail xs)++catpairs :: [(A,A)] -> [A]+-- testing 360 combinations of argument values+-- pruning with 12/13 rules+-- 1 candidates of size 1+-- 1 candidates of size 2+-- 1 candidates of size 3+-- 3 candidates of size 4+-- 5 candidates of size 5+-- 11 candidates of size 6+-- 22 candidates of size 7+-- 46 candidates of size 8+-- 106 candidates of size 9+-- tested 124 candidates+catpairs []  =  []+catpairs (xy:xys)  =  fst xy:snd xy:catpairs xys++pairwise :: [A] -> [(A,A)]+-- testing 360 combinations of argument values+-- pruning with 10/10 rules+-- 1 candidates of size 1+-- 0 candidates of size 2+-- 0 candidates of size 3+-- 0 candidates of size 4+-- 0 candidates of size 5+-- 0 candidates of size 6+-- 7 candidates of size 7+-- 26 candidates of size 8+-- tested 23 candidates+pairwise []  =  []+pairwise [x]  =  []+pairwise (x:y:xs)  =  (x,y):pairwise xs++catpairs :: [(A,A)] -> [A]+-- testing 360 combinations of argument values+-- pruning with 12/13 rules+-- 1 candidates of size 1+-- 1 candidates of size 2+-- 1 candidates of size 3+-- 3 candidates of size 4+-- 6 candidates of size 5+-- 15 candidates of size 6+-- 31 candidates of size 7+-- 68 candidates of size 8+-- tested 97 candidates+catpairs []  =  []+catpairs ((x,y):xys)  =  x:y:catpairs xys+
mk/depend.mk view
@@ -802,6 +802,23 @@   src/Conjure/Conjurable.hs \   src/Conjure/Conjurable/Derive.hs \   eg/tri.hs+eg/tuple: \+  eg/tuple.hs \+  mk/toplibs+eg/tuple.o: \+  src/Conjure/Utils.hs \+  src/Conjure/Red.hs \+  src/Conjure/Reason.hs \+  src/Conjure/Prim.hs \+  src/Conjure.hs \+  src/Conjure/Expr.hs \+  src/Conjure/Engine.hs \+  src/Conjure/Defn/Test.hs \+  src/Conjure/Defn/Redundancy.hs \+  src/Conjure/Defn.hs \+  src/Conjure/Conjurable.hs \+  src/Conjure/Conjurable/Derive.hs \+  eg/tuple.hs mk/All.o: \   src/Conjure/Utils.hs \   src/Conjure/Red.hs \@@ -863,6 +880,8 @@   src/Conjure/Defn/Test.hs \   src/Conjure/Defn.hs \   src/Conjure/Conjurable.hs+src/Conjure/Engine: \+  mk/toplibs src/Conjure/Engine.o: \   src/Conjure/Utils.hs \   src/Conjure/Red.hs \
mk/haskell.mk view
@@ -69,6 +69,10 @@ %.hugs: %.hs 	$(HUGSCMD) $< +.PHONY: %.runhaskell+%.runhaskell: %.hs+	$(GHCCMD) -O0 --run $<+ .PHONY: %.runhugs %.runhugs: %.hs 	$(RUNHUGSCMD) $<
src/Conjure/Conjurable.hs view
@@ -44,6 +44,9 @@   , conjureArgumentPats   , conjureMostGeneralCanonicalVariation   , conjureCasesFor+  , conjurePatternsFor+  , conjureArgumentPatterns+  , conjurePatternsDebug   ) where @@ -390,14 +393,10 @@ -- | Compute 'tiers' of values encoded as 'Expr's --   of the type of the given 'Expr'. conjureTiersFor :: Conjurable f => f -> Expr -> [[Expr]]-conjureTiersFor f e  =  tf allTiers-  where-  allTiers :: [ [[Expr]] ]-  allTiers  =  [etiers | (_,_,Just etiers,_,_,_) <- conjureReification f]-  tf []  =  [[e]] -- no tiers found, keep variable-  tf (etiers:etc)  =  case etiers of-                      ((e':_):_) | typ e' == typ e -> etiers-                      _                            -> tf etc+conjureTiersFor f e  =+  case [metiers | (eh,_,metiers,_,_,_) <- conjureReification f, typ e == typ eh] of+  (Nothing:_) -> [[e]] -- no tiers found, keep variable+  (Just etiers:_) -> etiers  conjureGrounds :: Conjurable f => f -> Expr -> [Expr] conjureGrounds  =  grounds . conjureTiersFor@@ -695,12 +694,12 @@  -- | Computes tiers of sets of patterns for the given function. ----- > > conjurePats [zero] "f" (undefined :: Int -> Int)+-- > > conjurePats 1 [zero] "f" (undefined :: Int -> Int) -- > [[[f x :: Int]],[[f 0 :: Int,f x :: Int]]]-conjurePats :: Conjurable f => [Expr] -> String -> f -> [[ [Expr] ]]-conjurePats  es nm f  =  mapT (map mkApp)-                      $  combinePatternOptions-                      $  conjureArgumentPats es f+conjurePats :: Conjurable f => Int -> [Expr] -> String -> f -> [[ [Expr] ]]+conjurePats d es nm f  =  mapT (map mkApp)+                       $  combinePatternOptions+                       $  conjureArgumentPatterns d es f   where   mkApp  =  foldApp . (ef:)          .  unfold@@ -781,6 +780,82 @@ --       but may be useful in the future if we decide to handle --       non-top-level case breakdowns. --       It can be used in building a replacement for conjureArgumentPats+++-- | Towards a replacement for conjurePats that allows non-top-level breakdowns...+--+-- This function is currently experimental and unused in Conjure.+--+-- > > conjurePatternsFor (undefined :: [Int] -> ()) (is_)+-- > [ [ [ _ ] ]+-- > , [ [ [], (_:_) ] ]+-- > , [ [ [], [_], (_:_:_) ] ]+-- > , [ [ [], [_], [_,_], (_:_:_:_) ] ]+-- > , ...+-- > ]+--+-- > > let mis_ = hole (undefined :: [Maybe Int])+-- > > conjurePatternsFor (undefined :: [Maybe Int] -> ()) mis_+-- > [ [ [ _ ] ]+-- > , [ [ [], (_:_) ]+-- > , [ [ [], (Nothing:_), (Just _:_) ]+-- >   , [ [], [_], (_:_:_) ] ]+-- > , [ [ [], [Nothing], [Just _], (_:_:_) ] ]+-- > , ...+-- > ]+--+-- Ints are /crudely/ supported+--+-- > ghci> putLL 4 $ conjurePatternsDebug [zero] (undefined :: [Int])+-- > [_ :: [Int]]+-- >+-- > [[] :: [Int],_:_ :: [Int]]+-- >+-- > [[] :: [Int],[_] :: [Int],_:_:_ :: [Int]]+-- > [[] :: [Int],_:_ :: [Int],0:_ :: [Int]]+conjurePatternsFor :: Conjurable f => Int -> [Expr] -> f -> Expr -> [[ [Expr] ]]+conjurePatternsFor d es f  =  cpf d . holeAsTypeOf+  where+  casesFor  =  conjureCasesFor f+  cpf :: Int -> Expr -> [[ [Expr] ]]+  cpf d h+    | d == 0     =  [[ [h] ]]+    | null cs    =  mapT (++ [h]) $ setsOf [[e] | e <- es, typ e == typ h]+    | otherwise  =  [ [h] ] : rest+    where+    cs  =  casesFor h+    rest :: [[ [Expr] ]]+    rest  =  mapT nubSort+          $  mapT (concatMap $ unfold . fill (fold cs))+          $  productsWith prods+          $  map (cpf (d-1))+          $  concatMap holes cs+    -- TODO: avoid nubSorting here, by somehow not generating repeats+    -- the repeats appear because of the way we fold before concatMapping+    -- this may cause a significant performance issue on wider types ([Bool])++  productsWith :: ([a] -> b) -> [ [[a]] ] -> [[b]]+  productsWith f  =  mapT f . products+  -- TODO: move productsWith to LeanCheck?+++-- | A drop-in replacement for conjureArgumentPats.+--+-- Still not in use by Conjure.+conjureArgumentPatterns :: Conjurable f => Int -> [Expr] -> f -> [ [[ [Expr] ]] ]+conjureArgumentPatterns depth es f  =  map (conjurePatternsFor depth es f) $ conjureArgumentHoles f+++-- | Use this instead of conjurePatternsFor for simpler calling.+--+-- This is an interface for running internal experiments.+-- It will go away in a future version of Conjure.+conjurePatternsDebug :: Conjurable a => [Expr] -> a -> [[ [Expr] ]]+conjurePatternsDebug es a  =  conjurePatternsFor (-1) es foo (hole a)+  where+  foo x  =  ()  where _  =  x `asTypeOf` a++  -- -- -- other Conjurable instances -- -- --
src/Conjure/Engine.hs view
@@ -171,6 +171,7 @@   , maxDeconstructionSize :: Int  -- ^ maximum size of deconstructions (e.g.: @_ - 1@)   , maxConstantSize       :: Int  -- ^ maximum size of constants (0 for no limit)   , maxPatternSize        :: Int  -- ^ maximum size of patterns (0 for no limit)+  , maxPatternDepth       :: Int  -- ^ maximum depth of patterns    -- advanced & debug options --   , carryOn               :: Bool -- ^ whether to carry on after finding a suitable candidate@@ -214,10 +215,11 @@   , target                 =  10080   , maxEvalRecursions      =  60   , maxEquationSize        =   5-  , maxSearchTests         =  100000+  , maxSearchTests         =  110880   , maxDeconstructionSize  =   4   , maxConstantSize        =   0 -- unlimited   , maxPatternSize         =   0 -- unlimited+  , maxPatternDepth        =   1    -- advanced & debug options --   , carryOn                =  False@@ -499,8 +501,8 @@   , deconstructions   )   where-  pats | maxPatternSize > 0  =  take maxPatternSize $ conjurePats es nm f-       | otherwise           =                        conjurePats es nm f+  pats | maxPatternSize > 0  =  take maxPatternSize $ conjurePats maxPatternDepth es nm f+       | otherwise           =                        conjurePats maxPatternDepth es nm f   fss  =  concatMapT ps2fss pats   -- replaces the any guard symbol with a guard of the correct type   es  =  [if isGuardSymbol e then conjureGuard f else e | (e,_) <- ps]@@ -613,28 +615,38 @@     where     hs  =  nub $ conjureArgumentHoles f +  recs :: Expr -> [[Expr]]   recs ep  =  filterT (keepR ep)            .  discardT (\e -> e == ep)            $  recsV' (tail (vars ep))++  recsV :: [Expr] -> [[Expr]]   recsV vs  =  filterT (\e -> any (`elem` vs) (vars e))             $  foldAppProducts ef [unguardT $ appsWith h vs | h <- conjureArgumentHoles f]+   -- like recs, but memoized+  recs' :: Expr -> [[Expr]]   recs' ep  =  fromMaybe errRP $ lookup ep eprs     where-    eprs = [(ep, recs ep) | ep <- possiblePats]-  possiblePats  =  nubSort . concat . concat $ pats+    eprs = [(ep, recs ep) | ep <- concat possiblePats]++  possiblePats :: [[Expr]]+  possiblePats  =  map (nubSort . concat) $ pats+   -- like recsV, but memoized-  recsV' vs  =  fromMaybe errRV $ lookup vs evrs+  recsV' :: [Expr] -> [[Expr]]+  recsV' vs  =  fromMaybe errRV $ lookup (nubSort vs) evrs     where-    evrs = [(vs, recsV vs) | vs <- nubSort $ map (tail . vars) possiblePats]+    evrs = [(vs, recsV vs) | vs <- concatMap nubSort $ mapT (nubSort . tail . vars) possiblePats] +  errRP  =  error "candidateDefnsC: unexpected pattern.  You have found a bug, please report it."+  errRV  =  error "candidateDefnsC: unexpected variables.  You have found a bug, please report it."+   thy  =  doubleCheck (===)        .  theoryFromAtoms (===) maxEquationSize . (:[]) . nub        $  cjHoles (prim nm f:ps) ++ [val False, val True] ++ es   (===)  =  cjAreEqual (prim nm f:ps) maxTests   isUnbreakable  =  conjureIsUnbreakable f-  errRP  =  error "candidateDefnsC: unexpected pattern.  You have found a bug, please report it."-  errRV  =  error "candidateDefnsC: unexpected variables.  You have found a bug, please report it."   -- | Checks if the given pattern is a ground pattern.
src/Conjure/Utils.hs view
@@ -46,6 +46,7 @@   , both   , (+++)   , isSubsetOf+  , prods   ) where @@ -221,3 +222,7 @@ (+++) :: Ord a => [a] -> [a] -> [a] (+++) = nubMerge infixr 5 +++++prods :: [[a]] -> [[a]]+prods []  =  [[]]+prods (xs:xss)  =  [y:ys | y <- xs, ys <- prods xss]
test/Test.hs view
@@ -57,7 +57,7 @@ conjurableOK x  =  and   [ holds 60 $ (-==-) ==== (==)   , holds 60 $ expr' === expr-  , tiers =| 6 |= (tiers -: [[x]])+  , tiers' =| 6 |= (mapT val $ tiers -: [[x]])   , all isWellTyped cases'   , all (\c -> typ c == typeOf x) cases'   ]@@ -65,3 +65,4 @@   (-==-)  =  evl (fromJust $ conjureEquality x) -:> x   expr'  =  (conjureExpress x . val) -:> x   cases'  =  conjureCases x+  tiers'  =  conjureTiersFor x (hole x)
test/conjurable.hs view
@@ -1,16 +1,12 @@ -- Copyright (C) 2021-2025 Rudy Matela -- Distributed under the 3-Clause BSD licence (see the file LICENSE). -{-# Language DeriveDataTypeable, StandaloneDeriving #-}  -- for GHC < 7.10- import Test import Data.Dynamic  -- An Unit type that is not an Eq instance data Unit  =  Unit  deriving Show -deriving instance Typeable Unit  -- for GHC < 7.10- instance Listable Unit where list = [Unit] instance Name Unit where name _ = "u" instance Conjurable Unit where@@ -132,7 +128,7 @@   , map length (conjureArgumentCases (undefined :: () -> Bool -> Int -> [Int] -> [Bool] -> ()))     == [1, 2, 0, 2, 2] -  , conjurePats [zero, one] "f" (undefined :: Int -> Int)+  , conjurePats 1 [zero, one] "f" (undefined :: Int -> Int)     == [ [ [ ff xx            ]          ]@@ -151,7 +147,7 @@          ]        ] -  , conjurePats [] "f" (undefined :: [Int] -> Int)+  , conjurePats 1 [] "f" (undefined :: [Int] -> Int)     == [ [ [ ffs xxs            ]          ]@@ -161,7 +157,7 @@          ]        ] -  , take 3 (conjurePats [zero, one] "?" (undefined :: Int -> Int -> Int))+  , take 3 (conjurePats 1 [zero, one] "?" (undefined :: Int -> Int -> Int))     == [ [ [ xx -?- yy            ]          ]@@ -189,14 +185,14 @@          ]        ] -  , mapT length (conjurePats [zero, one] "foo" (undefined :: [Int] -> Int -> Int))+  , mapT length (conjurePats 1 [zero, one] "foo" (undefined :: [Int] -> Int -> Int))     == [[1],[2,2],[2,3,3],[3,3,4,3],[4,4,4,4],[5,4,5],[5,5],[6]]  -  , mapT length (conjurePats [zero, one] "foo" (undefined :: Int -> [Int] -> Int))+  , mapT length (conjurePats 1 [zero, one] "foo" (undefined :: Int -> [Int] -> Int))     == [[1],[2,2],[3,3,2],[4,3,3,3],[4,4,4,4],[5,5,5],[6]] -  , conjurePats [] "foo" (undefined :: [Int] -> [Char] -> Int)+  , conjurePats 1 [] "foo" (undefined :: [Int] -> [Char] -> Int)     == [ [ [ ffoo xxs ccs            ]          ]@@ -313,6 +309,27 @@        , (zero -:- val [0::Int], zero -:- zero -:- nil)        , (one -:- nil,           one -:- nil)        ]++  , conjureArgumentPatterns 1 [] (undefined :: Int -> ())+      ==  conjureArgumentPats [] (undefined :: Int -> ())++  , conjureArgumentPatterns 1 [] (undefined :: Bool -> ())+      ==  conjureArgumentPats [] (undefined :: Bool -> ())++  , conjureArgumentPatterns 1 [] (undefined :: [Bool] -> ())+      ==  conjureArgumentPats [] (undefined :: [Bool] -> ())++  , conjureArgumentPatterns 1 [zero, one] (undefined :: [Int] -> ())+      ==  conjureArgumentPats [zero, one] (undefined :: [Int] -> ())++  , conjureArgumentPatterns 1 [] (undefined :: [Maybe Bool] -> ())+      ==  conjureArgumentPats [] (undefined :: [Maybe Bool] -> ())++  , conjureArgumentPatterns 1 [] (undefined :: Maybe Bool -> ())+      ==  conjureArgumentPats [] (undefined :: Maybe Bool -> ())++  , conjureArgumentPatterns 1 [zero, one] (undefined :: Int -> ())+      ==  conjureArgumentPats [zero, one] (undefined :: Int -> ())   ]  isNumeric :: Expr -> Bool
test/derive.hs view
@@ -1,7 +1,6 @@ -- Copyright (c) 2019-2025 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveDataTypeable #-}  -- uncomment to debug derivation: -- {-# OPTIONS_GHC -ddump-splices #-}@@ -9,33 +8,51 @@ import Test hiding ((-:), (->:)) -- -: and ->: should be generated by deriveConjurable -data Choice  =  Ae | Bee | Cee deriving (Show, Eq, Typeable)-data Peano  =  Zero | Succ Peano deriving (Show, Eq, Typeable)-data Lst a  =  a :- Lst a | Nil deriving (Show, Eq, Typeable)-data Bush a  =  Bush a :-: Bush a | Leaf a deriving (Show, Eq, Typeable)-data Tree a  =  Node (Tree a) a (Tree a) | Null deriving (Show, Eq, Typeable)+-- replication of Haskell's built-in data types+-- in the order of the Haskell98 standard+-- https://www.haskell.org/onlinereport/basic.html+data  Choice  =  Yes | No  deriving (Show, Eq)+data  Peano  =  Zero | Succ Peano  deriving (Show, Eq)+data  Lst a  =  Nil | a :- Lst a  deriving (Show, Eq)+data  Unit  =  Unit  deriving (Show, Eq)+data  Perhaps a  =  Naught | Precisely a  deriving (Show, Eq)+data  Alternatively a b  =  Sinister a | Dexter b  deriving (Show, Eq)+data  Relation  =  Smaller | Same | Bigger  deriving (Show, Eq)  deriveConjurable ''Choice deriveConjurable ''Peano deriveConjurable ''Lst+deriveConjurable ''Unit+deriveConjurable ''Perhaps+deriveConjurable ''Alternatively+deriveConjurable ''Relation++-- tree types+data  Bush a  =  Bush a :-: Bush a | Leaf a  deriving (Show, Eq)+data  Tree a  =  Node (Tree a) a (Tree a) | Null  deriving (Show, Eq)+ deriveConjurable ''Bush deriveConjurable ''Tree +-- inner/outer+data  Inner  =  I  deriving (Eq, Ord, Show)+data  Outer  =  O Inner  deriving (Eq, Ord, Show)++deriveConjurableCascading ''Outer+ -- Nested datatype cascade-data Nested  =  Nested N0 (N1 Int) (N2 Int Int) deriving (Eq, Show, Typeable)-data N0      =  R0 Int deriving (Eq, Show, Typeable)-data N1 a    =  R1 a   deriving (Eq, Show, Typeable)-data N2 a b  =  R2 a b deriving (Eq, Show, Typeable)+data  Nested  =  Nested N0 (N1 Int) (N2 Int Int)  deriving (Eq, Show)+data  N0      =  R0 Int  deriving (Eq, Show)+data  N1 a    =  R1 a    deriving (Eq, Show)+data  N2 a b  =  R2 a b  deriving (Eq, Show)  deriveConjurableCascading ''Nested  -- Recursive nested datatype cascade-data RN       =  RN RN0 (RN1 Int) (RN2 Int RN) deriving (Eq, Show, Typeable)-data RN0      =  Nest0 Int | Recurse0 RN deriving (Eq, Show, Typeable)-data RN1 a    =  Nest1 a   | Recurse1 RN deriving (Eq, Show, Typeable)-data RN2 a b  =  Nest2 a b | Recurse2 RN deriving (Eq, Show, Typeable)--- beware: values of the above type are always infinite!---         derivation works but full evaluation does not terminate+data  RN       =  RN RN0 (RN1 Int) (RN2 Int RN0)  deriving (Eq, Show)+data  RN0      =  Nest0 Int | Recurse0 RN  deriving (Eq, Show)+data  RN1 a    =  Nest1 a   | Recurse1 RN  deriving (Eq, Show)+data  RN2 a b  =  Nest2 a b | Recurse2 RN  deriving (Eq, Show)  deriveConjurableCascading ''RN @@ -51,8 +68,8 @@ deriveConjurableIfNeeded ''Maybe deriveConjurableIfNeeded ''Either -data Mutual    =  Mutual0   | Mutual CoMutual deriving (Eq, Show, Typeable)-data CoMutual  =  CoMutual0 | CoMutual Mutual deriving (Eq, Show, Typeable)+data Mutual    =  Mutual0   | Mutual CoMutual deriving (Eq, Show)+data CoMutual  =  CoMutual0 | CoMutual Mutual deriving (Eq, Show)  deriveConjurableCascading ''Mutual @@ -64,33 +81,55 @@ tests n  =   [ True +  -- re-test standard types   , conjurableOK (undefined :: Bool)   , conjurableOK (undefined :: Int)-  , conjurableOK (undefined :: Char)-  , conjurableOK (undefined :: [Bool])+  , conjurableOK (undefined :: [A])   , conjurableOK (undefined :: [Int])-  , conjurableOK (undefined :: String)+  , conjurableOK (undefined :: [Bool])+  , conjurableOK (undefined :: ())+  , conjurableOK (undefined :: Maybe A)+  , conjurableOK (undefined :: Either A B)+  , conjurableOK (undefined :: Ordering) +  -- replication of Haskell's built-in types   , conjurableOK (undefined :: Choice)   , conjurableOK (undefined :: Peano)-  , conjurableOK (undefined :: Lst Int)+  , conjurableOK (undefined :: Lst A)+  , conjurableOK (undefined :: Lst Peano)+  , conjurableOK (undefined :: Lst Choice)+  , conjurableOK (undefined :: Unit)+  , conjurableOK (undefined :: Perhaps A)+  , conjurableOK (undefined :: Alternatively A B)+  , conjurableOK (undefined :: Relation)++  -- tree types   , conjurableOK (undefined :: Bush Int)   , conjurableOK (undefined :: Tree Int)---, conjurableOK (undefined :: RN) -- TODO: FIX: infinite loop somewhere... -  , conjureSize Ae == 1-  , conjureSize Bee == 1-  , conjureSize Cee == 1+  , conjurableOK (undefined :: Inner)+  , conjurableOK (undefined :: Outer)++  , conjurableOK (undefined :: RN)+  , conjurableOK (undefined :: Mutual)+  , conjurableOK (undefined :: CoMutual)++  , conjureSize Yes == 1+  , conjureSize No == 1+   , conjureSize Zero == 1   , conjureSize (Succ Zero) == 2   , conjureSize (Succ (Succ Zero)) == 3+  , conjureSize (Succ (Succ (Succ Zero))) == 4+   , conjureSize (Nil :: Lst Int) == 1   , conjureSize (10 :- (20 :- Nil) :: Lst Int) == 33 +  , conjureSize Unit == 1+   , conjureCases choice-    == [ val Ae-       , val Bee-       , val Cee+    == [ val Yes+       , val No        ]    , conjureCases peano@@ -99,10 +138,16 @@        ]    , conjureCases (lst int)-    == [ value ":-" ((:-) ->>: lst int) :$ hole int :$ hole (lst int)-       , val (Nil :: Lst Int)+    == [ val (Nil :: Lst Int)+       , value ":-" ((:-) ->>: lst int) :$ hole int :$ hole (lst int)        ] +  , conjureCases relation+    == [ val Smaller+       , val Same+       , val Bigger+       ]+   , conjureCases (bush int)     == [ value ":-:" ((:-:) ->>: bush int) :$ hole (bush int) :$ hole (bush int)        , value "Leaf" (Leaf ->: bush int) :$ hole int@@ -124,9 +169,13 @@                                          , hole (undefined :: Bool)                                          ]   , conjureHoles (undefined :: Lst Int) == [ hole (undefined :: Int)-                                            , hole (undefined :: Lst Int)-                                            , hole (undefined :: Bool)-                                            ]+                                           , hole (undefined :: Lst Int)+                                           , hole (undefined :: Bool)+                                           ]+  , conjureHoles (undefined :: Lst Peano) == [ hole (undefined :: Peano)+                                             , hole (undefined :: Lst Peano)+                                             , hole (undefined :: Bool)+                                             ]   , conjureHoles (undefined :: Nested) == [ hole (undefined :: N0)                                           , hole (undefined :: N1 Int)                                           , hole (undefined :: Int)@@ -134,10 +183,10 @@                                           , hole (undefined :: Nested)                                           , hole (undefined :: Bool)                                           ]-  , conjureHoles (undefined :: RN) == [ hole (undefined :: RN0)-                                      , hole (undefined :: RN1 Int)+  , conjureHoles (undefined :: RN) == [ hole (undefined :: RN1 Int)                                       , hole (undefined :: Int)-                                      , hole (undefined :: RN2 Int RN)+                                      , hole (undefined :: RN0)+                                      , hole (undefined :: RN2 Int RN0)                                       , hole (undefined :: RN)                                       , hole (undefined :: Bool)                                       ]@@ -161,6 +210,9 @@  lst :: a -> Lst a lst _  =  undefined++relation :: Relation+relation  =  undefined  bush :: a -> Bush a bush _  =  undefined
test/utils.hs view
@@ -20,4 +20,8 @@   , sets [1]  ==  [[1], [] :: [Int]]   , sets [1,2]  ==  [[1,2], [1], [2], [] :: [Int]]   , sets [1,2,3]  ==  [[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[] :: [Int]]++  , prods [ [1], [2], [3] ] == [[1,2,3]]+  , prods [ [1,2], [3,4], [5] ] == [[1,3,5],[1,4,5],[2,3,5],[2,4,5]]+  , prods [ [1,2], [3], [4,5] ] == [[1,3,4],[1,3,5],[2,3,4],[2,3,5]]   ]