Skip to content

Instantly share code, notes, and snippets.

@gatlin
Last active August 29, 2015 14:17
Show Gist options
  • Save gatlin/92cc2b5d09d95cf50d25 to your computer and use it in GitHub Desktop.
Save gatlin/92cc2b5d09d95cf50d25 to your computer and use it in GitHub Desktop.
Perhaps comonadic fix points can be useful in compilers and interpreters?
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
import Prelude hiding (take)
import Control.Comonad
import Control.Comonad.Sheet
import Data.Foldable
import Data.Traversable
import Control.Monad.Free
import Control.Comonad.Env
import Data.Functor.Identity
type Symbol = String
-- Simple expression language
data ExprF a
= EInt Int
| EBoolean Bool
| ESymbol Symbol
| ELambda [Symbol] a
| EApply a [a]
| EUnit
deriving (Functor, Foldable, Traversable, Show)
type Expr = Free ExprF
-- * Convenience constructors
eUnit :: Expr a
eUnit = Free EUnit
eInt :: Int -> Expr a
eInt n = liftF $ EInt n
eBoolean :: Bool -> Expr a
eBoolean b = liftF $ EBoolean b
eSymbol :: Symbol -> Expr a
eSymbol s = liftF $ ESymbol s
eLambda :: [Symbol] -> Expr a -> Expr a
eLambda args body = Free $ ELambda args body
eApply :: Expr a -> [Expr a] -> Expr a
eApply op args = Free $ EApply op args
expr1 :: Expr a
expr1 = eApply (eLambda ["x", "y"] $ eApply (eSymbol "*") [eSymbol "x", eSymbol "y"])
[eInt 5, eInt 2]
-- * Primitive functions
addFun :: t -> Expr a
addFun = \_ -> eLambda ["x", "y"] $ eApply (eSymbol "+") [eSymbol "x", eSymbol "y"]
mulFun :: t -> Expr a
mulFun = \_ -> eLambda ["x", "y"] $ eApply (eSymbol "*") [eSymbol "x", eSymbol "y"]
-- | Fills in the background
fun0 :: Sheet1 (Expr a) -> Expr a
fun0 = \_ -> eUnit
-- * User-defined functions
-- Like the kind that Parsec might be able to spit out.
fun1 :: Sheet1 (Expr a) -> Expr a
fun1 = \_ -> eInt (5 :: Int)
fun2 :: Sheet1 (Expr a) -> Expr a
fun2 = \w -> let eMul = cell (leftBy 1) w -- I am too stupid to figure out
eArg = cell (rightBy 1) w -- absolute references.
in eApply eMul [eInt 2, eArg]
-- | A program is basically a set of definitions.
program :: Sheet1 (Sheet1 (Expr a) -> Expr a)
program = go (rightBy 2) $ sheet fun0 [ addFun, mulFun, fun2, fun1 ]
-- | And here we evaluate our program
result = take (rightBy 1) $ evaluate program
{- Notes
Every function in this little EDSL gets the current environment as a parameter.
After getting 'result' it is straightforward to slice the relevant cells and
begin mapping optimization, translation, and type checking functions over
them. 'evaluate' might be used on multiple subsequent sheets, all transformed
from this original one.
I suppose there is nothing stopping one of the functions from taking its
argument, inserting new definitions, and performing a sub-computation. This
mirrors local definitions nicely.
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment