diff options
Diffstat (limited to 'src/Interpreter.hs')
| -rw-r--r-- | src/Interpreter.hs | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 3d6f33d..2c63b24 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -19,7 +19,8 @@ module Interpreter ( Value(..), ) where -import Control.Monad (foldM, join) +import Control.Monad (foldM, join, when) +import Data.Bifunctor (bimap) import Data.Char (isSpace) import Data.Kind (Type) import Data.Int (Int64) @@ -35,7 +36,6 @@ import AST.Pretty import CHAD.Types import Data import Interpreter.Rep -import Data.Bifunctor (bimap) newtype AcM s a = AcM { unAcM :: IO a } @@ -48,25 +48,33 @@ acmDebugLog :: String -> AcM s () acmDebugLog s = AcM (hPutStrLn stderr s) interpret :: Ex '[] t -> Rep t -interpret = interpretOpen SNil +interpret = interpretOpen False SNil -interpretOpen :: SList Value env -> Ex env t -> Rep t -interpretOpen env e = runAcM (let ?depth = 0 in interpret' env e) +-- | Bool: whether to trace execution with debug prints (very verbose) +interpretOpen :: Bool -> SList Value env -> Ex env t -> Rep t +interpretOpen prints env e = + runAcM $ + let ?depth = 0 + ?prints = prints + in interpret' env e -interpret' :: forall env t s. (?depth :: Int) => SList Value env -> Ex env t -> AcM s (Rep t) +interpret' :: forall env t s. (?prints :: Bool, ?depth :: Int) => SList Value env -> Ex env t -> AcM s (Rep t) interpret' env e = do let dep = ?depth - acmDebugLog $ replicate dep ' ' ++ "ev: " ++ ppExpr env e + let lenlimit = max 20 (100 - dep) + let trunc s | length s > lenlimit = take (lenlimit - 3) s ++ "..." + | otherwise = s + when ?prints $ acmDebugLog $ replicate dep ' ' ++ "ev: " ++ trunc (ppExpr env e) res <- let ?depth = dep + 1 in interpret'Rec env e - acmDebugLog $ replicate dep ' ' ++ "<- " ++ showValue 0 (typeOf e) res "" + when ?prints $ acmDebugLog $ replicate dep ' ' ++ "<- " ++ showValue 0 (typeOf e) res "" return res -interpret'Rec :: forall env t s. (?depth :: Int) => SList Value env -> Ex env t -> AcM s (Rep t) +interpret'Rec :: forall env t s. (?prints :: Bool, ?depth :: Int) => SList Value env -> Ex env t -> AcM s (Rep t) interpret'Rec env = \case EVar _ _ i -> case slistIdx env i of Value x -> return x ELet _ a b -> do x <- interpret' env a - interpret' (Value x `SCons` env) b + let ?depth = ?depth - 1 in interpret' (Value x `SCons` env) b expr | False && trace ("<i> " ++ takeWhile (not . isSpace) (show expr)) False -> undefined EPair _ a b -> (,) <$> interpret' env a <*> interpret' env b EFst _ e -> fst <$> interpret' env e |