syntactic 1.15.1 → 1.16

raw patch · 29 files changed

+2581/−973 lines, 29 files

Files

• examples/NanoFeldspar/Core.hs +10/−4
• examples/NanoFeldspar/Extra.hs +4/−1
• examples/NanoFeldspar/Vector.hs +3/−1
• src/Language/Syntactic.hs +2/−1
• src/Language/Syntactic/Constraint.hs +116/−18
• src/Language/Syntactic/Constructs/Binding.hs +146/−27
• src/Language/Syntactic/Constructs/Binding/HigherOrder.hs +11/−1
• src/Language/Syntactic/Constructs/Binding/Optimize.hs +27/−7
• src/Language/Syntactic/Constructs/Condition.hs +5/−2
• src/Language/Syntactic/Constructs/Construct.hs +5/−2
• src/Language/Syntactic/Constructs/Decoration.hs +29/−7
• src/Language/Syntactic/Constructs/Identity.hs +5/−2
• src/Language/Syntactic/Constructs/Literal.hs +11/−2
• src/Language/Syntactic/Constructs/Monad.hs +22/−7
• src/Language/Syntactic/Constructs/Tuple.hs +10/−3
• src/Language/Syntactic/Frontend/Monad.hs +14/−1
• src/Language/Syntactic/Frontend/Tuple.hs +1208/−779
• src/Language/Syntactic/Frontend/TupleConstrained.hs +706/−8
• src/Language/Syntactic/Interpretation.hs +27/−0
• src/Language/Syntactic/Interpretation/Equality.hs +39/−1
• src/Language/Syntactic/Interpretation/Evaluation.hs +23/−6
• src/Language/Syntactic/Interpretation/Render.hs +52/−3
• src/Language/Syntactic/Interpretation/Semantics.hs +4/−73
• src/Language/Syntactic/Sharing/CodeMotion2.hs +10/−0
• src/Language/Syntactic/Sharing/Graph.hs +15/−2
• src/Language/Syntactic/Sugar.hs +18/−1
• src/Language/Syntactic/Syntax.hs +28/−5
• src/Language/Syntactic/Traversal.hs +15/−8
• syntactic.cabal +16/−1

