Useful but limited polymorphism

2026-05-25 17:54:04 -05:00
parent fdebb6c13d
commit a4fcc1cb36
18 changed files with 1781 additions and 130 deletions
--- a/src/Check.hs
+++ b/src/Check.hs
@@ -10,7 +10,7 @@ import Check.Core
 import Check.IO
 import ContentStore (ObjectRef, StorePath, getViewType)
 import Eval (evalTricu)
-import FileEval (LoadedSource(..), defaultStorePath, evaluateFile, evaluateFileWithStore, loadFileWithStore)
+import FileEval (LoadedSource(..), defaultStorePath, evaluateFile, evaluateFileWithStore, loadFileWithStore, valueViewFactsFromEnv)
 import Research (Env, ViewType)

 import qualified Data.Map as Map
@@ -29,7 +29,8 @@ checkFileWithStore store path = do
  let baseEnv = Map.union viewEnv (loadedImports loaded)
      checkerEnv = evalTricu baseEnv (loadedAst loaded)
  imports <- importedViewsFromResolvedModulesEither (loadImportedView store) (loadedModules loaded)
-  checkProgramWithEnvAndImportedViews checkerEnv imports (loadedAst loaded)
+  valueFacts <- either (errorWithoutStackTrace . ("invalid value-level viewFacts: " ++)) pure (valueViewFactsFromEnv checkerEnv)
+  checkProgramWithEnvAndImportedViews checkerEnv (imports ++ valueFacts) (loadedAst loaded)

 viewCheckerEnv :: Env
 viewCheckerEnv = unsafePerformIO (evaluateFile "./lib/view.tri")
--- a/src/Check/Core.hs
+++ b/src/Check/Core.hs
@@ -12,9 +12,12 @@ module Check.Core
  , lowerViewExpr
  ) where

+import Control.Applicative ((<|>))
 import Control.Monad.State.Strict
 import Data.Char (isDigit)
+import Data.Maybe (mapMaybe)
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T

 import ContentStore.Alias (ObjectRef(..))
@@ -27,8 +30,9 @@ import Parser (parseTricu)
 import Research

 data ImportedView = ImportedView
-  { importedViewName :: String
-  , importedViewType :: ViewType
+  { importedViewName       :: String
+  , importedViewType       :: ViewType
+  , importedViewProvenance :: ViewProvenance
  } deriving (Show, Eq)

 -- Convert module-resolution metadata into checker evidence inputs. The loader
@@ -57,7 +61,7 @@ importedViewsFromResolvedModulesEither loadView modules = concat <$> mapM fromMo
            ++ show (resolvedExportLocalName ex)
            ++ " (kind " ++ showRefKind ref ++ ", hash " ++ showRefHash ref ++ "): "
            ++ err
-          Right view -> pure [ImportedView (resolvedExportLocalName ex) view]
+          Right view -> pure [ImportedView (resolvedExportLocalName ex) view (maybe ViewUnchecked id (resolvedExportProvenance ex))]

    showRefKind = T.unpack . objectRefKind
    showRefHash = T.unpack . objectRefHash
@@ -96,6 +100,102 @@ annotateDiagnostic debugNames message =
          "symbol " ++ symText ++ " (" ++ label ++ ") " ++ unwords rest
    _ -> message

+viewExprHasParametricBinder :: ViewExpr -> Bool
+viewExprHasParametricBinder expr = case expr of
+  VEVar _ -> True
+  VEVarId _ -> True
+  VEList items -> any viewExprHasParametricBinder items
+  VEApp fn arg -> viewExprHasParametricBinder fn || viewExprHasParametricBinder arg
+  VEForall binders body -> not (null binders) || viewExprHasParametricBinder body
+  VEExists binders body -> not (null binders) || viewExprHasParametricBinder body
+  VEName _ -> False
+  VEInt _ -> False
+  VEString _ -> False
+  VERaw _ -> False
+
+rawTaintedDefinitions :: Set.Set String -> [TricuAST] -> Map.Map String String
+rawTaintedDefinitions allowedExternalFacts asts = fixedPoint initiallyRaw
+  where
+    allowedFacts = allowedExternalFacts
+    definitions = Map.fromList
+      [ (name, (args, body))
+      | ast <- asts
+      , Just (name, args, body) <- [definitionBody ast]
+      ]
+    localNames = Map.keysSet definitions
+    initiallyRaw = Map.mapMaybeWithKey
+      (\name (args, body) ->
+        if name `Set.member` allowedFacts
+          then Nothing
+          else definitionUnsafeBaseReason localNames allowedFacts (Set.fromList args) body)
+      definitions
+
+    fixedPoint tainted =
+      let tainted' = Map.mapMaybeWithKey (transitiveReason tainted) definitions
+          combined = Map.union tainted tainted'
+      in if combined == tainted then tainted else fixedPoint combined
+
+    transitiveReason tainted name (args, body)
+      | name `Map.member` tainted = Nothing
+      | name `Set.member` allowedFacts = Nothing
+      | otherwise = case filter (`Map.member` tainted) (astFreeRefs (foldr Set.delete localNames args) body) of
+          helper : _ -> Just $ "depends on raw-tainted local helper " ++ show helper ++ " (" ++ tainted Map.! helper ++ ")"
+          [] -> Nothing
+
+    definitionBody ast = case ast of
+      SDef name args body -> Just (name, args, body)
+      SDefAnn name args _ body -> Just (name, defArgNames args, body)
+      _ -> Nothing
+
+definitionUnsafeBaseReason :: Set.Set String -> Set.Set String -> Set.Set String -> TricuAST -> Maybe String
+definitionUnsafeBaseReason localNames allowedExternalFacts bound ast = case ast of
+  SVar name _
+    | name `Set.member` bound -> Nothing
+    | name `Set.member` localNames -> Nothing
+    | name `Set.member` allowedExternalFacts -> Nothing
+    | name == "triage" -> Just "uses raw triage directly"
+    | otherwise -> Just $ "depends on unchecked or unknown external name " ++ show name
+  SInt _ -> Nothing
+  SStr _ -> Nothing
+  SList items -> firstJust (map (definitionUnsafeBaseReason localNames allowedExternalFacts bound) items)
+  SDef _ args body -> definitionUnsafeBaseReason localNames allowedExternalFacts (foldr Set.insert bound args) body
+  SDefAnn _ args _ body -> definitionUnsafeBaseReason localNames allowedExternalFacts (foldr Set.insert bound (defArgNames args)) body
+  SApp fn arg -> definitionUnsafeBaseReason localNames allowedExternalFacts bound fn <|> definitionUnsafeBaseReason localNames allowedExternalFacts bound arg
+  TLeaf -> Just "uses raw t directly"
+  TStem _ -> Just "uses raw t directly"
+  TFork _ _ -> Just "uses raw t directly"
+  SLambda args body -> definitionUnsafeBaseReason localNames allowedExternalFacts (foldr Set.insert bound args) body
+  SEmpty -> Nothing
+  SImport _ _ -> Nothing
+
+firstJust :: [Maybe a] -> Maybe a
+firstJust [] = Nothing
+firstJust (Just x : _) = Just x
+firstJust (Nothing : xs) = firstJust xs
+
+astFreeRefs :: Set.Set String -> TricuAST -> [String]
+astFreeRefs candidates ast = case ast of
+  SVar name _ | name `Set.member` candidates -> [name]
+  SVar _ _ -> []
+  SInt _ -> []
+  SStr _ -> []
+  SList items -> concatMap (astFreeRefs candidates) items
+  SDef _ args body -> astFreeRefs (foldr Set.delete candidates args) body
+  SDefAnn _ args _ body -> astFreeRefs (foldr Set.delete candidates (defArgNames args)) body
+  SApp fn arg -> astFreeRefs candidates fn ++ astFreeRefs candidates arg
+  TLeaf -> []
+  TStem inner -> astFreeRefs candidates inner
+  TFork left right -> astFreeRefs candidates left ++ astFreeRefs candidates right
+  SLambda args body -> astFreeRefs (foldr Set.delete candidates args) body
+  SEmpty -> []
+  SImport _ _ -> []
+
+defArgNames :: [DefArg] -> [String]
+defArgNames = mapMaybe defArgName
+  where
+    defArgName (DefBinder name _) = Just name
+    defArgName (DefPhantom _) = Nothing
+
 lowerSource :: String -> Either String String
 lowerSource = lowerProgram . parseTricu

@@ -127,6 +227,7 @@ data LowerState = LowerState
  , knownNodeViews :: Map.Map Integer ViewExpr
  , nodePayloads :: Map.Map Integer T
  , debugNames :: Map.Map Integer String
+  , rawTaintedDefs :: Map.Map String String
  }

 type LowerM a = StateT LowerState (Either String) a
