[WIP] Add a return statement

src/AST.hs

@@ -2422,6 +2422,7 @@ foldStmt' sfn efn val (Not negated) pos =
 foldStmt' sfn efn val (TestBool exp) pos = foldExp sfn efn val exp Nothing
 foldStmt' _   _   val Nop pos = val
 foldStmt' _   _   val Fail pos = val
+foldStmt' _   _   val Return pos = val
 foldStmt' sfn efn val (Loop body _ _) pos = foldStmts sfn efn val body
 foldStmt' sfn efn val (UseResources _ _ body) pos = foldStmts sfn efn val body
 foldStmt' sfn efn val (For generators body) pos = val3
@@ -2848,6 +2849,8 @@ data Stmt
      | Nop
      -- |Do nothing (and fail)
      | Fail
+     -- |Do nothing (and exit call)
+     | Return
 
      -- After unbranching, this can only appear as the last Stmt in a body.
 
@@ -2932,6 +2935,7 @@ stmtImpurity (For _ stmts) = stmtsImpurity stmts
 stmtImpurity (TestBool _) = return Pure
 stmtImpurity Nop = return Pure
 stmtImpurity Fail = return Pure
+stmtImpurity Return = return Pure
 stmtImpurity Break = return Pure
 stmtImpurity Next = return Pure
 
@@ -3952,6 +3956,7 @@ showStmt indent (UseResources resources vars stmts) =
     ++ maybe "" (("\n   preserving -> "++) . showVarMap) vars
 showStmt _ Fail = "fail"
 showStmt _ Nop = "pass"
+showStmt _ Return = "return"
 showStmt indent (For generators body) =
   "for "
     ++ intercalate ", " [show var ++ " in " ++ show gen

src/Flatten.hs

@@ -307,12 +307,6 @@ flattenStmt' stmt@(ProcCall fn@(First [] "=" id) callDetism res [arg1,arg2]) pos
   where varCheck argContent hasOuts
             = expIsVar argContent && flowsOut (flattenedExpFlow argContent)
                                   && hasOuts
-flattenStmt' stmt@(ProcCall (First [] "fail" _) _ _ []) pos _ =
-    emit pos Fail
-flattenStmt' stmt@(ProcCall (First [] "break" _) _ _ []) pos _ =
-    emit pos Break
-flattenStmt' stmt@(ProcCall (First [] "next" _) _ _ []) pos _ =
-    emit pos Next
 flattenStmt' stmt@(ProcCall func detism res args) pos d = do
     logFlatten $ " Flattening call " ++ show stmt
     args' <- flattenStmtArgs args pos
@@ -406,6 +400,7 @@ flattenStmt' (UseResources res vars body) pos detism = do
     emit pos $ UseResources res vars body'
 flattenStmt' Nop pos _ = emit pos Nop
 flattenStmt' Fail pos _ = emit pos Fail
+flattenStmt' Return pos _ = emit pos Return
 flattenStmt' Break pos _ = emit pos Break
 flattenStmt' Next pos _ = emit pos Next
 

src/Parser.hs

@@ -1032,6 +1032,14 @@ termToStmt (Call pos [] "unless" ParamIn [test]) = do
     return $ Placed (Cond t [Unplaced Next] [Unplaced Nop] Nothing Nothing Nothing) pos
 termToStmt (Call pos [] "pass" ParamIn []) = do
     return $ Placed Nop pos
+termToStmt (Call pos [] "return" ParamIn []) = do
+    return $ Placed Return pos
+termToStmt (Call pos [] "break" ParamIn []) = do
+    return $ Placed Break pos
+termToStmt (Call pos [] "fail" ParamIn []) = do
+    return $ Placed Fail pos
+termToStmt (Call pos [] "next" ParamIn []) = do
+    return $ Placed Next pos
 termToStmt (Call pos [] "|" ParamIn
              [Call _ [] "::" ParamIn [test1,thn],
               Call _ [] "::" ParamIn [Call _ [] test2 ParamIn [],els]])

src/Resources.hs

@@ -398,6 +398,7 @@ transformStmt (UseResources res vars stmts) pos = do
          ++ stores)
 transformStmt Nop pos = return ([Nop `maybePlace` pos], False)
 transformStmt Fail pos = return ([Fail `maybePlace` pos], False)
+transformStmt Return pos = return ([Return `maybePlace` pos], False)
 transformStmt Break pos = do
     restores <- restoreLoopGlobals pos
     return (restores ++ [Break `maybePlace` pos], False)

src/Types.hs

@@ -1343,6 +1343,7 @@ bodyCalls'' _ (TestBool exp) pos = do
     return []
 bodyCalls'' _ Nop _ = return []
 bodyCalls'' _ Fail _ = return []
+bodyCalls'' _ Return _ = return []
 bodyCalls'' _ Break _ = return []
 bodyCalls'' _ Next _ = return []
 
@@ -1856,6 +1857,12 @@ forceFailure st =
             bindingDetism = determinismFail $ bindingDetism st}
 
 
+-- | Returns the definitely terminal version of the specified binding state.
+forceTerminal :: BindingState -> BindingState
+forceTerminal st =
+        st {bindingDetism = Terminal}
+
+
 -- | Returns the binding state after a statement with the specified determinism that
 --   definitely binds the specified variables.
 bindingStateSeq :: Determinism -> Impurity -> Set VarName -> BindingState
@@ -2119,6 +2126,9 @@ modecheckStmt _ _ _ assigned _ final Nop pos = do
 modecheckStmt _ _ _ assigned _ final Fail pos = do
     logTyped "Mode checking Fail"
     return ([maybePlace Fail pos], forceFailure assigned)
+modecheckStmt _ _ _ assigned _ final Return pos = do
+    logTyped "Mode checking Return"
+    return ([maybePlace Return pos], forceTerminal assigned)
 modecheckStmt m name defPos assigned detism final
     stmt@(Cond tstStmt thnStmts elsStmts _ _ res) pos = do
     logTyped $ "Mode checking conditional " ++ show stmt
@@ -2714,6 +2724,7 @@ checkStmtTyped name pos Case{} ppos =
     shouldnt "Case statement left by flattening"
 checkStmtTyped _ _ Nop _ = return ()
 checkStmtTyped _ _ Fail _ = return ()
+checkStmtTyped _ _ Return _ = return ()
 checkStmtTyped _ _ Break _ = return ()
 checkStmtTyped _ _ Next _ = return ()
 

src/Unbranch.hs

@@ -522,6 +522,9 @@ unbranchStmt detism Fail pos stmts alt sense = do
     -- XXX JB we stil have alt stmts to go...
     -- return [maybePlace Fail pos] -- no execution after Fail
     return alt
+unbranchStmt detism Return pos stmts alt sense = do
+    logUnbranch "Unbranching a Return"
+    return []
 unbranchStmt _ Break pos _ _ _ = do
     logUnbranch "Unbranching a Break"
     brk <- getLoopBreak pos

src/Unique.hs

@@ -300,6 +300,7 @@ uniquenessCheckStmt (Not negated) pos =
 uniquenessCheckStmt (TestBool exp) pos = uniquenessCheckExp exp pos
 uniquenessCheckStmt Nop pos = return ()
 uniquenessCheckStmt Fail pos = return ()
+uniquenessCheckStmt Return pos = return ()
 uniquenessCheckStmt (Loop body _ _) _ = uniquenessCheckStmts body
 uniquenessCheckStmt (UseResources res _ body) pos = do
     -- resource is implicitly stored before block