| Copyright | (c) 2021-2025 Rudy Matela |
|---|---|
| License | 3-Clause BSD (see the file LICENSE) |
| Maintainer | Rudy Matela <rudy@matela.com.br> |
| Safe Haskell | None |
| Language | Haskell2010 |
Conjure.Ingredient
Description
This module is part of Conjure.
The Ingredient type and utilities involving it.
You are probably better off importing Conjure.
Synopsis
- type Ingredient = (Expr, Reification)
- fun :: Conjurable a => String -> a -> Ingredient
- unfun :: (Conjurable a, Show a) => a -> Ingredient
- iif :: Conjurable a => a -> Ingredient
- ordcase :: Conjurable a => a -> Ingredient
- guard :: Ingredient
- cjHoles :: [Ingredient] -> [Expr]
- cjTiersFor :: [Ingredient] -> Expr -> [[Expr]]
- cjAreEqual :: [Ingredient] -> Int -> Expr -> Expr -> Bool
- cjMkEquation :: [Ingredient] -> Expr -> Expr -> Expr
- type Prim = Ingredient
- pr :: (Conjurable a, Show a) => a -> Ingredient
- prim :: Conjurable a => String -> a -> Ingredient
- prif :: Conjurable a => a -> Ingredient
- primOrdCaseFor :: Conjurable a => a -> Ingredient
- con :: (Conjurable a, Show a) => a -> Ingredient
Documentation
type Ingredient = (Expr, Reification) Source #
A single functional ingredient in conjuring.
Specify conjure ingredients with unfun and fun:
conjure "foo" foo [ unfun False
, unfun True
, unfun (0 :: Int)
, unfun (1 :: Int)
, ...
, fun "&&" (&&)
, fun "||" (||)
, fun "+" ((+) :: Int -> Int -> Int)
, fun "*" ((*) :: Int -> Int -> Int)
, fun "-" ((-) :: Int -> Int -> Int)
, ...
]Ingredients may include arbitrary
functional values (fun)
and non-functional values (unfun).
These may be built-in or user defined.
Use unfun on Show instances
and fun otherwise.
This is internally
an arbitrary atomic Expression
paired with
a Reification of type information.
fun :: Conjurable a => String -> a -> Ingredient Source #
Provides a functional value as an ingredient to Conjure.
To be used on values that are not Show instances
such as functions.
(cf. unfun)
conjure "foo" foo [ ...
, fun "&&" (&&)
, fun "||" (||)
, fun "+" ((+) :: Int -> Int -> Int)
, fun "*" ((*) :: Int -> Int -> Int)
, fun "-" ((-) :: Int -> Int -> Int)
, ...
]Argument types have to be monomorphized, so use type bindings when applicable.
unfun :: (Conjurable a, Show a) => a -> Ingredient Source #
iif :: Conjurable a => a -> Ingredient Source #
Provides an if condition bound to the given return type as a Conjure ingredient.
This should be used when one wants Conjure to consider if-expressions at all:
last' :: [Int] -> Int last' [x] = x last' [x,y] = y last' [x,y,z] = z
> conjure "last" last' [ unfun ([] :: [Int])
> , fun ":" ((:) :: Int -> [Int] -> [Int])
> , fun "null" (null :: [Int] -> Bool)
> , iif (undefined :: Int)
> , fun "undefined" (undefined :: Int)
> ]
last :: [Int] -> Int
-- 0.0s, testing 360 combinations of argument values
-- 0.0s, pruning with 5/5 rules
-- ... ... ... ... ...
-- 0.0s, 4 candidates of size 7
-- 0.0s, tested 2 candidates
last [] = undefined
last (x:xs) = if null xs
then x
else last xsordcase :: Conjurable a => a -> Ingredient Source #
Provides a case condition bound to the given return type.
This should be used when one wants Conjure to consider ord-case expressions:
> conjure "mem" mem
> [ unfun False
> , unfun True
> , fun "`compare`" (compare :: Int -> Int -> Ordering)
> , ordcase (undefined :: Bool)
> ]
mem :: Int -> Tree -> Bool
-- ... ... ... ... ...
-- 0.0s, 384 candidates of size 12
-- 0.0s, tested 346 candidates
mem x Leaf = False
mem x (Node t1 y t2) = case x `compare` y of
LT -> mem x t1
EQ -> True
GT -> mem x t2guard :: Ingredient Source #
Provides a guard bound to the conjured function's return type.
Guards are only alllowed at the root fo the RHS.
last' :: [Int] -> Int last' [x] = x last' [x,y] = y last' [x,y,z] = z
> conjure "last" last' > [ unfun ([] :: [Int]) > , fun ":" ((:) :: Int -> [Int] -> [Int]) > , fun "null" (null :: [Int] -> Bool) > , guard > , fun "undefined" (undefined :: Int) > ] last :: [Int] -> Int -- 0.0s, testing 360 combinations of argument values -- 0.0s, pruning with 5/5 rules -- 0.0s, 1 candidates of size 1 -- 0.0s, 0 candidates of size 2 -- 0.0s, 0 candidates of size 3 -- 0.0s, 0 candidates of size 4 -- 0.0s, 0 candidates of size 5 -- 0.0s, 0 candidates of size 6 -- 0.0s, 4 candidates of size 7 -- 0.0s, tested 2 candidates last [] = undefined last (x:xs) | null xs = x | otherwise = last xs
cjHoles :: [Ingredient] -> [Expr] Source #
Computes a list of holes encoded as Exprs from a list of Ingredients.
This function mirrors functionality from conjureHoles.
cjTiersFor :: [Ingredient] -> Expr -> [[Expr]] Source #
Given a list of Ingredients,
returns a function that given an Expr
will return tiers of test Expr values.
This is used in cjAreEqual.
cjAreEqual :: [Ingredient] -> Int -> Expr -> Expr -> Bool Source #
Given a list of Ingredients,
computes a function that checks whether two Exprs are equal
up to a given number of tests.
cjMkEquation :: [Ingredient] -> Expr -> Expr -> Expr Source #
Computes a function that equates two Exprs from a list of Ingredients.
This function mirrors functionality from conjureMkEquation.
type Prim = Ingredient Source #
Deprecated: Prim is deprecated, please use Ingredient instead
DEPRACATED. Please use Ingredient instead
pr :: (Conjurable a, Show a) => a -> Ingredient Source #
prim :: Conjurable a => String -> a -> Ingredient Source #
prif :: Conjurable a => a -> Ingredient Source #
primOrdCaseFor :: Conjurable a => a -> Ingredient Source #
Deprecated: primOrdCaseFor is deprecated, please use ordcase instead
con :: (Conjurable a, Show a) => a -> Ingredient Source #