@@ -149,18 +250,29 @@ lowerProgramWithImportedViewsDebugInEnv checkerEnvForLowering imports asts = do
      topNames = map definitionName definitions
      tops = Map.fromList (zip topNames [0..])
      topCount = Map.size tops
+      importCandidates = Set.fromList (map importedViewName imports) `Set.difference` Set.fromList topNames
+      usedImportNames = Set.fromList (concatMap (astFreeRefs importCandidates) asts)
+      activeImports = filter (\imported -> importedViewName imported `Set.member` usedImportNames) imports
      importedSyms = Map.fromList
        [ (importedViewName imported, fromIntegral (topCount + idx))
-        | (idx, imported) <- zip [0..] imports
+        | (idx, imported) <- zip [0..] activeImports
        ]
      topDebug = Map.fromList [ (sym, name) | (name, sym) <- Map.toList tops ]
      importDebug = Map.fromList
        [ (sym, "imported " ++ name)
        | (name, sym) <- Map.toList importedSyms
        ]
+      localFactByName = Map.fromList [(importedViewName imported, imported) | imported <- imports, importedViewName imported `elem` topNames]
+      trustedLocalFacts =
+        [ (sym, viewTypeToExpr (importedViewType imported), importedViewProvenance imported)
+        | (name, sym) <- Map.toList tops
+        , Just imported <- [Map.lookup name localFactByName]
+        , importedViewProvenance imported `elem` [ViewChecked, ViewTrusted]
+        ]
+      trustedLocalKnown = Map.fromList [(sym, view) | (sym, view, _) <- trustedLocalFacts]
      importKnown = Map.fromList
        [ (sym, viewTypeToExpr (importedViewType imported))
-        | imported <- imports
+        | imported <- activeImports
        , Just sym <- [Map.lookup (importedViewName imported) importedSyms]
        ]
      payloads = Map.fromList $
@@ -173,31 +285,39 @@ lowerProgramWithImportedViewsDebugInEnv checkerEnvForLowering imports asts = do
        , Just term <- [Map.lookup name checkerEnvForLowering]
        ]
      annotated = [ def | def@SDefAnn {} <- asts ]
+      allowedExternalFacts = Set.fromList
+        [ importedViewName imported
+        | imported <- imports
+        , importedViewProvenance imported `elem` [ViewChecked, ViewTrusted]
+        ]
+      taintedDefs = rawTaintedDefinitions allowedExternalFacts asts
      initialState = LowerState
        { nextSym = fromIntegral (Map.size tops + Map.size importedSyms)
        , topSyms = tops
        , scopes = []
        , externSyms = importedSyms
-        , knownNodeViews = importKnown
+        , knownNodeViews = Map.union trustedLocalKnown importKnown
        , nodePayloads = payloads
        , debugNames = Map.union topDebug importDebug
+        , rawTaintedDefs = taintedDefs
        }
  (localNodes, finalState) <- runStateT (lowerAnnotatedProgram annotated) initialState
+  trustedLocalNodes <- mapM (lowerImportedView (nodePayloads finalState)) trustedLocalFacts
  importNodes <- mapM (lowerImportedView (nodePayloads finalState))
