Fix a bug in monadic tuple bindings I introduced by

misunderstaning the type annotation on StmtBind.
GaloisInc · Apr 22, 2022 · 03045b8 · 03045b8
1 parent 9ed30cd
commit 03045b8
Showing 1 changed file with 6 additions and 6 deletions.
diff --git 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 ->