syntactic 1.2.1 → 1.3
raw patch · 12 files changed
+134/−103 lines, 12 files
Files
- examples/NanoFeldspar/Core.hs +9/−8
- examples/NanoFeldspar/Extra.hs +3/−3
- examples/NanoFeldspar/Vector.hs +2/−1
- src/Language/Syntactic/Constructs/Binding/HigherOrder.hs +6/−4
- src/Language/Syntactic/Frontend/Monad.hs +4/−2
- src/Language/Syntactic/Frontend/Tuple.hs +39/−33
- src/Language/Syntactic/Frontend/TupleConstrained.hs +39/−33
- src/Language/Syntactic/Sharing/ReifyHO.hs +1/−1
- src/Language/Syntactic/Sharing/SimpleCodeMotion.hs +2/−1
- src/Language/Syntactic/Sugar.hs +17/−14
- src/Language/Syntactic/Syntax.hs +11/−2
- syntactic.cabal +1/−1
examples/NanoFeldspar/Core.hs view
@@ -135,15 +135,16 @@ newtype Data a = Data { unData :: ASTF FeldDomainAll a } -- | Declaring 'Data' as syntactic sugar-instance Type a => Syntactic (Data a) FeldDomainAll+instance Type a => Syntactic (Data a) where+ type Domain (Data a) = FeldDomainAll type Internal (Data a) = a desugar = unData sugar = Data -- | Specialization of the 'Syntactic' class for the Feldspar domain-class (Syntactic a FeldDomainAll, Type (Internal a)) => Syntax a-instance (Syntactic a FeldDomainAll, Type (Internal a)) => Syntax a+class (Syntactic a, Domain a ~ FeldDomainAll, Type (Internal a)) => Syntax a+instance (Syntactic a, Domain a ~ FeldDomainAll, Type (Internal a)) => Syntax a -- | A predicate deciding which constructs can be shared. Variables, lambdas and literals are not -- shared.@@ -163,23 +164,23 @@ -------------------------------------------------------------------------------- -- | Show the expression-showExpr :: Syntactic a FeldDomainAll => a -> String+showExpr :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> String showExpr = render . reifySmart canShareDict -- | Print the expression-printExpr :: Syntactic a FeldDomainAll => a -> IO ()+printExpr :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> IO () printExpr = Syntactic.printExpr . reifySmart canShareDict -- | Draw the syntax tree using ASCII-showAST :: Syntactic a FeldDomainAll => a -> String+showAST :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> String showAST = Syntactic.showAST . reifySmart canShareDict -- | Draw the syntax tree on the terminal using ASCII-drawAST :: Syntactic a FeldDomainAll => a -> IO ()+drawAST :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> IO () drawAST = Syntactic.drawAST . reifySmart canShareDict -- | Evaluation-eval :: Syntactic a FeldDomainAll => a -> Internal a+eval :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> Internal a eval = evalBind . reifySmart canShareDict
examples/NanoFeldspar/Extra.hs view
@@ -36,7 +36,7 @@ canShare2 _ = True -- | Draw the syntax graph after common sub-expression elimination-drawCSE :: Syntactic a FeldDomainAll => a -> IO ()+drawCSE :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> IO () drawCSE a = do (g,_) <- reifyGraph canShare2 a drawASG@@ -46,7 +46,7 @@ $ g -- | Draw the syntax graph after observing sharing-drawObs :: Syntactic a FeldDomainAll => a -> IO ()+drawObs :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> IO () drawObs a = do (g,_) <- reifyGraph canShare2 a drawASG@@ -77,6 +77,6 @@ _ -> expr ) expr -drawPart :: Syntactic a FeldDomainAll => a -> IO ()+drawPart :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> IO () drawPart = Syntactic.drawAST . optimize constFold . reify
examples/NanoFeldspar/Vector.hs view
@@ -31,8 +31,9 @@ where Indexed :: Data Length -> (Data Index -> a) -> Vector a -instance Syntax a => Syntactic (Vector a) FeldDomainAll+instance Syntax a => Syntactic (Vector a) where+ type Domain (Vector a) = FeldDomainAll type Internal (Vector a) = [Internal a] desugar = desugar . freezeVector . map resugar sugar = map resugar . unfreezeVector . sugar
src/Language/Syntactic/Constructs/Binding/HigherOrder.hs view
@@ -55,14 +55,15 @@ lambda = injC . HOLambda instance- ( Syntactic a (HODomain dom p pVar)- , Syntactic b (HODomain dom p pVar)+ ( Syntactic a, Domain a ~ HODomain dom p pVar+ , Syntactic b, Domain b ~ HODomain dom p pVar , p (Internal a -> Internal b) , p (Internal a) , pVar (Internal a) ) =>- Syntactic (a -> b) (HODomain dom p pVar)+ Syntactic (a -> b) where+ type Domain (a -> b) = Domain a type Internal (a -> b) = Internal a -> Internal b desugar f = lambda (desugar . f . sugar) sugar = error "sugar not implemented for (a -> b)"@@ -91,6 +92,7 @@ -- variables) in the argument. This is guaranteed by the exported interface. -- | Reify an n-ary syntactic function-reify :: Syntactic a (HODomain dom p pVar) => a -> ASTF (FODomain dom p pVar) (Internal a)+reify :: (Syntactic a, Domain a ~ HODomain dom p pVar) =>+ a -> ASTF (FODomain dom p pVar) (Internal a) reify = reifyTop . desugar
src/Language/Syntactic/Frontend/Monad.hs view
@@ -65,15 +65,17 @@ -> Mon dom pVar m (ASTF (HODomain dom Typeable pVar) a) sugarMonad ma = Mon $ cont $ sugarSymC Bind ma -instance ( Syntactic a (HODomain dom Typeable pVar)+instance ( Syntactic a+ , Domain a ~ HODomain dom Typeable pVar , InjectC (MONAD m) dom (m (Internal a)) , Monad m , Typeable1 m , Typeable (Internal a) , pVar (Internal a) ) =>- Syntactic (Mon dom pVar m a) (HODomain dom Typeable pVar)+ Syntactic (Mon dom pVar m a) where+ type Domain (Mon dom pVar m a) = Domain a type Internal (Mon dom pVar m a) = m (Internal a) desugar = desugarMonad . fmap desugar sugar = fmap sugar . sugarMonad
src/Language/Syntactic/Frontend/Tuple.hs view
@@ -13,8 +13,8 @@ instance- ( Syntactic a dom- , Syntactic b dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom , InjectC Tuple dom ( Internal a , Internal b@@ -22,8 +22,9 @@ , InjectC Select dom (Internal a) , InjectC Select dom (Internal b) ) =>- Syntactic (a,b) dom+ Syntactic (a,b) where+ type Domain (a,b) = Domain a type Internal (a,b) = ( Internal a , Internal b@@ -36,9 +37,9 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom , InjectC Tuple dom ( Internal a , Internal b@@ -48,8 +49,9 @@ , InjectC Select dom (Internal b) , InjectC Select dom (Internal c) ) =>- Syntactic (a,b,c) dom+ Syntactic (a,b,c) where+ type Domain (a,b,c) = Domain a type Internal (a,b,c) = ( Internal a , Internal b@@ -64,10 +66,10 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom , InjectC Tuple dom ( Internal a , Internal b@@ -79,8 +81,9 @@ , InjectC Select dom (Internal c) , InjectC Select dom (Internal d) ) =>- Syntactic (a,b,c,d) dom+ Syntactic (a,b,c,d) where+ type Domain (a,b,c,d) = Domain a type Internal (a,b,c,d) = ( Internal a , Internal b@@ -97,11 +100,11 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom- , Syntactic e dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom+ , Syntactic e, Domain e ~ dom , InjectC Tuple dom ( Internal a , Internal b@@ -115,8 +118,9 @@ , InjectC Select dom (Internal d) , InjectC Select dom (Internal e) ) =>- Syntactic (a,b,c,d,e) dom+ Syntactic (a,b,c,d,e) where+ type Domain (a,b,c,d,e) = Domain a type Internal (a,b,c,d,e) = ( Internal a , Internal b@@ -135,12 +139,12 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom- , Syntactic e dom- , Syntactic f dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom+ , Syntactic e, Domain e ~ dom+ , Syntactic f, Domain f ~ dom , InjectC Tuple dom ( Internal a , Internal b@@ -156,8 +160,9 @@ , InjectC Select dom (Internal e) , InjectC Select dom (Internal f) ) =>- Syntactic (a,b,c,d,e,f) dom+ Syntactic (a,b,c,d,e,f) where+ type Domain (a,b,c,d,e,f) = Domain a type Internal (a,b,c,d,e,f) = ( Internal a , Internal b@@ -178,13 +183,13 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom- , Syntactic e dom- , Syntactic f dom- , Syntactic g dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom+ , Syntactic e, Domain e ~ dom+ , Syntactic f, Domain f ~ dom+ , Syntactic g, Domain g ~ dom , InjectC Tuple dom ( Internal a , Internal b@@ -202,8 +207,9 @@ , InjectC Select dom (Internal f) , InjectC Select dom (Internal g) ) =>- Syntactic (a,b,c,d,e,f,g) dom+ Syntactic (a,b,c,d,e,f,g) where+ type Domain (a,b,c,d,e,f,g) = Domain a type Internal (a,b,c,d,e,f,g) = ( Internal a , Internal b
src/Language/Syntactic/Frontend/TupleConstrained.hs view
@@ -46,8 +46,8 @@ instance- ( Syntactic a dom- , Syntactic b dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom , TupleSat dom p , p (Internal a, Internal b) , p (Internal a)@@ -59,8 +59,9 @@ , InjectC (Select :|| p) dom (Internal a) , InjectC (Select :|| p) dom (Internal b) ) =>- Syntactic (a,b) dom+ Syntactic (a,b) where+ type Domain (a,b) = Domain a type Internal (a,b) = ( Internal a , Internal b@@ -73,9 +74,9 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom , TupleSat dom p , p ( Internal a , Internal b@@ -93,8 +94,9 @@ , InjectC (Select :|| p) dom (Internal b) , InjectC (Select :|| p) dom (Internal c) ) =>- Syntactic (a,b,c) dom+ Syntactic (a,b,c) where+ type Domain (a,b,c) = Domain a type Internal (a,b,c) = ( Internal a , Internal b@@ -109,10 +111,10 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom , TupleSat dom p , p ( Internal a , Internal b@@ -134,8 +136,9 @@ , InjectC (Select :|| p) dom (Internal c) , InjectC (Select :|| p) dom (Internal d) ) =>- Syntactic (a,b,c,d) dom+ Syntactic (a,b,c,d) where+ type Domain (a,b,c,d) = Domain a type Internal (a,b,c,d) = ( Internal a , Internal b@@ -152,11 +155,11 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom- , Syntactic e dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom+ , Syntactic e, Domain e ~ dom , TupleSat dom p , p ( Internal a , Internal b@@ -182,8 +185,9 @@ , InjectC (Select :|| p) dom (Internal d) , InjectC (Select :|| p) dom (Internal e) ) =>- Syntactic (a,b,c,d,e) dom+ Syntactic (a,b,c,d,e) where+ type Domain (a,b,c,d,e) = Domain a type Internal (a,b,c,d,e) = ( Internal a , Internal b@@ -202,12 +206,12 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom- , Syntactic e dom- , Syntactic f dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom+ , Syntactic e, Domain e ~ dom+ , Syntactic f, Domain f ~ dom , TupleSat dom p , p ( Internal a , Internal b@@ -237,8 +241,9 @@ , InjectC (Select :|| p) dom (Internal e) , InjectC (Select :|| p) dom (Internal f) ) =>- Syntactic (a,b,c,d,e,f) dom+ Syntactic (a,b,c,d,e,f) where+ type Domain (a,b,c,d,e,f) = Domain a type Internal (a,b,c,d,e,f) = ( Internal a , Internal b@@ -259,13 +264,13 @@ ) instance- ( Syntactic a dom- , Syntactic b dom- , Syntactic c dom- , Syntactic d dom- , Syntactic e dom- , Syntactic f dom- , Syntactic g dom+ ( Syntactic a, Domain a ~ dom+ , Syntactic b, Domain b ~ dom+ , Syntactic c, Domain c ~ dom+ , Syntactic d, Domain d ~ dom+ , Syntactic e, Domain e ~ dom+ , Syntactic f, Domain f ~ dom+ , Syntactic g, Domain g ~ dom , TupleSat dom p , p ( Internal a , Internal b@@ -299,8 +304,9 @@ , InjectC (Select :|| p) dom (Internal f) , InjectC (Select :|| p) dom (Internal g) ) =>- Syntactic (a,b,c,d,e,f,g) dom+ Syntactic (a,b,c,d,e,f,g) where+ type Domain (a,b,c,d,e,f,g) = Domain a type Internal (a,b,c,d,e,f,g) = ( Internal a , Internal b
src/Language/Syntactic/Sharing/ReifyHO.hs view
@@ -100,7 +100,7 @@ -- This function is not referentially transparent (hence the 'IO'). However, it -- is well-behaved in the sense that the worst thing that could happen is that -- sharing is lost. It is not possible to get false sharing.-reifyGraph :: Syntactic a (HODomain dom p pVar)+reifyGraph :: (Syntactic a, Domain a ~ HODomain dom p pVar) => (forall a . ASTF (HODomain dom p pVar) a -> Bool) -- ^ A function that decides whether a given node can be shared -> a
src/Language/Syntactic/Sharing/SimpleCodeMotion.hs view
@@ -191,7 +191,8 @@ -- | Like 'reify' but with common sub-expression elimination and variable hoisting reifySmart :: forall dom p pVar a . ( AlphaEq dom dom (FODomain dom p pVar) [(VarId,VarId)]- , Syntactic a (HODomain dom p pVar)+ , Syntactic a+ , Domain a ~ HODomain dom p pVar , p :< Typeable ) => MkInjDict (FODomain dom p pVar)
src/Language/Syntactic/Sugar.hs view
@@ -14,24 +14,22 @@ -- | It is usually assumed that @(`desugar` (`sugar` a))@ has the same meaning -- as @a@.-class Syntactic a dom | a -> dom- -- Note: using a functional dependency rather than an associated type,- -- because this makes it possible to make a class alias constraining dom.- -- TODO Now that GHC allows equality super class constraints, this should be- -- changed to an associated type.+class Syntactic a where+ type Domain a :: * -> * type Internal a- desugar :: a -> ASTF dom (Internal a)- sugar :: ASTF dom (Internal a) -> a+ desugar :: a -> ASTF (Domain a) (Internal a)+ sugar :: ASTF (Domain a) (Internal a) -> a -instance Syntactic (ASTF dom a) dom+instance Syntactic (ASTF dom a) where+ type Domain (ASTF dom a) = dom type Internal (ASTF dom a) = a desugar = id sugar = id -- | Syntactic type casting-resugar :: (Syntactic a dom, Syntactic b dom, Internal a ~ Internal b) => a -> b+resugar :: (Syntactic a, Syntactic b, Domain a ~ Domain b, Internal a ~ Internal b) => a -> b resugar = sugar . desugar -- | N-ary syntactic functions@@ -39,10 +37,14 @@ -- 'desugarN' has any type of the form: -- -- > desugarN ::--- > ( Syntactic a dom--- > , Syntactic b dom+-- > ( Syntactic a+-- > , Syntactic b -- > , ...--- > , Syntactic x dom+-- > , Syntactic x+-- > , Domain a ~ dom+-- > , Domain b ~ dom+-- > , ...+-- > , Domain x ~ dom -- > ) => (a -> b -> ... -> x) -- > -> ( ASTF dom (Internal a) -- > -> ASTF dom (Internal b)@@ -56,13 +58,14 @@ desugarN :: a -> internal sugarN :: internal -> a -instance (Syntactic a dom, ia ~ AST dom (Full (Internal a))) => SyntacticN a ia+instance (Syntactic a, Domain a ~ dom, ia ~ AST dom (Full (Internal a))) => SyntacticN a ia where desugarN = desugar sugarN = sugar instance- ( Syntactic a dom+ ( Syntactic a+ , Domain a ~ dom , ia ~ Internal a , SyntacticN b ib ) =>
src/Language/Syntactic/Syntax.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -cpp #-}+ -- | Generic representation of typed syntax trees -- -- For details, see: A Generic Abstract Syntax Model for Embedded Languages@@ -27,6 +29,7 @@ +import Control.Monad.Instances -- Not needed in GHC 7.6 import Data.Typeable import Data.PolyProxy@@ -52,13 +55,18 @@ -- | Fully applied abstract syntax tree type ASTF dom a = AST dom (Full a) +instance Functor dom => Functor (AST dom)+ where+ fmap f (Sym s) = Sym (fmap f s)+ fmap f (s :$ a) = fmap (fmap f) s :$ a+ -- | Signature of a fully applied symbol newtype Full a = Full { result :: a }- deriving (Eq, Show, Typeable)+ deriving (Eq, Show, Typeable, Functor) -- | Signature of a partially applied (or unapplied) symbol newtype a :-> sig = Partial (a -> sig)- deriving (Typeable)+ deriving (Typeable, Functor) infixr :-> @@ -96,6 +104,7 @@ where InjL :: dom1 a -> (dom1 :+: dom2) a InjR :: dom2 a -> (dom1 :+: dom2) a+ deriving (Functor) infixr :+:
syntactic.cabal view
@@ -1,5 +1,5 @@ Name: syntactic-Version: 1.2.1+Version: 1.3 Synopsis: Generic abstract syntax, and utilities for embedded languages Description: This library provides: .