-    [ (sym, viewTypeToExpr (importedViewType imported))
-    | imported <- imports
+    [ (sym, viewTypeToExpr (importedViewType imported), importedViewProvenance imported)
+    | imported <- activeImports
    , Just sym <- [Map.lookup (importedViewName imported) importedSyms]
    ]
-  let nodes = importNodes ++ localNodes
+  let nodes = trustedLocalNodes ++ importNodes ++ localNodes
      rootSym = if null nodes then 0 else nextSym finalState - 1
      typedProgramSource =
        "typedProgram " ++ show rootSym ++ " [" ++ unwords (map parens nodes) ++ "]"
  pure (typedProgramSource, debugNames finalState)
-lowerImportedView :: Map.Map Integer T -> (Integer, ViewExpr) -> Either String String
-lowerImportedView payloadsBySym (sym, view) = do
+lowerImportedView :: Map.Map Integer T -> (Integer, ViewExpr, ViewProvenance) -> Either String String
+lowerImportedView payloadsBySym (sym, view, provenance) = do
  viewExpr <- lowerViewExpr view
  let payload = maybe "t" treeSource (Map.lookup sym payloadsBySym)
-  pure $ "typedValue " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload
+  pure $ "typedValueWithProvenance " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload ++ " " ++ viewProvenanceSource provenance

 lowerAnnotatedProgram :: [TricuAST] -> LowerM [String]
 lowerAnnotatedProgram defs = do
@@ -207,19 +327,23 @@ lowerAnnotatedProgram defs = do

 lowerDefinitionDeclaration :: TricuAST -> LowerM [String]
 lowerDefinitionDeclaration (SDefAnn name args ret _) = do
-  sym <- symbolForTop name
-  argViews <- mapM lowerArgView args
-  retExpr <- liftEither (maybe (Right "viewAny") lowerViewExpr ret)
-  recordKnown sym (declaredDefinitionView args ret)
-  node <- emitDeclaration sym argViews retExpr
-  pure [node]
+  let (_, _, declaredView) = canonicalDefinitionViews args ret
+  tainted <- gets rawTaintedDefs
+  if viewExprHasParametricBinder declaredView && name `Map.member` tainted
+    then liftEither (Left $ "parametric View definition " ++ show name ++ " depends on raw intensional Tree Calculus machinery (" ++ tainted Map.! name ++ "); use a trusted eliminator boundary instead")
+    else do
+      sym <- symbolForTop name
+      recordKnown sym declaredView
+      node <- typedValueNode sym declaredView
+      pure [node]
 lowerDefinitionDeclaration _ = liftEither (Left "internal check error: expected annotated definition")

 lowerDefinitionFlow :: TricuAST -> LowerM [String]
 lowerDefinitionFlow (SDefAnn _ args ret body) = withDefinitionScope args $ do
-  binderNodes <- concat <$> mapM lowerBinderDeclaration args
-  let phantomViews = map lowerPhantomArgType (phantomArgs args)
-  (returnArgs, returnResult) <- lowerReturnObligation ret
+  let (flowArgs, flowRet, _) = canonicalDefinitionViews args ret
+  binderNodes <- concat <$> mapM lowerBinderDeclaration flowArgs
+  let phantomViews = map lowerPhantomArgType (phantomArgs flowArgs)
+  (returnArgs, returnResult) <- lowerReturnObligation flowRet
  bodyNodes <- lowerBodyWithPhantoms (phantomViews ++ returnArgs) returnResult body
  pure (binderNodes ++ bodyNodes)
 lowerDefinitionFlow _ = liftEither (Left "internal check error: expected annotated definition")
@@ -227,6 +351,19 @@ lowerDefinitionFlow _ = liftEither (Left "internal check error: expected annotat
 viewAnyType :: ViewExpr
 viewAnyType = VEName "Any"

+canonicalDefinitionViews :: [DefArg] -> Maybe ViewExpr -> ([DefArg], Maybe ViewExpr, ViewExpr)
+canonicalDefinitionViews args ret =
+  let rawView = declaredDefinitionView args ret
+      vars = Set.toList (freeViewVars rawView)
+      binderIds = zip vars [0..]
+      binderMap = Map.fromList binderIds
+      mappedArgs = map (mapDefArgView (rewriteViewVars binderMap)) args
+      mappedRet = fmap (rewriteViewVars binderMap) ret
+      mappedView = declaredDefinitionView mappedArgs mappedRet
+      binders = map snd binderIds
+      declaredView = if null vars then mappedView else VEForall binders mappedView
+  in (mappedArgs, mappedRet, declaredView)
+
 declaredDefinitionView :: [DefArg] -> Maybe ViewExpr -> ViewExpr
 declaredDefinitionView args ret =
  case map argType args of
@@ -235,6 +372,10 @@ declaredDefinitionView args ret =
  where
    resultType = maybe viewAnyType id ret

+mapDefArgView :: (ViewExpr -> ViewExpr) -> DefArg -> DefArg
+mapDefArgView f (DefBinder name mTy) = DefBinder name (fmap f mTy)
+mapDefArgView f (DefPhantom ty) = DefPhantom (f ty)
+
 argType :: DefArg -> ViewExpr
 argType (DefBinder _ Nothing) = viewAnyType
 argType (DefBinder _ (Just ty)) = ty
@@ -249,10 +390,13 @@ emitDeclaration sym views retExpr = do
  pure $ "typedValue " ++ show sym ++ " (viewFn [" ++ unwords (map parens views) ++ "] " ++ parens retExpr ++ ") " ++ payload

 typedValueNode :: Integer -> ViewExpr -> LowerM String
-typedValueNode sym view = do
+typedValueNode sym view = typedValueNodeWithProvenance sym view ViewChecked
+
+typedValueNodeWithProvenance :: Integer -> ViewExpr -> ViewProvenance -> LowerM String
+typedValueNodeWithProvenance sym view provenance = do
  viewExpr <- liftEither (lowerViewExpr view)
  payload <- payloadSourceFor sym
-  pure ("typedValue " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload)
+  pure ("typedValueWithProvenance " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload ++ " " ++ viewProvenanceSource provenance)

 typedRequireNode :: Integer -> ViewExpr -> LowerM String
 typedRequireNode sym view = do
@@ -260,6 +404,11 @@ typedRequireNode sym view = do
  payload <- payloadSourceFor sym
  pure ("typedRequire " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload)

+viewProvenanceSource :: ViewProvenance -> String
+viewProvenanceSource ViewChecked = "viewProvenanceChecked"
+viewProvenanceSource ViewTrusted = "viewProvenanceTrusted"
+viewProvenanceSource ViewUnchecked = "viewProvenanceUnchecked"
+
 declareKnown :: Integer -> ViewExpr -> LowerM String
 declareKnown sym view = do
  recordKnown sym view
@@ -553,11 +702,23 @@ lowerListLiteral items = do
 lowerApplicationArgument :: Maybe ViewExpr -> TricuAST -> LowerM (Integer, [String], Maybe ViewExpr)
 lowerApplicationArgument (Just fnView) arg =
  case viewExprFnParts fnView of
-    Just (argView : _, _) -> lowerExprKnownAgainst arg argView
+    Just (argView : _, _)
+      | containsViewVar argView -> lowerExprKnown arg
+      | otherwise -> lowerExprKnownAgainst arg argView
    _ -> lowerExprKnown arg
 lowerApplicationArgument _ arg =
  lowerExprKnown arg

+containsViewVar :: ViewExpr -> Bool
+containsViewVar view = case view of
+  VEVar _ -> True
+  VEVarId _ -> True
+  VEList items -> any containsViewVar items
+  VEApp f a -> containsViewVar f || containsViewVar a
+  VEForall _ body -> containsViewVar body
+  VEExists _ body -> containsViewVar body
+  _ -> False
+
 applicationDebugLabel :: TricuAST -> String
 applicationDebugLabel func =
  case applicationHeadName func of
@@ -672,6 +833,7 @@ lowerArgView (DefPhantom ty) = liftEither (lowerViewExpr ty)
 viewTypeToExpr :: ViewType -> ViewExpr
 viewTypeToExpr view = case view of
  VTName name -> VEName name
+  VTVar varId -> VEVarId varId
  VTRef n -> VEApp (VEName "Ref") (VEInt n)
  VTRefText s -> VEApp (VEName "Ref") (VEString s)
  VTList item -> VEApp (VEName "List") (viewTypeToExpr item)
@@ -679,6 +841,8 @@ viewTypeToExpr view = case view of
  VTPair left right -> VEApp (VEApp (VEName "Pair") (viewTypeToExpr left)) (viewTypeToExpr right)
  VTResult err ok -> VEApp (VEApp (VEName "Result") (viewTypeToExpr err)) (viewTypeToExpr ok)
  VTGuarded base guard -> VEApp (VEApp (VEName "viewGuarded") (viewTypeToExpr base)) (VERaw (treeSource guard))
+  VTForall binders body -> VEForall binders (viewTypeToExpr body)
+  VTExists binders body -> VEExists binders (viewTypeToExpr body)
  VTFn args resultView -> viewExprFn (map viewTypeToExpr args) (viewTypeToExpr resultView)

 viewExprFn :: [ViewExpr] -> ViewExpr -> ViewExpr
@@ -688,12 +852,15 @@ viewExprList :: ViewExpr -> ViewExpr
 viewExprList = VEApp (VEName "List")

 viewExprFnParts :: ViewExpr -> Maybe ([ViewExpr], ViewExpr)
+viewExprFnParts (VEForall _ body) = viewExprFnParts body
 viewExprFnParts (VEApp (VEApp (VEName "Fn") (VEList args)) resultView) = Just (args, resultView)
 viewExprFnParts _ = Nothing

 viewExprAsType :: ViewExpr -> Maybe ViewType
 viewExprAsType view = case view of
  VEName name -> Just (VTName name)
+  VEVar _ -> Nothing
+  VEVarId varId -> Just (VTVar varId)
  VEApp (VEName "Ref") (VEInt n) -> Just (VTRef n)
  VEApp (VEName "Ref") (VEString s) -> Just (VTRefText s)
  VEApp (VEName "List") item -> VTList <$> viewExprAsType item
@@ -701,6 +868,8 @@ viewExprAsType view = case view of
  VEApp (VEApp (VEName "Pair") left) right -> VTPair <$> viewExprAsType left <*> viewExprAsType right
  VEApp (VEApp (VEName "Result") err) ok -> VTResult <$> viewExprAsType err <*> viewExprAsType ok
  VEApp (VEApp (VEName "Fn") (VEList args)) resultView -> VTFn <$> mapM viewExprAsType args <*> viewExprAsType resultView
+  VEForall binders body -> VTForall binders <$> viewExprAsType body
+  VEExists binders body -> VTExists binders <$> viewExprAsType body
  _ -> Nothing

 lowerViewExpr :: ViewExpr -> Either String String
@@ -711,6 +880,8 @@ lowerViewExpr ty = case ty of
  VEName "Byte" -> Right "viewByte"
  VEName "Unit" -> Right "viewUnit"
  VEName name -> Right name
+  VEVar name -> Right $ "viewVar " ++ show name
+  VEVarId varId -> Right $ "viewVar " ++ show varId
  VEInt n -> Right (show n)
  VEString s -> Right (show s)
  VEList items -> do
@@ -740,8 +911,45 @@ lowerViewExpr ty = case ty of
    f <- lowerViewExpr func
    a <- lowerViewExpr arg
    Right $ parens f ++ " " ++ parens a
+  VEForall binders body -> do
+    bodyExpr <- lowerViewExpr body
+    Right $ "viewForall " ++ lowerStringList binders ++ " " ++ parens bodyExpr
+  VEExists binders body -> do
+    bodyExpr <- lowerViewExpr body
+    Right $ "viewExists " ++ lowerStringList binders ++ " " ++ parens bodyExpr
  VERaw raw -> Right raw

+lowerStringList :: [Integer] -> String
+lowerStringList items = "[" ++ unwords (map (parens . show) items) ++ "]"
+
+quantifyFreeViewVars :: ViewExpr -> ViewExpr
+quantifyFreeViewVars view =
+  let vars = Set.toList (freeViewVars view)
+      binderIds = zip vars [0..]
+      binderMap = Map.fromList binderIds
+      body = rewriteViewVars binderMap view
+      binders = map snd binderIds
+  in if null vars then view else VEForall binders body
+
+rewriteViewVars :: Map.Map String Integer -> ViewExpr -> ViewExpr
+rewriteViewVars binderMap view = case view of
+  VEVar name -> maybe (VEVar name) VEVarId (Map.lookup name binderMap)
+  VEList items -> VEList (map (rewriteViewVars binderMap) items)
+  VEApp f a -> VEApp (rewriteViewVars binderMap f) (rewriteViewVars binderMap a)
+  VEForall binders body -> VEForall binders (rewriteViewVars binderMap body)
+  VEExists binders body -> VEExists binders (rewriteViewVars binderMap body)
+  _ -> view
+
+freeViewVars :: ViewExpr -> Set.Set String
+freeViewVars view = case view of
+  VEVar name -> Set.singleton name
+  VEVarId _ -> Set.empty
+  VEList items -> Set.unions (map freeViewVars items)
+  VEApp f a -> Set.union (freeViewVars f) (freeViewVars a)
+  VEForall _ body -> freeViewVars body
+  VEExists _ body -> freeViewVars body
+  _ -> Set.empty
+
 treeSource :: T -> String
 treeSource Leaf = "t"
 treeSource (Stem x) = "(t " ++ treeSource x ++ ")"
--- a/src/Check/IO.hs
+++ b/src/Check/IO.hs
@@ -32,12 +32,15 @@ viewExprList :: ViewExpr -> ViewExpr
 viewExprList = VEApp (VEName "List")

 viewExprFnParts :: ViewExpr -> Maybe ([ViewExpr], ViewExpr)
+viewExprFnParts (VEForall _ body) = viewExprFnParts body
 viewExprFnParts (VEApp (VEApp (VEName "Fn") (VEList args)) resultView) = Just (args, resultView)
 viewExprFnParts _ = Nothing

 viewExprAsType :: ViewExpr -> Maybe ViewType
 viewExprAsType view = case view of
  VEName name -> Just (VTName name)
+  VEVar _ -> Nothing
+  VEVarId varId -> Just (VTVar varId)
  VEApp (VEName "Ref") (VEInt n) -> Just (VTRef n)
  VEApp (VEName "Ref") (VEString st) -> Just (VTRefText st)
  VEApp (VEName "List") item -> VTList <$> viewExprAsType item
@@ -45,11 +48,14 @@ viewExprAsType view = case view of
  VEApp (VEApp (VEName "Pair") left) right -> VTPair <$> viewExprAsType left <*> viewExprAsType right
  VEApp (VEApp (VEName "Result") err) ok -> VTResult <$> viewExprAsType err <*> viewExprAsType ok
  VEApp (VEApp (VEName "Fn") (VEList args)) resultView -> VTFn <$> mapM viewExprAsType args <*> viewExprAsType resultView
+  VEForall binders body -> VTForall binders <$> viewExprAsType body
+  VEExists binders body -> VTExists binders <$> viewExprAsType body
  _ -> Nothing

 viewTypeToExpr :: ViewType -> ViewExpr
 viewTypeToExpr view = case view of
  VTName name -> VEName name
+  VTVar varId -> VEVarId varId
  VTRef n -> VEApp (VEName "Ref") (VEInt n)
  VTRefText st -> VEApp (VEName "Ref") (VEString st)
  VTList item -> VEApp (VEName "List") (viewTypeToExpr item)
@@ -57,6 +63,8 @@ viewTypeToExpr view = case view of
  VTPair left right -> VEApp (VEApp (VEName "Pair") (viewTypeToExpr left)) (viewTypeToExpr right)
  VTResult err ok -> VEApp (VEApp (VEName "Result") (viewTypeToExpr err)) (viewTypeToExpr ok)
  VTGuarded base guard -> VEApp (VEApp (VEName "viewGuarded") (viewTypeToExpr base)) (VERaw (treeSource guard))
+  VTForall binders body -> VEForall binders (viewTypeToExpr body)
+  VTExists binders body -> VEExists binders (viewTypeToExpr body)
  VTFn args resultView -> viewExprFn (map viewTypeToExpr args) (viewTypeToExpr resultView)

 treeSource :: T -> String
--- a/src/ContentStore/ViewContract.hs
+++ b/src/ContentStore/ViewContract.hs
@@ -36,6 +36,7 @@ encodeViewType :: ViewType -> BS.ByteString
 encodeViewType = go
  where
    go (VTName name) = BS.cons 0x00 (putBytes (encodeUtf8 (T.pack name)))
+    go (VTVar varId) = BS.cons 0x08 (putU32 (fromIntegral varId))
    go (VTRefRaw (ViewRefInt n)) = BS.cons 0x01 (putBytes (encodeUtf8 (T.pack ("i:" ++ show n))))
    go (VTRefRaw (ViewRefText s)) = BS.cons 0x01 (putBytes (encodeUtf8 (T.pack ("s:" ++ s))))
    go (VTList item) = BS.cons 0x02 (go item)
@@ -43,6 +44,8 @@ encodeViewType = go
    go (VTPair left right) = BS.cons 0x04 (go left <> go right)
    go (VTResult err ok) = BS.cons 0x05 (go err <> go ok)
    go (VTGuarded base guard) = BS.cons 0x07 (go base <> putBytes (encodeTreeTerm guard))
+    go (VTForall binders body) = BS.cons 0x09 (putIntegerList binders <> go body)
+    go (VTExists binders body) = BS.cons 0x0a (putIntegerList binders <> go body)
    go (VTFn args result) =
      BS.cons 0x06 (putU32 (length args) <> mconcat (map go args) <> go result)

@@ -76,12 +79,15 @@ viewTypeToTree view = case view of
  VTName "Byte" -> viewTypeToTree (VTRef 2)
  VTName "Unit" -> viewTypeToTree (VTRef 3)
  VTName name -> viewTypeToTree (VTRefText name)
+  VTVar varId -> record 8 [field 10 (ofNumber varId)]
  VTRefRaw ref -> record 2 [field 2 (viewRefToTree ref)]
  VTList item -> record 3 [field 3 (viewTypeToTree item)]
  VTMaybe item -> record 4 [field 3 (viewTypeToTree item)]
  VTPair left right -> record 5 [field 4 (viewTypeToTree left), field 5 (viewTypeToTree right)]
  VTResult err ok -> record 6 [field 6 (viewTypeToTree err), field 7 (viewTypeToTree ok)]
  VTGuarded base guard -> record 7 [field 8 (viewTypeToTree base), field 9 guard]
+  VTForall binders body -> record 9 [field 11 (ofList (map ofNumber binders)), field 12 (viewTypeToTree body)]
+  VTExists binders body -> record 10 [field 11 (ofList (map ofNumber binders)), field 12 (viewTypeToTree body)]
  VTFn args result -> record 1 [field 0 (ofList (map viewTypeToTree args)), field 1 (viewTypeToTree result)]
  where
    record tag fields = Fork (ofNumber tag) (ofList fields)
@@ -107,6 +113,9 @@ treeToViewType viewTree = do
    5 -> VTPair <$> (fieldValueAt 4 fields >>= treeToViewType) <*> (fieldValueAt 5 fields >>= treeToViewType)
    6 -> VTResult <$> (fieldValueAt 6 fields >>= treeToViewType) <*> (fieldValueAt 7 fields >>= treeToViewType)
    7 -> VTGuarded <$> (fieldValueAt 8 fields >>= treeToViewType) <*> fieldValueAt 9 fields
+    8 -> VTVar <$> (fieldValueAt 10 fields >>= toNumber)
+    9 -> VTForall <$> (fieldValueAt 11 fields >>= integerListFromTree) <*> (fieldValueAt 12 fields >>= treeToViewType)
+    10 -> VTExists <$> (fieldValueAt 11 fields >>= integerListFromTree) <*> (fieldValueAt 12 fields >>= treeToViewType)
    _ -> Left $ "unknown View Contract view tag in tree: " ++ show tag
  where
    recordParts (Fork tagTree fieldsTree) = do
@@ -133,6 +142,8 @@ treeToViewType viewTree = do
      pure (tag, value)
    fieldParts _ = Left "View Contract view field is not a pair"

+    integerListFromTree tree = toList tree >>= mapM toNumber
+
    viewRefFromTree tree =
      case toNumber tree of
        Right n -> Right (ViewRefInt n)
@@ -175,6 +186,17 @@ getViewTypeBytes bs = case BS.uncons bs of
      (rawGuard, afterGuard) <- getBytes afterBase
      guard <- decodeTreeTerm rawGuard
      pure (VTGuarded base guard, afterGuard)
+    0x08 -> do
+      (varId, afterVarId) <- getU32 rest
+      pure (VTVar (fromIntegral varId), afterVarId)
+    0x09 -> do
+      (binders, afterBinders) <- getIntegerList rest
+      (body, afterBody) <- getViewTypeBytes afterBinders
+      pure (VTForall binders body, afterBody)
+    0x0a -> do
+      (binders, afterBinders) <- getIntegerList rest
+      (body, afterBody) <- getViewTypeBytes afterBinders
+      pure (VTExists binders body, afterBody)
    _ -> Left $ "unknown View Contract type tag: " ++ show tag

 parseViewRef :: String -> Either String ViewRef
@@ -193,6 +215,19 @@ getMany n bs
      (item, afterItem) <- getViewTypeBytes rest
      go (k - 1) afterItem (item : acc)

+putIntegerList :: [Integer] -> BS.ByteString
+putIntegerList items = putU32 (length items) <> mconcat (map (putU32 . fromIntegral) items)
+
+getIntegerList :: BS.ByteString -> Either String ([Integer], BS.ByteString)
+getIntegerList bs = do
+  (count, afterCount) <- getU32 bs
+  go count afterCount []
+  where
+    go 0 rest acc = Right (reverse acc, rest)
+    go n rest acc = do
+      (varId, afterVarId) <- getU32 rest
+      go (n - 1) afterVarId (fromIntegral varId : acc)
+
 putBytes :: BS.ByteString -> BS.ByteString
 putBytes bytes = putU32 (BS.length bytes) <> bytes

--- a/src/ContentStore/ViewTree.hs
+++ b/src/ContentStore/ViewTree.hs
@@ -4,7 +4,9 @@ module ContentStore.ViewTree
  , encodeViewTree
  , decodeViewTree
  , singletonViewTree
+  , singletonViewTreeWithProvenance
  , viewTreeRootTerm
+  , viewTreeRootViewFact
  , putViewTree
  , getViewTree
  ) where
@@ -13,8 +15,8 @@ import ContentStore.Arboricx (decodeTreeTerm, encodeTreeTerm)
 import ContentStore.Alias (ObjectRef(..))
 import ContentStore.Filesystem (getObject, putObject)
 import ContentStore.Object (Domain(..), StorePath)
-import ContentStore.ViewContract (viewTypeToTree)
-import Research (T(..), ViewType(..), ofList, ofNumber, toList, toNumber)
+import ContentStore.ViewContract (treeToViewType, viewTypeToTree)
+import Research (T(..), ViewProvenance(..), ViewType(..), ofList, ofNumber, toList, toNumber)

 import qualified Data.ByteString as BS
 import qualified Data.Text as T
@@ -35,10 +37,13 @@ decodeViewTree :: BS.ByteString -> Either String T
 decodeViewTree = decodeTreeTerm

 singletonViewTree :: Maybe ViewType -> T -> T
-singletonViewTree mView term =
+singletonViewTree mView term = singletonViewTreeWithProvenance (fmap (\view -> (view, ViewUnchecked)) mView) term
+
+singletonViewTreeWithProvenance :: Maybe (ViewType, ViewProvenance) -> T -> T
+singletonViewTreeWithProvenance mViewFact term =
  record typedProgramTag
    [ field typedProgramFieldRoot (ofNumber 0)
-    , field typedProgramFieldNodes (ofList [typedValueNode 0 (maybe viewAnyTree viewTypeToTree mView) term])
+    , field typedProgramFieldNodes (ofList [typedValueNode 0 (maybe viewAnyTree (viewTypeToTree . fst) mViewFact) term (fmap snd mViewFact)])
    ]

 -- | Extract the executable root payload from a view-tree artifact without
@@ -69,19 +74,55 @@ viewTreeRootTerm tree = do
        23 -> fieldValue typedNodeFieldTerm node
        _  -> Left $ "view-tree node has unexpected tag: " ++ show tag

+viewTreeRootViewFact :: T -> Either String (Maybe (ViewType, ViewProvenance))
+viewTreeRootViewFact tree = do
+  tag <- recordTag tree
+  if tag /= typedProgramTag
+    then Left $ "view-tree root has unexpected tag: " ++ show tag
+    else do
+      root <- fieldValue typedProgramFieldRoot tree >>= toNumber
+      nodes <- fieldValue typedProgramFieldNodes tree >>= toList
+      lookupRoot root nodes
+  where
+    lookupRoot _ [] = Left "view-tree root symbol not found"
+    lookupRoot root (node : rest) = do
+      sym <- fieldValue typedNodeFieldSymbol node >>= toNumber
+      if sym == root
+        then nodeViewFact node
+        else lookupRoot root rest
+
+    nodeViewFact node = do
+      tag <- recordTag node
+      case tag of
+        21 -> do
+          view <- fieldValue typedNodeFieldView node >>= treeToViewType
+          provenance <- maybe (Right ViewUnchecked) treeToViewProvenance (fieldValueMaybe typedNodeFieldProvenance node)
+          Right (Just (view, provenance))
+        23 -> do
+          view <- fieldValue typedNodeFieldView node >>= treeToViewType
+          provenance <- maybe (Right ViewUnchecked) treeToViewProvenance (fieldValueMaybe typedNodeFieldProvenance node)
+          Right (Just (view, provenance))
+        22 -> Right Nothing
+        _  -> Left $ "view-tree node has unexpected tag: " ++ show tag
+
 record :: Integer -> [T] -> T
 record tag fields = Fork (ofNumber tag) (ofList fields)

 field :: Integer -> T -> T
 field tag value = Fork (ofNumber tag) value

-typedValueNode :: Integer -> T -> T -> T
-typedValueNode sym view term =
-  record typedNodeTagValue
+typedValueNode :: Integer -> T -> T -> Maybe ViewProvenance -> T
+typedValueNode sym view term mProvenance =
+  record typedNodeTagValue $
    [ field typedNodeFieldSymbol (ofNumber sym)
    , field typedNodeFieldView view
    , field typedNodeFieldTerm term
-    ]
+    ] ++ maybe [] (\provenance -> [field typedNodeFieldProvenance (viewProvenanceToTree provenance)]) mProvenance
+
+viewProvenanceToTree :: ViewProvenance -> T
+viewProvenanceToTree ViewChecked = ofNumber 0
+viewProvenanceToTree ViewTrusted = ofNumber 1
+viewProvenanceToTree ViewUnchecked = ofNumber 2

 viewAnyTree :: T
 viewAnyTree = record 0 []
