mirror of
https://github.com/github/semantic.git
synced 2024-12-22 14:21:31 +03:00
Handle a bunch of resumable effects.
This commit is contained in:
Rob Rix
parent
78c037f4a6
commit
a2264fd16e
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user