@@ -44,7 +44,8 @@  -- | Convenient class alias class    (Ord a, Show a, Typeable a) => Type a-instance (Ord a, Show a, Typeable a) => Type a+instance (Ord a, Show a, Typeable a) => Type a where+  {-# SPECIALIZE instance (Ord a, Show a, Typeable a) => Type a #-}  type Length = Int type Index  = Int@@ -61,11 +62,15 @@  instance Constrained Parallel   where+    {-# SPECIALIZE instance Constrained Parallel #-}+    {-# INLINABLE exprDict #-}     type Sat Parallel = Type     exprDict Parallel = Dict  instance Semantic Parallel   where+    {-# SPECIALIZE instance Semantic Parallel #-}+    {-# INLINABLE semantics #-}     semantics Parallel = Sem         { semanticName = "parallel"         , semanticEval = \len ixf -> map ixf [0 .. len-1]@@ -73,11 +78,13 @@  semanticInstances ''Parallel -instance EvalBind Parallel where evalBindSym = evalBindSymDefault+instance EvalBind Parallel where+  {-# SPECIALIZE instance EvalBind Parallel #-}  instance AlphaEq dom dom dom env => AlphaEq Parallel Parallel dom env   where-    alphaEqSym = alphaEqSymDefault+    {-# SPECIALIZE instance AlphaEq dom dom dom env =>+          AlphaEq Parallel Parallel dom env #-}   @@ -274,4 +281,3 @@  min :: Type a => Data a -> Data a -> Data a min = sugarSymC $ Construct "min" Prelude.min-

@@ -64,10 +64,14 @@  instance Optimize ForLoop   where+    {-# SPECIALIZE instance Optimize ForLoop #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym = optimizeSymDefault  instance Optimize Parallel   where+    {-# SPECIALIZE instance Optimize Parallel #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym = optimizeSymDefault  constFold :: forall a@@ -90,4 +94,3 @@  drawSimp :: (Syntactic a, Domain a ~ FeldDomainAll) => a -> IO () drawSimp = Syntactic.drawAST . reifySimp-

@@ -33,6 +33,9 @@  instance Syntax a => Syntactic (Vector a)   where+    {-# SPECIALIZE instance Syntax a => Syntactic (Vector a) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (Vector a)   = FeldDomainAll     type Internal (Vector a) = [Internal a]     desugar = desugar . freezeVector . map resugar@@ -96,4 +99,3 @@ -- | Transpose of a matrix. Assumes that the number of rows is > 0. transpose :: Type a => Matrix a -> Matrix a transpose a = indexed (length (a!0)) $ \k -> indexed (length a) $ \l -> a ! l ! k-

@@ -6,6 +6,7 @@     , module Language.Syntactic.Traversal     , module Language.Syntactic.Constraint     , module Language.Syntactic.Sugar+    , module Language.Syntactic.Interpretation     , module Language.Syntactic.Interpretation.Equality     , module Language.Syntactic.Interpretation.Render     , module Language.Syntactic.Interpretation.Evaluation@@ -20,10 +21,10 @@ import Language.Syntactic.Traversal import Language.Syntactic.Constraint import Language.Syntactic.Sugar+import Language.Syntactic.Interpretation import Language.Syntactic.Interpretation.Equality import Language.Syntactic.Interpretation.Render import Language.Syntactic.Interpretation.Evaluation import Language.Syntactic.Interpretation.Semantics  import Data.Constraint (Constraint, Dict (..))-

@@ -27,19 +27,23 @@  -- | Intersection of type predicates class    (c1 a, c2 a) => (c1 :/\: c2) a-instance (c1 a, c2 a) => (c1 :/\: c2) a+instance (c1 a, c2 a) => (c1 :/\: c2) a where+  {-# SPECIALIZE instance (c1 a, c2 a) => (c1 :/\: c2) a #-}  infixr 5 :/\:  -- | Universal type predicate class    Top a-instance Top a+instance Top a where+  {-# SPECIALIZE instance Top a #-}  pTop :: P Top pTop = P+{-# INLINABLE pTop #-}  pTypeable :: P Typeable pTypeable = P+{-# INLINABLE pTypeable #-}  -- | Evidence that the predicate @sub@ is a subset of @sup@ type Sub sub sup = forall a . Dict (sub a) -> Dict (sup a)@@ -47,10 +51,12 @@ -- | Weaken an intersection weakL :: Sub (c1 :/\: c2) c1 weakL Dict = Dict+{-# INLINABLE weakL #-}  -- | Weaken an intersection weakR :: Sub (c1 :/\: c2) c2 weakR Dict = Dict+{-# INLINABLE weakR #-}  -- | Subset relation on type predicates class (sub :: * -> Constraint) :< (sup :: * -> Constraint)@@ -61,14 +67,20 @@  instance p :< p   where+    {-# SPECIALIZE instance p :< p #-}+    {-# INLINABLE sub #-}     sub = id  instance (p :/\: ps) :< p   where+    {-# SPECIALIZE instance (p :/\: ps) :< p #-}+    {-# INLINABLE sub #-}     sub = weakL  instance (ps :< q) => ((p :/\: ps) :< q)   where+    {-# SPECIALIZE instance (ps :< q) => ((p :/\: ps) :< q) #-}+    {-# INLINABLE sub #-}     sub = sub . weakR  @@ -86,24 +98,36 @@  instance Project sub sup => Project sub (sup :| pred)   where+    {-# SPECIALIZE instance (Project sub sup) => Project sub (sup :| pred) #-}+    {-# INLINABLE prj #-}     prj (C s) = prj s  instance Equality dom => Equality (dom :| pred)   where+    {-# SPECIALIZE instance (Equality dom) => Equality (dom :| pred) #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (C a) (C b) = equal a b     exprHash (C a)    = exprHash a  instance Render dom => Render (dom :| pred)   where+    {-# SPECIALIZE instance (Render dom) => Render (dom :| pred) #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym (C a) = renderSym a     renderArgs args (C a) = renderArgs args a  instance Eval dom => Eval (dom :| pred)   where+    {-# SPECIALIZE instance (Eval dom) => Eval (dom :| pred) #-}+    {-# INLINABLE evaluate #-}     evaluate (C a) = evaluate a  instance StringTree dom => StringTree (dom :| pred)   where+    {-# SPECIALIZE instance (StringTree dom) => StringTree (dom :| pred) #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym args (C a) = stringTreeSym args a  @@ -123,24 +147,36 @@  instance Project sub sup => Project sub (sup :|| pred)   where+    {-# SPECIALIZE instance (Project sub sup) => Project sub (sup :|| pred) #-}+    {-# INLINABLE prj #-}     prj (C' s) = prj s  instance Equality dom => Equality (dom :|| pred)   where+    {-# SPECIALIZE instance (Equality dom) => Equality (dom :|| pred) #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (C' a) (C' b) = equal a b     exprHash (C' a)     = exprHash a  instance Render dom => Render (dom :|| pred)   where+    {-# SPECIALIZE instance (Render dom) => Render (dom :|| pred) #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym (C' a) = renderSym a     renderArgs args (C' a) = renderArgs args a  instance Eval dom => Eval (dom :|| pred)   where+    {-# SPECIALIZE instance (Eval dom) => Eval (dom :|| pred) #-}+    {-# INLINABLE evaluate #-}     evaluate (C' a) = evaluate a  instance StringTree dom => StringTree (dom :|| pred)   where+    {-# SPECIALIZE instance (StringTree dom) => StringTree (dom :|| pred) #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym args (C' a) = stringTreeSym args a  @@ -157,33 +193,42 @@  instance Constrained dom => Constrained (AST dom)   where+    {-# SPECIALIZE instance (Constrained dom) => Constrained (AST dom) #-}+    {-# INLINABLE exprDict #-}     type Sat (AST dom) = Sat dom     exprDict (Sym s)  = exprDict s     exprDict (s :$ _) = exprDict s  instance Constrained (sub1 :+: sub2)   where+    {-# SPECIALIZE instance (Constrained (sub1 :+: sub2)) #-}+    {-# INLINABLE exprDict #-}     -- | An over-approximation of the union of @Sat sub1@ and @Sat sub2@     type Sat (sub1 :+: sub2) = Top-    exprDict (InjL s) = Dict-    exprDict (InjR s) = Dict+    exprDict (InjL _) = Dict+    exprDict (InjR _) = Dict  instance Constrained dom => Constrained (dom :| pred)   where+    {-# SPECIALIZE instance (Constrained dom) => Constrained (dom :| pred) #-}+    {-# INLINABLE exprDict #-}     type Sat (dom :| pred) = pred :/\: Sat dom     exprDict (C s) = case exprDict s of Dict -> Dict  instance Constrained (dom :|| pred)   where+    {-# SPECIALIZE instance Constrained (dom :|| pred) #-}+    {-# INLINABLE exprDict #-}     type Sat (dom :|| pred) = pred-    exprDict (C' s) = Dict+    exprDict (C' _) = Dict  type ConstrainedBy expr p = (Constrained expr, Sat expr :< p)  -- | A version of 'exprDict' that returns a constraint for a particular -- predicate @p@ as long as @(p :< Sat dom)@ holds exprDictSub :: ConstrainedBy expr p => P p -> expr a -> Dict (p (DenResult a))-exprDictSub _ = sub . exprDict+exprDictSub = const $ sub . exprDict+{-# INLINABLE exprDictSub #-}  -- | A version of 'exprDict' that works for domains of the form -- @(dom1 :+: dom2)@ as long as @(Sat dom1 ~ Sat dom2)@ holds@@ -192,6 +237,7 @@ exprDictPlus (s :$ _)       = exprDictPlus s exprDictPlus (Sym (InjL a)) = exprDict a exprDictPlus (Sym (InjR a)) = exprDict a+{-# INLINABLE exprDictPlus #-}   @@ -200,28 +246,40 @@   where     injC :: (DenResult sig ~ a) => sub sig -> sup sig -instance InjectC sub sup a => InjectC sub (AST sup) a+instance (InjectC sub sup a, Sat (AST sup) a) => InjectC sub (AST sup) a   where+    {-# SPECIALIZE instance (InjectC sub sup a, Sat (AST sup) a) => InjectC sub (AST sup) a #-}+    {-# INLINABLE injC #-}     injC = Sym . injC -instance (InjectC sub sup a, pred a) => InjectC sub (sup :| pred) a+instance (InjectC sub sup a, Sat (sup :| pred) a) => InjectC sub (sup :| pred) a   where+    {-# SPECIALIZE instance (InjectC sub sup a, Sat (sup :| pred) a) => InjectC sub (sup :| pred) a #-}+    {-# INLINABLE injC #-}     injC = C . injC -instance (InjectC sub sup a, pred a) => InjectC sub (sup :|| pred) a+instance (InjectC sub sup a, Sat (sup :|| pred) a) => InjectC sub (sup :|| pred) a   where+    {-# SPECIALIZE instance (InjectC sub sup a, Sat (sup :|| pred) a) => InjectC sub (sup :|| pred) a #-}+    {-# INLINABLE injC #-}     injC = C' . injC  instance Sat expr a => InjectC expr expr a   where+    {-# SPECIALIZE instance Sat expr a => InjectC expr expr a #-}+    {-# INLINABLE injC #-}     injC = id  instance InjectC expr1 (expr1 :+: expr2) a   where+    {-# SPECIALIZE instance InjectC expr1 (expr1 :+: expr2) a #-}+    {-# INLINABLE injC #-}     injC = InjL  instance InjectC expr1 expr3 a => InjectC expr1 (expr2 :+: expr3) a   where+    {-# SPECIALIZE instance InjectC expr1 expr3 a => InjectC expr1 (expr2 :+: expr3) a #-}+    {-# INLINABLE injC #-}     injC = InjR . injC  @@ -235,6 +293,7 @@ -- >     -> (ASTF dom a -> ASTF dom b -> ... -> ASTF dom x) appSymC :: (ApplySym sig f dom, InjectC sym (AST dom) (DenResult sig)) => sym sig -> f appSymC = appSym' . injC+{-# INLINABLE appSymC #-}   @@ -246,29 +305,43 @@  instance Constrained dom => Constrained (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance Constrained dom => Constrained (SubConstr1 c dom p) #-}+    {-# INLINABLE exprDict #-}     type Sat (SubConstr1 c dom p) = Sat dom     exprDict (SubConstr1 s) = exprDict s  instance Project sub sup => Project sub (SubConstr1 c sup p)   where+    {-# SPECIALIZE instance Project sub sup => Project sub (SubConstr1 c sup p) #-}+    {-# INLINABLE prj #-}     prj (SubConstr1 s) = prj s  instance Equality dom => Equality (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance Equality dom => Equality (SubConstr1 c dom p) #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (SubConstr1 a) (SubConstr1 b) = equal a b     exprHash (SubConstr1 s) = exprHash s  instance Render dom => Render (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance Render dom => Render (SubConstr1 c dom p) #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym (SubConstr1 s) = renderSym s     renderArgs args (SubConstr1 s) = renderArgs args s  instance StringTree dom => StringTree (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance StringTree dom => StringTree (SubConstr1 c dom p) #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym args (SubConstr1 a) = stringTreeSym args a  instance Eval dom => Eval (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance Eval dom => Eval (SubConstr1 c dom p) #-}+    {-# INLINABLE evaluate #-}     evaluate (SubConstr1 a) = evaluate a  @@ -281,29 +354,43 @@  instance Constrained dom => Constrained (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance Constrained dom => Constrained (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE exprDict #-}     type Sat (SubConstr2 c dom pa pb) = Sat dom     exprDict (SubConstr2 s) = exprDict s  instance Project sub sup => Project sub (SubConstr2 c sup pa pb)   where+    {-# SPECIALIZE instance Project sub sup => Project sub (SubConstr2 c sup pa pb) #-}+    {-# INLINABLE prj #-}     prj (SubConstr2 s) = prj s  instance Equality dom => Equality (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance Equality dom => Equality (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (SubConstr2 a) (SubConstr2 b) = equal a b     exprHash (SubConstr2 s) = exprHash s  instance Render dom => Render (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance Render dom => Render (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym (SubConstr2 s) = renderSym s     renderArgs args (SubConstr2 s) = renderArgs args s  instance StringTree dom => StringTree (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance StringTree dom => StringTree (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym args (SubConstr2 a) = stringTreeSym args a  instance Eval dom => Eval (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance Eval dom => Eval (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE evaluate #-}     evaluate (SubConstr2 a) = evaluate a  @@ -322,11 +409,13 @@     -> ASTE dom     -> b liftASTE f (ASTE a) = f a+{-# INLINABLE liftASTE #-}  liftASTE2     :: (forall a b . ASTF dom a -> ASTF dom b -> c)     -> ASTE dom -> ASTE dom -> c liftASTE2 f (ASTE a) (ASTE b) = f a b+{-# INLINABLE liftASTE2 #-}   @@ -340,11 +429,13 @@     -> ASTB dom p     -> b liftASTB f (ASTB a) = f a+{-# INLINABLE liftASTB #-}  liftASTB2     :: (forall a b . (p a, p b) => ASTF dom a -> ASTF dom b -> c)     -> ASTB dom p -> ASTB dom p -> c liftASTB2 f (ASTB a) (ASTB b) = f a b+{-# INLINABLE liftASTB2 #-}  type ASTSAT dom = ASTB dom (Sat dom) @@ -375,15 +466,23 @@  instance Constrained Empty   where+    {-# SPECIALIZE instance Constrained Empty #-}     type Sat Empty = Top     exprDict = error "Not implemented: exprDict for Empty" -instance Equality   Empty where equal      = error "Not implemented: equal for Empty"-                                exprHash   = error "Not implemented: exprHash for Empty"-instance Eval       Empty where evaluate   = error "Not implemented: equal for Empty"-instance Render     Empty where renderSym  = error "Not implemented: renderSym for Empty"-                                renderArgs = error "Not implemented: renderArgs for Empty"-instance StringTree Empty+instance Equality Empty where+  {-# SPECIALIZE instance Equality Empty #-}+  equal      = error "Not implemented: equal for Empty"+  exprHash   = error "Not implemented: exprHash for Empty"+instance Eval Empty where+  {-# SPECIALIZE instance Eval Empty #-}+  evaluate   = error "Not implemented: equal for Empty"+instance Render Empty where+  {-# SPECIALIZE instance Render Empty #-}+  renderSym  = error "Not implemented: renderSym for Empty"+  renderArgs = error "Not implemented: renderArgs for Empty"+instance StringTree Empty where+  {-# SPECIALIZE instance StringTree Empty #-}   @@ -391,6 +490,5 @@ universe a = ASTE a : go a   where     go :: AST dom a -> [ASTE dom]-    go (Sym s)  = []-    go (s :$ a) = go s ++ universe a-+    go (Sym _)  = []+    go (s :$ b) = go s ++ universe b

@@ -1,3 +1,4 @@+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE UndecidableInstances #-}  -- | General binding constructs@@ -51,8 +52,10 @@  instance Constrained Variable   where+    {-# SPECIALIZE instance Constrained Variable #-}+    {-# INLINABLE exprDict #-}     type Sat Variable = Top-    exprDict _ = Dict+    exprDict = const Dict  -- | 'equal' does strict identifier comparison; i.e. no alpha equivalence. --@@ -62,15 +65,22 @@ -- @`alphaEq` a b  ==>  `exprHash` a == `exprHash` b@ instance Equality Variable   where+    {-# SPECIALIZE instance Equality Variable #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (Variable v1) (Variable v2) = v1==v2     exprHash (Variable _)             = hashInt 0  instance Render Variable   where+    {-# SPECIALIZE instance Render Variable #-}+    {-# INLINABLE renderSym #-}     renderSym (Variable v) = showVar v  instance StringTree Variable   where+    {-# SPECIALIZE instance StringTree Variable #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym [] (Variable v) = Node ("var:" ++ show v) []  @@ -86,8 +96,10 @@  instance Constrained Lambda   where+    {-# SPECIALIZE instance Constrained Lambda #-}+    {-# INLINABLE exprDict #-}     type Sat Lambda = Top-    exprDict _ = Dict+    exprDict = const Dict  -- | 'equal' does strict identifier comparison; i.e. no alpha equivalence. --@@ -97,21 +109,30 @@ -- @`alphaEq` a b  ==>  `exprHash` a == `exprHash` b@ instance Equality Lambda   where+    {-# SPECIALIZE instance Equality Lambda #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (Lambda v1) (Lambda v2) = v1==v2     exprHash (Lambda _)           = hashInt 0  instance Render Lambda   where+    {-# SPECIALIZE instance Render Lambda #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym (Lambda v) = "Lambda " ++ show v     renderArgs [body] (Lambda v) = "(\\" ++ showVar v ++ " -> "  ++ body ++ ")"  instance StringTree Lambda   where+    {-# SPECIALIZE instance StringTree Lambda #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym [body] (Lambda v) = Node ("Lambda " ++ show v) [body]  -- | Allow an existing binding to be used with a body of a different type reuseLambda :: Lambda (b :-> Full (a -> b)) -> Lambda (c :-> Full (a -> c)) reuseLambda (Lambda v) = Lambda v+{-# INLINABLE reuseLambda #-}   @@ -129,31 +150,42 @@  instance Constrained Let   where+    {-# SPECIALIZE instance Constrained Let #-}+    {-# INLINABLE exprDict #-}     type Sat Let = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Equality Let   where+    {-# SPECIALIZE instance Equality Let #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal Let Let = True     exprHash Let  = hashInt 0  instance Render Let   where+    {-# SPECIALIZE instance Render Let #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym Let = "Let"     renderArgs []    Let = "Let"     renderArgs [f,a] Let = "(" ++ unwords ["letBind",f,a] ++ ")"  instance StringTree Let   where+    {-# SPECIALIZE instance StringTree Let #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym [a,body] Let = case splitAt 7 node of         ("Lambda ", var) -> Node ("Let " ++ var) [a,body']         _                -> Node "Let" [a,body]       where         Node node ~[body'] = body-        var                = drop 7 node  -- Drop the "Lambda " prefix  instance Eval Let   where+    {-# SPECIALIZE instance Eval Let #-}+    {-# INLINABLE evaluate #-}     evaluate Let = flip ($)  @@ -166,7 +198,7 @@ -- -- Note: Variables with a different type than the new expression will be -- silently ignored.-subst :: forall constr dom a b+subst :: forall dom a b     .  ( ConstrainedBy dom Typeable        , Project Lambda dom        , Project Variable dom@@ -175,7 +207,7 @@     -> ASTF dom a  -- ^ Expression to substitute for     -> ASTF dom b  -- ^ Expression to substitute in     -> ASTF dom b-subst v new a = go a+subst v new = go   where     go :: AST dom c -> AST dom c     go a@((prj -> Just (Lambda w)) :$ _)@@ -205,6 +237,7 @@     -> ASTF dom b betaReduce new (lam :$ body)     | Just (Lambda v) <- prj lam = subst v new body+{-# INLINABLE betaReduce #-}   @@ -216,12 +249,21 @@         => sub sig         -> Args (AST dom) sig         -> Reader [(VarId,Dynamic)] (DenResult sig)+    default evalBindSym+        :: (Eval sub, EvalBind dom, ConstrainedBy dom Typeable, Typeable (DenResult sig))+        => sub sig+        -> Args (AST dom) sig+        -> Reader [(VarId,Dynamic)] (DenResult sig)+    evalBindSym = evalBindSymDefault+    {-# INLINABLE evalBindSym #-}   -- `(Typeable (DenResult sig))` is required because this dictionary cannot (in   -- general) be obtained from `sub`. It can only be obtained from `dom`, and   -- this is what `evalBindM` does.  instance (EvalBind sub1, EvalBind sub2) => EvalBind (sub1 :+: sub2)   where+    {-# SPECIALIZE instance (EvalBind sub1, EvalBind sub2) => EvalBind (sub1 :+: sub2) #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym (InjL a) = evalBindSym a     evalBindSym (InjR a) = evalBindSym a @@ -231,15 +273,18 @@ evalBindM a     | Dict <- exprDictSub pTypeable a     = liftM result $ match (\s -> liftM Full . evalBindSym s) a+{-# INLINABLE evalBindM #-}  -- | Evaluation of closed expressions evalBind :: (EvalBind dom, ConstrainedBy dom Typeable) => ASTF dom a -> a evalBind = flip runReader [] . evalBindM+{-# INLINABLE evalBind #-}  -- | Apply a symbol denotation to a list of arguments appDen :: Denotation sig -> Args Monad.Identity sig -> DenResult sig appDen a Nil       = a appDen f (a :* as) = appDen (f $ result $ Monad.runIdentity a) as+{-# INLINABLE appDen #-}  -- | Convenient default implementation of 'evalBindSym' evalBindSymDefault@@ -250,53 +295,70 @@ evalBindSymDefault sym args = do     args' <- mapArgsM (liftM (Monad.Identity . Full) . evalBindM) args     return $ appDen (evaluate sym) args'+{-# INLINABLE evalBindSymDefault #-}  instance EvalBind dom => EvalBind (dom :| pred)   where+    {-# SPECIALIZE instance (EvalBind dom) => EvalBind (dom :| pred) #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym (C a) = evalBindSym a  instance EvalBind dom => EvalBind (dom :|| pred)   where+    {-# SPECIALIZE instance (EvalBind dom) => EvalBind (dom :|| pred) #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym (C' a) = evalBindSym a  instance EvalBind dom => EvalBind (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance (EvalBind dom) => EvalBind (SubConstr1 c dom p) #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym (SubConstr1 a) = evalBindSym a  instance EvalBind dom => EvalBind (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance (EvalBind dom) => EvalBind (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym (SubConstr2 a) = evalBindSym a  instance EvalBind Empty   where+    {-# SPECIALIZE instance EvalBind Empty #-}     evalBindSym = error "Not implemented: evalBindSym for Empty"  instance EvalBind dom => EvalBind (Decor info dom)   where+    {-# SPECIALIZE instance (EvalBind dom) => EvalBind (Decor info dom) #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym = evalBindSym . decorExpr -instance EvalBind Identity  where evalBindSym = evalBindSymDefault-instance EvalBind Construct where evalBindSym = evalBindSymDefault-instance EvalBind Literal   where evalBindSym = evalBindSymDefault-instance EvalBind Condition where evalBindSym = evalBindSymDefault-instance EvalBind Tuple     where evalBindSym = evalBindSymDefault-instance EvalBind Select    where evalBindSym = evalBindSymDefault-instance EvalBind Let       where evalBindSym = evalBindSymDefault+instance EvalBind Identity where {-# SPECIALIZE instance EvalBind Identity #-}+instance EvalBind Construct where {-# SPECIALIZE instance EvalBind Construct #-}+instance EvalBind Literal where {-# SPECIALIZE instance EvalBind Literal #-}+instance EvalBind Condition where {-# SPECIALIZE instance EvalBind Condition #-}+instance EvalBind Tuple where {-# SPECIALIZE instance EvalBind Tuple #-}+instance EvalBind Select where {-# SPECIALIZE instance EvalBind Select #-}+instance EvalBind Let where {-# SPECIALIZE instance EvalBind Let #-} -instance Monad m => EvalBind (MONAD m) where evalBindSym = evalBindSymDefault+instance Monad m => EvalBind (MONAD m) where+  {-# SPECIALIZE instance Monad m => EvalBind (MONAD m) #-}  instance EvalBind Variable   where-    evalBindSym (Variable v) Nil = do+    {-# SPECIALIZE instance EvalBind Variable #-}+    {-# INLINABLE evalBindSym #-}+    evalBindSym (Variable v) _ = do         env <- ask         case lookup v env of             Nothing -> return $ error "evalBind: evaluating free variable"             Just a  -> case fromDyn a of-              Just a -> return a+              Just b -> return b               _      -> return $ error "evalBind: internal type error"  instance EvalBind Lambda   where+    {-# SPECIALIZE instance EvalBind Lambda #-}+    {-# INLINABLE evalBindSym #-}     evalBindSym lam@(Lambda v) (body :* Nil) = do         env <- ask         return@@ -304,7 +366,7 @@             $ evalBindM body       where         funType :: Lambda (b :-> Full (a -> b)) -> P (a -> b)-        funType _ = P+        funType = const P   @@ -320,6 +382,9 @@  instance VarEqEnv [(VarId,VarId)]   where+    {-# SPECIALIZE instance VarEqEnv [(VarId,VarId)] #-}+    {-# INLINABLE prjVarEqEnv #-}+    {-# INLINABLE modVarEqEnv #-}     prjVarEqEnv = id     modVarEqEnv = id @@ -332,10 +397,23 @@         -> sub2 b         -> Args (AST dom) b         -> Reader env Bool+    default alphaEqSym+        :: (AlphaEq dom dom dom env, Equality sub2, sub1 ~ sub2)+        => sub1 a+        -> Args (AST dom) a+        -> sub2 b+        -> Args (AST dom) b+        -> Reader env Bool+    alphaEqSym = alphaEqSymDefault+    {-# INLINABLE alphaEqSym #-}  instance (AlphaEq subA1 subB1 dom env, AlphaEq subA2 subB2 dom env) =>     AlphaEq (subA1 :+: subA2) (subB1 :+: subB2) dom env   where+    {-# SPECIALIZE instance+          (AlphaEq subA1 subB1 dom env, AlphaEq subA2 subB2 dom env) =>+            AlphaEq (subA1 :+: subA2) (subB1 :+: subB2) dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (InjL a) aArgs (InjL b) bArgs = alphaEqSym a aArgs b bArgs     alphaEqSym (InjR a) aArgs (InjR b) bArgs = alphaEqSym a aArgs b bArgs     alphaEqSym _ _ _ _ = return False@@ -343,16 +421,19 @@ alphaEqM :: AlphaEq dom dom dom env =>     ASTF dom a -> ASTF dom b -> Reader env Bool alphaEqM a b = simpleMatch (alphaEqM2 b) a+{-# INLINABLE alphaEqM #-}  alphaEqM2 :: AlphaEq dom dom dom env =>     ASTF dom b -> dom a -> Args (AST dom) a -> Reader env Bool alphaEqM2 b a aArgs = simpleMatch (alphaEqSym a aArgs) b+{-# INLINABLE alphaEqM2 #-}  -- | Alpha-equivalence on lambda expressions. Free variables are taken to be -- equivalent if they have the same identifier. alphaEq :: AlphaEq dom dom dom [(VarId,VarId)] =>     ASTF dom a -> ASTF dom b -> Bool alphaEq a b = flip runReader ([] :: [(VarId,VarId)]) $ alphaEqM a b+{-# INLINABLE alphaEq #-}  alphaEqSymDefault :: (Equality sub, AlphaEq dom dom dom env)     => sub a@@ -366,6 +447,7 @@   where     a' = appArgs (Sym (undefined :: dom a)) aArgs     b' = appArgs (Sym (undefined :: dom b)) bArgs+{-# INLINABLE alphaEqSymDefault #-}  alphaEqChildren :: AlphaEq dom dom dom env =>     AST dom a -> AST dom b -> Reader env Bool@@ -374,50 +456,85 @@     (alphaEqChildren f g)     (alphaEqM a b) alphaEqChildren _ _ = return False+{-# INLINABLE alphaEqChildren #-}  instance AlphaEq sub sub dom env => AlphaEq (sub :| pred) (sub :| pred) dom env   where+    {-# SPECIALIZE instance (AlphaEq sub sub dom env) =>+          AlphaEq (sub :| pred) (sub :| pred) dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (C a) aArgs (C b) bArgs = alphaEqSym a aArgs b bArgs  instance AlphaEq sub sub dom env => AlphaEq (sub :|| pred) (sub :|| pred) dom env   where+    {-# SPECIALIZE instance (AlphaEq sub sub dom env) =>+          AlphaEq (sub :|| pred) (sub :|| pred) dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (C' a) aArgs (C' b) bArgs = alphaEqSym a aArgs b bArgs  instance AlphaEq sub sub dom env => AlphaEq (SubConstr1 c sub p) (SubConstr1 c sub p) dom env   where+    {-# SPECIALIZE instance (AlphaEq sub sub dom env) =>+          AlphaEq (SubConstr1 c sub p) (SubConstr1 c sub p) dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (SubConstr1 a) aArgs (SubConstr1 b) bArgs = alphaEqSym a aArgs b bArgs  instance AlphaEq sub sub dom env =>     AlphaEq (SubConstr2 c sub pa pb) (SubConstr2 c sub pa pb) dom env   where+    {-# SPECIALIZE instance (AlphaEq sub sub dom env) =>+          AlphaEq (SubConstr2 c sub pa pb) (SubConstr2 c sub pa pb) dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (SubConstr2 a) aArgs (SubConstr2 b) bArgs = alphaEqSym a aArgs b bArgs  instance AlphaEq Empty Empty dom env   where+    {-# SPECIALIZE instance AlphaEq Empty Empty dom env #-}     alphaEqSym = error "Not implemented: alphaEqSym for Empty" -instance AlphaEq dom dom dom env => AlphaEq Condition Condition dom env where alphaEqSym = alphaEqSymDefault-instance AlphaEq dom dom dom env => AlphaEq Construct Construct dom env where alphaEqSym = alphaEqSymDefault-instance AlphaEq dom dom dom env => AlphaEq Identity  Identity  dom env where alphaEqSym = alphaEqSymDefault-instance AlphaEq dom dom dom env => AlphaEq Let       Let       dom env where alphaEqSym = alphaEqSymDefault-instance AlphaEq dom dom dom env => AlphaEq Literal   Literal   dom env where alphaEqSym = alphaEqSymDefault-instance AlphaEq dom dom dom env => AlphaEq Select    Select    dom env where alphaEqSym = alphaEqSymDefault-instance AlphaEq dom dom dom env => AlphaEq Tuple     Tuple     dom env where alphaEqSym = alphaEqSymDefault+instance AlphaEq dom dom dom env => AlphaEq Condition Condition dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Condition Condition dom env #-}+instance AlphaEq dom dom dom env => AlphaEq Construct Construct dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Construct Construct dom env #-}+instance AlphaEq dom dom dom env => AlphaEq Identity  Identity  dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Identity Identity dom env #-}+instance AlphaEq dom dom dom env => AlphaEq Let       Let       dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Let Let dom env #-}+instance AlphaEq dom dom dom env => AlphaEq Literal   Literal   dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Literal Literal dom env #-}+instance AlphaEq dom dom dom env => AlphaEq Select    Select    dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Select Select dom env #-}+instance AlphaEq dom dom dom env => AlphaEq Tuple     Tuple     dom env where+  {-# SPECIALIZE instance AlphaEq dom dom dom env =>+        AlphaEq Tuple Tuple dom env #-}  instance AlphaEq sub sub dom env =>     AlphaEq (Decor info sub) (Decor info sub) dom env   where+    {-# SPECIALIZE instance (AlphaEq sub sub dom env) =>+          AlphaEq (Decor info sub) (Decor info sub) dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym a aArgs b bArgs =         alphaEqSym (decorExpr a) aArgs (decorExpr b) bArgs  instance (AlphaEq dom dom dom env, Monad m) => AlphaEq (MONAD m) (MONAD m) dom env   where-    alphaEqSym = alphaEqSymDefault+    {-# SPECIALIZE instance (AlphaEq dom dom dom env, Monad m) =>+          AlphaEq (MONAD m) (MONAD m) dom env #-}  instance (AlphaEq dom dom dom env, VarEqEnv env) =>     AlphaEq Variable Variable dom env   where-    alphaEqSym (Variable v1) Nil (Variable v2) Nil = do+    {-# SPECIALIZE instance (AlphaEq dom dom dom env, VarEqEnv env) =>+          AlphaEq Variable Variable dom env #-}+    {-# INLINABLE alphaEqSym #-}+    alphaEqSym (Variable v1) _ (Variable v2) _ = do         env <- asks prjVarEqEnv         case lookup v1 env of           Nothing  -> return (v1==v2)   -- Free variables@@ -426,6 +543,8 @@ instance (AlphaEq dom dom dom env, VarEqEnv env) =>     AlphaEq Lambda Lambda dom env   where+    {-# SPECIALIZE instance (AlphaEq dom dom dom env, VarEqEnv env) =>+          AlphaEq Lambda Lambda dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (Lambda v1) (body1 :* Nil) (Lambda v2) (body2 :* Nil) =         local (modVarEqEnv ((v1,v2):)) $ alphaEqM body1 body2-

@@ -55,6 +55,8 @@  instance IsHODomain (HODomain dom p pVar) p pVar   where+    {-# SPECIALIZE instance IsHODomain (HODomain dom p pVar) p pVar #-}+    {-# INLINABLE lambda #-}     lambda = injC . HOLambda  instance@@ -67,6 +69,15 @@     ) =>       Syntactic (a -> b)   where+    {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+                            , Syntactic b, Domain b ~ dom+                            , IsHODomain dom p pVar+                            , p (Internal a -> Internal b)+                            , p (Internal a)+                            , pVar (Internal a)+                            ) => Syntactic (a -> b) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a -> b)   = Domain a     type Internal (a -> b) = Internal a -> Internal b     desugar f = lambda (desugar . f . sugar)@@ -100,4 +111,3 @@ reify :: (Syntactic a, Domain a ~ HODomain dom p pVar) =>     a -> ASTF (FODomain dom p pVar) (Internal a) reify = reifyTop . desugar-

@@ -52,6 +52,8 @@         -> sym sig         -> Args (AST dom) sig         -> Writer (Set VarId) (ASTF dom (DenResult sig))+    optimizeSym = optimizeSymDefault+    {-# INLINABLE optimizeSym #-}    -- The reason for having @dom@ as a class parameter is that many instances   -- need to put additional constraints on @dom@.@@ -65,6 +67,9 @@  instance (Optimize sub1, Optimize sub2) => Optimize (sub1 :+: sub2)   where+    {-# SPECIALIZE instance (Optimize sub1, Optimize sub2) =>+          Optimize (sub1 :+: sub2) #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym constFold injecter (InjL a) = optimizeSym constFold (injecter . InjL) a     optimizeSym constFold injecter (InjR a) = optimizeSym constFold (injecter . InjR) a @@ -96,33 +101,45 @@  instance Optimize dom => Optimize (dom :| p)   where+    {-# SPECIALIZE instance Optimize dom => Optimize (dom :| p) #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym cf i (C s) args = optimizeSym cf (i . C) s args  instance Optimize dom => Optimize (dom :|| p)   where+    {-# SPECIALIZE instance Optimize dom => Optimize (dom :|| p) #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym cf i (C' s) args = optimizeSym cf (i . C') s args  instance Optimize Empty   where+    {-# SPECIALIZE instance Optimize Empty #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym = error "Not implemented: optimizeSym for Empty"  instance Optimize dom => Optimize (SubConstr1 c dom p)   where+    {-# SPECIALIZE instance Optimize dom => Optimize (SubConstr1 c dom p) #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym cf i (SubConstr1 s) args = optimizeSym cf (i . SubConstr1) s args  instance Optimize dom => Optimize (SubConstr2 c dom pa pb)   where+    {-# SPECIALIZE instance Optimize dom => Optimize (SubConstr2 c dom pa pb) #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym cf i (SubConstr2 s) args = optimizeSym cf (i . SubConstr2) s args -instance Optimize Identity  where optimizeSym = optimizeSymDefault-instance Optimize Construct where optimizeSym = optimizeSymDefault-instance Optimize Literal   where optimizeSym = optimizeSymDefault-instance Optimize Tuple     where optimizeSym = optimizeSymDefault-instance Optimize Select    where optimizeSym = optimizeSymDefault-instance Optimize Let       where optimizeSym = optimizeSymDefault+instance Optimize Identity  where {-# SPECIALIZE instance Optimize Identity #-}+instance Optimize Construct where {-# SPECIALIZE instance Optimize Construct #-}+instance Optimize Literal   where {-# SPECIALIZE instance Optimize Literal #-}+instance Optimize Tuple     where {-# SPECIALIZE instance Optimize Tuple #-}+instance Optimize Select    where {-# SPECIALIZE instance Optimize Select #-}+instance Optimize Let       where {-# SPECIALIZE instance Optimize Let #-}  instance Optimize Condition   where+    {-# SPECIALIZE instance Optimize Condition #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym constFold injecter cond@Condition args@(c :* t :* e :* Nil)         | Set.null cVars = optimizeM constFold t_or_e         | alphaEq t e    = optimizeM constFold t@@ -133,13 +150,16 @@  instance Optimize Variable   where+    {-# SPECIALIZE instance Optimize Variable #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym _ injecter var@(Variable v) Nil = do         tell (singleton v)         return (injecter var)  instance Optimize Lambda   where+    {-# SPECIALIZE instance Optimize Lambda #-}+    {-# INLINABLE optimizeSym #-}     optimizeSym constFold injecter lam@(Lambda v) (body :* Nil) = do         body' <- censor (delete v) $ optimizeM constFold body         return $ injecter lam :$ body'-

@@ -16,12 +16,15 @@  instance Constrained Condition   where+    {-# SPECIALIZE instance Constrained Condition #-}+    {-# INLINABLE exprDict #-}     type Sat Condition = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Semantic Condition   where+    {-# SPECIALIZE instance Semantic Condition #-}+    {-# INLINABLE semantics #-}     semantics Condition = Sem "condition" (\c t e -> if c then t else e)  semanticInstances ''Condition-

@@ -19,12 +19,15 @@  instance Constrained Construct   where+    {-# SPECIALIZE instance Constrained Construct #-}+    {-# INLINABLE exprDict #-}     type Sat Construct = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Semantic Construct   where+    {-# SPECIALIZE instance Semantic Construct #-}+    {-# INLINABLE semantics #-}     semantics (Construct name den) = Sem name den  semanticInstances ''Construct-

@@ -36,29 +36,43 @@  instance Constrained expr => Constrained (Decor info expr)   where+    {-# SPECIALIZE instance (Constrained expr) => Constrained (Decor info expr) #-}+    {-# INLINABLE exprDict #-}     type Sat (Decor info expr) = Sat expr     exprDict (Decor _ a) = exprDict a  instance Project sub sup => Project sub (Decor info sup)   where+    {-# SPECIALIZE instance (Project sub sup) => Project sub (Decor info sup) #-}+    {-# INLINABLE prj #-}     prj = prj . decorExpr  instance Equality expr => Equality (Decor info expr)   where+    {-# SPECIALIZE instance (Equality expr) => Equality (Decor info expr) #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal a b = decorExpr a `equal` decorExpr b     exprHash  = exprHash . decorExpr  instance Render expr => Render (Decor info expr)   where+    {-# SPECIALIZE instance (Render expr) => Render (Decor info expr) #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym = renderSym . decorExpr     renderArgs args = renderArgs args . decorExpr  instance StringTree expr => StringTree (Decor info expr)   where+    {-# SPECIALIZE instance (StringTree expr) => StringTree (Decor info expr) #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym args = stringTreeSym args . decorExpr  instance Eval expr => Eval (Decor info expr)   where+    {-# SPECIALIZE instance (Eval expr) => Eval (Decor info expr) #-}+    {-# INLINABLE evaluate #-}     evaluate = evaluate . decorExpr  @@ -67,6 +81,7 @@ getInfo :: AST (Decor info dom) sig -> info (DenResult sig) getInfo (Sym (Decor info _)) = info getInfo (f :$ _)             = getInfo f+{-# INLINABLE getInfo #-}  -- | Update the decoration of the top-level node updateDecor :: forall info dom a .@@ -88,16 +103,17 @@ -- @(`Decor` info dom)@. liftDecor :: (expr s -> info (DenResult s) -> b) -> (Decor info expr s -> b) liftDecor f (Decor info a) = f a info+{-# INLINABLE liftDecor #-}  -- | Collect the decorations of all nodes-collectInfo :: (forall sig . info sig -> b) -> AST (Decor info dom) sig -> [b]+collectInfo :: (forall sig . info sig -> b) -> AST (Decor info dom) a -> [b] collectInfo coll (Sym (Decor info _)) = [coll info] collectInfo coll (f :$ a) = collectInfo coll f ++ collectInfo coll a  -- | Rendering of decorated syntax trees stringTreeDecor :: forall info dom a . (StringTree dom) =>-    (forall a. info a -> String) -> ASTF (Decor info dom) a -> Tree String-stringTreeDecor showInfo a = mkTree [] a+    (forall sig. info sig -> String) -> ASTF (Decor info dom) a -> Tree String+stringTreeDecor showInfo = mkTree []   where     mkTree :: [Tree String] -> AST (Decor info dom) sig -> Tree String     mkTree args (Sym (Decor info expr)) = Node infoStr [stringTreeSym args expr]@@ -106,16 +122,21 @@     mkTree args (f :$ a) = mkTree (mkTree [] a : args) f  -- | Show an decorated syntax tree using ASCII art-showDecorWith :: StringTree dom => (forall a. info a -> String) -> ASTF (Decor info dom) a -> String+showDecorWith :: StringTree dom+              => (forall sig. info sig -> String)+              -> ASTF (Decor info dom) a -> String showDecorWith showInfo = showTree . stringTreeDecor showInfo  -- | Print an decorated syntax tree using ASCII art-drawDecorWith :: StringTree dom => (forall a. info a -> String) -> ASTF (Decor info dom) a -> IO ()+drawDecorWith :: StringTree dom+              => (forall sig. info sig -> String)+              -> ASTF (Decor info dom) a -> IO () drawDecorWith showInfo = putStrLn . showDecorWith showInfo  writeHtmlDecorWith :: forall info sym a. (StringTree sym)-                   => (forall b. info b -> String) -> FilePath -> ASTF (Decor info sym) a -> IO ()-writeHtmlDecorWith showInfo file a = writeHtmlTree file $ mkTree [] a+                   => (forall sig. info sig -> String)+                   -> FilePath -> ASTF (Decor info sym) a -> IO ()+writeHtmlDecorWith showInfo file = writeHtmlTree file . mkTree []   where     mkTree :: [Tree NodeInfo] -> AST (Decor info sym) sig -> Tree NodeInfo     mkTree args (f :$ a) = mkTree (mkTree [] a : args) f@@ -125,3 +146,4 @@ stripDecor :: AST (Decor info dom) sig -> AST dom sig stripDecor (Sym (Decor _ a)) = Sym a stripDecor (f :$ a)          = stripDecor f :$ stripDecor a+{-# INLINABLE stripDecor #-}

@@ -17,12 +17,15 @@  instance Constrained Identity   where+    {-# SPECIALIZE instance Constrained Identity #-}+    {-# INLINABLE exprDict #-}     type Sat Identity = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Semantic Identity   where+    {-# SPECIALIZE instance Semantic Identity #-}+    {-# INLINABLE semantics #-}     semantics Id = Sem "id" id  semanticInstances ''Identity-

@@ -18,11 +18,16 @@  instance Constrained Literal   where+    {-# SPECIALIZE instance Constrained Literal #-}+    {-# INLINABLE exprDict #-}     type Sat Literal = Eq :/\: Show :/\: Typeable :/\: Top     exprDict (Literal _) = Dict  instance Equality Literal   where+    {-# SPECIALIZE instance Equality Literal #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     Literal a `equal` Literal b = case cast a of         Just a' -> a'==b         Nothing -> False@@ -31,11 +36,15 @@  instance Render Literal   where+    {-# SPECIALIZE instance Render Literal #-}+    {-# INLINABLE renderSym #-}     renderSym (Literal a) = show a -instance StringTree Literal+instance StringTree Literal where+  {-# SPECIALIZE instance StringTree Literal #-}  instance Eval Literal   where+    {-# SPECIALIZE instance Eval Literal #-}+    {-# INLINABLE evaluate #-}     evaluate (Literal a) = a-

@@ -23,23 +23,38 @@  instance Constrained (MONAD m)   where+    {-# SPECIALIZE instance Constrained (MONAD m) #-}+    {-# INLINABLE exprDict #-}     type Sat (MONAD m) = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Monad m => Semantic (MONAD m)   where+    {-# SPECIALIZE instance (Monad m) => Semantic (MONAD m) #-}+    {-# INLINABLE semantics #-}     semantics Return = Sem "return" return     semantics Bind   = Sem "bind"   (>>=)     semantics Then   = Sem "then"   (>>)     semantics When   = Sem "when"   when -instance Monad m => Equality   (MONAD m) where equal      = equalDefault; exprHash = exprHashDefault-instance Monad m => Render     (MONAD m) where renderSym  = renderSymDefault-                                               renderArgs = renderArgsDefault-instance Monad m => Eval       (MONAD m) where evaluate   = evaluateDefault-instance Monad m => StringTree (MONAD m)+instance Monad m => Equality   (MONAD m) where+  {-# SPECIALIZE instance (Monad m) => Equality (MONAD m) #-}+  {-# INLINABLE equal #-}+  {-# INLINABLE exprHash #-}+  equal = equalDefault+  exprHash = exprHashDefault+instance Monad m => Render     (MONAD m) where+  {-# SPECIALIZE instance (Monad m) => Render (MONAD m) #-}+  {-# INLINABLE renderSym #-}+  renderSym = renderSymDefault+instance Monad m => Eval       (MONAD m) where+  {-# SPECIALIZE instance (Monad m) => Eval (MONAD m) #-}+  {-# INLINABLE evaluate #-}+  evaluate = evaluateDefault+instance Monad m => StringTree (MONAD m) where+  {-# SPECIALIZE instance (Monad m) => StringTree (MONAD m) #-}  -- | Projection with explicit monad type prjMonad :: Project (MONAD m) sup => P m -> sup sig -> Maybe (MONAD m sig) prjMonad _ = prj-+{-# INLINABLE prjMonad #-}

@@ -36,11 +36,15 @@  instance Constrained Tuple   where+    {-# SPECIALIZE instance Constrained Tuple #-}+    {-# INLINE exprDict #-}     type Sat Tuple = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Semantic Tuple   where+    {-# SPECIALIZE instance Semantic Tuple #-}+    {-# INLINABLE semantics #-}     semantics Tup2  = Sem "tup2"  (,)     semantics Tup3  = Sem "tup3"  (,,)     semantics Tup4  = Sem "tup4"  (,,,)@@ -238,11 +242,15 @@  instance Constrained Select   where+    {-# SPECIALIZE instance Constrained Select #-}+    {-# INLINE exprDict #-}     type Sat Select = Top-    exprDict _ = Dict+    exprDict = const Dict  instance Semantic Select   where+    {-# SPECIALIZE instance Semantic Select #-}+    {-# INLINABLE semantics #-}     semantics Sel1 = Sem "sel1" sel1     semantics Sel2 = Sem "sel2" sel2     semantics Sel3 = Sem "sel3" sel3@@ -280,4 +288,3 @@ selectPos Sel13 = 13 selectPos Sel14 = 14 selectPos Sel15 = 15-

@@ -93,8 +93,21 @@          ) =>            Syntactic (Mon dom m a)   where+    {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+                            , IsHODomain dom Typeable pVar+                            , InjectC (MONAD m) dom (m (Internal a))+                            , Monad m+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+                            , Typeable m+#else+                            , Typeable1 m+#endif+                            , Typeable (Internal a)+                            , pVar (Internal a)+                            ) => Syntactic (Mon dom m a) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (Mon dom m a)   = dom     type Internal (Mon dom m a) = m (Internal a)     desugar = desugarMonad . fmap desugar     sugar   = fmap sugar   . sugarMonad-

@@ -24,782 +24,1211 @@     ) =>       Syntactic (a,b)   where-    type Domain (a,b) = Domain a-    type Internal (a,b) =-        ( Internal a-        , Internal b-        )--    desugar = uncurryN $ sugarSymC Tup2-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        )--instance-    ( Syntactic a, Domain a ~ dom-    , Syntactic b, Domain b ~ dom-    , Syntactic c, Domain c ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    ) =>-      Syntactic (a,b,c)-  where-    type Domain (a,b,c) = Domain a-    type Internal (a,b,c) =-        ( Internal a-        , Internal b-        , Internal c-        )--    desugar = uncurryN $ sugarSymC Tup3-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        )--instance-    ( 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-        , Internal c-        , Internal d-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    ) =>-      Syntactic (a,b,c,d)-  where-    type Domain (a,b,c,d) = Domain a-    type Internal (a,b,c,d) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        )--    desugar = uncurryN $ sugarSymC Tup4-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        )--instance-    ( 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-        , Internal c-        , Internal d-        , Internal e-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    ) =>-      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-        , Internal c-        , Internal d-        , Internal e-        )--    desugar = uncurryN $ sugarSymC Tup5-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        )--instance-    ( 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-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    ) =>-      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-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        )--    desugar = uncurryN $ sugarSymC Tup6-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        )--instance-    ( 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-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    ) =>-      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-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        )--    desugar = uncurryN $ sugarSymC Tup7-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h)-  where-    type Domain (a,b,c,d,e,f,g,h) = Domain a-    type Internal (a,b,c,d,e,f,g,h) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        )--    desugar = uncurryN $ sugarSymC Tup8-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i)-  where-    type Domain (a,b,c,d,e,f,g,h,i) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        )--    desugar = uncurryN $ sugarSymC Tup9-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , Syntactic j, Domain j ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    , InjectC Select dom (Internal j)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i,j)-  where-    type Domain (a,b,c,d,e,f,g,h,i,j) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i,j) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        )--    desugar = uncurryN $ sugarSymC Tup10-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        , sugarSymC Sel10 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , Syntactic j, Domain j ~ dom-    , Syntactic k, Domain k ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    , InjectC Select dom (Internal j)-    , InjectC Select dom (Internal k)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i,j,k)-  where-    type Domain (a,b,c,d,e,f,g,h,i,j,k) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i,j,k) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        )--    desugar = uncurryN $ sugarSymC Tup11-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        , sugarSymC Sel10 a-        , sugarSymC Sel11 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , Syntactic j, Domain j ~ dom-    , Syntactic k, Domain k ~ dom-    , Syntactic l, Domain l ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    , InjectC Select dom (Internal j)-    , InjectC Select dom (Internal k)-    , InjectC Select dom (Internal l)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i,j,k,l)-  where-    type Domain (a,b,c,d,e,f,g,h,i,j,k,l) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i,j,k,l) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        )--    desugar = uncurryN $ sugarSymC Tup12-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        , sugarSymC Sel10 a-        , sugarSymC Sel11 a-        , sugarSymC Sel12 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , Syntactic j, Domain j ~ dom-    , Syntactic k, Domain k ~ dom-    , Syntactic l, Domain l ~ dom-    , Syntactic m, Domain m ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        , Internal m-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    , InjectC Select dom (Internal j)-    , InjectC Select dom (Internal k)-    , InjectC Select dom (Internal l)-    , InjectC Select dom (Internal m)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m)-  where-    type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        , Internal m-        )--    desugar = uncurryN $ sugarSymC Tup13-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        , sugarSymC Sel10 a-        , sugarSymC Sel11 a-        , sugarSymC Sel12 a-        , sugarSymC Sel13 a-        )--instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , Syntactic j, Domain j ~ dom-    , Syntactic k, Domain k ~ dom-    , Syntactic l, Domain l ~ dom-    , Syntactic m, Domain m ~ dom-    , Syntactic n, Domain n ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        , Internal m-        , Internal n-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    , InjectC Select dom (Internal j)-    , InjectC Select dom (Internal k)-    , InjectC Select dom (Internal l)-    , InjectC Select dom (Internal m)-    , InjectC Select dom (Internal n)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n)-  where-    type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        , Internal m-        , Internal n-        )--    desugar = uncurryN $ sugarSymC Tup14-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        , sugarSymC Sel10 a-        , sugarSymC Sel11 a-        , sugarSymC Sel12 a-        , sugarSymC Sel13 a-        , sugarSymC Sel14 a-        )---instance-    ( 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-    , Syntactic h, Domain h ~ dom-    , Syntactic i, Domain i ~ dom-    , Syntactic j, Domain j ~ dom-    , Syntactic k, Domain k ~ dom-    , Syntactic l, Domain l ~ dom-    , Syntactic m, Domain m ~ dom-    , Syntactic n, Domain n ~ dom-    , Syntactic o, Domain o ~ dom-    , InjectC Tuple dom-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        , Internal m-        , Internal n-        , Internal o-        )-    , InjectC Select dom (Internal a)-    , InjectC Select dom (Internal b)-    , InjectC Select dom (Internal c)-    , InjectC Select dom (Internal d)-    , InjectC Select dom (Internal e)-    , InjectC Select dom (Internal f)-    , InjectC Select dom (Internal g)-    , InjectC Select dom (Internal h)-    , InjectC Select dom (Internal i)-    , InjectC Select dom (Internal j)-    , InjectC Select dom (Internal k)-    , InjectC Select dom (Internal l)-    , InjectC Select dom (Internal m)-    , InjectC Select dom (Internal n)-    , InjectC Select dom (Internal o)-    ) =>-      Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)-  where-    type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Domain a-    type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =-        ( Internal a-        , Internal b-        , Internal c-        , Internal d-        , Internal e-        , Internal f-        , Internal g-        , Internal h-        , Internal i-        , Internal j-        , Internal k-        , Internal l-        , Internal m-        , Internal n-        , Internal o-        )--    desugar = uncurryN $ sugarSymC Tup15-    sugar a =-        ( sugarSymC Sel1 a-        , sugarSymC Sel2 a-        , sugarSymC Sel3 a-        , sugarSymC Sel4 a-        , sugarSymC Sel5 a-        , sugarSymC Sel6 a-        , sugarSymC Sel7 a-        , sugarSymC Sel8 a-        , sugarSymC Sel9 a-        , sugarSymC Sel10 a-        , sugarSymC Sel11 a-        , sugarSymC Sel12 a-        , sugarSymC Sel13 a-        , sugarSymC Sel14 a-        , sugarSymC Sel15 a-        )+    {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+                            , Syntactic b, Domain b ~ dom+                            , InjectC Tuple dom+                                ( Internal a+                                , Internal b+                                )+                            , InjectC Select dom (Internal a)+                            , InjectC Select dom (Internal b)+                            ) => Syntactic (a,b) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}+    type Domain (a,b) = Domain a+    type Internal (a,b) =+        ( Internal a+        , Internal b+        )++    -- desugar = uncurryN $ sugarSymC Tup2+    desugar (a,b) = sugarSymC Tup2 a b+    sugar a =+        ( sugarSymC Sel1 a+        , sugarSymC Sel2 a+        )++-- instance+--     ( Syntactic a, Domain a ~ dom+--     , Syntactic b, Domain b ~ dom+--     , Syntactic c, Domain c ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     ) =>+--       Syntactic (a,b,c)+--   where+--     {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+--                             , Syntactic b, Domain b ~ dom+--                             , Syntactic c, Domain c ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             ) => Syntactic (a,b,c) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c) = Domain a+--     type Internal (a,b,c) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         )+--+--     desugar = uncurryN $ sugarSymC Tup3+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         )+--+-- instance+--     ( 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+--         , Internal c+--         , Internal d+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     ) =>+--       Syntactic (a,b,c,d)+--   where+--     {-# SPECIALIZE instance ( 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+--                                 , Internal c+--                                 , Internal d+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             ) => Syntactic (a,b,c,d) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d) = Domain a+--     type Internal (a,b,c,d) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         )+--+--     desugar = uncurryN $ sugarSymC Tup4+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         )+--+-- instance+--     ( 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+--         , Internal c+--         , Internal d+--         , Internal e+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     ) =>+--       Syntactic (a,b,c,d,e)+--   where+--     {-# SPECIALIZE instance ( 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+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             ) => Syntactic (a,b,c,d,e) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e) = Domain a+--     type Internal (a,b,c,d,e) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         )+--+--     desugar = uncurryN $ sugarSymC Tup5+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         )+--+-- instance+--     ( 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+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     ) =>+--       Syntactic (a,b,c,d,e,f)+--   where+--     {-# SPECIALIZE instance ( 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+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             ) => Syntactic (a,b,c,d,e,f) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f) = Domain a+--     type Internal (a,b,c,d,e,f) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         )+--+--     desugar = uncurryN $ sugarSymC Tup6+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         )+--+-- instance+--     ( 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+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g)+--   where+--     {-# SPECIALIZE instance ( 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+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             ) => Syntactic (a,b,c,d,e,f,g) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g) = Domain a+--     type Internal (a,b,c,d,e,f,g) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         )+--+--     desugar = uncurryN $ sugarSymC Tup7+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             ) => Syntactic (a,b,c,d,e,f,g,h) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h) = Domain a+--     type Internal (a,b,c,d,e,f,g,h) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         )+--+--     desugar = uncurryN $ sugarSymC Tup8+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             ) => Syntactic (a,b,c,d,e,f,g,h,i) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         )+--+--     desugar = uncurryN $ sugarSymC Tup9+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , Syntactic j, Domain j ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     , InjectC Select dom (Internal j)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i,j)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , Syntactic j, Domain j ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 , Internal j+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             , InjectC Select dom (Internal j)+--                             ) =>+--                               Syntactic (a,b,c,d,e,f,g,h,i,j) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i,j) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i,j) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         )+--+--     desugar = uncurryN $ sugarSymC Tup10+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         , sugarSymC Sel10 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , Syntactic j, Domain j ~ dom+--     , Syntactic k, Domain k ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     , InjectC Select dom (Internal j)+--     , InjectC Select dom (Internal k)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i,j,k)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , Syntactic j, Domain j ~ dom+--                             , Syntactic k, Domain k ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 , Internal j+--                                 , Internal k+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             , InjectC Select dom (Internal j)+--                             , InjectC Select dom (Internal k)+--                             ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i,j,k) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i,j,k) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         )+--+--     desugar = uncurryN $ sugarSymC Tup11+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         , sugarSymC Sel10 a+--         , sugarSymC Sel11 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , Syntactic j, Domain j ~ dom+--     , Syntactic k, Domain k ~ dom+--     , Syntactic l, Domain l ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     , InjectC Select dom (Internal j)+--     , InjectC Select dom (Internal k)+--     , InjectC Select dom (Internal l)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , Syntactic j, Domain j ~ dom+--                             , Syntactic k, Domain k ~ dom+--                             , Syntactic l, Domain l ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 , Internal j+--                                 , Internal k+--                                 , Internal l+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             , InjectC Select dom (Internal j)+--                             , InjectC Select dom (Internal k)+--                             , InjectC Select dom (Internal l)+--                             ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i,j,k,l) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i,j,k,l) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         )+--+--     desugar = uncurryN $ sugarSymC Tup12+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         , sugarSymC Sel10 a+--         , sugarSymC Sel11 a+--         , sugarSymC Sel12 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , Syntactic j, Domain j ~ dom+--     , Syntactic k, Domain k ~ dom+--     , Syntactic l, Domain l ~ dom+--     , Syntactic m, Domain m ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         , Internal m+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     , InjectC Select dom (Internal j)+--     , InjectC Select dom (Internal k)+--     , InjectC Select dom (Internal l)+--     , InjectC Select dom (Internal m)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , Syntactic j, Domain j ~ dom+--                             , Syntactic k, Domain k ~ dom+--                             , Syntactic l, Domain l ~ dom+--                             , Syntactic m, Domain m ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 , Internal j+--                                 , Internal k+--                                 , Internal l+--                                 , Internal m+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             , InjectC Select dom (Internal j)+--                             , InjectC Select dom (Internal k)+--                             , InjectC Select dom (Internal l)+--                             , InjectC Select dom (Internal m)+--                             ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         , Internal m+--         )+--+--     desugar = uncurryN $ sugarSymC Tup13+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         , sugarSymC Sel10 a+--         , sugarSymC Sel11 a+--         , sugarSymC Sel12 a+--         , sugarSymC Sel13 a+--         )+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , Syntactic j, Domain j ~ dom+--     , Syntactic k, Domain k ~ dom+--     , Syntactic l, Domain l ~ dom+--     , Syntactic m, Domain m ~ dom+--     , Syntactic n, Domain n ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         , Internal m+--         , Internal n+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     , InjectC Select dom (Internal j)+--     , InjectC Select dom (Internal k)+--     , InjectC Select dom (Internal l)+--     , InjectC Select dom (Internal m)+--     , InjectC Select dom (Internal n)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , Syntactic j, Domain j ~ dom+--                             , Syntactic k, Domain k ~ dom+--                             , Syntactic l, Domain l ~ dom+--                             , Syntactic m, Domain m ~ dom+--                             , Syntactic n, Domain n ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 , Internal j+--                                 , Internal k+--                                 , Internal l+--                                 , Internal m+--                                 , Internal n+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             , InjectC Select dom (Internal j)+--                             , InjectC Select dom (Internal k)+--                             , InjectC Select dom (Internal l)+--                             , InjectC Select dom (Internal m)+--                             , InjectC Select dom (Internal n)+--                             ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         , Internal m+--         , Internal n+--         )+--+--     desugar = uncurryN $ sugarSymC Tup14+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         , sugarSymC Sel10 a+--         , sugarSymC Sel11 a+--         , sugarSymC Sel12 a+--         , sugarSymC Sel13 a+--         , sugarSymC Sel14 a+--         )+--+--+-- instance+--     ( 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+--     , Syntactic h, Domain h ~ dom+--     , Syntactic i, Domain i ~ dom+--     , Syntactic j, Domain j ~ dom+--     , Syntactic k, Domain k ~ dom+--     , Syntactic l, Domain l ~ dom+--     , Syntactic m, Domain m ~ dom+--     , Syntactic n, Domain n ~ dom+--     , Syntactic o, Domain o ~ dom+--     , InjectC Tuple dom+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         , Internal m+--         , Internal n+--         , Internal o+--         )+--     , InjectC Select dom (Internal a)+--     , InjectC Select dom (Internal b)+--     , InjectC Select dom (Internal c)+--     , InjectC Select dom (Internal d)+--     , InjectC Select dom (Internal e)+--     , InjectC Select dom (Internal f)+--     , InjectC Select dom (Internal g)+--     , InjectC Select dom (Internal h)+--     , InjectC Select dom (Internal i)+--     , InjectC Select dom (Internal j)+--     , InjectC Select dom (Internal k)+--     , InjectC Select dom (Internal l)+--     , InjectC Select dom (Internal m)+--     , InjectC Select dom (Internal n)+--     , InjectC Select dom (Internal o)+--     ) =>+--       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)+--   where+--     {-# SPECIALIZE instance ( 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+--                             , Syntactic h, Domain h ~ dom+--                             , Syntactic i, Domain i ~ dom+--                             , Syntactic j, Domain j ~ dom+--                             , Syntactic k, Domain k ~ dom+--                             , Syntactic l, Domain l ~ dom+--                             , Syntactic m, Domain m ~ dom+--                             , Syntactic n, Domain n ~ dom+--                             , Syntactic o, Domain o ~ dom+--                             , InjectC Tuple dom+--                                 ( Internal a+--                                 , Internal b+--                                 , Internal c+--                                 , Internal d+--                                 , Internal e+--                                 , Internal f+--                                 , Internal g+--                                 , Internal h+--                                 , Internal i+--                                 , Internal j+--                                 , Internal k+--                                 , Internal l+--                                 , Internal m+--                                 , Internal n+--                                 , Internal o+--                                 )+--                             , InjectC Select dom (Internal a)+--                             , InjectC Select dom (Internal b)+--                             , InjectC Select dom (Internal c)+--                             , InjectC Select dom (Internal d)+--                             , InjectC Select dom (Internal e)+--                             , InjectC Select dom (Internal f)+--                             , InjectC Select dom (Internal g)+--                             , InjectC Select dom (Internal h)+--                             , InjectC Select dom (Internal i)+--                             , InjectC Select dom (Internal j)+--                             , InjectC Select dom (Internal k)+--                             , InjectC Select dom (Internal l)+--                             , InjectC Select dom (Internal m)+--                             , InjectC Select dom (Internal n)+--                             , InjectC Select dom (Internal o)+--                             ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) #-}+--     {-# INLINABLE desugar #-}+--     {-# INLINABLE sugar #-}+--     type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Domain a+--     type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =+--         ( Internal a+--         , Internal b+--         , Internal c+--         , Internal d+--         , Internal e+--         , Internal f+--         , Internal g+--         , Internal h+--         , Internal i+--         , Internal j+--         , Internal k+--         , Internal l+--         , Internal m+--         , Internal n+--         , Internal o+--         )+--+--     desugar = uncurryN $ sugarSymC Tup15+--     sugar a =+--         ( sugarSymC Sel1 a+--         , sugarSymC Sel2 a+--         , sugarSymC Sel3 a+--         , sugarSymC Sel4 a+--         , sugarSymC Sel5 a+--         , sugarSymC Sel6 a+--         , sugarSymC Sel7 a+--         , sugarSymC Sel8 a+--         , sugarSymC Sel9 a+--         , sugarSymC Sel10 a+--         , sugarSymC Sel11 a+--         , sugarSymC Sel12 a+--         , sugarSymC Sel13 a+--         , sugarSymC Sel14 a+--         , sugarSymC Sel15 a+--         )

@@ -21,15 +21,22 @@ -- (whichever appears first) in a domain. class TupleSat (dom :: * -> *) (p :: * -> Constraint) | dom -> p -instance TupleSat (Tuple :|| p) p-instance TupleSat ((Tuple :|| p) :+: dom2) p+instance TupleSat (Tuple :|| p) p where+  {-# SPECIALIZE instance TupleSat (Tuple :|| p) p #-}+instance TupleSat ((Tuple :|| p) :+: dom2) p where+  {-# SPECIALIZE instance TupleSat ((Tuple :|| p) :+: dom2) p #-} -instance TupleSat (Select :|| p) p-instance TupleSat ((Select :|| p) :+: dom2) p+instance TupleSat (Select :|| p) p where+  {-# SPECIALIZE instance TupleSat (Select :|| p) p #-}+instance TupleSat ((Select :|| p) :+: dom2) p where+  {-# SPECIALIZE instance TupleSat ((Select :|| p) :+: dom2) p #-} -instance TupleSat dom p => TupleSat (dom :| q) p-instance TupleSat dom p => TupleSat (dom :|| q) p-instance TupleSat dom2 p => TupleSat (dom1 :+: dom2) p+instance TupleSat dom p => TupleSat (dom :| q) p where+  {-# SPECIALIZE instance TupleSat dom p => TupleSat (dom :| q) p #-}+instance TupleSat dom p => TupleSat (dom :|| q) p where+  {-# SPECIALIZE instance TupleSat dom p => TupleSat (dom :|| q) p #-}+instance TupleSat dom2 p => TupleSat (dom1 :+: dom2) p where+  {-# SPECIALIZE instance TupleSat dom2 p => TupleSat (dom1 :+: dom2) p #-}   @@ -42,6 +49,7 @@        )     => sym sig -> c sugarSymC' s = sugarSymC (C' s :: (sym :|| p) sig)+{-# INLINABLE sugarSymC' #-}   @@ -61,6 +69,21 @@     ) =>       Syntactic (a,b)   where+    {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+                            , Syntactic b, Domain b ~ dom+                            , TupleSat dom p+                            , p (Internal a, Internal b)+                            , p (Internal a)+                            , p (Internal b)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            ) => Syntactic (a,b) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b) = Domain a     type Internal (a,b) =         ( Internal a@@ -96,6 +119,28 @@     ) =>       Syntactic (a,b,c)   where+    {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+                            , Syntactic b, Domain b ~ dom+                            , Syntactic c, Domain c ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            ) => Syntactic (a,b,c) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c) = Domain a     type Internal (a,b,c) =         ( Internal a@@ -138,6 +183,33 @@     ) =>       Syntactic (a,b,c,d)   where+    {-# SPECIALIZE instance ( 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+                                , Internal c+                                , Internal d+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            ) => Syntactic (a,b,c,d) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d) = Domain a     type Internal (a,b,c,d) =         ( Internal a@@ -187,6 +259,38 @@     ) =>       Syntactic (a,b,c,d,e)   where+    {-# SPECIALIZE instance ( 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+                                , Internal c+                                , Internal d+                                , Internal e+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            ) => Syntactic (a,b,c,d,e) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e) = Domain a     type Internal (a,b,c,d,e) =         ( Internal a@@ -243,6 +347,43 @@     ) =>       Syntactic (a,b,c,d,e,f)   where+    {-# SPECIALIZE instance ( 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+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            ) => Syntactic (a,b,c,d,e,f) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f) = Domain a     type Internal (a,b,c,d,e,f) =         ( Internal a@@ -306,6 +447,48 @@     ) =>       Syntactic (a,b,c,d,e,f,g)   where+    {-# SPECIALIZE instance ( 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+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            ) => Syntactic (a,b,c,d,e,f,g) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g) = Domain a     type Internal (a,b,c,d,e,f,g) =         ( Internal a@@ -377,6 +560,53 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            ) => Syntactic (a,b,c,d,e,f,g,h) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h) = Domain a     type Internal (a,b,c,d,e,f,g,h) =         ( Internal a@@ -455,6 +685,58 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i) = Domain a     type Internal (a,b,c,d,e,f,g,h,i) =         ( Internal a@@ -540,6 +822,63 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i,j)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , Syntactic j, Domain j ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , p (Internal j)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            , InjectC (Select :|| p) dom (Internal j)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i,j) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i,j) = Domain a     type Internal (a,b,c,d,e,f,g,h,i,j) =         ( Internal a@@ -632,6 +971,68 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i,j,k)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , Syntactic j, Domain j ~ dom+                            , Syntactic k, Domain k ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , p (Internal j)+                            , p (Internal k)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            , InjectC (Select :|| p) dom (Internal j)+                            , InjectC (Select :|| p) dom (Internal k)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i,j,k) = Domain a     type Internal (a,b,c,d,e,f,g,h,i,j,k) =         ( Internal a@@ -731,6 +1132,73 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , Syntactic j, Domain j ~ dom+                            , Syntactic k, Domain k ~ dom+                            , Syntactic l, Domain l ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , p (Internal j)+                            , p (Internal k)+                            , p (Internal l)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            , InjectC (Select :|| p) dom (Internal j)+                            , InjectC (Select :|| p) dom (Internal k)+                            , InjectC (Select :|| p) dom (Internal l)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i,j,k,l) = Domain a     type Internal (a,b,c,d,e,f,g,h,i,j,k,l) =         ( Internal a@@ -837,6 +1305,78 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , Syntactic j, Domain j ~ dom+                            , Syntactic k, Domain k ~ dom+                            , Syntactic l, Domain l ~ dom+                            , Syntactic m, Domain m ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                , Internal m+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , p (Internal j)+                            , p (Internal k)+                            , p (Internal l)+                            , p (Internal m)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                , Internal m+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            , InjectC (Select :|| p) dom (Internal j)+                            , InjectC (Select :|| p) dom (Internal k)+                            , InjectC (Select :|| p) dom (Internal l)+                            , InjectC (Select :|| p) dom (Internal m)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m) = Domain a     type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m) =         ( Internal a@@ -950,6 +1490,83 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , Syntactic j, Domain j ~ dom+                            , Syntactic k, Domain k ~ dom+                            , Syntactic l, Domain l ~ dom+                            , Syntactic m, Domain m ~ dom+                            , Syntactic n, Domain n ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                , Internal m+                                , Internal n+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , p (Internal j)+                            , p (Internal k)+                            , p (Internal l)+                            , p (Internal m)+                            , p (Internal n)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                , Internal m+                                , Internal n+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            , InjectC (Select :|| p) dom (Internal j)+                            , InjectC (Select :|| p) dom (Internal k)+                            , InjectC (Select :|| p) dom (Internal l)+                            , InjectC (Select :|| p) dom (Internal m)+                            , InjectC (Select :|| p) dom (Internal n)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Domain a     type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =         ( Internal a@@ -1070,6 +1687,88 @@     ) =>       Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)   where+    {-# SPECIALIZE instance ( 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+                            , Syntactic h, Domain h ~ dom+                            , Syntactic i, Domain i ~ dom+                            , Syntactic j, Domain j ~ dom+                            , Syntactic k, Domain k ~ dom+                            , Syntactic l, Domain l ~ dom+                            , Syntactic m, Domain m ~ dom+                            , Syntactic n, Domain n ~ dom+                            , Syntactic o, Domain o ~ dom+                            , TupleSat dom p+                            , p ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                , Internal m+                                , Internal n+                                , Internal o+                                )+                            , p (Internal a)+                            , p (Internal b)+                            , p (Internal c)+                            , p (Internal d)+                            , p (Internal e)+                            , p (Internal f)+                            , p (Internal g)+                            , p (Internal h)+                            , p (Internal i)+                            , p (Internal j)+                            , p (Internal k)+                            , p (Internal l)+                            , p (Internal m)+                            , p (Internal n)+                            , p (Internal o)+                            , InjectC (Tuple :|| p) dom+                                ( Internal a+                                , Internal b+                                , Internal c+                                , Internal d+                                , Internal e+                                , Internal f+                                , Internal g+                                , Internal h+                                , Internal i+                                , Internal j+                                , Internal k+                                , Internal l+                                , Internal m+                                , Internal n+                                , Internal o+                                )+                            , InjectC (Select :|| p) dom (Internal a)+                            , InjectC (Select :|| p) dom (Internal b)+                            , InjectC (Select :|| p) dom (Internal c)+                            , InjectC (Select :|| p) dom (Internal d)+                            , InjectC (Select :|| p) dom (Internal e)+                            , InjectC (Select :|| p) dom (Internal f)+                            , InjectC (Select :|| p) dom (Internal g)+                            , InjectC (Select :|| p) dom (Internal h)+                            , InjectC (Select :|| p) dom (Internal i)+                            , InjectC (Select :|| p) dom (Internal j)+                            , InjectC (Select :|| p) dom (Internal k)+                            , InjectC (Select :|| p) dom (Internal l)+                            , InjectC (Select :|| p) dom (Internal m)+                            , InjectC (Select :|| p) dom (Internal n)+                            , InjectC (Select :|| p) dom (Internal o)+                            ) => Syntactic (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) #-}+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}     type Domain (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Domain a     type Internal (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =         ( Internal a@@ -1107,4 +1806,3 @@         , sugarSymC' Sel14 a         , sugarSymC' Sel15 a         )-

@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}++module Language.Syntactic.Interpretation where++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import Language.Syntactic.Interpretation.Equality+import Language.Syntactic.Interpretation.Render+import Language.Syntactic.Interpretation.Evaluation++-- | Derive instances for 'Semantic' related classes+-- ('Equality', 'Render', 'StringTree', 'Eval')+semanticInstances :: Name -> DecsQ+semanticInstances n =+    [d|+        instance Equality $(typ) where+          {-# SPECIALIZE instance Equality $(typ) #-}+        instance Render $(typ) where+          {-# SPECIALIZE instance Render $(typ) #-}+        instance StringTree $(typ) where+          {-# SPECIALIZE instance StringTree $(typ) #-}+        instance Eval $(typ) where+          {-# SPECIALIZE instance Eval $(typ) #-}+    |]+  where+    typ = conT n

@@ -1,3 +1,5 @@+{-# LANGUAGE DefaultSignatures #-}+ module Language.Syntactic.Interpretation.Equality where  @@ -5,6 +7,7 @@ import Data.Hash  import Language.Syntactic.Syntax+import Language.Syntactic.Interpretation.Semantics   @@ -23,30 +26,65 @@     -- @equal a b  ==>  exprHash a == exprHash b@     exprHash :: expr a -> Hash +    default equal :: Semantic expr => expr a -> expr b -> Bool+    equal = equalDefault+    {-# INLINABLE equal #-} +    default exprHash :: Semantic expr => expr a -> Hash+    exprHash = exprHashDefault+    {-# INLINABLE exprHash #-}+++-- | Default implementation of 'equal'+equalDefault :: Semantic expr => expr a -> expr b -> Bool+equalDefault a b = equal (semantics a) (semantics b)+{-# INLINE equalDefault #-}++-- | Default implementation of 'exprHash'+exprHashDefault :: Semantic expr => expr a -> Hash+exprHashDefault = exprHash . semantics+{-# INLINE exprHashDefault #-}+++instance Equality Semantics+  where+    {-# SPECIALIZE instance Equality Semantics #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}+    equal (Sem a _) (Sem b _) = a==b+    exprHash (Sem name _)     = hash name+ instance Equality dom => Equality (AST dom)   where+    {-# SPECIALIZE instance (Equality dom) => Equality (AST dom) #-}+    {-# INLINABLE equal #-}     equal (Sym a)    (Sym b)    = equal a b     equal (s1 :$ a1) (s2 :$ a2) = equal s1 s2 && equal a1 a2     equal _ _                   = False +    {-# INLINABLE exprHash #-}     exprHash (Sym a)  = hashInt 0 `combine` exprHash a     exprHash (s :$ a) = hashInt 1 `combine` exprHash s `combine` exprHash a  instance Equality dom => Eq (AST dom a)   where+    {-# SPECIALIZE instance (Equality dom) => Eq (AST dom a) #-}+    {-# INLINABLE (==) #-}     (==) = equal  instance (Equality expr1, Equality expr2) => Equality (expr1 :+: expr2)   where+    {-# SPECIALIZE instance (Equality expr1, Equality expr2) => Equality (expr1 :+: expr2) #-}+    {-# INLINABLE equal #-}     equal (InjL a) (InjL b) = equal a b     equal (InjR a) (InjR b) = equal a b     equal _ _               = False +    {-# INLINABLE exprHash #-}     exprHash (InjL a) = hashInt 0 `combine` exprHash a     exprHash (InjR a) = hashInt 1 `combine` exprHash a  instance (Equality expr1, Equality expr2) => Eq ((expr1 :+: expr2) a)   where+    {-# SPECIALIZE instance (Equality expr1, Equality expr2) => Eq ((expr1 :+: expr2) a)#-}     (==) = equal-

@@ -1,28 +1,45 @@+{-# LANGUAGE DefaultSignatures #-}+ module Language.Syntactic.Interpretation.Evaluation where    import Language.Syntactic.Syntax+import Language.Syntactic.Interpretation.Semantics   --- | The denotation of a symbol with the given signature-type family   Denotation sig-type instance Denotation (Full a)    = a-type instance Denotation (a :-> sig) = a -> Denotation sig- class Eval expr   where     -- | Evaluation of expressions     evaluate :: expr a -> Denotation a +    default evaluate :: Semantic expr => expr a -> Denotation a+    evaluate = evaluateDefault+    {-# INLINABLE evaluate #-}++-- | Default implementation of 'evaluate'+evaluateDefault :: Semantic expr => expr a -> Denotation a+evaluateDefault = evaluate . semantics+{-# INLINE evaluateDefault #-}++instance Eval Semantics+  where+    {-# SPECIALIZE instance Eval Semantics #-}+    {-# INLINABLE evaluate #-}+    evaluate (Sem _ a) = a++ instance Eval dom => Eval (AST dom)   where+    {-# SPECIALIZE instance (Eval dom) => Eval (AST dom) #-}+    {-# INLINABLE evaluate #-}     evaluate (Sym a)  = evaluate a     evaluate (s :$ a) = evaluate s $ evaluate a  instance (Eval expr1, Eval expr2) => Eval (expr1 :+: expr2)   where+    {-# SPECIALIZE instance (Eval expr1, Eval expr2) => Eval (expr1 :+: expr2) #-}+    {-# INLINABLE evaluate #-}     evaluate (InjL a) = evaluate a     evaluate (InjR a) = evaluate a-

@@ -1,5 +1,9 @@+{-# LANGUAGE DefaultSignatures #-}+ module Language.Syntactic.Interpretation.Render     ( Render (..)+    , renderSymDefault+    , renderArgsDefault     , render     , StringTree (..)     , stringTree@@ -15,7 +19,7 @@ import Data.Tree.View  import Language.Syntactic.Syntax-+import Language.Syntactic.Interpretation.Semantics   -- | Render a symbol as concrete syntax. A complete instance must define at least the 'renderSym'@@ -29,9 +33,46 @@     renderArgs :: [String] -> dom sig -> String     renderArgs []   a = renderSym a     renderArgs args a = "(" ++ unwords (renderSym a : args) ++ ")"+    {-# INLINABLE renderArgs #-} +    default renderSym :: Semantic dom => dom sig -> String+    renderSym = renderSymDefault+    {-# INLINABLE renderSym #-}++-- | Default implementation of 'renderSym'+renderSymDefault :: Semantic expr => expr a -> String+renderSymDefault = renderSym . semantics+{-# INLINE renderSymDefault #-}++-- | Default implementation of 'renderArgs'+renderArgsDefault :: Semantic expr => [String] -> expr a -> String+renderArgsDefault args = renderArgs args . semantics+{-# INLINE renderArgsDefault #-}++instance Render Semantics+  where+    {-# SPECIALIZE instance Render Semantics #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}+    renderSym (Sem name _) = name+    renderArgs [] (Sem name _) = name+    renderArgs args (Sem name _)+        | isInfix   = "(" ++ unwords [a,op,b] ++ ")"+        | otherwise = "(" ++ unwords (name : args) ++ ")"+      where+        [a,b] = args+        op    = init $ tail name+        isInfix+          =  not (null name)+          && head name == '('+          && last name == ')'+          && length args == 2+ instance (Render expr1, Render expr2) => Render (expr1 :+: expr2)   where+    {-# SPECIALIZE instance (Render expr1, Render expr2) => Render (expr1 :+: expr2) #-}+    {-# INLINABLE renderSym #-}+    {-# INLINABLE renderArgs #-}     renderSym (InjL a) = renderSym a     renderSym (InjR a) = renderSym a     renderArgs args (InjL a) = renderArgs args a@@ -44,9 +85,11 @@     go :: [String] -> AST dom sig -> String     go args (Sym a)  = renderArgs args a     go args (s :$ a) = go (render a : args) s+{-# INLINABLE render #-}  instance Render dom => Show (ASTF dom a)   where+    {-# SPECIALIZE instance Render dom => Show (ASTF dom a) #-}     show = render  @@ -57,9 +100,12 @@     -- | Convert a symbol to a 'Tree' given a list of argument trees     stringTreeSym :: [Tree String] -> dom a -> Tree String     stringTreeSym args a = Node (renderSym a) args+    {-# INLINABLE stringTreeSym #-}  instance (StringTree dom1, StringTree dom2) => StringTree (dom1 :+: dom2)   where+    {-# SPECIALIZE instance (StringTree dom1, StringTree dom2) => StringTree (dom1 :+: dom2) #-}+    {-# INLINABLE stringTreeSym #-}     stringTreeSym args (InjL a) = stringTreeSym args a     stringTreeSym args (InjR a) = stringTreeSym args a @@ -69,16 +115,19 @@   where     go :: [Tree String] -> AST dom sig -> Tree String     go args (Sym a)  = stringTreeSym args a-    go args (s :$ a) = go (stringTree a : args) s+    go args (s :$ a) = go (go [] a : args) s+{-# INLINABLE stringTree #-}  -- | Show a syntax tree using ASCII art showAST :: StringTree dom => ASTF dom a -> String showAST = showTree . stringTree+{-# INLINABLE showAST #-}  -- | Print a syntax tree using ASCII art drawAST :: StringTree dom => ASTF dom a -> IO () drawAST = putStrLn . showAST+{-# INLINABLE drawAST #-}  writeHtmlAST :: StringTree sym => FilePath -> ASTF sym a -> IO () writeHtmlAST file = writeHtmlTree file . fmap (\n -> NodeInfo n "") . stringTree-+{-# INLINABLE writeHtmlAST #-}

@@ -6,18 +6,9 @@   -import Language.Haskell.TH-import Language.Haskell.TH.Quote--import Data.Hash- import Language.Syntactic.Syntax-import Language.Syntactic.Interpretation.Equality-import Language.Syntactic.Interpretation.Render-import Language.Syntactic.Interpretation.Evaluation  - -- | A representation of a syntactic construct as a 'String' and an evaluation -- function. It is not meant to be used as a syntactic symbol in an 'AST'. Its -- only purpose is to provide the default implementations of functions like@@ -31,73 +22,13 @@         -> Semantics a  --instance Equality Semantics-  where-    equal (Sem a _) (Sem b _) = a==b-    exprHash (Sem name _)     = hash name--instance Render Semantics-  where-    renderSym (Sem name _) = name-    renderArgs [] (Sem name _) = name-    renderArgs args (Sem name _)-        | isInfix   = "(" ++ unwords [a,op,b] ++ ")"-        | otherwise = "(" ++ unwords (name : args) ++ ")"-      where-        [a,b] = args-        op    = init $ tail name-        isInfix-          =  not (null name)-          && head name == '('-          && last name == ')'-          && length args == 2--instance Eval Semantics-  where-    evaluate (Sem _ a) = a-+-- | The denotation of a symbol with the given signature+type family   Denotation sig+type instance Denotation (Full a)    = a+type instance Denotation (a :-> sig) = a -> Denotation sig   -- | Class of expressions that can be treated as constructs class Semantic expr   where     semantics :: expr a -> Semantics a---- | Default implementation of 'equal'-equalDefault :: Semantic expr => expr a -> expr b -> Bool-equalDefault a b = equal (semantics a) (semantics b)---- | Default implementation of 'exprHash'-exprHashDefault :: Semantic expr => expr a -> Hash-exprHashDefault = exprHash . semantics---- | Default implementation of 'renderSym'-renderSymDefault :: Semantic expr => expr a -> String-renderSymDefault = renderSym . semantics---- | Default implementation of 'renderArgs'-renderArgsDefault :: Semantic expr => [String] -> expr a -> String-renderArgsDefault args = renderArgs args . semantics---- | Default implementation of 'evaluate'-evaluateDefault :: Semantic expr => expr a -> Denotation a-evaluateDefault = evaluate . semantics---- | Derive instances for 'Semantic' related classes--- ('Equality', 'Render', 'StringTree', 'Eval')-semanticInstances :: Name -> DecsQ-semanticInstances n =-    [d|-        instance Equality $(typ) where-          equal    = equalDefault-          exprHash = exprHashDefault-        instance Render $(typ) where-          renderSym  = renderSymDefault-          renderArgs = renderArgsDefault-        instance StringTree $(typ)-        instance Eval $(typ) where evaluate = evaluateDefault-    |]-  where-    typ = conT n-

@@ -44,15 +44,23 @@  instance AlphaEq dom dom dom env => AlphaEq Node Node dom env   where+    {-# SPECIALIZE instance AlphaEq dom dom dom env =>+          AlphaEq Node Node dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (Node n1) _ (Node n2) _ = return (n1 == n2)  instance Constrained Node   where+    {-# SPECIALIZE instance Constrained Node #-}+    {-# INLINABLE exprDict #-}     type Sat Node = Top     exprDict _ = Dict  instance Equality Node   where+    {-# SPECIALIZE instance Equality Node #-}+    {-# INLINABLE equal #-}+    {-# INLINABLE exprHash #-}     equal (Node n1) (Node n2) = error "can't compare nodes for equality"     exprHash (Node n)         = hash (nodeInteger n) @@ -64,6 +72,8 @@     Node :: NodeId -> Node (Full a)  instance Render Node where+  {-# SPECIALIZE instance Render Node #-}+  {-# INLINABLE renderSym #-}   renderSym (Node n) = showNode n  

@@ -45,14 +45,19 @@  instance Constrained Node   where+    {-# SPECIALIZE instance Constrained Node #-}+    {-# INLINABLE exprDict #-}     type Sat Node = Top     exprDict _ = Dict  instance Render Node   where+    {-# SPECIALIZE instance Render Node #-}+    {-# INLINABLE renderSym #-}     renderSym (Node a) = showNode a -instance StringTree Node+instance StringTree Node where+  {-# SPECIALIZE instance StringTree Node #-}   @@ -71,17 +76,26 @@  instance (p ~ Sat dom) => NodeEqEnv dom (EqEnv dom p)   where+    {-# SPECIALIZE instance (p ~ Sat dom) => NodeEqEnv dom (EqEnv dom p) #-}+    {-# INLINABLE prjNodeEqEnv #-}+    {-# INLINABLE modNodeEqEnv #-}     prjNodeEqEnv   = snd     modNodeEqEnv f = (id *** f)  instance VarEqEnv (EqEnv dom p)   where+    {-# SPECIALIZE instance VarEqEnv (EqEnv dom p) #-}+    {-# INLINABLE prjVarEqEnv #-}+    {-# INLINABLE modVarEqEnv #-}     prjVarEqEnv   = fst     modVarEqEnv f = (f *** id)  instance (AlphaEq dom dom dom env, NodeEqEnv dom env) =>     AlphaEq Node Node dom env   where+    {-# SPECIALIZE instance (AlphaEq dom dom dom env, NodeEqEnv dom env) =>+          AlphaEq Node Node dom env #-}+    {-# INLINABLE alphaEqSym #-}     alphaEqSym (Node n1) Nil (Node n2) Nil         | n1 == n2  = return True         | otherwise = do@@ -334,4 +348,3 @@   where     parts   = partitionNodes graph     reixTab = array (0,n-1) [(n,p) | (part,p) <- parts `zip` [0..], n <- part]-

@@ -23,14 +23,18 @@  instance Syntactic (ASTF dom a)   where+    {-# SPECIALIZE instance Syntactic (ASTF dom a) #-}     type Domain (ASTF dom a)   = dom     type Internal (ASTF dom a) = a     desugar = id     sugar   = id+    {-# INLINABLE desugar #-}+    {-# INLINABLE sugar #-}  -- | Syntactic type casting resugar :: (Syntactic a, Syntactic b, Domain a ~ Domain b, Internal a ~ Internal b) => a -> b resugar = sugar . desugar+{-# INLINABLE resugar #-}  -- | N-ary syntactic functions --@@ -60,8 +64,13 @@  instance (Syntactic a, Domain a ~ dom, ia ~ AST dom (Full (Internal a))) => SyntacticN a ia   where+    {-# SPECIALIZE instance ( Syntactic a, Domain a ~ dom+                            , ia ~ AST dom (Full (Internal a))+                            ) => SyntacticN a ia #-}     desugarN = desugar     sugarN   = sugar+    {-# INLINABLE desugarN #-}+    {-# INLINABLE sugarN #-}  instance     ( Syntactic a@@ -71,8 +80,15 @@     ) =>       SyntacticN (a -> b) (AST dom (Full ia) -> ib)   where+    {-# SPECIALIZE instance ( Syntactic a+                            , Domain a ~ dom+                            , ia ~ Internal a+                            , SyntacticN b ib+                            ) => SyntacticN (a -> b) (AST dom (Full ia) -> ib) #-}     desugarN f = desugarN . f . sugar     sugarN f   = sugarN . f . desugar+    {-# INLINABLE desugarN #-}+    {-# INLINABLE sugarN #-}   @@ -91,6 +107,7 @@ sugarSym :: (sym :<: AST dom, ApplySym sig b dom, SyntacticN c b) =>     sym sig -> c sugarSym = sugarN . appSym+{-# INLINABLE sugarSym #-}  -- | \"Sugared\" symbol application --@@ -111,4 +128,4 @@        )     => sym sig -> c sugarSymC = sugarN . appSymC-+{-# INLINABLE sugarSymC #-}

@@ -27,8 +27,9 @@     ) where  --import Control.Monad.Instances  -- Not needed in GHC 7.6+#if (__GLASGOW_HASKELL__ <= 704)+import Control.Monad.Instances ()+#endif import Data.Typeable  import Data.PolyProxy@@ -81,10 +82,14 @@  instance ApplySym (Full a) (ASTF dom a) dom   where+    {-# SPECIALIZE instance ApplySym (Full a) (ASTF dom a) dom #-}+    {-# INLINABLE appSym' #-}     appSym' = id  instance ApplySym sig f dom => ApplySym (a :-> sig) (ASTF dom a -> f) dom   where+    {-# SPECIALIZE instance ApplySym sig f dom => ApplySym (a :-> sig) (ASTF dom a -> f) dom #-}+    {-# INLINABLE appSym' #-}     appSym' sym a = appSym' (sym :$ a)  -- | The result type of a symbol with the given signature@@ -115,20 +120,28 @@  instance Project sub sup => Project sub (AST sup)   where+    {-# SPECIALIZE instance Project sub sup => Project sub (AST sup) #-}+    {-# INLINABLE prj #-}     prj (Sym a) = prj a     prj _       = Nothing  instance Project expr expr   where+    {-# SPECIALIZE instance Project expr expr #-}+    {-# INLINABLE prj #-}     prj = Just  instance Project expr1 (expr1 :+: expr2)   where+    {-# SPECIALIZE instance Project expr1 (expr1 :+: expr2) #-}+    {-# INLINABLE prj #-}     prj (InjL a) = Just a     prj _        = Nothing  instance Project expr1 expr3 => Project expr1 (expr2 :+: expr3)   where+    {-# SPECIALIZE instance Project expr1 expr3 => Project expr1 (expr2 :+: expr3) #-}+    {-# INLINABLE prj #-}     prj (InjR a) = prj a     prj _        = Nothing @@ -140,18 +153,26 @@  instance (sub :<: sup) => (sub :<: AST sup)   where+    {-# SPECIALIZE instance (sub :<: sup) => (sub :<: AST sup) #-}+    {-# INLINABLE inj #-}     inj = Sym . inj  instance (expr :<: expr)   where+    {-# SPECIALIZE instance (expr :<: expr) #-}+    {-# INLINABLE inj #-}     inj = id  instance (expr1 :<: (expr1 :+: expr2))   where+    {-# SPECIALIZE instance (expr1 :<: (expr1 :+: expr2)) #-}+    {-# INLINABLE inj #-}     inj = InjL  instance (expr1 :<: expr3) => (expr1 :<: (expr2 :+: expr3))   where+    {-# SPECIALIZE instance (expr1 :<: expr3) => (expr1 :<: (expr2 :+: expr3)) #-}+    {-# INLINABLE inj #-}     inj = InjR . inj  -- The reason for separating the `Project` and `(:<:)` classes is that there are@@ -167,6 +188,7 @@ -- >     -> (ASTF dom a -> ASTF dom b -> ... -> ASTF dom x) appSym :: (ApplySym sig f dom, sym :<: AST dom) => sym sig -> f appSym = appSym' . inj+{-# INLINABLE appSym #-}   @@ -176,9 +198,10 @@  -- | Constrain a symbol to a specific type symType :: P sym -> sym sig -> sym sig-symType _ = id+symType = const id+{-# INLINABLE symType #-}  -- | Projection to a specific symbol type prjP :: Project sub sup => P sub -> sup sig -> Maybe (sub sig)-prjP _ = prj-+prjP = const prj+{-# INLINABLE prjP #-}

@@ -11,6 +11,7 @@     , mapArgsA     , mapArgsM     , appArgs+    , foldrArgs     , listFold     , match     , query@@ -36,7 +37,7 @@ gmapT :: forall dom       .  (forall a . ASTF dom a -> ASTF dom a)       -> (forall a . ASTF dom a -> ASTF dom a)-gmapT f a = go a+gmapT f = go   where     go :: forall a . AST dom a -> AST dom a     go (s :$ a) = go s :$ f a@@ -48,7 +49,7 @@ gmapQ :: forall dom b       .  (forall a . ASTF dom a -> b)       -> (forall a . ASTF dom a -> [b])-gmapQ f a = go a+gmapQ f = go   where     go :: forall a . AST dom a -> [b]     go (s :$ a) = f a : go s@@ -79,21 +80,21 @@ -- | Map a function over an 'Args' list and collect the results in an ordinary -- list listArgs :: (forall a . c (Full a) -> b) -> Args c sig -> [b]-listArgs f Nil       = []+listArgs _ Nil       = [] listArgs f (a :* as) = f a : listArgs f as  -- | Map a function over an 'Args' list mapArgs     :: (forall a   . c1 (Full a) -> c2 (Full a))     -> (forall sig . Args c1 sig -> Args c2 sig)-mapArgs f Nil       = Nil+mapArgs _ Nil       = Nil mapArgs f (a :* as) = f a :* mapArgs f as  -- | Map an applicative function over an 'Args' list mapArgsA :: Applicative f     => (forall a   . c1 (Full a) -> f (c2 (Full a)))     -> (forall sig . Args c1 sig -> f (Args c2 sig))-mapArgsA f Nil       = pure Nil+mapArgsA _ Nil       = pure Nil mapArgsA f (a :* as) = (:*) <$> f a <*> mapArgsA f as  -- | Map a monadic function over an 'Args' list@@ -107,7 +108,7 @@     :: (forall a . c (Full a) -> b -> b)     -> b     -> (forall sig . Args c sig -> b)-foldrArgs f b Nil       = b+foldrArgs _ b Nil       = b foldrArgs f b (a :* as) = f a (foldrArgs f b as)  -- | Apply a (partially applied) symbol to a list of argument terms@@ -123,11 +124,12 @@        )     -> ASTF dom a     -> c (Full a)-match f a = go a Nil+match f = flip go Nil   where     go :: (a ~ DenResult sig) => AST dom sig -> Args (AST dom) sig -> c (Full a)     go (Sym a)  as = f a as     go (s :$ a) as = go s (a :* as)+{-# INLINABLE match #-}  query :: forall dom a c     .  ( forall sig . (a ~ DenResult sig) =>@@ -144,12 +146,14 @@     -> ASTF dom a     -> b simpleMatch f = getConst . match (\s -> Const . f s)+{-# INLINABLE simpleMatch #-}  -- | Fold an 'AST' using an 'Args' list to hold the results of sub-terms fold :: forall dom c     .  (forall sig . dom sig -> Args c sig -> c (Full (DenResult sig)))     -> (forall a   . ASTF dom a -> c (Full a)) fold f = match (\s -> f s . mapArgs (fold f))+{-# INLINABLE fold #-}  -- | Simplified version of 'fold' for situations where all intermediate results -- have the same type@@ -157,12 +161,14 @@     .  (forall sig . dom sig -> Args (Const b) sig -> b)     -> (forall a   . ASTF dom a                    -> b) simpleFold f = getConst . fold (\s -> Const . f s)+{-# INLINABLE simpleFold #-}  -- | Fold an 'AST' using a list to hold the results of sub-terms listFold :: forall dom b     .  (forall sig . dom sig -> [b] -> b)     -> (forall a   . ASTF dom a     -> b) listFold f = simpleFold (\s -> f s . listArgs getConst)+{-# INLINABLE listFold #-}  newtype WrapAST c dom sig = WrapAST { unWrapAST :: c (AST dom sig) }   -- Only used in the definition of 'matchTrans'@@ -176,6 +182,7 @@     -> ASTF dom a     -> c (ASTF dom' a) matchTrans f = unWrapAST . match (\s -> WrapAST . f s)+{-# INLINABLE matchTrans #-}  -- | Can be used to make an arbitrary type constructor indexed by @(`Full` a)@. -- This is useful as the type constructor parameter of 'Args'. That is, use@@ -194,4 +201,4 @@ -- | Convert an 'AST' to a 'Tree' toTree :: forall dom a b . (forall sig . dom sig -> b) -> ASTF dom a -> Tree b toTree f = listFold (Node . f)-+{-# INLINABLE toTree #-}

@@ -1,5 +1,5 @@ Name:           syntactic-Version:        1.15.1+Version:        1.16 Synopsis:       Generic abstract syntax, and utilities for embedded languages Description:    This library provides:                 .@@ -71,6 +71,7 @@     Language.Syntactic.Traversal     Language.Syntactic.Constraint     Language.Syntactic.Sugar+    Language.Syntactic.Interpretation     Language.Syntactic.Interpretation.Equality     Language.Syntactic.Interpretation.Evaluation     Language.Syntactic.Interpretation.Render@@ -144,6 +145,10 @@   main-is: NanoFeldsparEval.hs    other-modules:+    NanoFeldspar.Core+    NanoFeldspar.Extra+    NanoFeldspar.Test+    NanoFeldspar.Vector    default-language: Haskell2010 @@ -178,6 +183,10 @@   main-is: NanoFeldsparEval2.hs    other-modules:+    NanoFeldspar.Core+    NanoFeldspar.Extra+    NanoFeldspar.Test+    NanoFeldspar.Vector    default-language: Haskell2010 @@ -210,6 +219,12 @@   hs-source-dirs: tests examples    main-is: NanoFeldsparTree.hs++  other-modules:+    NanoFeldspar.Core+    NanoFeldspar.Extra+    NanoFeldspar.Test+    NanoFeldspar.Vector    default-language: Haskell2010