@@ -102,6 +143,12 @@ fieldValue expected recordTree = do
    Just value -> Right value
    Nothing -> Left $ "view-tree missing field tag: " ++ show expected

+fieldValueMaybe :: Integer -> T -> Maybe T
+fieldValueMaybe expected recordTree = do
+  fields <- either (const Nothing) Just (recordFields recordTree)
+  values <- either (const Nothing) Just (mapM fieldParts fields)
+  lookup expected values
+
 fieldParts :: T -> Either String (Integer, T)
 fieldParts (Fork tagTree value) = do
  tag <- toNumber tagTree
@@ -113,11 +160,21 @@ typedProgramTag = 20
 typedProgramFieldRoot = 0
 typedProgramFieldNodes = 1

-typedNodeTagValue, typedNodeFieldSymbol, typedNodeFieldView, typedNodeFieldTerm :: Integer
+typedNodeTagValue, typedNodeFieldSymbol, typedNodeFieldView, typedNodeFieldTerm, typedNodeFieldProvenance :: Integer
 typedNodeTagValue = 21
 typedNodeFieldSymbol = 0
 typedNodeFieldView = 1
 typedNodeFieldTerm = 2
+typedNodeFieldProvenance = 5
+
+treeToViewProvenance :: T -> Either String ViewProvenance
+treeToViewProvenance tree = do
+  tag <- toNumber tree
+  case tag of
+    0 -> Right ViewChecked
+    1 -> Right ViewTrusted
+    2 -> Right ViewUnchecked
+    _ -> Left $ "unknown view-tree View Contract provenance tag: " ++ show tag

 putViewTree :: StorePath -> T -> IO ObjectRef
 putViewTree store viewTree = do
