-
Notifications
You must be signed in to change notification settings - Fork 43
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
3813 add selected hooks for INT, BOOL, MAP, LIST (#3828)
Context: #3813 Adds a number of hooks (as per documentation in https://github.com/runtimeverification/haskell-backend/blob/master/docs/hooks.md) and splits the `Booster.Builtin` module into several parts. * `Bool` : all hooked operations implemented * `Int`: selected binary and unary operations and comparisons * `List`: `get` (indexing) and `size` * `Map`: all hooked operations except `removeAll` and `keys` (which would require using internal sets)
- Loading branch information
Showing
14 changed files
with
1,445 additions
and
365 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,79 @@ | ||
{- | | ||
Copyright : (c) Runtime Verification, 2023 | ||
License : BSD-3-Clause | ||
Built-in functions (hooks) in the BOOL namespace, as described in | ||
[docs/hooks.md](https://github.com/runtimeverification/haskell-backend/blob/master/docs/hooks.md). | ||
-} | ||
module Booster.Builtin.BOOL ( | ||
builtinsBOOL, | ||
boolTerm, | ||
) where | ||
|
||
import Data.ByteString.Char8 (ByteString) | ||
import Data.Map (Map) | ||
import Data.Map qualified as Map | ||
|
||
import Booster.Builtin.Base | ||
import Booster.Pattern.Base | ||
import Booster.Pattern.Bool | ||
|
||
builtinsBOOL :: Map ByteString BuiltinFunction | ||
builtinsBOOL = | ||
Map.mapKeys ("BOOL." <>) $ | ||
Map.fromList | ||
[ "or" ~~> orHook | ||
, "and" ~~> andHook | ||
, "xor" ~~> boolOperator (/=) | ||
, "eq" ~~> boolOperator (==) | ||
, "ne" ~~> boolOperator (/=) | ||
, "not" ~~> notHook | ||
, "implies" ~~> impliesHook | ||
] | ||
|
||
-- shortcut evaluations for or and and | ||
orHook :: BuiltinFunction | ||
orHook args | ||
| length args /= 2 = arityError "BOOL.or" 2 args | ||
| [TrueBool, _] <- args = pure $ Just TrueBool | ||
| [_, TrueBool] <- args = pure $ Just TrueBool | ||
| [FalseBool, FalseBool] <- args = pure $ Just FalseBool | ||
| otherwise = pure Nothing -- arguments not determined | ||
|
||
andHook :: BuiltinFunction | ||
andHook args | ||
| length args /= 2 = arityError "BOOL.and" 2 args | ||
| [FalseBool, _] <- args = pure $ Just FalseBool | ||
| [_, FalseBool] <- args = pure $ Just FalseBool | ||
| [TrueBool, TrueBool] <- args = pure $ Just TrueBool | ||
| otherwise = pure Nothing -- arguments not determined | ||
|
||
notHook :: BuiltinFunction | ||
notHook [arg] | ||
| Just b <- readBoolTerm arg = pure . Just . boolTerm $ not b | ||
| otherwise = pure Nothing | ||
notHook args = arityError "BOOL.not" 1 args | ||
|
||
impliesHook :: BuiltinFunction | ||
impliesHook args | ||
| length args /= 2 = arityError "BOOL.implies" 2 args | ||
| [FalseBool, _] <- args = pure $ Just TrueBool | ||
| [TrueBool, FalseBool] <- args = pure $ Just FalseBool | ||
| [TrueBool, TrueBool] <- args = pure $ Just TrueBool | ||
| otherwise = pure Nothing -- arguments not determined | ||
|
||
boolOperator :: (Bool -> Bool -> Bool) -> BuiltinFunction | ||
boolOperator f args | ||
| length args /= 2 = arityError "BOOL.<operator>" 2 args | ||
| [Just arg1, Just arg2] <- map readBoolTerm args = | ||
pure . Just . boolTerm $ f arg1 arg2 | ||
| otherwise = pure Nothing -- arguments not determined | ||
|
||
boolTerm :: Bool -> Term | ||
boolTerm True = TrueBool | ||
boolTerm False = FalseBool | ||
|
||
readBoolTerm :: Term -> Maybe Bool | ||
readBoolTerm TrueBool = Just True | ||
readBoolTerm FalseBool = Just False | ||
readBoolTerm _other = Nothing |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,72 @@ | ||
{- | | ||
Copyright : (c) Runtime Verification, 2023 | ||
License : BSD-3-Clause | ||
Base type definitions and helpers for built-in functions (hooks). | ||
-} | ||
module Booster.Builtin.Base ( | ||
BuiltinFunction, | ||
-- helpers | ||
(~~>), | ||
arityError, | ||
isConstructorLike_, | ||
shouldHaveSort, | ||
) where | ||
|
||
import Control.Monad.Trans.Except | ||
import Data.ByteString.Char8 (ByteString) | ||
import Data.Text (Text) | ||
import Data.Text qualified as Text | ||
import Data.Text.Encoding qualified as Text | ||
import Prettyprinter (pretty) | ||
|
||
import Booster.Pattern.Base | ||
import Booster.Pattern.Util | ||
import Booster.Prettyprinter | ||
|
||
{- | | ||
Built-in functions may fail on arity or sort errors, and may be | ||
partial (returning a Maybe type) | ||
The built-in function fails outright when its function is called with | ||
a wrong argument count. When required arguments are unevaluated, the | ||
hook returns 'Nothing'. | ||
-} | ||
type BuiltinFunction = [Term] -> Except Text (Maybe Term) | ||
|
||
------------------------------------------------------------ | ||
-- Helpers | ||
|
||
(~~>) :: ByteString -> BuiltinFunction -> (ByteString, BuiltinFunction) | ||
(~~>) = (,) | ||
|
||
isConstructorLike_ :: Term -> Bool | ||
isConstructorLike_ = (.isConstructorLike) . getAttributes | ||
|
||
{- | checks that the arguments list has the expected length. | ||
Returns nothing if the arg.count matches, so it can be used as a | ||
fall-through case in hook function definitions. | ||
-} | ||
arityError :: Text -> Int -> [Term] -> Except Text (Maybe Term) | ||
arityError fname argCount args | ||
| l == argCount = | ||
pure Nothing | ||
| otherwise = | ||
throwE $ fname <> Text.pack msg | ||
where | ||
l = length args | ||
msg = unwords [": wrong arity. Expected ", show argCount, ", got ", show l] | ||
|
||
-- check for simple (parameter-less) sorts | ||
shouldHaveSort :: Term -> SortName -> Except Text () | ||
t `shouldHaveSort` s | ||
| sortOfTerm t == SortApp s [] = | ||
pure () | ||
| otherwise = | ||
throwE $ | ||
Text.unlines | ||
[ "Argument term has unexpected sort (expected " <> Text.decodeLatin1 s <> "):" | ||
, renderText (pretty t) | ||
] |
Oops, something went wrong.