Final Tagless AST

.hs

{-# LANGUAGE ConstraintKinds  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}

class ArithOp op where add, mul :: op

class LogicalOp op where and :: op

class CompareOp op where less, equal :: op

class (ArithOp op, LogicalOp op) => AssignOp op where assignOp :: op

type AnyOp op = (ArithOp op, LogicalOp op, CompareOp op)

type Name = String

class AnyOp (ExprOp expr) => Expr expr where
  type ExprOp expr
  variable      :: Name -> expr
  literalNumber :: Integer -> expr
  binary        :: ExprOp expr -> expr -> expr -> expr
  -- ...

class Expr (DeclInit decl) => Declare decl where
  type DeclInit decl
  declare :: Name -> Maybe (DeclInit decl) -> decl

class Expr (SideExpr stmt) => SideStmt stmt where
  type SideExpr stmt
  empty    :: stmt
  callExpr :: SideExpr stmt -> stmt
  assign   :: Name -> SideExpr stmt -> stmt

class
  ( Declare stmt,
    SideStmt stmt,
    Declare (ForInit stmt),
    SideStmt (ForInit stmt),
    Expr (ForCondition stmt)
  ) =>
    Stmt stmt where
  type ForCondition stmt
  type ForInit stmt
  while :: a -> stmt
  for :: ForInit stmt -> stmt -> ForCondition stmt -> block -> stmt
  -- ...

example :: Stmt stmt => stmt
example =
  for
    (declare "i" $ Just $ literalNumber 0)
    (assign "i" $ binary add (variable "i") $ literalNumber 1)
    (binary less (variable "i") $ literalNumber 10)
    undefined