--- a/src/FileEval.hs
+++ b/src/FileEval.hs
@@ -14,11 +14,13 @@ module FileEval
  , compileFileWithStore
  , loadFileWithStore
  , loadFileWithStoreMode
+  , valueViewFactsFromEnv
  , defaultStorePath
  ) where

 import Check.Core
-  ( checkProgramWithEnvAndImportedViews
+  ( ImportedView(..)
+  , checkProgramWithEnvAndImportedViews
  , importedViewsFromResolvedModulesEither
  , lowerViewExpr
  )
@@ -34,6 +36,8 @@ import Wire (buildBundle, encodeBundle, decodeBundle, verifyBundle, Bundle(..))

 import Data.List       (partition, isPrefixOf)
 import Data.Maybe      (mapMaybe)
+import Control.Monad   (forM)
+import qualified Data.Set as Set
 import System.Directory (getHomeDirectory, getTemporaryDirectory)
 import System.FilePath ((</>))
 import System.Exit (die)
@@ -199,21 +203,31 @@ buildWorkspaceModule ctx store moduleName sourcePath = do
        else localNames
  localViewsResult <- localViews
  resolvedLocalViews <- either (errorWithoutStackTrace . (("Workspace module " ++ show moduleName ++ " has invalid exported View Contract annotation: ") ++)) pure localViewsResult
-  exports <- mapM (buildExport env resolvedLocalViews) names
+  importedViews <- importedViewsFromResolvedModulesEither (getViewType store) (loadedModules loaded)
+  valueFacts <- either (errorWithoutStackTrace . (("Workspace module " ++ show moduleName ++ " has invalid value-level viewFacts: ") ++)) pure (valueViewFactsFromEnv env)
+  validateValueViewFactExports moduleName names valueFacts
+  let localViewFacts = Map.map (\view -> (view, ViewChecked)) resolvedLocalViews
+      importedViewFacts = Map.fromList [(importedViewName iv, (importedViewType iv, importedViewProvenance iv)) | iv <- importedViews]
+      valueViewFacts = Map.fromList [(importedViewName iv, (importedViewType iv, importedViewProvenance iv)) | iv <- valueFacts]
+      exportViewFacts = Map.unions [localViewFacts, valueViewFacts, importedViewFacts]
+  exports <- mapM (buildExport env exportViewFacts) names
  manifestHash <- putManifest store (ModuleManifest [] exports)
  writeAlias store ModuleAlias (T.pack moduleName) (ObjectRef (unDomain manifestDomain) manifestHash)
  where
-    buildExport env localViews name = case Map.lookup name env of
+    buildExport env viewFacts name = case Map.lookup name env of
      Nothing -> errorWithoutStackTrace $ "Workspace module export not found after evaluation: " ++ name
      Just term -> do
-        let exportView = Map.lookup name localViews
-        rootRef <- putViewTree store (singletonViewTree exportView term)
+        let exportFact = Map.lookup name viewFacts
+            exportView = fmap fst exportFact
+            exportProvenance = fmap snd exportFact
+        rootRef <- putViewTree store (singletonViewTreeWithProvenance exportFact term)
        viewRef <- mapM (putViewType store) exportView
        return ModuleExport
          { moduleExportName = T.pack name
          , moduleExportObject = rootRef
          , moduleExportAbi = "arboricx.abi.view-tree.v1"
          , moduleExportView = viewRef
+          , moduleExportViewProvenance = exportProvenance
          }

 enforceWorkspaceModuleContracts :: StorePath -> String -> Env -> [ResolvedModule] -> [TricuAST] -> IO ()
@@ -223,12 +237,62 @@ enforceWorkspaceModuleContracts store moduleName importEnv modules asts
      viewEnv <- evaluateFileWithContextWithStoreAndMode IgnoreContracts (Just store) Map.empty "./lib/view.tri"
      let checkerEnv = evalTricu (Map.union viewEnv importEnv) asts
      imports <- importedViewsFromResolvedModulesEither (getViewType store) modules
-      resultText <- checkProgramWithEnvAndImportedViews checkerEnv imports asts
+      valueFacts <- either (errorWithoutStackTrace . (("Workspace module " ++ show moduleName ++ " has invalid value-level viewFacts: ") ++)) pure (valueViewFactsFromEnv checkerEnv)
+      resultText <- checkProgramWithEnvAndImportedViews checkerEnv (imports ++ valueFacts) asts
      case resultText of
        "ok" -> pure ()
        diagnostic -> errorWithoutStackTrace $
          "Workspace module " ++ show moduleName ++ " failed View Contract check: " ++ diagnostic

+valueViewFactsFromEnv :: Env -> Either String [ImportedView]
+valueViewFactsFromEnv env = case Map.lookup "viewFacts" env of
+  Nothing -> Right []
+  Just factsTree -> do
+    facts <- context "viewFacts is not a list" (toList factsTree)
+    decoded <- forM (zip [0 :: Int ..] facts) (uncurry decodeFactAt)
+    rejectDuplicateFacts decoded
+    pure decoded
+  where
+    decodeFactAt index factTree = do
+      (nameTree, rest) <- context prefix (pairParts factTree)
+      name <- context (prefix ++ ": export name is not a string") (toString nameTree)
+      (provenanceTree, viewTree) <- context (prefixFor name ++ ": payload is not a pair") (pairParts rest)
+      provenance <- context (prefixFor name ++ ": invalid provenance") (decodeProvenance provenanceTree)
+      view <- context (prefixFor name ++ ": malformed View") (treeToViewType viewTree)
+      pure (ImportedView name view provenance)
+      where
+        prefix = "viewFacts[" ++ show index ++ "]"
+        prefixFor name = prefix ++ " for " ++ show name
+
+    pairParts (Fork left right) = Right (left, right)
+    pairParts _ = Left "expected pair"
+
+    decodeProvenance tree = do
+      n <- toNumber tree
+      case n of
+        0 -> Right ViewChecked
+        1 -> Right ViewTrusted
+        2 -> Right ViewUnchecked
+        _ -> Left $ "unknown provenance tag " ++ show n
+
+    rejectDuplicateFacts facts = go Set.empty facts
+      where
+        go _ [] = Right ()
+        go seen (fact : rest)
+          | importedViewName fact `Set.member` seen = Left $ "duplicate viewFacts entry for " ++ show (importedViewName fact)
+          | otherwise = go (Set.insert (importedViewName fact) seen) rest
+
+    context label = either (Left . ((label ++ ": ") ++)) Right
+
+validateValueViewFactExports :: String -> [String] -> [ImportedView] -> IO ()
+validateValueViewFactExports moduleName exportedNames facts = do
+  let exported = Set.fromList exportedNames
+      missing = [importedViewName fact | fact <- facts, importedViewName fact `Set.notMember` exported]
+  case missing of
+    [] -> pure ()
+    name : _ -> errorWithoutStackTrace $
+      "Workspace module " ++ show moduleName ++ " has value-level viewFacts for non-exported name " ++ show name
+
 isAnnotatedDefinition :: TricuAST -> Bool
 isAnnotatedDefinition SDefAnn {} = True
 isAnnotatedDefinition _ = False
@@ -236,10 +300,13 @@ isAnnotatedDefinition _ = False
 topLevelDefinitions :: [TricuAST] -> [String]
 topLevelDefinitions = mapMaybe go
  where
-    go (SDef name _ _) = Just name
-    go (SDefAnn name _ _ _) = Just name
+    go (SDef name _ _) | not (isViewFactMetadataName name) = Just name
+    go (SDefAnn name _ _ _) | not (isViewFactMetadataName name) = Just name
    go _ = Nothing

+isViewFactMetadataName :: String -> Bool
+isViewFactMetadataName name = name == "viewFacts"
+
 topLevelDefinitionViews :: [TricuAST] -> Map.Map String ViewExpr
 topLevelDefinitionViews asts = Map.fromList (mapMaybe go asts)
  where
@@ -261,7 +328,7 @@ resolveViewExpression checkerEnv view = do
    Left err -> Left $ "could not validate view expression " ++ show expr ++ ": " ++ err

 definitionView :: [DefArg] -> Maybe ViewExpr -> ViewExpr
-definitionView args resultView =
+definitionView args resultView = quantifyFreeViewVars $
  case argViews of
    [] -> finalView
    _  -> VEApp (VEApp (VEName "Fn") (VEList argViews)) finalView
@@ -269,6 +336,34 @@ definitionView args resultView =
    argViews = map defArgView args
    finalView = maybe exportedViewAny id resultView

+quantifyFreeViewVars :: ViewExpr -> ViewExpr
+quantifyFreeViewVars view =
+  let vars = Set.toList (freeViewVars view)
+      binderIds = zip vars [0..]
+      binderMap = Map.fromList binderIds
+      body = rewriteViewVars binderMap view
+      binders = map snd binderIds
+  in if null vars then view else VEForall binders body
+
+rewriteViewVars :: Map.Map String Integer -> ViewExpr -> ViewExpr
+rewriteViewVars binderMap view = case view of
+  VEVar name -> maybe (VEVar name) VEVarId (Map.lookup name binderMap)
+  VEList items -> VEList (map (rewriteViewVars binderMap) items)
+  VEApp f a -> VEApp (rewriteViewVars binderMap f) (rewriteViewVars binderMap a)
+  VEForall binders body -> VEForall binders (rewriteViewVars binderMap body)
+  VEExists binders body -> VEExists binders (rewriteViewVars binderMap body)
+  _ -> view
+
+freeViewVars :: ViewExpr -> Set.Set String
+freeViewVars view = case view of
+  VEVar name -> Set.singleton name
+  VEVarId _ -> Set.empty
+  VEList items -> Set.unions (map freeViewVars items)
+  VEApp f a -> Set.union (freeViewVars f) (freeViewVars a)
+  VEForall _ body -> freeViewVars body
+  VEExists _ body -> freeViewVars body
+  _ -> Set.empty
+
 defArgView :: DefArg -> ViewExpr
 defArgView (DefBinder _ Nothing) = exportedViewAny
 defArgView (DefBinder _ (Just ty)) = ty
@@ -288,14 +383,14 @@ defaultStorePath = do

 selectedExportsForImport :: Bool -> String -> String -> [TricuAST] -> Maybe (Set.Set T.Text)
 selectedExportsForImport True _ _ _ = Nothing
-selectedExportsForImport False _moduleTarget namespace asts =
+selectedExportsForImport False _moduleTarget importNamespace asts =
  Just $ Set.fromList directSelections
  where
    directSelections = mapMaybe select (Set.toList used)
    used = foldMap freeVars asts
-    prefix = namespace ++ "."
+    prefix = importNamespace ++ "."
    select name
-      | namespace == "!Local" = Just (T.pack name)
+      | importNamespace == "!Local" = Just (T.pack name)
      | prefix `isPrefixOf` name = Just (T.pack (drop (length prefix) name))
      | otherwise = Nothing

--- a/src/Main.hs
+++ b/src/Main.hs
@@ -444,6 +444,7 @@ runImport opts = do
            (treeTermRef root)
            "arboricx.abi.tree.v1"
            Nothing
+            Nothing
        | (name, root) <- roots
        ]
      moduleName = T.pack $ maybe (takeBaseName file) id (importModule opts)
