github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Move Unspecialized handling into Quietly.

Browse Source
This commit is contained in:
Rob Rix 2018-04-24 19:44:10 -04:00
parent beea1ba3c2
commit 2da077217c
3 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Analysis/Abstract/Evaluating.hs
View File

@ -26,7 +26,6 @@ type EvaluatingEffects location term value
= '[ Exc (ReturnThrow value)
, Exc (LoopThrow value)
, Resumable (LoadError term value)
, Resumable (Unspecialized value)
, Fail -- Failure with an error message
, Fresh -- For allocating new addresses and/or type variables.
, Reader (SomeOrigin term) -- The current term’s origin.
@ -66,11 +65,10 @@ instance ( Ord location
=> Interpreter
(EvaluatingEffects location term value) result
( Either String
(Either (SomeExc (Unspecialized value))
(Either (SomeExc (LoadError term value))
(Either (LoopThrow value)
(Either (ReturnThrow value)
result))))
result)))
, EvaluatorState location term value)
(Evaluating location term value) where
interpret
@ -82,7 +80,6 @@ instance ( Ord location
. runEffect
. runFail
. Res.runError
. Res.runError
. Exc.runError
. Exc.runError
. lower

17
src/Analysis/Abstract/Quiet.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Analysis.Abstract.Quiet
( Quietly
) where
@ -25,13 +25,20 @@ instance ( Effectful m
, MonadValue location value effects (Quietly m)
)
=> MonadAnalysis location term value effects (Quietly m) where
type Effects location term value (Quietly m) = Effects location term value m
type Effects location term value (Quietly m) = Resumable (Unspecialized value) ': Effects location term value m
analyzeTerm eval term = resume @(Unspecialized value) (liftAnalyze analyzeTerm eval term) (\yield err@(Unspecialized _) ->
traceM ("Unspecialized:" <> show err) >> hole >>= yield)
analyzeModule = liftAnalyze analyzeModule
instance Interpreter effects result rest m
=> Interpreter effects result rest (Quietly m) where
interpret (Quietly m) = interpret m
instance ( Interpreter effects result rest m
, MonadValue location value effects m
)
=> Interpreter (Resumable (Unspecialized value) ': effects) result rest (Quietly m) where
interpret
= interpret
. raise @m
. relay pure (\ (Resumable err) yield -> case err of
Unspecialized _ -> lower @m hole >>= yield)
. lower

3
src/Semantic/Util.hs
View File

@ -47,8 +47,9 @@ type JustEvaluating term
= Erroring (AddressError (Located Precise term) (Value (Located Precise term)))
( Erroring (EvalError (Value (Located Precise term)))
( Erroring (ResolutionError (Value (Located Precise term)))
( Erroring (Unspecialized (Value (Located Precise term)))
( Erroring (ValueError (Located Precise term) (Value (Located Precise term)))
( Evaluating (Located Precise term) term (Value (Located Precise term))))))
( Evaluating (Located Precise term) term (Value (Located Precise term)))))))
type EvaluatingWithHoles term = BadAddresses (BadModuleResolutions (BadVariables (BadValues (Quietly (Evaluating (Located Precise term) term (Value (Located Precise term)))))))
type ImportGraphingWithHoles term = ImportGraphing (EvaluatingWithHoles term)