From 5b18b47db73d93eb476c23ea786e21c796f2d458 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 25 Apr 2018 09:07:27 -0400 Subject: [PATCH] Interpreters determine their effects. --- src/Analysis/Abstract/BadAddresses.hs | 2 ++ src/Analysis/Abstract/BadModuleResolutions.hs | 5 ++++- src/Analysis/Abstract/BadVariables.hs | 2 ++ src/Analysis/Abstract/Caching.hs | 2 ++ src/Analysis/Abstract/Collecting.hs | 2 ++ src/Analysis/Abstract/Dead.hs | 2 ++ src/Analysis/Abstract/Quiet.hs | 2 ++ src/Analysis/Abstract/Tracing.hs | 2 ++ src/Control/Abstract/Analysis.hs | 2 +- 9 files changed, 19 insertions(+), 2 deletions(-) diff --git a/src/Analysis/Abstract/BadAddresses.hs b/src/Analysis/Abstract/BadAddresses.hs index 782d359e6..a583d588d 100644 --- a/src/Analysis/Abstract/BadAddresses.hs +++ b/src/Analysis/Abstract/BadAddresses.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.BadAddresses where import Control.Abstract.Analysis @@ -30,6 +31,7 @@ instance ( Effectful m analyzeModule = liftAnalyze analyzeModule instance ( Interpreter effects result rest m + , MonadEvaluator location term value effects m , MonadHole value effects m , Monoid (Cell location value) ) diff --git a/src/Analysis/Abstract/BadModuleResolutions.hs b/src/Analysis/Abstract/BadModuleResolutions.hs index 6c13330eb..a7bfd3e7f 100644 --- a/src/Analysis/Abstract/BadModuleResolutions.hs +++ b/src/Analysis/Abstract/BadModuleResolutions.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.BadModuleResolutions where import Control.Abstract.Analysis @@ -27,7 +28,9 @@ instance ( Effectful m analyzeModule = liftAnalyze analyzeModule -instance Interpreter effects result rest m +instance ( Interpreter effects result rest m + , MonadEvaluator location term value effects m + ) => Interpreter (Resumable (ResolutionError value) ': effects) result rest (BadModuleResolutions m) where interpret = interpret . raise @m . relay pure (\ (Resumable err) yield -> case err of RubyError nameToResolve -> yield nameToResolve diff --git a/src/Analysis/Abstract/BadVariables.hs b/src/Analysis/Abstract/BadVariables.hs index 7a6206480..f30e69354 100644 --- a/src/Analysis/Abstract/BadVariables.hs +++ b/src/Analysis/Abstract/BadVariables.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.BadVariables ( BadVariables ) where @@ -37,6 +38,7 @@ instance ( Effectful m analyzeModule = liftAnalyze analyzeModule instance ( Interpreter effects (result, [Name]) rest m + , MonadEvaluator location term value effects m , MonadHole value (State [Name] ': effects) m ) => Interpreter (Resumable (EvalError value) ': State [Name] ': effects) result rest (BadVariables m) where diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 3ba992347..e9e547125 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.Caching ( Caching ) where @@ -122,6 +123,7 @@ scatter = foldMapA (\ (value, heap') -> putHeap heap' $> value) instance ( Interpreter effects ([result], Cache location term value) rest m + , MonadEvaluator location term value effects m , Ord (Cell location value) , Ord location , Ord term diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index d993b6cd6..0ca52844f 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.Collecting ( Collecting ) where @@ -79,6 +80,7 @@ reachable roots heap = go mempty roots instance ( Interpreter effects result rest m + , MonadEvaluator location term value effects m , Ord location ) => Interpreter (Reader (Live location value) ': effects) result rest (Collecting m) where diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs index 1943db0ba..f1d534deb 100644 --- a/src/Analysis/Abstract/Dead.hs +++ b/src/Analysis/Abstract/Dead.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.Dead ( DeadCode ) where @@ -54,6 +55,7 @@ instance ( Corecursive term liftAnalyze analyzeModule recur m instance ( Interpreter effects (result, Dead term) rest m + , MonadEvaluator location term value effects m , Ord term ) => Interpreter (State (Dead term) ': effects) result rest (DeadCode m) where diff --git a/src/Analysis/Abstract/Quiet.hs b/src/Analysis/Abstract/Quiet.hs index e7569f64e..7f6e2a1d6 100644 --- a/src/Analysis/Abstract/Quiet.hs +++ b/src/Analysis/Abstract/Quiet.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.Quiet ( Quietly ) where @@ -33,6 +34,7 @@ instance ( Effectful m analyzeModule = liftAnalyze analyzeModule instance ( Interpreter effects result rest m + , MonadEvaluator location term value effects m , MonadHole value effects m ) => Interpreter (Resumable (Unspecialized value) ': effects) result rest (Quietly m) where diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index 686141e9f..62f10071a 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint module Analysis.Abstract.Tracing ( Tracing ) where @@ -36,6 +37,7 @@ instance ( Corecursive term analyzeModule = liftAnalyze analyzeModule instance ( Interpreter effects (result, trace (Configuration location term value)) rest m + , MonadEvaluator location term value effects m , Monoid (trace (Configuration location term value)) ) => Interpreter (Writer (trace (Configuration location term value)) ': effects) result rest (Tracing trace m) where diff --git a/src/Control/Abstract/Analysis.hs b/src/Control/Abstract/Analysis.hs index 1b76fcdb1..be05b9020 100644 --- a/src/Control/Abstract/Analysis.hs +++ b/src/Control/Abstract/Analysis.hs @@ -47,7 +47,7 @@ class MonadEvaluator location term value effects m => MonadAnalysis location ter isolate :: m effects a -> m effects a isolate = withEnv mempty . withExports mempty -class Effectful m => Interpreter effects result function m | m effects result -> function where +class Effectful m => Interpreter effects result function m | m -> effects, m result -> function where interpret :: m effects result -> function instance Interpreter '[] result result Eff where