--- a/src/Module/Manifest.hs
+++ b/src/Module/Manifest.hs
@@ -12,6 +12,7 @@ module Module.Manifest
 import ContentStore.Filesystem (getObject, putObject)
 import ContentStore.Object
 import ContentStore.Alias (ObjectRef(..))
+import Research (ViewProvenance(..))

 import Data.ByteString (ByteString)
 import Data.Text (Text)
@@ -37,10 +38,11 @@ data ModuleReference = ModuleReference

 -- | Exported executable artifact plus optional direct View Contract type.
 data ModuleExport = ModuleExport
-  { moduleExportName    :: Text
-  , moduleExportObject  :: ObjectRef
-  , moduleExportAbi     :: Text
-  , moduleExportView    :: Maybe ObjectRef
+  { moduleExportName           :: Text
+  , moduleExportObject         :: ObjectRef
+  , moduleExportAbi            :: Text
+  , moduleExportView           :: Maybe ObjectRef
+  , moduleExportViewProvenance :: Maybe ViewProvenance
  } deriving (Eq, Ord, Show)

 manifestDomain :: Domain
@@ -66,6 +68,7 @@ encodeManifest manifest = encodeUtf8 $ Text.unlines $
      , esc (moduleExportAbi ex)
      , maybe "-" (esc . objectRefKind) (moduleExportView ex)
      , maybe "-" (esc . objectRefHash) (moduleExportView ex)
+      , maybe "-" encodeProvenance (moduleExportViewProvenance ex)
      ]

 -- | Parse the canonical manifest encoding.
