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)
- con :: (Conjurable a, Show a) => a -> Ingredient
- unfun :: (Conjurable a, Show a) => a -> Ingredient
- fun :: Conjurable a => String -> 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
Documentation
type Ingredient = (Expr, Reification) Source #
A single functional ingredient in conjuring.
Specify conjure ingredients with con
and fun
:
conjure "foo" foo [ con False , con True , con (0 :: Int) , con (1 :: Int) , ... , fun "&&" (&&) , fun "||" (||) , fun "+" ((+) :: Int -> Int -> Int) , fun "*" ((*) :: Int -> Int -> Int) , fun "-" ((-) :: Int -> Int -> Int) , ... ]
Ingredients may include arbitrary
constants (con
),
constructors (con
)
or functions (fun
).
These may be built-in or user defined.
Use con
on Show
instances
and fun
otherwise.
This is internally
an arbitrary atomic Expr
ession
paired with
a Reification
of type information.
con :: (Conjurable a, Show a) => a -> Ingredient Source #
unfun :: (Conjurable a, Show a) => a -> Ingredient Source #
Provided a Show
-able non-functional value to Conjure.
(cf. fun
)
conjure "foo" foo [ unfun False , unfun True , unfun (0 :: Int) , unfun (1 :: Int) , ... ]
Argument types have to be monomorphized, so use type bindings when applicable.
TODO: Make unfun
the standard way to create encode Show
values.
This is a replacement to con
.
In hindsight, con
is not such a great name:
con
structors may be fun
ctional after all!
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
, con
)
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.
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' [ con ([] :: [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 xs
ordcase :: 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 > [ con False > , con 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 t2
guard :: 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' > [ con ([] :: [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 Expr
s from a list of Ingredient
s.
This function mirrors functionality from conjureHoles
.
cjTiersFor :: [Ingredient] -> Expr -> [[Expr]] Source #
Given a list of Ingredient
s,
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 Ingredient
s,
computes a function that checks whether two Expr
s are equal
up to a given number of tests.
cjMkEquation :: [Ingredient] -> Expr -> Expr -> Expr Source #
Computes a function that equates two Expr
s from a list of Ingredient
s.
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