code-conjure-0.7.2: synthesize Haskell functions out of partial definitions
Copyright(c) 2021-2025 Rudy Matela
License3-Clause BSD (see the file LICENSE)
MaintainerRudy Matela <rudy@matela.com.br>
Safe HaskellNone
LanguageHaskell2010

Conjure.Ingredient

Description

This module is part of Conjure.

The Ingredient type and utilities involving it.

You are probably better off importing Conjure.

Synopsis

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 Expression paired with a Reification of type information.

con :: (Conjurable a, Show a) => a -> Ingredient Source #

Provides a constant or constructor as an ingredient to Conjure. To be used on Show instances. (cf. fun)

conjure "foo" foo [ con False
                  , con True
                  , con (0 :: Int)
                  , con (1 :: Int)
                  , ...
                  ]

Argument types have to be monomorphized, so use type bindings when applicable.

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: constructors may be functional 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 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 #

Deprecated: pr is deprecated, please use con instead

DEPRECATED. Please use con instead.

prim :: Conjurable a => String -> a -> Ingredient Source #

Deprecated: prim is deprecated, please use fun instead

DEPRECATED. Please use fun instead.

prif :: Conjurable a => a -> Ingredient Source #

Deprecated: prif is deprecated, please use iif instead

primOrdCaseFor :: Conjurable a => a -> Ingredient Source #

Deprecated: primOrdCaseFor is deprecated, please use ordcase instead