@@ -85,12 +88,26 @@ decodeManifest bs = do
          ref <- ModuleReference <$> unesc alias <*> (ObjectRef <$> unesc kind <*> unesc hash)
          Right manifest { moduleManifestReferences = moduleManifestReferences manifest ++ [ref] }
        ["export", name, kind, hash, abi, viewKind, viewHash] -> do
+          -- Legacy manifests predate explicit View Contract provenance. Keep
+          -- the decoded field absent; checker import code treats absent
+          -- provenance as ViewUnchecked/Assumed at the use boundary.
          view <- optionalRef viewKind viewHash
          ex <- ModuleExport
            <$> unesc name
            <*> (ObjectRef <$> unesc kind <*> unesc hash)
            <*> unesc abi
            <*> pure view
+            <*> pure Nothing
+          Right manifest { moduleManifestExports = moduleManifestExports manifest ++ [ex] }
+        ["export", name, kind, hash, abi, viewKind, viewHash, provenanceText] -> do
+          view <- optionalRef viewKind viewHash
+          provenance <- optionalProvenance provenanceText
+          ex <- ModuleExport
+            <$> unesc name
+            <*> (ObjectRef <$> unesc kind <*> unesc hash)
+            <*> unesc abi
+            <*> pure view
+            <*> pure provenance
          Right manifest { moduleManifestExports = moduleManifestExports manifest ++ [ex] }
        _ -> Left $ "invalid module manifest row: " ++ Text.unpack line

