Begin removing view related code and docs

src/Frontend/ContractDesugar.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Frontend.ContractDesugar
+  ( desugarContracts
+  , viewExprToAst
+  , withContractE
+  ) where
+
+import Research
+
+-- | Convert source-level contract annotations into runtime boundary checks.
+--
+-- A definition such as
+--
+--     addPos x@positive? y@positive? =@positive? (add x y)
+--
+-- is desugared to a plain definition whose body wraps every annotated
+-- argument and the result with 'withContract' from the contract library:
+--
+--     addPos = \x -> withContract positive? x
+--       (\x -> \y -> withContract positive? y
+--         (\y -> withContract positive? (add x y)
+--           (\r -> r)
+--           (\msg _ -> msg))
+--         (\msg _ -> msg))
+--       (\msg _ -> msg)
+--
+-- This makes annotated source depend on the existing 'withContract' helper,
+-- which is an ordinary 'tricu' function from 'lib/contracts.tri'. Files that
+-- use annotations should import the contract library (or another library that
+-- re-exports 'withContract').
+desugarContracts :: [TricuAST] -> [TricuAST]
+desugarContracts asts = map desugarTopItem asts
+  where
+    desugarTopItem (SDefAnn name args ret body) = desugarDefAnn name args ret body
+    desugarTopItem other = other
+
+desugarDefAnn :: String -> [DefArg] -> Maybe ViewExpr -> TricuAST -> TricuAST
+desugarDefAnn name args ret body = SDef name [] (wrapArgs args body')
+  where
+    body' = wrapReturn ret body
+
+    wrapReturn Nothing b = b
+    wrapReturn (Just c) b =
+      withContractE (viewExprToAst c) b (SLambda ["r"] (SVar "r" Nothing)) errCont
+
+    wrapArgs [] b = b
+    wrapArgs (DefBinder nm Nothing : rest) b = SLambda [nm] (wrapArgs rest b)
+    wrapArgs (DefBinder nm (Just c) : rest) b =
+      SLambda [nm] $
+        withContractE (viewExprToAst c) (SVar nm Nothing)
+          (SLambda [nm] (wrapArgs rest b))
+          errCont
+    wrapArgs (DefPhantom _ : _) _ =
+      error "phantom contract arguments are not yet supported by the frontend"
+
+    errCont = SLambda ["msg"] (SVar "msg" Nothing)
+
+-- | Turn a source annotation expression into an ordinary AST expression.
+-- Contract annotations are written with the same surface syntax as terms,
+-- so the mapping is mostly structural.
+viewExprToAst :: ViewExpr -> TricuAST
+viewExprToAst = \case
+  VEName s -> SVar s Nothing
+  VEVar s  -> SVar s Nothing
+  VEInt i  -> SInt i
+  VEString s -> SStr s
+  VEList es -> SList (map viewExprToAst es)
+  VEApp f a -> SApp (viewExprToAst f) (viewExprToAst a)
+  VERaw s -> SStr s
+  VEVarId _ -> error "view variable ids are not supported by the frontend"
+  VEForall _ _ -> error "forall annotations are not supported by the frontend"
+  VEExists _ _ -> error "exists annotations are not supported by the frontend"
+
+-- | Build an application of 'withContract' from the contract library.
+withContractE :: TricuAST -> TricuAST -> TricuAST -> TricuAST -> TricuAST
+withContractE contract value onOk onFail =
+  SApp
+    (SApp
+      (SApp
+        (SApp (SVar "withContract" Nothing) contract)
+        value)
+      onOk)
+    onFail