Commit 553b51d2 authored by Sven Keidel's avatar Sven Keidel

restore the analyses for the while language extended with exceptions

parent 75f7893c
Pipeline #13348 passed with stages
in 43 minutes and 23 seconds
......@@ -53,7 +53,7 @@ deriving instance ArrowFix x y c => ArrowFix x y (ConcreteT c)
deriving instance ArrowEnv var Val env c => ArrowEnv var Val env (ConcreteT c)
-- | Concrete instance of the interface for value operations.
instance (ArrowChoice c, ArrowFail String c) => IsVal Val (ConcreteT c) where
instance (ArrowChoice c, ArrowFail String c) => IsNum Val (ConcreteT c) where
type Join (ConcreteT c) x y = ()
succ = proc x -> case x of
NumVal n -> returnA -< NumVal (n + 1)
......
......@@ -20,7 +20,7 @@ import GHC.Exts (IsString(..),Constraint)
-- | Shared interpreter for PCF.
eval :: (ArrowChoice c, ArrowFix Expr v c, ArrowEnv Text v env c, ArrowFail e c, IsString e,
IsVal v c, IsClosure v env c, Env.Join c ((v,Text),Text) v, Join c (Expr,Expr) v)
IsNum v c, IsClosure v env c, Env.Join c ((v,Text),Text) v, Join c (Expr,Expr) v)
=> c Expr v
eval = fix $ \ev -> proc e0 -> case e0 of
Var x _ -> lookup' -< x
......@@ -59,7 +59,7 @@ eval = fix $ \ev -> proc e0 -> case e0 of
_ -> fail -< fromString $ "found unexpected epxression in closure: " ++ show e
-- | Interface for numeric operations
class Arrow c => IsVal v c | c -> v where
class Arrow c => IsNum v c | c -> v where
type family Join (c :: * -> * -> *) x y :: Constraint
-- | increments the given number value.
......
......@@ -120,7 +120,7 @@ instance ArrowTrans IntervalT where
lift = IntervalT
unlift = runIntervalT
instance (IsString e, ArrowChoice c, ArrowFail e c, ArrowJoin c) => IsVal Val (IntervalT c) where
instance (IsString e, ArrowChoice c, ArrowFail e c, ArrowJoin c) => IsNum Val (IntervalT c) where
type Join (IntervalT c) x y = Complete y
succ = proc x -> case x of
......@@ -133,7 +133,7 @@ instance (IsString e, ArrowChoice c, ArrowFail e c, ArrowJoin c) => IsVal Val (I
NumVal n -> returnA -< NumVal $ n - 1
ClosureVal _ -> fail -< "Expected a number as argument for 'pred'"
zero = proc _ -> returnA -< (NumVal 0)
zero = proc _ -> returnA -< NumVal 0
if_ f g = proc v -> case v of
(Top, (x,y)) -> (f -< x) <> (g -< y) <> (fail -< "Expected a number as condition for 'ifZero'")
......
......@@ -5,24 +5,6 @@ packages:
- 'lib'
- 'pcf'
- 'while'
- 'stratego'
# - 'stratego'
# - 'jimple'
- 'tutorial'
package-indices:
- download-prefix: https://hackage.haskell.org/
hackage-security:
keyids:
- 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d
- 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42
- 280b10153a522681163658cb49f632cde3f38d768b736ddbc901d99a1a772833
- 2a96b1889dc221c17296fcc2bb34b908ca9734376f0f361660200935916ef201
- 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3
- 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921
- 772e9f4c7db33d251d5c6e357199c819e569d130857dc225549b40845ff0890d
- aa315286e6ad281ad61182235533c41e806e5a787e0b6d1e7eef3f09d137d2e9
- fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0
key-threshold: 3 # number of keys required
# ignore expiration date, see https://github.com/commercialhaskell/stack/pull/4614
ignore-expiry: true
\ No newline at end of file
# - 'tutorial'
\ No newline at end of file
......@@ -16,12 +16,10 @@ dependencies:
- unordered-containers
library:
ghc-options: -Wall
source-dirs:
- src
ghc-options: -Wall
tests:
spec:
main: Spec.hs
......
......@@ -7,6 +7,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Concrete interpreter of the While language.
module ConcreteInterpreter where
import Prelude hiding (read,fail,(.))
......@@ -26,6 +27,7 @@ import Data.Profunctor
import Control.Category
import Control.Arrow
import Control.Arrow.Except
import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Environment
......@@ -41,9 +43,13 @@ import qualified System.Random as R
import GHC.Generics (Generic)
-- | Values of the While language can be booleans or numbers.
data Val = BoolVal Bool | NumVal Int deriving (Eq, Show, Generic)
type Addr = Label
-- | The concrete interpreter of the while language instantiates
-- 'Generic.run' with the concrete components for failure ('FailureT'), store ('StoreT'),
-- environments ('EnvT'), random numbers ('RandomT'), and values ('ConcreteT').
run :: [LStatement] -> Error String (HashMap Addr Val)
run ss =
fst <$>
......@@ -61,8 +67,9 @@ run ss =
(->))))) [Statement] ())))))
(M.empty,(M.empty,(R.mkStdGen 0, generate <$> ss)))
-- | The 'ConcreteT' transformer defines the value operations for the While language.
newtype ConcreteT c x y = ConcreteT { runConcreteT :: c x y }
deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowFail e, ArrowEnv var addr env, ArrowStore addr val)
deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowFail e, ArrowEnv var addr env, ArrowStore addr val,ArrowExcept exc)
deriving instance ArrowFix x y c => ArrowFix x y (ConcreteT c)
deriving instance ArrowRand v c => ArrowRand v (ConcreteT c)
......@@ -70,7 +77,7 @@ instance (ArrowChoice c, Profunctor c) => ArrowAlloc (Text,Val,Label) Addr (Conc
alloc = arr $ \(_,_,l) -> l
instance (ArrowChoice c, ArrowFail String c) => IsVal Val (ConcreteT c) where
type Join (ConcreteT c) x y = ()
type JoinVal (ConcreteT c) x y = ()
boolLit = arr (\(b,_) -> BoolVal b)
and = proc (v1,v2,_) -> case (v1,v2) of
......
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Concrete interpreter of the While language.
module Exceptions.ConcreteInterpreter where
import Prelude hiding (read,fail,id,(.))
import Exceptions.Syntax
import ConcreteInterpreter
import Exceptions.GenericInterpreter
import qualified Exceptions.GenericInterpreter as Generic
import Data.Concrete.Error (Error)
import Data.HashMap.Lazy(HashMap)
import qualified Data.HashMap.Lazy as M
import Data.Text (Text)
import Data.Label
import Control.Category
import Control.Arrow
import Control.Arrow.Transformer.Concrete.Except
import Control.Arrow.Transformer.Concrete.Failure
import Control.Arrow.Transformer.Concrete.Environment
import Control.Arrow.Transformer.Concrete.Random
import Control.Arrow.Transformer.Concrete.Store
import qualified System.Random as R
-- | Values of the While language can be booleans or numbers.
type Exception = (Text,Val)
-- | The concrete interpreter of the while language instantiates
-- 'Generic.run' with the concrete components for failure ('FailureT'), store ('StoreT'),
-- environments ('EnvT'), random numbers ('RandomT'), and values ('ConcreteT').
run :: [LStatement] -> Error String (Error Exception (HashMap Addr Val))
run ss =
fmap (fmap fst) $
runFailureT
(runExceptT
(runStoreT
(runEnvT
(runRandomT
(runConcreteT
(Generic.run ::
ConcreteT
(RandomT
(EnvT Text Addr
(StoreT Addr Val
(ExceptT Exception
(FailureT String
(->)))))) [Statement] ()))))))
(M.empty,(M.empty,(R.mkStdGen 0, generate <$> ss)))
instance ArrowChoice c => IsException Exception Val (ConcreteT c) where
type JoinExc (ConcreteT c) x y = ()
namedException = id
matchException f g = proc (name,(name',v),x) ->
if (name == name')
then f -< (v,x)
else g -< x
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
-- | Generic interpreter for the While-Language.
module Exceptions.GenericInterpreter where
import Prelude hiding (lookup, and, or, not, div, read)
import Data.Label
import GenericInterpreter(IsVal(..))
import Control.Arrow
import Control.Arrow.Alloc
import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Environment(ArrowEnv,lookup,lookup'',extendEnv')
import qualified Control.Arrow.Environment as Env
import Control.Arrow.Random
import Control.Arrow.Store(ArrowStore,read',write)
import Control.Arrow.Except(ArrowExcept,throw,catch,finally)
import qualified Control.Arrow.Except as Except
import qualified Control.Arrow.Store as Store
import Control.Arrow.Utils
import Data.Text (Text)
import Data.String
import Exceptions.Syntax hiding (finally)
import GHC.Exts
type Prog = [Statement]
-- | Generic interpreter for expressions of the While-language. It is
-- an arrow computation @c Expr v@ that consumes expressions and
-- produces values. The interpreter is parameterized by the type of
-- values @v@, addresses @addr@, environment @env@ and arrow type
-- @c@. It uses the @IsVal@ interface to combine values and uses the
-- @ArrowEnv@ and @ArrowStore@ interface to access the environment.
eval :: (Show addr, ArrowChoice c, ArrowRand v c,
ArrowEnv Text addr env c, ArrowStore addr v c,
ArrowFail err c, IsString err, ArrowExcept exc c,
IsVal v c, IsException exc v c,
Env.Join c ((addr, Text),Text) v,
Store.Join c ((v, addr),addr) v
)
=> c Expr v
eval = proc e -> case e of
Var x _ -> lookup'' read' -< x
BoolLit b l -> boolLit -< (b,l)
And e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
and -< (v1,v2,l)
Or e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
or -< (v1,v2,l)
Not e1 l -> do
v1 <- eval -< e1
not -< (v1,l)
NumLit n l -> numLit -< (n,l)
RandomNum _ -> random -< ()
Add e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
add -< (v1,v2,l)
Sub e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
sub -< (v1,v2,l)
Mul e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
mul -< (v1,v2,l)
Div e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
div -< (v1,v2,l)
Eq e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
eq -< (v1,v2,l)
Lt e1 e2 l -> do
v1 <- eval -< e1
v2 <- eval -< e2
lt -< (v1,v2,l)
Throw ex e1 _ -> do
v <- eval -< e1
throw <<< namedException -< (ex,v)
-- | Generic interpreter for statements of the While-language. It is
-- an arrow computation @c [Statement] ()@ that consumes statements
-- and does not produces a result. The interpreter is parameterized by
-- the type of values @v@, addresses @addr@, environment @env@ and
-- arrow type @c@.
run :: (Show addr, ArrowChoice c, ArrowFix [Statement] () c,
ArrowEnv Text addr env c, ArrowStore addr v c,
ArrowAlloc (Text,v,Label) addr c, ArrowFail err c,
ArrowExcept exc c, ArrowRand v c, IsString err,
IsVal v c, IsException exc v c,
Env.Join c ((addr, Text),Text) v, Env.Join c ((addr, (Text,v,Label)), (Text,v,Label)) addr,
Store.Join c ((v, addr),addr) v,
Except.Join c ((), ((Statement, (Text, Text, Statement, Label)), exc)) (),
Except.Join c (((Statement, Statement), ()), ((Statement, Statement), exc)) (),
JoinVal c ([Statement],[Statement]) (),
JoinExc c ((v, (Text, Statement, Label)), (Text, Statement, Label)) ()
)
=> c [Statement] ()
run = fix $ \run' -> proc stmts -> case stmts of
Assign x e l:ss -> do
v <- eval -< e
addr <- lookup (proc (addr,_) -> returnA -< addr)
(proc (x,v,l) -> alloc -< (x,v,l))
-< (x,(x,v,l))
write -< (addr,v)
extendEnv' run' -< (x,addr,ss)
If cond s1 s2 _:ss -> do
b <- eval -< cond
if_ run' run' -< (b,([s1],[s2]))
run' -< ss
While cond body l:ss ->
run' -< If cond (Begin [body,While cond body l] l) (Begin [] l) l : ss
Begin ss _:ss' -> do
run' -< ss
run' -< ss'
TryCatch body ex x handler l:ss -> do
catch
(proc (body,_) -> run' -< [body])
(proc ((_,(ex,x,handler,l)),e) ->
matchException
(proc (v,(x,handler,l)) -> do
addr <- lookup pi1 alloc -< (x,(x,v,l))
write -< (addr,v)
extendEnv' run' -< (x, addr, [handler]))
(proc _ -> returnA -< ())
-< (ex,e,(x,handler,l)))
-< (body,(ex,x,handler,l))
run' -< ss
Finally body fin _:ss -> do
finally (proc (body,_) -> run' -< [body])
(proc (_,fin) -> run' -< [fin])
-< (body,fin)
run' -< ss
[] ->
returnA -< ()
class IsException exc v c | c -> v where
type family JoinExc (c :: * -> * -> *) x y :: Constraint
namedException :: c (Text,v) exc
matchException :: JoinExc c ((v,x),x) y => c (v,x) y -> c x y -> c (Text,exc,x) y
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-partial-type-signatures #-}
-- | Interval Analysis for the While language.
module Exceptions.IntervalAnalysis where
import Prelude hiding (Bool(..),Bounded(..),(/),fail)
import IntervalAnalysis
import Exceptions.Syntax
import Exceptions.GenericInterpreter
import qualified Exceptions.GenericInterpreter as Generic
import Data.Abstract.Except (Except(..))
import qualified Data.Abstract.Except as Exc
import Data.Abstract.Error (Error(..))
import qualified Data.Abstract.Error as E
import qualified Data.Abstract.Interval as I
import qualified Data.Abstract.StrongMap as SM
import qualified Data.Abstract.Map as M
import Data.Abstract.Map (Map)
import Data.Abstract.Terminating (Terminating)
import qualified Data.Abstract.Terminating as T
import Data.Abstract.DiscretePowerset (Pow)
import qualified Data.Abstract.Widening as W
import qualified Data.Abstract.IterationStrategy as S
import qualified Data.Abstract.StackWidening as SW
import qualified Data.Abstract.Maybe as AM
import qualified Data.Lens as L
import Data.Order
import Data.Label
import Data.Text (Text)
import Control.Arrow
import Control.Arrow.Fix
import Control.Arrow.Abstract.Join
import Control.Arrow.Transformer.Abstract.Environment
import Control.Arrow.Transformer.Abstract.Error
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.Store
import Control.Arrow.Transformer.Abstract.Terminating
-- | Abstract values are either abstract booleans or intervals.
newtype Exception = Exception (Map Text Val) deriving (PreOrd,Complete)
-- | The interval analysis instantiates the generic interpreter
-- 'Generic.run' with the components for fixpoint computation
-- ('FixT'), termination ('TerminatingT'), failure ('ErrorT'), store
-- ('StoreT'), environments ('EnvT'), and values ('IntervalT').
run :: (?bound :: IV) => Int -> [(Text,Addr)] -> [LStatement]
-> Terminating (Error (Pow String) (Except Exception (M.Map Addr Val)))
run k env ss =
fmap (fmap fst) <$>
runFixT iterationStrategy
(runTerminatingT
(runErrorT
(runExceptT
(runStoreT
(runEnvT
(runIntervalT
(Generic.run ::
Fix [Statement] ()
(IntervalT
(EnvT Text Addr
(StoreT Addr Val
(ExceptT Exception
(ErrorT (Pow String)
(TerminatingT
(FixT () () _))))))) [Statement] ())))))))
(M.empty,(SM.fromList env, generate (sequence ss)))
where
iterationStrategy = S.filter (L.second (L.second whileLoops))
$ S.chaotic stackWiden widenResult
stackWiden = SW.groupBy (L.iso (\(store,(ev,stmts)) -> (stmts,(ev,store)))
(\(stmts,(ev,store)) -> (store,(ev,stmts))))
$ SW.maxSize k
$ SW.reuseFirst
$ SW.fromWidening (SM.widening W.finite W.** M.widening widenVal)
$ SW.finite
widenVal = widening (W.bounded ?bound I.widening)
widenExc (Exception m1) (Exception m2) = Exception <$> (M.widening widenVal m1 m2)
widenResult = T.widening $ E.widening W.finite (Exc.widening widenExc (M.widening widenVal W.** W.finite))
instance (ArrowChoice c, ArrowJoin c) => IsException Exception Val (IntervalT c) where
type JoinExc (IntervalT c) x y = Complete y
namedException = proc (name,val) -> returnA -< Exception (M.singleton name val)
matchException f g = proc (name,Exception m,x) -> case M.lookup name m of
AM.Just v -> f -< (v,x)
AM.Nothing -> g -< x
AM.JustNothing v -> (f -< (v,x)) <> (g -< x)
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ImplicitParams #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-partial-type-signatures #-}
-- | Reaching Definition Analysis for the While language.
module Exceptions.ReachingDefinitionsAnalysis where
import Prelude hiding (pred)
import Exceptions.Syntax
import qualified Exceptions.GenericInterpreter as Generic
import IntervalAnalysis
import Exceptions.IntervalAnalysis(Exception(..))
import Data.Text (Text)
import Data.Label
import qualified Data.List as L
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as Map
import qualified Data.Lens as L
import Data.Order
import Data.Maybe
import qualified Data.Abstract.Except as Exc
import qualified Data.Abstract.Error as E
import qualified Data.Abstract.StrongMap as SM
import qualified Data.Abstract.Map as M
import Data.Abstract.DiscretePowerset(Pow)
import qualified Data.Abstract.StackWidening as SW
import qualified Data.Abstract.Widening as W
import qualified Data.Abstract.IterationStrategy as S
import qualified Data.Abstract.Interval as I
import qualified Data.Abstract.Terminating as T
import Data.Identifiable
import Control.Arrow.Fix
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.ReachingDefinitions
import Control.Arrow.Transformer.Abstract.Environment
import Control.Arrow.Transformer.Abstract.Store
import Control.Arrow.Transformer.Abstract.Error
import Control.Arrow.Transformer.Abstract.Terminating
import Control.Arrow.Transformer.Abstract.Fix
-- | Calculates the entry sets of which definitions may be reached for
-- each statment. The analysis instantiates the generic interpreter
-- 'Generic.run' with analysis components for fixpoint computation
-- ('FixT'), termination ('TerminatingT'), failure ('ErrorT'), store
-- ('StoreT'), environments ('EnvT'), and values ('IntervalT')
run :: (?bound :: IV) => Int -> [LStatement] -> [(Label, M.Map Text (Pow Label))]
run k lstmts =
L.sortOn fst $
Map.toList $
-- Joins the reaching definitions for each statement for all call context.
-- Filters out statements created during execution that are not part
-- of the input program.
joinOnKey (\(store,(env,st)) _ -> case st of
stmt:_ | stmt `elem` blocks stmts ->
Just (label stmt, dropValues (combineMaps env store))
_ -> Nothing) $
-- get the fixpoint cache
fst $
-- Run the computation
S.runChaoticT
(runFixT' iterationStrategy
(runTerminatingT
(runErrorT
(runExceptT
(runStoreT
(runReachingDefsT'
(runEnvT
(runIntervalT
(Generic.run ::
Fix [Statement] ()
(IntervalT
(EnvT Text Addr
(ReachingDefsT Label
(StoreT Addr (Val, Pow Label)
(ExceptT Exception
(ErrorT (Pow String)
(TerminatingT
(FixT () () _)))))))) [Statement] ())))))))))
(M.empty,(SM.empty,stmts))
where
stmts = generate (sequence lstmts)
iterationStrategy = S.chaotic stackWiden widenResult
stackWiden = SW.groupBy (L.iso (\(store,(ev,sts)) -> (sts,(ev,store)))
(\(sts,(ev,store)) -> (store,(ev,sts))))
$ SW.maxSize k
$ SW.reuseFirst
$ SW.fromWidening (SM.widening W.finite W.** M.widening (widenVal W.** W.finite))
$ SW.finite
widenVal = widening (W.bounded ?bound I.widening)
widenExc (Exception m1) (Exception m2) = Exception <$> (M.widening widenVal m1 m2)
widenResult = T.widening $ E.widening W.finite (Exc.widening widenExc (M.widening (widenVal W.** W.finite) W.** W.finite))
combineMaps :: (Identifiable k, Identifiable a) => SM.Map k a -> M.Map a v -> M.Map k v
combineMaps env store = M.fromList [ (a,c) | (a,b) <- fromJust (SM.toList env)
, Just c <- [M.unsafeLookup b store]]
dropValues :: M.Map a (v,l) -> M.Map a l
dropValues = M.map snd
joinOnKey :: (Identifiable k',Complete v') => (k -> v -> Maybe (k',v')) -> HashMap k v -> HashMap k' v'
joinOnKey pred = Map.foldlWithKey' (\m k v -> case pred k v of
Just (k',v') -> Map.insertWith () k' v' m
Nothing -> m
) Map.empty
instance HasLabel (x,[Statement]) Label where
label (_,ss) = label (head ss)
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- | Syntax for the While language
module Exceptions.Syntax where
import Control.Monad.State
import Data.Label
import Data.Text (Text,unpack)
import Data.Hashable
import Data.Order
import Data.String
import Data.Lens (Prism')
import qualified Data.Lens as L