From ab190cec0252c6a7083bb355ea9ddb1d8f06b297 Mon Sep 17 00:00:00 2001 From: Rob Dockins Date: Fri, 22 Apr 2022 16:18:00 -0700 Subject: [PATCH] Fix a bug in monadic tuple bindings I introduced by misunderstaning the type annotation on StmtBind. --- src/SAWScript/Interpreter.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index a900e3338c..c8d725ab25 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -121,8 +121,8 @@ bindPatternLocal pat ms v env = Nothing -> repeat Nothing Just (SS.Forall ks (SS.TyCon (SS.TupleCon _) ts)) -> [ Just (SS.Forall ks t) | t <- ts ] - _ -> error "bindPattern: expected tuple value" - _ -> error "bindPattern: expected tuple value" + Just t -> error ("bindPatternLocal: expected tuple type " ++ show t) + _ -> error "bindPatternLocal: expected tuple value" SS.LPattern _ pat' -> bindPatternLocal pat' ms v env bindPatternEnv :: SS.Pattern -> Maybe SS.Schema -> Value -> TopLevelRW -> TopLevel TopLevelRW @@ -139,8 +139,8 @@ bindPatternEnv pat ms v env = Nothing -> repeat Nothing Just (SS.Forall ks (SS.TyCon (SS.TupleCon _) ts)) -> [ Just (SS.Forall ks t) | t <- ts ] - _ -> error "bindPattern: expected tuple value" - _ -> error "bindPattern: expected tuple value" + Just t -> error ("bindPatternEnv: expected tuple type " ++ show t) + _ -> error "bindPatternEnv: expected tuple value" SS.LPattern _ pat' -> bindPatternEnv pat' ms v env -- Interpretation of SAWScript ------------------------------------------------- @@ -238,10 +238,10 @@ interpretStmts stmts = case stmts of [] -> fail "empty block" [SS.StmtBind _ (SS.PWild _) _ e] -> interpret e - SS.StmtBind pos pat mt e : ss -> + SS.StmtBind pos pat _mcxt e : ss -> do env <- getLocalEnv v1 <- interpret e - let f v = withLocalEnv (bindPatternLocal pat (SS.tMono <$> mt) v env) (interpretStmts ss) + let f v = withLocalEnv (bindPatternLocal pat Nothing v env) (interpretStmts ss) bindValue pos v1 (VLambda f) SS.StmtLet _ bs : ss -> interpret (SS.Let bs (SS.Block ss)) SS.StmtCode _ s : ss ->