...
 
Commits (8)
......@@ -40,7 +40,8 @@ test/GraphsBroken.hs
test/Test2.hs
test/TypedArithExtension.hs
.gitignore
./papers
./benchmarks
TAGS
doc/Fatal
......
......@@ -10,7 +10,7 @@ name: AspectAG
-- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
version: 0.5.2.0
version: 0.6.0.0
-- A short (one-line) description of the package.
synopsis: Strongly typed Attribute Grammars implemented using type-level programming.
......@@ -66,20 +66,11 @@ cabal-version: >=1.10
library
-- Modules exported by the library.
exposed-modules: Language.Grammars.AspectAG,
Language.Grammars.FastAG,
Language.Grammars.AspectAG.TH,
Language.Grammars.AspectAG.HList,
Language.Grammars.AspectAG.TPrelude,
Language.Grammars.AspectAG.Label
Language.Grammars.AspectAG.GenRecord,
Language.Grammars.AspectAG.RecordInstances,
Language.Grammars.AspectAG.Require,
Language.Grammars.FastAG.GenRecord,
Language.Grammars.FastAG.HList,
Language.Grammars.FastAG.RecordInstances,
Language.Grammars.FastAG.TPrelude,
Language.Grammars.FastAG.TH
-- LANGUAGE extensions used by modules in this package.
Language.Grammars.AspectAG.RecordInstances
-- LANGUAGE extensions used by modules in this package.
other-extensions: TypeInType,
TypeFamilies,
FlexibleContexts,
......@@ -104,11 +95,13 @@ library
InstanceSigs
-- Other library packages from which modules are imported.
build-depends: base >=4.11 && <4.13,
build-depends: base >=4.11,
tagged >=0.8,
containers >= 0.5,
template-haskell >= 2.13,
mtl >= 2.0
mtl >= 2.0,
require >=0.6 && <0.7,
poly-rec >=0.6 && <0.7
-- Directories containing source files.
......
File deleted
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import Language.Grammars.AspectAG
import Language.Grammars.AspectAG.TH
import System.Environment
$(addNont "Root")
$(addNont "Tree")
$(addProd "Leaf" ''Nt_Tree [("val", Ter ''Int)])
$(addProd "Node" ''Nt_Tree [("l", NonTer ''Nt_Tree),("r", NonTer ''Nt_Tree)])
$(addProd "Root" ''Nt_Root [("tree",NonTer ''Nt_Tree)])
$(closeNTs [''Nt_Root,''Nt_Tree])
$(mkSemFunc ''Nt_Tree)
$(mkSemFunc ''Nt_Root)
$(attLabels [("sres", ''Tree), ("smin", ''Int), ("ival", ''Int)])
asp_smin
= syn smin p_Node (min @ Int <$> at ch_l smin <*> at ch_r smin)
.+: syn smin p_Leaf (ter ch_val)
.+: emptyAspect
asp_sres
= syn sres p_Node (Node <$> at ch_l sres <*> at ch_r sres)
.+: syn sres p_Leaf (Leaf <$> at lhs ival)
.+: syn sres p_Root (at ch_tree sres)
.+: emptyAspect
asp_ival
= inh ival p_Root ch_tree (at ch_tree smin)
.+: inh ival p_Node ch_l (at lhs ival)
.+: inh ival p_Node ch_r (at lhs ival)
.+: emptyAspect
asp_repmin
= asp_smin .:+: asp_ival .:+: asp_sres
examplet = (Node (Node (Node (Leaf 3) (Leaf 4))
(Node (Leaf 2) (Leaf 7))
)
(Node (Node (Leaf (5)) (Leaf (27)))
(Leaf 6)
)
)
exampleT 0 = examplet
exampleT n = Node (examplet) (exampleT (n-1))
repmin t = sem_Root asp_repmin (Root t) emptyAtt #. sres
minT t = sem_Tree asp_smin t emptyAtt #. smin
main
= getArgs >>= \args ->
let n = (read :: String -> Int) (args!!0) in
print $ minT $ repmin $ exampleT n
ghc -O2 -o benchNew Repmin.hs
To use AspectAG in a module, some extensions must be enabled,
otherwise type errors we won't be readable.
> {-# LANGUAGE TemplateHaskell #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE AllowAmbiguousTypes #-}
> {-# LANGUAGE NoMonomorphismRestriction #-}
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE TypeApplications #-}
> module CoreLang where
> import Language.Grammars.AspectAG
> import Language.Grammars.AspectAG.TH
> $(addNont "Expr")
> $(addProd "EVar" ''Nt_Expr [("name", Ter ''String)])
> $(closeNTs [''Nt_Expr])
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE
TypeFamilies,
FlexibleContexts,
ScopedTypeVariables,
NoMonomorphismRestriction,
ImplicitParams,
ExtendedDefaultRules,
UnicodeSyntax,
DataKinds,
TypeApplications,
PartialTypeSignatures,
AllowAmbiguousTypes
#-}
module Expr where
import System.Exit (exitFailure)
import Language.Grammars.AspectAG
import Control.Monad
import Control.Applicative
import Data.Proxy
import GHC.TypeLits
import Data.Map
import Data.Maybe
import Debug.Trace
import Language.Grammars.AspectAG.TH
type Nt_Expr = 'NT "Expr"
expr = Label @ Nt_Expr
type P_Add = 'Prd "p_Add" Nt_Expr
add = Label @ P_Add
type P_Val = 'Prd "p_Val" Nt_Expr
val = Label @ P_Val
type P_Var = 'Prd "p_Var" Nt_Expr
var = Label @ P_Var
leftAdd = Label @ ('Chi "leftAdd" P_Add ('Left Nt_Expr))
rightAdd = Label @ ('Chi "rightAdd" P_Add ('Left Nt_Expr))
ival = Label @ ('Chi "ival" P_Val ('Right ('T Int)))
vname = Label @ ('Chi "vname" P_Var ('Right ('T String)))
eval = Label @ ('Att "eval" Int)
env = Label @ ('Att "env" (Map String Int))
add_eval = syndefM eval add $ (+) <$> at leftAdd eval <*> at rightAdd eval
--add_eval'' = uses eval (add .:. KNil) (expr .:. eL) ((+) @ Int) 0
--add_eval' = useadd add
-- .:+: use eval mul (expr .:. eL) ((*) @ Int) 1
useadd prd = use eval prd (expr .:. eL) ((+) @ Int) 0
val_eval = syndefM eval val $ ter ival
var_eval = syndefM eval var $ slookup <$> ter vname <*> at lhs env
slookup nm = fromJust . Data.Map.lookup nm
aspEval = traceAspect (Proxy @ ('Text "eval")) $
add_eval .+: val_eval .+: var_eval .+: emptyAspect
aspEval' = traceAspect (Proxy @ ('Text "eval")) $
val_eval .+: var_eval .+: add_eval
add_leftAdd_env = inh env add leftAdd $ at lhs env
add_rightAdd_env = inh env add rightAdd $ at lhs env
-- val_ival_env = inhdefM env val ival $ at lhs env
aspEnv = traceAspect (Proxy @ ('Text "env")) $
{- add_leftAdd_env .+:-} add_rightAdd_env .+: emptyAspect
asp = aspEval' .:+: aspEnv
data Expr = Val Int
| Var String
| Add Expr Expr
deriving Show
sem_Expr asp (Add l r) = knitAspect add asp
$ leftAdd .=. sem_Expr asp l
.*. rightAdd .=. sem_Expr asp r
.*. EmptyRec
sem_Expr asp (Val i) = knitAspect val asp$
ival .=. sem_Lit i .*. EmptyRec
sem_Expr asp (Var v) = knitAspect var asp$
vname .=. sem_Lit v .*. EmptyRec
evalExpr e m = sem_Expr asp e (env =. m .*. emptyAtt) #. eval
exampleExpr = Add (Val (-9)) (Add (Var "x") (Val 2))
exampleEval = evalExpr exampleExpr (insert "x" 5 Data.Map.empty)
> {-# LANGUAGE RankNTypes #-}
> {-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE TemplateHaskell #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE AllowAmbiguousTypes #-}
> {-# LANGUAGE NoMonomorphismRestriction #-}
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE TypeApplications #-}
> module Hoas where
> import Language.Grammars.AspectAG
> import Language.Grammars.AspectAG.TH
> import Data.Proxy
> import Language.Grammars.AspectAG.Require
This module tests AspectAG to encode semantics of a GADT,
representing a grammar using higher order abstract syntax.
From WYAH:
> data Expr a where
> Lift :: a -> Expr a
> Tup :: Expr a -> Expr b -> Expr (a, b)
> Lam :: (Expr a -> Expr b) -> Expr (a -> b)
> App :: Expr (a -> b) -> Expr a -> Expr b
> Fix :: Expr (a -> a) -> Expr a
> type Nt_Expr = 'NT "Expr"
> nt_Expr = Label @ Nt_Expr
> type P_Lift = 'Prd "Lift" Nt_Expr
> p_Lift = Label @ P_Lift
> ch_unLift :: forall a . Label ('Chi "unLift" P_Lift ('Right ('T a)))
> ch_unLift = Label
> type P_Tup = 'Prd "Tup" Nt_Expr
> p_Tup = Label @ P_Tup
> ch_fst :: forall a . Label ('Chi "fst" P_Tup ('Left Nt_Expr))
> ch_fst = Label
> ch_snd :: forall a . Label ('Chi "snd" P_Tup ('Left Nt_Expr))
> ch_snd = Label
-- > sem_Expr asp (Lift a :: Expr a)
-- > = knitAspect p_Lift asp
-- > $ ch_unLift @ a .=. sem_Lit @ a a
-- > .*. EmptyRec
-- > sem_Expr asp ((Tup a b) :: Expr (a, b))
-- > = knitAspect p_Tup asp
-- > $ ch_fst @ a .=. sem_Expr asp a
-- > $ ch_snd @ b .=. sem_Expr asp b
-- > .*. EmptyRec
-- > sem_Expr asp (Proxy :: Proxy a)(Lift a :: Expr a)
-- > = knitAspect p_Lift asp
-- > $ ch_unLift @ a .=. sem_Lit @ a a
-- > .*. EmptyRec
-- > sem_Expr asp (Proxy :: Proxy (a,b)) ((Tup a b) :: Expr (a, b))
-- > = knitAspect p_Tup asp
-- > $ ch_fst @ a .=. sem_Expr proxy asp a
-- > $ ch_snd @ b .=. sem_Expr proxy asp b
-- > .*. EmptyRec
-- > foo (Lift a) = show a
-- > foo (Tup a b) = foo a ++ foo b
> class Sem_Expr a where
> sem_Expr :: CAspect '[] r -> Expr a -> Attribution ip -> Attribution sp
> instance
> (Language.Grammars.AspectAG.Require.ReqR (OpLookup PrdReco P_Lift r) ~
> CRule '[]
> P_Lift
> '[ '( 'Chi "unLift" P_Lift ('Right ('T a)), '[ '( 'Att "term" a, a)])]
> ip
> '[ '( 'Chi "unLift" P_Lift ('Right ('T a)), '[])]
> '[]
> '[ '( 'Chi "unLift" P_Lift ('Right ('T a)), '[])]
> sp)
> => Sem_Expr a where
> sem_Expr asp (Lift a)
> = knitAspect p_Lift asp
> $ ch_unLift @ a .=. sem_Lit @ a a
> .*. EmptyRec
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE
TypeFamilies,
FlexibleContexts,
ScopedTypeVariables,
NoMonomorphismRestriction,
ImplicitParams,
ExtendedDefaultRules,
UnicodeSyntax,
DataKinds,
TypeApplications,
PartialTypeSignatures,
AllowAmbiguousTypes,
RankNTypes,
ScopedTypeVariables
#-}
module List where
import Prelude hiding (head, tail, sum, all, length, null, last)
import Language.Grammars.AspectAG
import Control.Monad
import Control.Applicative
import Data.Proxy
import GHC.TypeLits
type Nt_List = 'NT "List"
list = Label @ Nt_List
type P_Cons = 'Prd "Cons" Nt_List
cons = Label @ P_Cons
type P_Nil = 'Prd "Nil" Nt_List
nil = Label @ P_Nil
head :: forall a . Label ('Chi "head" P_Cons ('Right ('T a)))
head = Label
tail = Label @ ('Chi "tail" P_Cons ('Left Nt_List))
nilCh :: Label ('Chi "nilCh" P_Nil ('Right ('T ())))
nilCh = Label
-- data List a = Cons a (List a) | Nil () deriving Show
sem_List (proxy :: Proxy a) asp (x:xs)
= knitAspect cons asp
$ head @ a .=. sem_Lit @ a x
.*. tail .=. sem_List proxy asp xs
.*. EmptyRec
sem_List (_ :: Proxy a) asp []
= knitAspect nil asp
$ nilCh .=. sem_Lit () .*. EmptyRec
scata :: forall b . Label ('Att "cata" b)
scata = Label
asp_cata (Proxy :: Proxy a) f e
= (syndefM (scata @ a) cons $ f <$> ter head <*> at tail (scata @ a))
.+: (syndefM (scata @ a) nil $ pure e)
.+: emptyAspect
sum :: [Integer] -> Integer
sum xs
= sem_List (Proxy @ Integer)
(asp_cata (Proxy @ Integer) (+) 0) xs emptyAtt #. (scata @ Integer)
all xs
= sem_List (Proxy @ Bool)
(asp_cata (Proxy @ Bool) (&&) True) xs emptyAtt #. (scata @ Bool)
cata :: (a -> b -> b) -> b -> [a] -> b
cata (f :: a -> b -> b) e xs
= sem_List (Proxy @ a) (asp_cata (Proxy @ b) f e) xs emptyAtt #. (scata @ b)
tyApp :: (forall a. Label ('Att "cata" a)) -> Proxy a
-> (Label ('Att "cata" a))
tyApp poly (Proxy :: Proxy a) = poly @ a
slen = Label @ ('Att "slen" Integer)
asp_slen
= syndefM slen cons ((1+) <$> at tail slen)
.+: syndefM slen nil (pure 0) .+: emptyAspect
length xs
= sem_List (proxyFrom xs) asp_slen xs emptyAtt #. slen
sempty = Label @ ('Att "sempty" Bool)
asp_sempty
= syndefM sempty cons (pure False) .+: syndefM sempty nil (pure True) .+: emptyAspect
null xs = sem_List (proxyFrom xs) asp_sempty xs emptyAtt #. sempty
sid :: forall a . Label ('Att "sid" [a]) ; sid = Label
asp_sid
= \(Proxy :: Proxy a)
-> syndefM (sid @ a) cons ((:) <$> ter head <*> at tail sid)
.+: syndefM (sid @ a) nil (pure []) .+: emptyAspect
idList (xs :: [a])
= sem_List (proxyFrom xs) (asp_sid (proxyFrom xs)) xs emptyAtt #. (sid @ a) -- TODO
-- Si queremos evitar anotar tipos, los atributos polimorficos pueden tomar un proxy como
-- parametro, y usar proxyFrom
slast :: forall a . Label ('Att "slast" a); slast = Label
asp_slast (Proxy :: Proxy a)
= syndefM (slast @ a) cons (
do isLast <- at tail sempty
case isLast of
True -> ter head
False -> at tail slast
)
.+: syndefM (slast @ a) nil (error "Exception: empty list")
.+: emptyAspect
last (xs :: [a])
= sem_List (proxyFrom xs) (asp_slast (proxyFrom xs) .:+: asp_sempty)
xs emptyAtt #. slast @ a
proxyFrom :: f a -> Proxy a
proxyFrom _ = Proxy
......@@ -151,14 +151,21 @@ A possibly better alternative:
avoid annotations, without touching attribute definitions:
< tyApp :: (forall b. Label ('Att name b)) -> Proxy a -> Label ('Att name a)
< att `tyApp` Proxy = att
> cata'' :: (a -> b -> b) -> b -> [a] -> b -- needed
> cata'' f e xs
> = semListPoly (asp_cata (getProxy e) f e) xs emptyAtt
> #. (scata `tyAppAtt` (getProxy e))
-- > tyApp :: (forall b. Label ('Att name b)) -> Proxy a -> Label ('Att name a)
-- > att `tyApp` Proxy = att
-- > cata'' :: (a -> b -> b) -> b -> [a] -> b -- needed
-- > cata'' f e xs
-- > = semListPoly (asp_cata (getProxy e) f e) xs emptyAtt
-- > #. (scata `tyAppAtt` (getProxy e))
-------------------------------------------------------------------------------
testing use
> proxyFrom :: f a -> Proxy a
> proxyFrom _ = Proxy
> getProxy :: a -> Proxy a
> getProxy _ = Proxy
> {-# LANGUAGE TemplateHaskell #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE AllowAmbiguousTypes #-}
> {-# LANGUAGE NoMonomorphismRestriction #-}
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE TypeApplications #-}
> module List where
> import Language.Grammars.AspectAG
> import Language.Grammars.AspectAG.TH
> import Prelude hiding (head, tail, sum, all, length,null, last)
> $(addNont "List")
> $(addProd "Nil" ''Nt_List [])
> $(addProd "Cons" ''Nt_List [("head", Poly), ("tail", NonTer ''Nt_List)])
Does not work:
> $(closeNTs [''Nt_List])
Parametric ASTs are not yet derivable from TH
To use AspectAG in a module, some extensions must be enabled,
otherwise type errors we won't have readable type errors.
......@@ -18,13 +14,14 @@ otherwise type errors we won't have readable type errors.
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE TypeApplications #-}
> {-# LANGUAGE PartialTypeSignatures #-}
> module RepminTH where
> import Language.Grammars.AspectAG
> import Language.Grammars.AspectAG.TH
> import Data.GenRec
To add a nonterminal we can use the TH function |addNont|:
......@@ -53,10 +50,11 @@ Semantic functions and a datatype by hand (for now)
> data Root = Root Tree deriving Show
> data Tree = Leaf Int | Node Tree Tree deriving Show
> t1 = Node (Leaf 4) (Node (Leaf 5) (Leaf 1))
> sem_Root asp (Root t)
> = knitAspect p_Root asp $ ch_tree .=. sem_Tree asp t .*. EmptyRec
> sem_Tree asp (Leaf i)
> = knitAspect p_Leaf asp $ ch_val .=. sem_Lit i .*. EmptyRec
> sem_Tree asp (Node l r)
......@@ -65,17 +63,17 @@ Semantic functions and a datatype by hand (for now)
> .*. ch_r .=. sem_Tree asp r
> .*. EmptyRec
> $(attLabels [("sres", ''Tree), ("smin", ''Int), ("ival", ''Int)])
> asp_smin
> = syn smin p_Node (min @ Int <$> at ch_l smin <*> at ch_r smin)
> .+: syn smin p_Leaf (ter ch_val)
> .+: emptyAspect
> =
> syn smin p_Leaf (ter ch_val) .+:
> syn smin p_Node (min @ Int <$> at ch_l smin <*> at ch_r smin) .+:
> emptyAspect
> asp_sres
> = syn sres p_Node (Node <$> at ch_l sres <*> at ch_r sres)
> .+: syn sres p_Leaf (Leaf <$> at lhs ival)
> = syn sres p_Leaf (Leaf <$> at lhs ival)
> .+: syn sres p_Node (Node <$> at ch_l sres <*> at ch_r sres)
> .+: syn sres p_Root (at ch_tree sres)
> .+: emptyAspect
......@@ -88,30 +86,31 @@ Semantic functions and a datatype by hand (for now)
> asp_repmin
> = asp_smin .:+: asp_sres .:+: asp_ival
> mini t = sem_Tree asp_smin t emptyAtt #. smin
> repmin t
> = sem_Root asp_repmin (Root t)
> emptyAtt #. sres
Another way to build semantic functions:
-- Another way to build semantic functions:
> semRoot_Root asp tree
> = knitAspect p_Root asp
> $ ch_tree .=. tree .*. EmptyRec
> semTree_Node asp l r
> = knitAspect p_Node asp
> $ ch_l .=. l
> .*. ch_r .=. r
> .*. EmptyRec
-- > semRoot_Root asp tree
-- > = knitAspect p_Root asp
-- > $ ch_tree .==. tree .**. EmptyRec
> semTree_Leaf asp i
> = knitAspect p_Leaf asp
> $ ch_val .=. i .*. EmptyRec
-- > semTree_Node asp l r
-- > = knitAspect p_Node asp
-- > $ ch_l .==. l
-- > .**. ch_r .==. r
-- > .**. EmptyRec
> semR asp (Root t) = semRoot_Root asp (semT asp t)
> semT asp (Node l r) = semTree_Node asp (semT asp l) (semT asp r)
> semT asp (Leaf i) = semTree_Leaf asp (sem_Lit i)
-- > semTree_Leaf asp i
-- > = knitAspect p_Leaf asp
-- > $ ch_val .==. i .**. EmptyRec
-- > semR asp (Root t) = semRoot_Root asp (semT asp t)
-- > semT asp (Node l r) = semTree_Node asp (semT asp l) (semT asp r)
-- > semT asp (Leaf i) = semTree_Leaf asp (sem_Lit i)
> repmin' t = sem_Root asp_repmin (Root t) emptyAtt #. sres
-- > repmin' t = sem_Root asp_repmin (Root t) emptyAtt #. sres
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE TemplateHaskell #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE AllowAmbiguousTypes #-}
> {-# LANGUAGE NoMonomorphismRestriction #-}
> {-# LANGUAGE TypeApplications #-}
> module RepminTHExt where
> import Language.Grammars.AspectAG
> import Language.Grammars.AspectAG.TH
> import RepminTH hiding (Tree, semT, Leaf)
Extending the grammar: New production, a ternary node
> $(addProd "Node3" ''Nt_Tree [("l3", NonTer ''Nt_Tree),
> ("c3", NonTer ''Nt_Tree),
> ("r3", NonTer ''Nt_Tree)])
A support datatype
> data Tree3
> = Node2 Tree3 Tree3
> | Node3 Tree3 Tree3 Tree3
> | Leaf Int
semantic function for the new production
> semTree_Node3 asp l c r
> = knitAspect p_Node3 asp
> $ ch_l3 .=. l
> .*. ch_c3 .=. c
> .*. ch_r3 .=. r
> .*. EmptyRec
> semT asp (Node2 l r)
> = semTree_Node asp (semT asp l) (semT asp r)
> semT asp (Node3 l c r)
> = semTree_Node3 asp (semT asp l) (semT asp c) (semT asp r)
> semT asp (Leaf i)
> = semTree_Leaf asp (sem_Lit i)
> asp_repmin3
> = syn sres p_Node3 (do x <- at ch_l3 sres
> y <- at ch_c3 sres
> z <- at ch_r3 sres
> return (Node x (Node y z)))
> .+: syn smin p_Node3 (min3 <$> at ch_l3 smin
> <*> at ch_c3 smin
> <*> at ch_r3 smin)
> .+: inh ival p_Node3 ch_l3 (at lhs ival)
> .+: inh ival p_Node3 ch_c3 (at lhs ival)
> .+: inh ival p_Node3 ch_r3 (at lhs ival)
> .+: asp_repmin
> where min3 a b c = a `min` b `min` c
-- TODO: invert arg order
> repmin'' t = semR3 asp_repmin3 (Root3 t) emptyAtt #. sres
> data Root3 = Root3 Tree3
> semR3 asp (Root3 t) = semRoot_Root asp (semT asp t)
This diff is collapsed.
This diff is collapsed.
In this paper we presented a library of first class strongly kinded attribute
grammars. Using type level programming we achieved to get precise domain
specific type errors.
%% We inherite all the advantages of an embedding. All Haskell ecosystem and
%% language features are avaiable to the user when implementing grammars.
%% Even though Template Haskell functions are provided to scrap some boilerplate,
%% the library can be used as a pure embedding within the host language, with no
%% preprocessing or postprocessing. This represents an advantage since a staged
%% compilation makes interactive development and debugging difficult.
Grammars do not need to be tied to a datatype. Reusing an AG in a new datatype
when a language is extended is nice, but the semantic function must be
implemented (or derived) twice. This is not a problem of our implementation, but
of Haskell's expresiveness. To explore how to integrate our library with
extensible datatypes is left as an open problem.
We think the library is useful and easy to use. Having the DSL embedded in
Haskell allows to develop furher abstractions, such as common patterns, or
macros, or to use the power of higher order to generate grammars. In addition to
the examples we have coded during the development, the library is being tested with
success in the implementation of a real compiler of a non trivial functional
language.
Working on performance optimization, to alleviate the performance overhead, is left for future work.
To get clear error messages we had to deal with some tradeoffs. It requires
careful management of context information annotated in types, and explicit term
level proxy arguments to carry type information during type checking.
Nevertheless, this implementation details are transparent to the user. By
strongly typing we have lost some flexibilities. For example, rules are related
to a production, this was not designed this way in previous versions of
\AspectAG, which allowed us to reuse some rules out of the box. Anyway, this can
be shallowed since the host language provides type -and kind- polymorphism.
We developed a methodology to manage error message generation using
|Requirements|. We think this idea can be applied similarly in other EDSL
implementations and it deserves to be explored.
This diff is collapsed.
This diff is collapsed.
\section{Introduction}
%% Higher order functions such as |foldr| are powerful abstraction tools for the
%% functional programmer. Given a datatype we capture the structural recursion
%% scheme by giving a function for each constructor to combine contained data and
%% recursive calls. From the algebraic perspective the programmer must provide an
%% \emph{algebra} capturing semantics for the grammar -or datatype, note that there
%% is a correspondence between both formalisms- and the \emph{catamorphism} builds
%% the computation. In practice, however, when constructing real world compilers
%% many problems arise. Abstract syntax trees tend to have a lot of alternatives
%% (meaning huge algebras), some information must flow top down, and many -maybe
%% non-orthogonal- alternative semantics are actually employed (well formedness
%% properties, type checking, program transformation, evaluation, among others).
%% Also, it is common for syntax to evolve over time when new constructs are added
%% to the language, breaking every algebra on an implementation.
%% More generally, given a functional program it is easy to extended it by defining
%% new functions. However, extending data (e.g. if a datatype is extended with a
%% new case construct) is not easy. Each case expression where a value of this type
%% is matched has to be inspected and modified accordingly. On the other side,
%% object oriented programing is good to define new data: one could implement
%% algebraic datatypes with a composite design pattern, and simply add a new class.
%% However, to define a new function for a data type, we have to inspect all the
%% existing subclasses and add a new method. This problem was first noted by
%% Reynolds\cite{REYNOLDS75B} and later referred to as “the expression problem” by Wadler
%% \cite{ExpressionProblem}. Attribute grammars offer an aproach to solve this
%% issue.
Attribute grammars (AGs) were originally introduced to describe
semantics for context-free languages \cite{Knuth68semanticsof}. Given a context-free grammar,
attributes are associated to each of its productions. Attribute values are computed
in every node of the abstract syntax tree
according to semantic rules that are expressed in terms of the attribute values
of the children and the parent. Attributes are classified in at least two sets: synthesized
attributes (where information flows bottom up) and inherited attibutes (where it
flows top down). AGs have not only proven useful to implement
programming language semantics, but as a general purpose programming paradigm.
%Domain Specific Languages (DSLs) are a useful abstraction tool to solve problems
%using specialized domain terms. DSLs can be implemented as a standalone language,
%introducing a full compiler toolchain, or embedded as a library in a host
%language (Embedded DSLs, EDSLs for short).
%The latter approach has some advantages.
%All constructs of the host language and its libraries are avaiable
%to users. Also, the amount of work required compared to the standalone approach
%is minimal.
%In higher order functional programming languages such as Haskell,
%the embedded approach is common and successf
%\AspectAG\ is a Haskell EDSL (Embedded Domain Specific Language) implementing first class attribute grammars,
%introduced by Viera \emph{et al} in 2009 \cite{Viera:2009:AGF:1596550.1596586}.
\AspectAG\ is a Haskell EDSL (Embedded Domain Specific Language), introduced by Viera \emph{et al}~\cite{Viera:2009:AGF:1596550.1596586} that implements first class AGs.
It uses extensible polymorphic records and predicates encoded using old fashioned type
level programming features, such as Multi Parameter Typeclasses \cite{type-classes-an-exploration-of-the-design-space} and Functional Dependencies \cite{DBLP:conf/esop/Jones00}
to ensure well-formedness of AGs at compile time.
An important drawback of EDSLs in general, and of \AspectAG\ in particular,
is that they are simply embedded libraries and when type errors occur they usually do not
deliver error messages that refer to domain terms, leaking in addition implementation details in those messages. This breaks all abstraction mechanisms that may have taken into account in building the library.
The problem is even worse if we use type-level programming techniques to
implement the DSL.
%
%Type errors
%were of course a weakness, aggravated by the fact that an AG is a structure that
%can be easily illformed.
%For instance, for the grammar implementator it is a
%common mistake to try to use attributes that are not defined in some production.
In the specific case of the original \AspectAG\ library, the type-level
programming techniques that were used were really ad-hoc, exploiting extensions
originally introduced for other uses. In particular, at type level, programming
was essentialy untyped.
More recent versions of GHC provide extensions to the type system to support a more robust and trustworthy programming at the type level.
%the encoding of more
%sort-of dependent types in a more comfortable way.
Notably {\tt
TypeFamilies}~\cite{Chakravarty:2005:ATS:1090189.1086397, Sulzmann:2007:SFT:1190315.1190324}, to
define functions at type level; {\tt
DataKinds}~\cite{Yorgey:2012:GHP:2103786.2103795} implementing data
promotion; {\tt PolyKinds}, providing kind polymorphism; {\tt
KindSignatures} %~\cite{ghcman}
to document and deambiguate kinds; or
{\tt TypeApplications}~\cite{conf/esop/EisenbergWA16} to provide visible
application at type level.
%With recent additions to GHC this issues can be tackled.
By using such extensions, we propose a reworked
version of \AspectAG\footnote{\url{http://hackage.haskell.org/package/AspectAG}}
that tackles the previously mentioned drawbacks. %some of its most important weaknesses.
These type-level programming techniques allowed us to do
that in a strongly typed fashion at type level (we say, strongly kinded).
We also define a framework to manipulate
type errors, keeping track of the context of the possible
sources of errors, to show precise (DSL oriented) messages when they occur.
The structure of the rest of the paper is as follows: In
Section~\ref{sec:example} we present the EDSL using an example, including a set
of example error cases with their corresponding messages. In
Section~\ref{sec:records} we make a summary of the techniques we used,
introducing polymorphic extensible records and proposing a methodology to manage
type errors. In Section~\ref{sec:aag} we present some implementation details.
Finally, we discuss some related work and conclude.
This diff is collapsed.
TEX = pdflatex -shell-escape -interaction=nonstopmode -file-line-error
LHS2TEX = ./lhs2TeX
.PHONY: all view
all : pdf
view : Main.tex
evince Main.pdf&
pdf : Main.lhs myformat.fmt ExprPaper.lhs GenRecord.lhs bib.bib
$(LHS2TEX) Main.lhs > Main.tex
$(TEX) Main.tex
pdflatex Main.tex
bibtex Main
pdflatex Main.tex
quotes : Main.tex
perl -pe 's/'\''\[/\\tk \[/g' ./Main.tex | perl -pe 's/'\''\(/\\tk \(/g' | perl -pe 's/'\''\:/\\tk \\\! \\\!\:/g' > Main2.tex
mv Main2.tex Main.tex
pdflatex Main.tex
.PHONY: clean
clean:
rm -f *.log *.aux *~ *.pdf *bbl
This diff is collapsed.
\usepackage{multicol}
\usepackage{color}
\usepackage{amsmath}
\usepackage{tikz}
\usetikzlibrary{arrows}
\usepackage{url}
\usepackage{xspace}
\usepackage{listings}
%include lhs2TeX.fmt
\lstdefinelanguage{oberon0}{
keywords={MODULE, END, PROCEDURE, VAR, TYPE, CONST, FOR, TO, WHILE, CASE, IF, BEGIN, ELSIF, ELSE, THEN, ARRAY, OF, RECORD, DO},
sensitive=true
}
\newcommand{\oberonsize}{\fontsize{10pt}{10pt}}
\lstnewenvironment{oberon0} {\lstset{language={oberon0}}\oberonsize}{}
\newcommand\textoberon[1]{{\lstinline[language={oberon0}]{#1}}}
\newcommand\textoberonF[1]{{\oberonsize\lstinline[language={oberon0}]{#1}}}
\lstset{
basicstyle=\small,
identifierstyle=\ttfamily,
keywordstyle=\ttfamily\bfseries,
commentstyle=\scriptsize\rmfamily,
basewidth={0.5em,0.5em},
fontadjust=true,
escapechar=~,
escapeinside={\%*}{*)}
}
\newcommand{\todo}[1]{%\error uncomment to make sure there are no todos left
\textcolor{blue}{\mbox{$^\ast$}}\marginpar{\raggedright
\hspace{0pt}\sffamily\tiny{\sc \textcolor{blue}{todo:}}\\ \textcolor{blue}{#1}}}
%\newcommand{\doaitse}[1]{\textcolor{red}{\textbf{Doaitse:}#1}}
%\newcommand{\marcos}[1]{\textcolor{red}{\textbf{Marcos:}#1}}
\newcommand{\doaitse}[1]{%\error uncomment to make sure there are no todos left
\textcolor{red}{\mbox{$^\ast$}}\marginpar{\raggedright
\hspace{0pt}\sffamily\tiny{\sc \textcolor{red}{doaitse:}}\\ \textcolor{red}{#1}}}
\newcommand{\marcos}[1]{%\error uncomment to make sure there are no todos left
\textcolor{red}{\mbox{$^\ast$}}\marginpar{\raggedright
\hspace{0pt}\sffamily\tiny{\sc \textcolor{red}{marcos:}}\\ \textcolor{red}{#1}}}
\renewcommand{\doaitse}[1]{}
%\renewcommand{\marcos}[1]{}
\usepackage[ pdftex, pdfstartpage=1, baseurl=http://www.fing.edu.uy/~mviera
, bookmarks, bookmarksnumbered, bookmarksopen=false
%% , breaklinks, colorlinks
, pdftitle={First Class Syntax, Semantics and Their Composition}
, pdfsubject={}
, pdfkeywords={haskell,attribute grammars, typed transformations, extensible languages, type-level programming}
, pdfcreator={LaTeX with Lhs2TeX}
, pdfproducer={pdflatex}
, pdfauthor={Marcos Viera}
, linkcolor=black
, citecolor=black
, filecolor=black
, urlcolor=black
]{hyperref}
\newcommand{\ChristmasTree}{\texttt{ChristmasTree}\xspace}
\newcommand{\AspectAG}{\texttt{AspectAG}\xspace}
\newcommand{\HList}{\texttt{HList}\xspace}
\newcommand{\murder}{\texttt{murder}\xspace}
\newcommand{\TTTAS}{\texttt{TTTAS}\xspace}
\newcommand{\uulib}{\texttt{uulib}\xspace}
\newcommand{\uuparsinglib}{\texttt{uu-parsinglib}\xspace}
\newcommand{\uuagc}{\texttt{uuagc}\xspace}
\newcommand{\languagec}{\texttt{language-c}\xspace}
\newcommand{\oberon}{\texttt{oberon0}\xspace}
\newcommand{\GHC}{\texttt{GHC}\xspace}
\newcommand{\UHC}{\texttt{UHC}\xspace}
\newcommand{\UUAGC}{\texttt{UUAGC}\xspace}
%format proc = "\mathbf{proc}"
%format mdo = "\mathbf{mdo}"
%format rec = "\mathbf{rec}"
%format >>> = "\mathbin{\text{\ttfamily{>>>}}}"
%%format <- = "\mathbin{\text{\ttfamily{<-}}}"
%%format -> = "\mathbin{\text{\ttfamily{->}}}"
%format -< = "\prec{}"
%format <* = "\mathbin{\text{\small\ttfamily{<*}}}"
%format <*> = "\mathbin{\text{\small\ttfamily{<*>}}}"
%format <**> = "\mathbin{\text{\small\ttfamily{<**>}}}"
%format <??> = "\mathbin{\text{\ttfamily{<??>}}}"
%format <|> = "\mathbin{\text{\small\ttfamily{<|>}}}"
%format <$> = "\mathbin{\text{\small\ttfamily{<\$>}}}"
%format <$ = "\mathbin{\text{\small\ttfamily{<\$}}}"
%format iI = "\llfloor"
%format Ii = "\rrfloor"
%format <.> = "\mathbin{\text{\small\ttfamily{<.>}}}"
%format --> = "\mathbin{\lhook\joinrel\relbar\joinrel\rightarrow}"
%format ~~> = "\mathbin{\relbar\joinrel\leadsto}"
%format ==> = "\mathbin{\Longrightarrow}"
%format >#< = "\mathbin{\text{\small\ttfamily{>\#<}}}"
%format <#> = "\mathbin{\text{\small\ttfamily{<\#>}}}"
%format #> = "\mathbin{\text{\small\ttfamily{ \#>}}}"
%format -#> = "\mathbin{\text{\small\ttfamily{-\#>}}}"
%format <-> = "\mathbin{\text{\small\ttfamily{<->}}}"
%format ^= = "\mathbin{\mathbf{\in}}"
%format ^| = "\mathbin{\text{\ttfamily{\^{}|}}}"
%format >|< = "\mathbin{\text{\ttfamily{>|<}}}"
%format <++> = "\mathbin{\text{\small\ttfamily{<++>}}}"
%format +>> = "\mathbin{\text{\small\ttfamily{+>>}}}"
%format forall = "\forall"
%format exists = "\exists"
%format ^ = " "
%format ^^ = "\;"
%format DATA = "\mathbf{DATA}"
%format ATTR = "\mathbf{ATTR}"
%format INH = "\mathbf{INH}"
%format SYN = "\mathbf{SYN}"
%format SEM = "\mathbf{SEM}"
%format USE = "\mathbf{USE}"
%format EXTENDS = "\mathbf{EXTENDS}"
%format lhs = "\mathbf{lhs}"
%format lhs_ = "lhs"
%format . = "."
%format ~ = "\mathbin{\;\sim\!}"
%format .*. = "\mathbin{.\!\!*\!\!.}"
%format .=. = "\mathbin{.\!\!=\!\!.}"
%format .+. = "\mathbf{\;\oplus\;}"
%format .*.. = "\mathbin{.\!\!*\!\!..}"
%format .=.. = "\mathbin{.\!\!=\!\!..}"
%format bl_ = "\{"
%format el_ = "\}"
%format br_ = "\{\!\{"
%format er_ = "\}\!\}"
%format bra_ = "\{\!\{\!\{"
%format era_ = "\}\!\}\!\}"
%format \$ = "\;\$\;"
%% Template Haskell quotation
%format TH(a) = $ ( a )
%format (THQ (a)) = "`" a
%format (THQQ (a)) = "``" a
%format exp1 = term
%format exp2 = factor
%format ntExp1 = ntTerm
%format ntExp2 = ntFactor
\setlength{\mathindent}{0.2cm}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Ralf Hinze (original version)
Daniel James (improvements to the documentation)
Andres Loeh (poly mode, maintainer)
Stefan Wehr (adjust patch)
Brian Smith (Cabal/Windows patch)
Acknowledgements:
Neil Mitchell (bug reports)
Jeremy Gibbons (bug reports)
Justin Bailey (line numbering improvements)
If you are not listed here, but feel
that you should be, please let me know.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.