From 9ef75501df80c0cb014d2189a3a990784b339e3b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 10 Aug 2023 15:19:45 -0700 Subject: [PATCH 1/2] Add IOWatches --- .../U/Codebase/Sqlite/Orphans.hs | 2 ++ codebase2/codebase/U/Codebase/WatchKind.hs | 6 +++++- .../src/Unison/Codebase/Runtime.hs | 17 ++++++++++++----- .../Codebase/SqliteCodebase/Conversions.hs | 2 ++ unison-core/src/Unison/WatchKind.hs | 12 ++++++++++++ 5 files changed, 33 insertions(+), 6 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Orphans.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Orphans.hs index fc71d102fe8..014cba7da8b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Orphans.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Orphans.hs @@ -60,12 +60,14 @@ instance ToField WatchKind where toField = \case WatchKind.RegularWatch -> SQLInteger 0 WatchKind.TestWatch -> SQLInteger 1 + WatchKind.IOWatch -> SQLInteger 2 instance FromField WatchKind where fromField = fromField @Int8 <&> fmap \case 0 -> WatchKind.RegularWatch 1 -> WatchKind.TestWatch + 2 -> WatchKind.IOWatch tag -> error $ "Unknown WatchKind id " ++ show tag instance ToRow NamespaceStats where diff --git a/codebase2/codebase/U/Codebase/WatchKind.hs b/codebase2/codebase/U/Codebase/WatchKind.hs index ba5bc4080e1..9016892e133 100644 --- a/codebase2/codebase/U/Codebase/WatchKind.hs +++ b/codebase2/codebase/U/Codebase/WatchKind.hs @@ -1,3 +1,7 @@ module U.Codebase.WatchKind where -data WatchKind = RegularWatch | TestWatch deriving (Eq, Ord, Show) +data WatchKind + = RegularWatch + | TestWatch + | IOWatch + deriving (Eq, Ord, Show) diff --git a/parser-typechecker/src/Unison/Codebase/Runtime.hs b/parser-typechecker/src/Unison/Codebase/Runtime.hs index 4aecad7eba0..d966e323c21 100644 --- a/parser-typechecker/src/Unison/Codebase/Runtime.hs +++ b/parser-typechecker/src/Unison/Codebase/Runtime.hs @@ -6,6 +6,7 @@ module Unison.Codebase.Runtime where import Data.Map qualified as Map import Unison.ABT qualified as ABT import Unison.Builtin.Decls (tupleTerm, pattern TupleTerm') +import Unison.Builtin.Decls qualified as DD import Unison.Codebase.CodeLookup qualified as CL import Unison.Codebase.CodeLookup.Util qualified as CL import Unison.Hashing.V2.Convert qualified as Hashing @@ -79,8 +80,12 @@ evaluateWatches :: IO (WatchResults v a) evaluateWatches code ppe evaluationCache rt tuf = do -- 1. compute hashes for everything in the file - let m :: Map v (Reference.Id, Term.Term v a) - m = fmap (\(_a, id, _wk, tm, _tp) -> (id, tm)) (UF.hashTermsId tuf) + let m :: Map v (Reference.Id, Maybe WatchKind, Term.Term v a) + m = + UF.hashTermsId tuf + <&> \case + (a, id, wk@(Just WK.IOWatch), tm, _tp) -> (id, wk, DD.forceTerm a a tm) + (_a, id, wk, tm, _tp) -> (id, wk, tm) watches :: Set v = Map.keysSet watchKinds watchKinds :: Map v WatchKind watchKinds = @@ -88,14 +93,16 @@ evaluateWatches code ppe evaluationCache rt tuf = do [(v, k) | (k, ws) <- UF.watchComponents tuf, (v, _a, _tm, _tp) <- ws] unann = Term.amap (const ()) -- 2. use the cache to lookup things already computed - m' <- fmap Map.fromList . for (Map.toList m) $ \(v, (r, t)) -> do - o <- evaluationCache r + m' <- fmap Map.fromList . for (Map.toList m) $ \(v, (r, mayWK, t)) -> do + o <- case mayWK of + Just WK.IOWatch -> pure Nothing + _ -> evaluationCache r case o of Nothing -> pure (v, (r, ABT.annotation t, unann t, False)) Just t' -> pure (v, (r, ABT.annotation t, t', True)) -- 3. create a big ol' let rec whose body is a big tuple of all watches let rv :: Map Reference.Id v - rv = Map.fromList [(r, v) | (v, (r, _)) <- Map.toList m] + rv = Map.fromList [(r, v) | (v, (r, _mayWK, _)) <- Map.toList m] bindings :: [(v, (), Term v)] bindings = [(v, (), unref rv b) | (v, (_, _, b, _)) <- Map.toList m'] watchVars = [Term.var () v | v <- toList watches] diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs index dd35d11a8fe..9830e796532 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs @@ -72,12 +72,14 @@ watchKind1to2 :: V1.WK.WatchKind -> V2.WatchKind watchKind1to2 = \case V1.WK.RegularWatch -> V2.WatchKind.RegularWatch V1.WK.TestWatch -> V2.WatchKind.TestWatch + V1.WK.IOWatch -> V2.WatchKind.IOWatch other -> error $ "What kind of watchkind is " ++ other ++ "?" watchKind2to1 :: V2.WatchKind -> V1.WK.WatchKind watchKind2to1 = \case V2.WatchKind.RegularWatch -> V1.WK.RegularWatch V2.WatchKind.TestWatch -> V1.WK.TestWatch + V2.WatchKind.IOWatch -> V1.WK.IOWatch term1to2 :: Hash -> V1.Term.Term V1.Symbol Ann -> V2.Term.Term V2.Symbol term1to2 h = diff --git a/unison-core/src/Unison/WatchKind.hs b/unison-core/src/Unison/WatchKind.hs index 3e52f45f1ac..b64950a316a 100644 --- a/unison-core/src/Unison/WatchKind.hs +++ b/unison-core/src/Unison/WatchKind.hs @@ -22,3 +22,15 @@ pattern RegularWatch = "" -- Note: currently test watches don't need to be named by the user, but that "feature" will be removed soon. pattern TestWatch :: (Eq a, IsString a) => a pattern TestWatch = "test" + +-- | A watch expression which runs an expression of type @@'{IO, Exception} a@@, such as +-- +-- @ +-- io> do +-- x = readFile "foo.txt" +-- length x +-- @ +-- +-- Note: currently test watches don't need to be named by the user, but that "feature" will be removed soon. +pattern IOWatch :: (Eq a, IsString a) => a +pattern IOWatch = "io" From 7bd659edb0d6066bcccd0d2aca660b5decd500db Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 10 Aug 2023 15:32:33 -0700 Subject: [PATCH 2/2] Typecheck before forcing --- .../src/Unison/Codebase/Runtime.hs | 30 +++++++++++-------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Runtime.hs b/parser-typechecker/src/Unison/Codebase/Runtime.hs index d966e323c21..f4fd3877670 100644 --- a/parser-typechecker/src/Unison/Codebase/Runtime.hs +++ b/parser-typechecker/src/Unison/Codebase/Runtime.hs @@ -17,6 +17,7 @@ import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Term qualified as Term import Unison.Type (Type) +import Unison.Typechecker qualified as Typechecker import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF import Unison.Util.Pretty qualified as P @@ -70,21 +71,24 @@ type WatchResults v a = -- `evaluationCache`. If that returns a result, evaluation of that definition -- can be skipped. evaluateWatches :: - forall v a. + forall v. (Var v) => - CL.CodeLookup v IO a -> + CL.CodeLookup v IO Ann -> PPE.PrettyPrintEnv -> (Reference.Id -> IO (Maybe (Term v))) -> Runtime v -> - TypecheckedUnisonFile v a -> - IO (WatchResults v a) + TypecheckedUnisonFile v Ann -> + IO (WatchResults v Ann) evaluateWatches code ppe evaluationCache rt tuf = do -- 1. compute hashes for everything in the file - let m :: Map v (Reference.Id, Maybe WatchKind, Term.Term v a) + let m :: Map v (Reference.Id, Maybe WatchKind, Term.Term v Ann) m = UF.hashTermsId tuf <&> \case - (a, id, wk@(Just WK.IOWatch), tm, _tp) -> (id, wk, DD.forceTerm a a tm) + -- Add a force to IOWatch'es which match the 'mainType' + (a, id, wk@(Just WK.IOWatch), tm, typ) + | Typechecker.fitsScheme typ (mainType rt) -> + (id, wk, DD.forceTerm a a tm) (_a, id, wk, tm, _tp) -> (id, wk, tm) watches :: Set v = Map.keysSet watchKinds watchKinds :: Map v WatchKind @@ -143,12 +147,12 @@ evaluateWatches code ppe evaluationCache rt tuf = do go _ = Nothing evaluateTerm' :: - (Var v, Monoid a) => - CL.CodeLookup v IO a -> + (Var v) => + CL.CodeLookup v IO Ann -> (Reference.Id -> IO (Maybe (Term v))) -> PPE.PrettyPrintEnv -> Runtime v -> - Term.Term v a -> + Term.Term v Ann -> IO (Either Error (Term v)) evaluateTerm' codeLookup cache ppe rt tm = do result <- cache (Hashing.hashClosedTerm tm) @@ -161,7 +165,7 @@ evaluateTerm' codeLookup cache ppe rt tm = do mempty mempty [(WK.RegularWatch, [(Var.nameds "result", mempty, tm, mempty <$> mainType rt)])] - r <- evaluateWatches (void codeLookup) ppe cache rt (void tuf) + r <- evaluateWatches (codeLookup) ppe cache rt (tuf) pure $ r <&> \(_, map) -> case Map.elems map of @@ -169,10 +173,10 @@ evaluateTerm' codeLookup cache ppe rt tm = do _ -> error "evaluateTerm': Pattern mismatch on watch results" evaluateTerm :: - (Var v, Monoid a) => - CL.CodeLookup v IO a -> + (Var v) => + CL.CodeLookup v IO Ann -> PPE.PrettyPrintEnv -> Runtime v -> - Term.Term v a -> + Term.Term v Ann -> IO (Either Error (Term v)) evaluateTerm codeLookup = evaluateTerm' codeLookup noCache