@@ -110,6 +127,18 @@ optionalRef :: Text -> Text -> Either String (Maybe ObjectRef)
 optionalRef "-" "-" = Right Nothing
 optionalRef kind hash = Just <$> (ObjectRef <$> unesc kind <*> unesc hash)

+encodeProvenance :: ViewProvenance -> Text
+encodeProvenance ViewChecked = "checked"
+encodeProvenance ViewTrusted = "trusted"
+encodeProvenance ViewUnchecked = "unchecked"
+
+optionalProvenance :: Text -> Either String (Maybe ViewProvenance)
+optionalProvenance "-" = Right Nothing
+optionalProvenance "checked" = Right (Just ViewChecked)
+optionalProvenance "trusted" = Right (Just ViewTrusted)
+optionalProvenance "unchecked" = Right (Just ViewUnchecked)
+optionalProvenance other = Left $ "invalid View Contract provenance: " ++ Text.unpack other
+
 esc :: Text -> Text
 esc = Text.concatMap $ \c -> case c of
  '%'  -> "%25"
--- a/src/Module/Resolver.hs
+++ b/src/Module/Resolver.hs
@@ -28,6 +28,7 @@ data ResolvedExport = ResolvedExport
  , resolvedExportObject     :: ObjectRef
  , resolvedExportAbi        :: T.Text
  , resolvedExportView       :: Maybe ObjectRef
+  , resolvedExportProvenance :: Maybe ViewProvenance
  , resolvedExportTerm       :: T
  } deriving (Show, Eq)

@@ -86,6 +87,7 @@ resolveModuleExport resolver namespace ex = do
        , resolvedExportObject = ref
        , resolvedExportAbi = moduleExportAbi ex
        , resolvedExportView = moduleExportView ex
+        , resolvedExportProvenance = moduleExportViewProvenance ex
        , resolvedExportTerm = term
        }

--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -195,8 +195,13 @@ atomicTypeP = do
  t <- tok isTypeName "type name"
  case t of
    LNamespace name -> pure (VEName name)
-    LIdentifier name -> pure (VEName name)
+    LIdentifier name
+      | isViewVarName name -> pure (VEVar name)
+      | otherwise -> pure (VEName name)
    _ -> fail "internal parser error: expected type name"
+  where
+    isViewVarName ('_' : rest) = not (null rest)
+    isViewVarName _ = False

 isTypeName :: LToken -> Bool
 isTypeName (LNamespace _) = True
--- a/src/Research.hs
+++ b/src/Research.hs
@@ -25,14 +25,23 @@ data ViewRef
  | ViewRefText String
  deriving (Show, Eq, Ord)

+data ViewProvenance
+  = ViewChecked
+  | ViewTrusted
+  | ViewUnchecked
+  deriving (Show, Eq, Ord)
+
 data ViewType
  = VTName String
+  | VTVar Integer
  | VTRefRaw ViewRef
  | VTList ViewType
  | VTMaybe ViewType
  | VTPair ViewType ViewType
  | VTResult ViewType ViewType
  | VTGuarded ViewType T
+  | VTForall [Integer] ViewType
+  | VTExists [Integer] ViewType
  | VTFn [ViewType] ViewType
  deriving (Show, Eq, Ord)

@@ -42,14 +51,18 @@ pattern VTRef n = VTRefRaw (ViewRefInt n)
 pattern VTRefText :: String -> ViewType
 pattern VTRefText s = VTRefRaw (ViewRefText s)

-{-# COMPLETE VTName, VTRef, VTRefText, VTList, VTMaybe, VTPair, VTResult, VTGuarded, VTFn #-}
+{-# COMPLETE VTName, VTVar, VTRef, VTRefText, VTList, VTMaybe, VTPair, VTResult, VTGuarded, VTForall, VTExists, VTFn #-}

 data ViewExpr
  = VEName String
+  | VEVar String
+  | VEVarId Integer
  | VEInt Integer
  | VEString String
  | VEList [ViewExpr]
  | VEApp ViewExpr ViewExpr
+  | VEForall [Integer] ViewExpr
+  | VEExists [Integer] ViewExpr
  | VERaw String
  deriving (Show, Eq, Ord)