module Funcons.Operations.Eval where

import Funcons.Operations.Expr
import Funcons.Operations.Values hiding (showArgs)

import Data.List (intercalate)

data EvalResult t = Error         (OpExpr t) (Result t)
                  | Success       t
                  | EvalResults   [EvalResult t]
                  deriving (Int -> EvalResult t -> ShowS
[EvalResult t] -> ShowS
EvalResult t -> String
(Int -> EvalResult t -> ShowS)
-> (EvalResult t -> String)
-> ([EvalResult t] -> ShowS)
-> Show (EvalResult t)
forall t. (HasValues t, Show t) => Int -> EvalResult t -> ShowS
forall t. (HasValues t, Show t) => [EvalResult t] -> ShowS
forall t. (HasValues t, Show t) => EvalResult t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalResult t] -> ShowS
$cshowList :: forall t. (HasValues t, Show t) => [EvalResult t] -> ShowS
show :: EvalResult t -> String
$cshow :: forall t. (HasValues t, Show t) => EvalResult t -> String
showsPrec :: Int -> EvalResult t -> ShowS
$cshowsPrec :: forall t. (HasValues t, Show t) => Int -> EvalResult t -> ShowS
Show)

eval :: HasValues t => OpExpr t -> EvalResult t
eval :: OpExpr t -> EvalResult t
eval OpExpr t
expr = OpExpr t -> Result t -> EvalResult t
forall t. OpExpr t -> Result t -> EvalResult t
applyEval OpExpr t
expr (OpExpr t -> Result t
forall t. HasValues t => OpExpr t -> Result t
applyExpr OpExpr t
expr) 

applyEval :: OpExpr t -> Result t -> EvalResult t
applyEval :: OpExpr t -> Result t -> EvalResult t
applyEval OpExpr t
expr (Normal t
v) = t -> EvalResult t
forall t. t -> EvalResult t
Success t
v
applyEval OpExpr t
expr (Nondeterministic [Result t]
ress) = [EvalResult t] -> EvalResult t
forall t. [EvalResult t] -> EvalResult t
EvalResults ((Result t -> EvalResult t) -> [Result t] -> [EvalResult t]
forall a b. (a -> b) -> [a] -> [b]
map (OpExpr t -> Result t -> EvalResult t
forall t. OpExpr t -> Result t -> EvalResult t
applyEval OpExpr t
expr) [Result t]
ress)
applyEval OpExpr t
expr Result t
res = OpExpr t -> Result t -> EvalResult t
forall t. OpExpr t -> Result t -> EvalResult t
Error OpExpr t
expr Result t
res 
 
instance (HasValues t, Show t) => Show (OpExpr t) where
  show :: OpExpr t -> String
show (ValExpr Values t
v)            = (t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
forall a. Show a => a -> String
show Values t
v
  show (TermExpr t
t)           = t -> String
forall a. Show a => a -> String
show t
t
  show (NullaryOp String
nm NullaryOp t
_)       = String
nm
  show (UnaryOp String
nm UnaryOp t
_ OpExpr t
x)       = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [OpExpr t] -> String
forall t. (HasValues t, Show t) => [OpExpr t] -> String
showArgs [OpExpr t
x]
  show (BinaryOp String
nm BinaryOp t
_ OpExpr t
x OpExpr t
y)    = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [OpExpr t] -> String
forall t. (HasValues t, Show t) => [OpExpr t] -> String
showArgs [OpExpr t
x,OpExpr t
y]
  show (TernaryOp String
nm TernaryOp t
_ OpExpr t
x OpExpr t
y OpExpr t
z) = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [OpExpr t] -> String
forall t. (HasValues t, Show t) => [OpExpr t] -> String
showArgs [OpExpr t
x,OpExpr t
y,OpExpr t
z]
  show (NaryOp String
nm NaryOp t
_ [OpExpr t]
xs)       = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [OpExpr t] -> String
forall t. (HasValues t, Show t) => [OpExpr t] -> String
showArgs [OpExpr t]
xs
  show (InvalidOp String
nm String
_ [OpExpr t]
xs)    = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [OpExpr t] -> String
forall t. (HasValues t, Show t) => [OpExpr t] -> String
showArgs [OpExpr t]
xs
  show (RewritesTo String
nm OpExpr t
_ [OpExpr t]
xs)   = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [OpExpr t] -> String
forall t. (HasValues t, Show t) => [OpExpr t] -> String
showArgs [OpExpr t]
xs

showArgs :: (HasValues t, Show t) => [OpExpr t] -> String
showArgs :: [OpExpr t] -> String
showArgs [OpExpr t]
args = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((OpExpr t -> String) -> [OpExpr t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OpExpr t -> String
forall a. Show a => a -> String
show [OpExpr t]
args) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"