diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 0443ee050..79233c685 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -198,7 +198,7 @@ runImportGraph lang (package :: Package term) f = in extractGraph <$> runEvaluator @_ @_ @(Value _ (Hole (Maybe Name) Precise)) (runImportGraphAnalysis (evaluate lang analyzeModule id runAddressEffects (fmap (Concrete.runBoolean . Concrete.runWhile) . Concrete.runFunction) (ModuleTable.toPairs (packageModules package) >>= toList . snd))) -runHeap :: Carrier sig m => Evaluator term address value (StateC (Heap address value) (Evaluator term address value m)) a -> Evaluator term address value m (Heap address value, a) +runHeap :: (Carrier sig m, Effect sig) => Evaluator term address value (StateC (Heap address value) (Evaluator term address value m)) a -> Evaluator term address value m (Heap address value, a) runHeap = runState lowerBound -- | Parse a list of files into a 'Package'. @@ -221,21 +221,23 @@ parseModules parser p@Project{..} = distributeFor (projectFiles p) (parseModule -- | Parse a list of packages from a python project. -parsePythonPackage :: forall syntax effs term. +parsePythonPackage :: forall syntax sig m term. ( Declarations1 syntax , Evaluatable syntax , FreeVariables1 syntax , Functor syntax , term ~ Term syntax Location - , Member (Error SomeException) effs - , Member Distribute effs - , Member Resolution effs - , Member Trace effs - , Member Task effs - , Effects effs) - => Parser term -- ^ A parser. - -> Project -- ^ Project to parse into a package. - -> Eff effs (Package term) + , Member (Error SomeException) sig + , Member Distribute sig + , Member Resolution sig + , Member Trace sig + , Member Task sig + , Carrier sig m + , Monad m + ) + => Parser term -- ^ A parser. + -> Project -- ^ Project to parse into a package. + -> m (Package term) parsePythonPackage parser project = do let runAnalysis = runEvaluator @_ @_ @(Value term (Hole (Maybe Name) Precise)) . runState PythonPackage.Unknown @@ -288,53 +290,57 @@ parsePythonPackage parser project = do resMap <- Task.resolutionMap p pure (Package.fromModules (name $ projectName p) modules resMap) -parseModule :: (Member (Error SomeException) effs, Member Task effs) +parseModule :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m, Monad m) => Project -> Parser term -> File - -> Eff effs (Module (Blob, term)) + -> m (Module (Blob, term)) parseModule proj parser file = do mBlob <- readFile proj file case mBlob of Just blob -> moduleForBlob (Just (projectRootDir proj)) blob . (,) blob <$> parse parser blob Nothing -> throwError (SomeException (FileNotFound (filePath file))) -withTermSpans :: ( Member (Reader Span) effects - , Member (State Span) effects -- last evaluated child's span +withTermSpans :: ( Member (Reader Span) sig + , Member (State Span) sig -- last evaluated child's span , Recursive term + , Carrier sig m , Base term ~ TermF syntax Location ) - => Open (Open (term -> Evaluator term address value effects a)) + => Open (Open (term -> Evaluator term address value m a)) withTermSpans recur0 recur term = let span = locationSpan (termFAnnotation (project term)) updatedSpanAlg = withCurrentSpan span (recur0 recur term) in modifyChildSpan span updatedSpanAlg -resumingResolutionError :: ( Member Trace effects - , Effects effects +resumingResolutionError :: ( Member Trace sig + , Carrier sig m ) - => Evaluator term address value (Resumable (BaseError ResolutionError) ': effects) a - -> Evaluator term address value effects a + => Evaluator term address value (ResumableWithC (BaseError ResolutionError) + (Evaluator term address value m)) a + -> Evaluator term address value m a resumingResolutionError = runResolutionErrorWith (\ baseError -> traceError "ResolutionError" baseError *> case baseErrorException baseError of NotFoundError nameToResolve _ _ -> pure nameToResolve GoImportError pathToResolve -> pure [pathToResolve]) resumingLoadError :: ( AbstractHole address - , Effects effects - , Member Trace effects + , Carrier sig m + , Member Trace sig , Ord address ) - => Evaluator term address value (Resumable (BaseError (LoadError address)) ': effects) a - -> Evaluator term address value effects a + => Evaluator term address value (ResumableWithC (BaseError (LoadError address)) + (Evaluator term address value m)) a + -> Evaluator term address value m a resumingLoadError = runLoadErrorWith (\ baseError -> traceError "LoadError" baseError *> case baseErrorException baseError of ModuleNotFoundError _ -> pure (lowerBound, (lowerBound, hole))) -resumingEvalError :: ( Effects effects - , Member Fresh effects - , Member Trace effects +resumingEvalError :: ( Carrier sig m + , Member Fresh sig + , Member Trace sig ) - => Evaluator term address value (Resumable (BaseError EvalError) ': effects) a - -> Evaluator term address value effects a + => Evaluator term address value (ResumableWithC (BaseError EvalError) + (Evaluator term address value m)) a + -> Evaluator term address value m a resumingEvalError = runEvalErrorWith (\ baseError -> traceError "EvalError" baseError *> case baseErrorException baseError of DefaultExportError{} -> pure () ExportError{} -> pure () @@ -344,32 +350,35 @@ resumingEvalError = runEvalErrorWith (\ baseError -> traceError "EvalError" base NoNameError -> gensym) resumingUnspecialized :: ( AbstractHole value - , Effects effects - , Member Trace effects + , Carrier sig m + , Member Trace sig ) - => Evaluator term address value (Resumable (BaseError (UnspecializedError value)) ': effects) a - -> Evaluator term address value effects a + => Evaluator term address value (ResumableWithC (BaseError (UnspecializedError value)) + (Evaluator term address value m)) a + -> Evaluator term address value m a resumingUnspecialized = runUnspecializedWith (\ baseError -> traceError "UnspecializedError" baseError *> case baseErrorException baseError of UnspecializedError _ -> pure hole) resumingAddressError :: ( AbstractHole value - , Effects effects - , Member Trace effects + , Carrier sig m + , Member Trace sig , Show address ) - => Evaluator term address value (Resumable (BaseError (AddressError address value)) ': effects) a - -> Evaluator term address value effects a + => Evaluator term address value (ResumableWithC (BaseError (AddressError address value)) + (Evaluator term address value m)) a + -> Evaluator term address value m a resumingAddressError = runAddressErrorWith $ \ baseError -> traceError "AddressError" baseError *> case baseErrorException baseError of UnallocatedAddress _ -> pure lowerBound UninitializedAddress _ -> pure hole -resumingValueError :: ( Effects effects - , Member Trace effects +resumingValueError :: ( Carrier sig m + , Member Trace sig , Show address , Show term ) - => Evaluator term address (Value term address) (Resumable (BaseError (ValueError term address)) ': effects) a - -> Evaluator term address (Value term address) effects a + => Evaluator term address (Value term address) (ResumableWithC (BaseError (ValueError term address)) + (Evaluator term address (Value term address) m)) a + -> Evaluator term address (Value term address) m a resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" baseError *> case baseErrorException baseError of CallError val -> pure val StringError val -> pure (pack (prettyShow val)) @@ -386,19 +395,22 @@ resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" b ArrayError{} -> pure lowerBound ArithmeticError{} -> pure hole) -resumingEnvironmentError :: ( Effects effects - , Member Trace effects +resumingEnvironmentError :: ( Carrier sig m + , Member Trace sig ) - => Evaluator term (Hole (Maybe Name) address) value (Resumable (BaseError (EnvironmentError (Hole (Maybe Name) address))) ': effects) a - -> Evaluator term (Hole (Maybe Name) address) value effects a + => Evaluator term (Hole (Maybe Name) address) value (ResumableWithC (BaseError (EnvironmentError (Hole (Maybe Name) address))) + (Evaluator term (Hole (Maybe Name) address) value m)) a + -> Evaluator term (Hole (Maybe Name) address) value m a resumingEnvironmentError = runResumableWith (\ baseError -> traceError "EnvironmentError" baseError >> (\ (FreeVariable name) -> pure (Partial (Just name))) (baseErrorException baseError)) -resumingTypeError :: ( Effects effects - , Member NonDet effects - , Member Trace effects +resumingTypeError :: ( Carrier sig m + , Member NonDet sig + , Member Trace sig ) - => Evaluator term address Type (Resumable (BaseError TypeError) ': State TypeMap ': effects) a - -> Evaluator term address Type effects a + => Evaluator term address Type (ResumableWithC (BaseError TypeError) + (Evaluator term address Type (StateC TypeMap + (Evaluator term address Type m)))) a + -> Evaluator term address Type m a resumingTypeError = runTypesWith (\ baseError -> traceError "TypeError" baseError *> case baseErrorException baseError of UnificationError l r -> pure l <|> pure r InfiniteType _ r -> pure r) @@ -406,5 +418,5 @@ resumingTypeError = runTypesWith (\ baseError -> traceError "TypeError" baseErro prettyShow :: Show a => a -> String prettyShow = hscolour TTY defaultColourPrefs False False "" False . ppShow -traceError :: (Member Trace effects, Show (exc resume)) => String -> BaseError exc resume -> Evaluator term address value effects () +traceError :: (Member Trace sig, Show (exc resume), Carrier sig m) => String -> BaseError exc resume -> Evaluator term address value m () traceError prefix baseError = trace $ prefix <> ": " <> prettyShow baseError