operational-alacarte 0.3 → 0.3.1

raw patch · 4 files changed

+316/−3 lines, 4 filesdep ~basedep ~mtl

Dependency ranges changed: base, mtl

Files

README.md +5/−0
examples/Advanced.hs +166/−0
examples/Simple.hs +137/−0
operational-alacarte.cabal +8/−3

+ README.md view

@@ -0,0 +1,5 @@+# operational-alacarte++A version of Operational suitable for EDSLs extensible via data types à la carte. For more information, see the [source code documentation](http://hackage.haskell.org/package/operational-alacarte/docs/Control-Monad-Operational-Higher.html).++[![Build Status](https://travis-ci.org/emilaxelsson/operational-alacarte.png)](https://travis-ci.org/emilaxelsson/operational-alacarte)

+ examples/Advanced.hs view

@@ -0,0 +1,166 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}++{-# OPTIONS_GHC -fno-warn-missing-methods #-}++module Advanced where++import Data.IORef++import Control.Monad.Operational.Higher++++-- This file is a version of `Simple.hs` where we want to expose the fact that+-- programs have expressions as sub-structures. To do this, we use instructions+-- with types of the form+--+--     instr (Param2 p e) a+--+-- where `p` represents sub-programs and `e` represents expressions.+--+-- The `Program` type is now specialized to `Program ... '[Exp]`.+--+-- By exposing expressions in this way, we decouple the interpretation of+-- instructions from that of expressions. This can be seen in the example below+-- which defines+--+--     main = fmap eval $ interpretBi (return . eval) prog+--+-- The interpretation of instructions is obtained from the `InterpBi` class,+-- while the interpretation of expressions is provided separately.++++--------------------------------------------------------------------------------+-- Simple expression language+--------------------------------------------------------------------------------++data Exp a+  where+    Lit :: a -> Exp a+    Add :: Num a => Exp a -> Exp a -> Exp a+    Eq  :: Eq a => Exp a -> Exp a -> Exp Bool++instance Num a => Num (Exp a)+  where+    fromInteger = Lit . fromInteger+    (+) = Add++eval :: Exp a -> a+eval (Lit i)   = i+eval (Add a b) = eval a + eval b+eval (Eq a b)  = eval a == eval b++++--------------------------------------------------------------------------------+-- Composable instructions+--------------------------------------------------------------------------------++data Val a = Val a++-- | If statement+data If fs a+  where+    If :: e Bool -> p a -> p a -> If (Param2 p e) a++-- | Loop+data Loop fs a+  where+    Loop :: e Int -> p () -> Loop (Param2 p e) ()++-- | Mutable references+data Ref fs a+  where+    NewRef :: e a -> Ref (Param2 p e) (IORef a)+    GetRef :: IORef a -> Ref (Param2 p e) (Val a)+    SetRef :: IORef a -> e a -> Ref (Param2 p e) ()+  -- Note: `GetRef` cannot return `exp a` as that would prevent writing the+  -- `HBifunctor` instance.++instance HFunctor If+  where+    hfmap f (If c thn els) = If c (f thn) (f els)++instance HFunctor Loop+  where+    hfmap f (Loop n body) = Loop n (f body)++instance HFunctor Ref+  where+    hfmap f (NewRef a)   = NewRef a+    hfmap f (GetRef r)   = GetRef r+    hfmap f (SetRef r a) = SetRef r a++instance HBifunctor If+  where+    hbimap f g (If c thn els) = If (g c) (f thn) (f els)++instance HBifunctor Loop+  where+    hbimap f g (Loop n body) = Loop (g n) (f body)++instance HBifunctor Ref+  where+    hbimap _ g (NewRef a)   = NewRef (g a)+    hbimap _ g (GetRef r)   = GetRef r+    hbimap _ g (SetRef r a) = SetRef r (g a)++instance InterpBi If IO fs+  where+    interpBi (If c thn els) = c >>= \c' -> if c' then thn else els++instance InterpBi Loop IO fs+  where+    interpBi (Loop n body) = n >>= \n' -> replicateM_ n' body++instance InterpBi Ref IO fs+  where+    interpBi (NewRef a)   = newIORef =<< a+    interpBi (GetRef r)   = fmap Val $ readIORef r+    interpBi (SetRef r a) = writeIORef r =<< a++++--------------------------------------------------------------------------------+-- Example+--------------------------------------------------------------------------------++type MyProgram a = Program (If :+: Loop :+: Ref) (Param1 Exp) a++iff :: Exp Bool -> MyProgram a -> MyProgram a -> MyProgram a+iff c thn els = singleInj $ If c thn els++loop :: Exp Int -> MyProgram () -> MyProgram ()+loop n = singleInj . Loop n++newRef :: Exp a -> MyProgram (IORef a)+newRef = singleInj . NewRef++getRef :: IORef a -> MyProgram (Exp a)+getRef r = do+    Val a <- singleInj $ GetRef r+    return $ Lit a++setRef :: IORef a -> Exp a -> MyProgram ()+setRef r = singleInj . SetRef r++prog :: MyProgram (Exp Int)+prog = do+    r <- newRef 0+    loop 10 $ do+        a <- getRef r+        iff (Eq a 3)+            (setRef r 100)+            (setRef r (a+1))+    getRef r++main = fmap eval $ interpretBi (return . eval) prog+

+ examples/Simple.hs view

@@ -0,0 +1,137 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}++{-# OPTIONS_GHC -fno-warn-missing-methods #-}++module Simple where++import Data.IORef++import Control.Monad.Operational.Higher++++-- This file demonstrates simple use of the library. Instructions have types of+-- the form+--+--     instr '[p] a+--+-- where `p` represents sub-programs.+--+-- The `Program` type is specialized to `Program ... '[]`, which means that+-- we're not interested in exposing any sub-structures of programs.++++--------------------------------------------------------------------------------+-- Simple expression language+--------------------------------------------------------------------------------++data Exp a+  where+    Lit :: a -> Exp a+    Add :: Num a => Exp a -> Exp a -> Exp a+    Eq  :: Eq a => Exp a -> Exp a -> Exp Bool++instance Num a => Num (Exp a)+  where+    fromInteger = Lit . fromInteger+    (+) = Add++eval :: Exp a -> a+eval (Lit i)   = i+eval (Add a b) = eval a + eval b+eval (Eq a b)  = eval a == eval b++++--------------------------------------------------------------------------------+-- Composable instructions+--------------------------------------------------------------------------------++-- | If statement+data If p a+  where+    If :: Exp Bool -> p a -> p a -> If (Param1 p) a++-- | Loop+data Loop p a+  where+    Loop :: Exp Int -> p () -> Loop (Param1 p) ()++-- | Mutable references+data Ref p a+  where+    NewRef :: Exp a -> Ref (Param1 p) (IORef a)+    GetRef :: IORef a -> Ref (Param1 p) (Exp a)+    SetRef :: IORef a -> Exp a -> Ref (Param1 p) ()++instance HFunctor If+  where+    hfmap f (If c thn els) = If c (f thn) (f els)++instance HFunctor Loop+  where+    hfmap f (Loop n body) = Loop n (f body)++instance HFunctor Ref+  where+    hfmap f (NewRef a)   = NewRef a+    hfmap f (GetRef r)   = GetRef r+    hfmap f (SetRef r a) = SetRef r a++instance Interp If IO fs+  where+    interp (If c thn els) = if eval c then thn else els++instance Interp Loop IO fs+  where+    interp (Loop n body) = replicateM_ (eval n) body++instance Interp Ref IO fs+  where+    interp (NewRef a)   = newIORef (eval a)+    interp (GetRef r)   = fmap Lit $ readIORef r+    interp (SetRef r a) = writeIORef r (eval a)++++--------------------------------------------------------------------------------+-- Example+--------------------------------------------------------------------------------++type MyProgram = Program (If :+: Loop :+: Ref) Param0++iff :: Exp Bool -> MyProgram a -> MyProgram a -> MyProgram a+iff c thn els = singleInj $ If c thn els++loop :: Exp Int -> MyProgram () -> MyProgram ()+loop n = singleInj . Loop n++newRef :: Exp a -> MyProgram (IORef a)+newRef = singleInj . NewRef++getRef :: IORef a -> MyProgram (Exp a)+getRef = singleInj . GetRef++setRef :: IORef a -> Exp a -> MyProgram ()+setRef r = singleInj . SetRef r++prog :: MyProgram (Exp Int)+prog = do+    r <- newRef 0+    loop 10 $ do+        a <- getRef r+        iff (Eq a 3)+            (setRef r 100)+            (setRef r (a+1))+    getRef r++main = fmap eval $ interpret prog+

operational-alacarte.cabal view

@@ -1,5 +1,5 @@ name:                operational-alacarte-version:             0.3+version:             0.3.1 synopsis:            A version of Operational suitable for extensible EDSLs description:         A version of Operational \[1\] suitable for EDSLs                      extensible via data types à la carte.@@ -22,7 +22,7 @@ license:             BSD3 license-file:        LICENSE author:              Emil Axelsson-maintainer:          emax@chalmers.se+maintainer:          78emil@gmail.com copyright:           Copyright (c) 2016 Emil Axelsson                      Copyright (c) 2015 Emil Axelsson, Heinrich Apfelmus homepage:            https://github.com/emilaxelsson/operational-alacarte@@ -31,6 +31,11 @@ build-type:          Simple cabal-version:       >=1.10 +extra-source-files:+  README.md+  examples/*.hs+  tests/*.hs+ source-repository head   type:     git   location: git@github.com:emilaxelsson/operational-alacarte.git@@ -58,7 +63,7 @@     -- DeriveDataTypeable only needed for GHC < 7.10    build-depends:-    base >=4 && <5,+    base >=4.6 && <5,     mtl    hs-source-dirs: src