diff --git a/ADP/Fusion/GAPlike.hs b/ADP/Fusion/GAPlike.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/GAPlike.hs
@@ -0,0 +1,571 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | 
+--
+-- HINTS for writing your own (Non-) terminals:
+--
+-- - ALWAYS provide types for local functions of 'mkStream' and
+-- 'mkStreamInner'. Otherwise stream-fusion gets confused and doesn't optimize.
+-- (Observable in core by looking for 'Left', 'RIght' constructors and 'SPEC'
+-- constructors.
+
+module ADP.Fusion.GAPlike where
+
+import Control.Monad.Primitive
+import Data.Primitive.Types (Prim(..))
+import Data.Vector.Fusion.Stream.Size
+import GHC.Prim (Constraint)
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Unboxed as VU
+
+import Data.PrimitiveArray (PrimArrayOps(..), MPrimArrayOps(..))
+import "PrimitiveArray" Data.Array.Repa.Index
+import qualified Data.PrimitiveArray as PA
+import qualified Data.PrimitiveArray.Zero.Unboxed as ZU
+
+
+
+-- * The required type classes. Each class does its own thing.
+
+-- | The 'Build' class. Combines the arguments into a stack before they are
+-- turned into a stream.
+--
+--
+--
+-- To use, simply write "instance Build MyDataCtor" as we have sensible default
+-- instances.
+
+class Build x where
+  -- | The stack of arguments we are building.
+  type BuildStack x :: *
+  -- | The default is for the left-most element.
+  type BuildStack x = None :. x
+  -- | Given an element, create the stack.
+  build :: x -> BuildStack x
+  -- | Default for the left-most element.
+  default build :: (BuildStack x ~ (None :. x)) => x -> BuildStack x
+  build x = None :. x
+  {-# INLINE build #-}
+
+-- | The stream element. Creates a type-level recursive data type containing
+-- the extracted arguments.
+
+class StreamElement x where
+  -- | one element of the stream, recursively defined
+  data StreamElm x :: *
+  -- | top-most index of the stream -- typically int
+  type StreamTopIdx  x :: *
+  -- | complete, recursively defined argument of the stream
+  type StreamArg  x :: *
+  -- | Given a stream element, we extract the top-most idx
+  getTopIdx :: StreamElm x -> StreamTopIdx x
+  -- | extract the recursively defined argument in a well-defined way for 'apply'
+  getArg :: StreamElm x -> StreamArg x
+
+-- | Given the arguments, creates a stream of 'StreamElement's.
+
+class (StreamConstraint x) => MkStream m x where
+  type StreamConstraint x :: Constraint
+  type StreamConstraint x = ()
+  mkStream      :: (StreamConstraint x) => x -> (Int,Int) -> S.Stream m (StreamElm x)
+  mkStreamInner :: (StreamConstraint x) => x -> (Int,Int) -> S.Stream m (StreamElm x)
+
+
+
+-- * Terminates the stack of arguments
+
+-- | Very simple data ctor
+
+data None = None
+
+-- | For CORE-language, we have our own Arg-terminator
+
+data ArgZ = ArgZ
+
+instance StreamElement None where
+  data StreamElm None    = SeNone !Int
+  type StreamTopIdx None = Int
+  type StreamArg    None = ArgZ
+  getTopIdx (SeNone k) = k
+  getArg _ = ArgZ
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+instance (Monad m) => MkStream m None where
+  mkStream None (i,j) = S.unfoldr step i where
+    step k
+      | k<=j = Just (SeNone i, j+1)
+      | otherwise = Nothing
+    {-# INLINE step #-}
+  {-# INLINE mkStream #-}
+  mkStreamInner = mkStream
+  {-# INLINE mkStreamInner #-}
+
+
+
+-- * A single character terminal. Using unboxed vector to hold the input. Note
+-- that "character" means parsing a scalar, not that the 'Chr' parser only
+-- accepts "Char"s.
+
+data Chr e = Chr !(VU.Vector e)
+
+instance Build (Chr e)
+
+instance (StreamElement x) => StreamElement (x:.Chr e) where
+  data StreamElm (x:.Chr e) = SeChr !(StreamElm x) !Int !e
+  type StreamTopIdx (x:.Chr e) = Int
+  type StreamArg (x:.Chr e) = StreamArg x :. e
+  getTopIdx (SeChr _ k _) = k
+  getArg (SeChr x _ e) = getArg x :. e
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+-- TODO I think, we can rewrite both versions to use S.map instead of S.flatten.
+
+instance (Monad m, MkStream m x, StreamElement x, StreamTopIdx x ~ Int, VU.Unbox e) => MkStream m (x:.Chr e) where
+  mkStream (x:.Chr es) (i,j) = S.flatten mk step Unknown $ mkStream x (i,j-1) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x)
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.Chr e)))
+    step (x,k)
+      | k+1 == j = return $ S.Yield (SeChr x (k+1) (VU.unsafeIndex es k)) (x,j+1)
+      | otherwise = return S.Done
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStream #-}
+  mkStreamInner (x:.Chr es) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j-1) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x)
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.Chr e)))
+    step (x,k)
+      | k < j     = return $ S.Yield (SeChr x (k+1) (VU.unsafeIndex es k)) (x,j+1)
+      | otherwise = return $ S.Done
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStreamInner #-}
+
+
+
+-- * Empty and non-empty tables.
+--
+-- TODO This will probably become more funny with triangular tables ...
+
+-- | empty subwords allowed
+
+data E
+
+-- | only non-empty subwords
+
+data N
+
+class TransToN t where
+  type TransTo t :: *
+  transToN :: t -> TransTo t
+
+-- | Used by the instances below for index calculations.
+
+class TblType tt where
+  initDeltaIdx :: tt -> Int
+
+instance TblType E where
+  initDeltaIdx _ = 0
+  {-# INLINE initDeltaIdx #-}
+
+instance TblType N where
+  initDeltaIdx _ = 1
+  {-# INLINE initDeltaIdx #-}
+
+-- ** Immutable tables
+
+data Tbl c es = Tbl !es
+
+instance TransToN (Tbl c es) where
+  type TransTo (Tbl c es) = Tbl N es
+  transToN (Tbl es) = Tbl es
+  {-# INLINE transToN #-}
+
+instance Build (Tbl c es)
+
+instance (StreamElement x, PrimArrayOps arr DIM2 e, TblType c) => StreamElement (x:.Tbl c (arr DIM2 e)) where
+  data StreamElm    (x:.Tbl c (arr DIM2 e)) = SeTbl !(StreamElm x) !Int !e
+  type StreamTopIdx (x:.Tbl c (arr DIM2 e)) = Int
+  type StreamArg    (x:.Tbl c (arr DIM2 e)) = StreamArg x :. e
+  getTopIdx (SeTbl _ k _) = k
+  getArg    (SeTbl x _ e) = getArg x :. e
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+instance (Monad m, MkStream m x, StreamElement x, StreamTopIdx x ~ Int, PrimArrayOps arr DIM2 e, TblType c) => MkStream m (x:.Tbl c (arr DIM2 e)) where
+  -- | The outer stream function assumes that mkStreamInner generates a valid
+  -- stream that does not need to be checked. (This should always be true!).
+  -- The table entry to read is [k,j], as we supposedly are generating the
+  -- outermost stream. Even more "outermost" streams will have changed 'j'
+  -- beforehand. 'mkStream' should only ever be used if 'j' can be fixed.
+  mkStream (x:.Tbl t) (i,j) = S.map step $ mkStreamInner x (i,j - initDeltaIdx (undefined :: c)) where
+    step :: StreamElm x -> StreamElm (x:.Tbl c (arr DIM2 e))
+    step x = let k = getTopIdx x in SeTbl x j (t PA.! (Z:.k:.j))
+    {-# INLINE step #-}
+  -- | The inner stream will, in each step, check if the current subword [k,l]
+  -- (forall l>=k) is valid and terminate the stream once l>j.
+  mkStreamInner (x:.Tbl t) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x + initDeltaIdx (undefined :: c))
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.Tbl c (arr DIM2 e))))
+    step (x,l)
+      | l<=j      = return $ S.Yield (SeTbl x l (t PA.! (Z:.k:.l))) (x,l+1)
+      | otherwise = return $ S.Done
+      where k = getTopIdx x
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStream #-}
+  {-# INLINE mkStreamInner #-}
+
+-- ** Mutable tables in some monad.
+
+data MTbl c es = MTbl !es
+
+instance TransToN (MTbl c es) where
+  type TransTo (MTbl c es) = MTbl N es
+  transToN (MTbl es) = MTbl es
+  {-# INLINE transToN #-}
+
+mtblN :: es -> MTbl N es
+mtblN es = MTbl es
+{-# INLINE mtblN #-}
+
+mtblE :: es -> MTbl E es
+mtblE es = MTbl es
+{-# INLINE mtblE #-}
+
+instance Build (MTbl c es)
+
+instance (StreamElement x, MPrimArrayOps marr DIM2 e, TblType c) => StreamElement (x:.MTbl c (marr s DIM2 e)) where
+  data StreamElm    (x:.MTbl c (marr s DIM2 e)) = SeMTbl !(StreamElm x) !Int !e
+  type StreamTopIdx (x:.MTbl c (marr s DIM2 e)) = Int
+  type StreamArg    (x:.MTbl c (marr s DIM2 e)) = StreamArg x :. e
+  getTopIdx (SeMTbl _ k _) = k
+  getArg    (SeMTbl x _ e) = getArg x :. e
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+instance
+  ( Monad m
+  , PrimMonad m
+  , MkStream m x
+  , StreamElement x
+  , StreamTopIdx x ~ Int
+  , MPrimArrayOps marr DIM2 e
+  , TblType c
+  , s ~ PrimState m
+  ) => MkStream m (x:.MTbl c (marr s DIM2 e)) where
+  -- | The outer stream function assumes that mkStreamInner generates a valid
+  -- stream that does not need to be checked. (This should always be true!).
+  -- The table entry to read is [k,j], as we supposedly are generating the
+  -- outermost stream. Even more "outermost" streams will have changed 'j'
+  -- beforehand. 'mkStream' should only ever be used if 'j' can be fixed.
+  mkStream (x:.MTbl t) (i,j) = S.mapM step $ mkStreamInner x (i,j - initDeltaIdx (undefined :: c)) where
+    step :: StreamElm x -> m (StreamElm (x:.MTbl c (marr s DIM2 e)))
+    step x = let k = getTopIdx x in PA.readM t (Z:.k:.j) >>= \e -> return $ SeMTbl x j e
+    {-# INLINE step #-}
+  -- | The inner stream will, in each step, check if the current subword [k,l]
+  -- (forall l>=k) is valid and terminate the stream once l>j.
+  mkStreamInner (x:.MTbl t) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x + initDeltaIdx (undefined :: c))
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.MTbl c (marr s DIM2 e))))
+    step (x,l)
+      | l<=j      = readM t (Z:.k:.l) >>= \e -> return $ S.Yield (SeMTbl x l e) (x,l+1)
+      | otherwise = return $ S.Done
+      where k = getTopIdx x
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStream #-}
+  {-# INLINE mkStreamInner #-}
+
+-- ** Some convenience functions.
+
+tNtoE :: Tbl N x -> Tbl E x
+tNtoE (Tbl x) = Tbl x
+{-# INLINE tNtoE #-}
+
+tEtoN :: Tbl E x -> Tbl N x
+tEtoN (Tbl x) = Tbl x
+{-# INLINE tEtoN #-}
+
+
+
+-- * Parses an empty subword.
+
+-- | The empty subword. Can not be part of a more complex RHS for obvious
+-- reasons: "S -> E S" doesn't make sense. Used in some grammars as the base
+-- case.
+
+data Empty = Empty
+
+instance Build Empty where
+  type BuildStack Empty = Empty
+  build c = c
+  {-# INLINE build #-}
+
+instance StreamElement (Empty) where
+  data StreamElm    Empty = SeEmpty !Int
+  type StreamTopIdx Empty = Int
+  type StreamArg    Empty = ArgZ :. ()
+  getTopIdx (SeEmpty k) = k
+  getArg    (SeEmpty _) = ArgZ :. ()
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+instance (Monad m) => MkStream m (Empty) where
+  mkStream Empty (i,j) = S.unfoldr step i where
+    step k
+      | k==j      = Just (SeEmpty k, j+1)
+      | otherwise = Nothing
+    {-# INLINE step #-}
+  mkStreamInner = error "undefined for Empty"
+  {-# INLINE mkStream #-}
+  {-# INLINE mkStreamInner #-}
+
+
+
+-- * Parsing subwords with restriced size. Both min- and max-size are given
+-- when binding input.
+
+data RestrictedRegion e = RRegion !Int !Int !(VU.Vector e)
+
+instance Build (RestrictedRegion e)
+
+instance (StreamElement x) => StreamElement (x:.RestrictedRegion e) where
+  data StreamElm (x:.RestrictedRegion e) = SeResRegion !(StreamElm x) !Int (VU.Vector e)
+  type StreamTopIdx (x:.RestrictedRegion e) = Int
+  type StreamArg (x:.RestrictedRegion e) = StreamArg x :. (VU.Vector e)
+  getTopIdx (SeResRegion _ k _) = k
+  getArg (SeResRegion x _ e) = getArg x :. e
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+instance (Monad m, MkStream m x, StreamElement x, StreamTopIdx x ~ Int, VU.Unbox e) => MkStream m (x:.RestrictedRegion e) where
+  mkStream (x:.RRegion minR maxR xs) (i,j) = S.flatten mk step Unknown $ mkStream x (i,j-1) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x)
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.RestrictedRegion e)))
+    step (x,k)
+      | k+minR <= j && k+maxR >= j = return $ S.Yield (SeResRegion x k (VU.unsafeSlice k (max maxR (j-k)) xs)) (x,j+1)
+      | otherwise = return S.Done
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStream #-}
+  mkStreamInner (x:.RRegion minR maxR xs) (i,j) = S.flatten mk step Unknown $ mkStream x (i,j) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x + minR)
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.RestrictedRegion e)))
+    step (x,l)
+      | l<=j && (l-k)<=maxR = return $ S.Yield (SeResRegion x l (VU.unsafeSlice k (l-k) xs)) (x,j+1)
+      | otherwise           = return S.Done
+      where k = getTopIdx x
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStreamInner #-}
+
+
+
+-- * Backtracking tables.
+--
+-- Since we want the slow forward phase to be fast, in the backtracking phase,
+-- we need to keep track of additional things. The backtracking table 'BTtbl'
+-- requires the table and an additional backtracking function. You should use
+-- the same composed function as for the forward pahse creating the bound table
+-- in the first place.
+
+-- | The backtracking table 'BTtbl" captures a DP table and the function used
+-- to fill it.
+
+data BTtbl c t g = BTtbl t g
+
+instance TransToN (BTtbl c t g) where
+  type TransTo (BTtbl c t g) = BTtbl N t g
+  transToN (BTtbl t g) = BTtbl t g
+  {-# INLINE transToN #-}
+
+bttblN :: t -> g -> BTtbl N t g
+bttblN t g = BTtbl t g
+{-# INLINE bttblN #-}
+
+bttblE :: t -> g -> BTtbl E t g
+bttblE t g = BTtbl t g
+{-# INLINE bttblE #-}
+
+instance Build (BTtbl c t g)
+
+-- | The backtracking function, given our index pair, return a stream of
+-- backtracked results. (Return as in we are in a monad).
+--
+-- TODO Should this be "(Int,Int) -> m (SM.Stream Id b)" or are there cases
+-- where we'd like to have monadic effects on the "b"s?
+
+type BTfun m b = (Int,Int) -> m (S.Stream m b)
+
+instance (Monad m, StreamElement x, TblType c) => StreamElement (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) where
+  data StreamElm    (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) = SeBTtbl !(StreamElm x) !Int !e (m (S.Stream m b))
+  type StreamTopIdx (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) = Int
+  type StreamArg    (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) = StreamArg x :. (e, m (S.Stream m b))
+  getTopIdx (SeBTtbl _ k _ _) = k
+  getArg    (SeBTtbl x _ e g) = getArg x :. (e,g)
+  {-# INLINE getTopIdx #-}
+  {-# INLINE getArg #-}
+
+instance
+  ( Monad m
+  , MkStream m x
+  , StreamElement x
+  , VU.Unbox e
+  , StreamTopIdx x ~ Int
+  , TblType c
+  ) => MkStream m (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) where
+  mkStream (x:.BTtbl t g) (i,j) = S.map step $ mkStreamInner x (i,j - initDeltaIdx (undefined :: c)) where
+    step :: StreamElm x -> StreamElm (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b))
+    step x = let k = getTopIdx x in SeBTtbl x j (t PA.! (Z:.k:.j)) (g (k,j))
+    {-# INLINE step #-}
+  mkStreamInner (x:.BTtbl t g) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j) where
+    mk :: StreamElm x -> m (StreamElm x, Int)
+    mk x = return (x, getTopIdx x + initDeltaIdx (undefined :: c))
+    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b))))
+    step (x,l)
+      | l<=j      = return $ S.Yield (SeBTtbl x l (t PA.! (Z:.k:.l)) (g (k,l))) (x,l+1)
+      | otherwise = return $ S.Done
+      where k = getTopIdx x
+    {-# INLINE mk #-}
+    {-# INLINE step #-}
+  {-# INLINE mkStream #-}
+  {-# INLINE mkStreamInner #-}
+
+
+
+-- * Build complex stacks
+
+instance Build x => Build (x,y) where
+  type BuildStack (x,y) = BuildStack x :. y
+  build (x,y) = build x :. y
+  {-# INLINE build #-}
+
+
+
+-- * combinators
+
+infixl 8 <<<
+(<<<) f t ij = S.map (\s -> apply f $ getArg s) $ mkStream (build t) ij
+{-# INLINE (<<<) #-}
+
+infixl 7 |||
+(|||) xs ys ij = xs ij S.++ ys ij
+{-# INLINE (|||) #-}
+
+infixl 6 ...
+(...) s h ij = h $ s ij
+{-# INLINE (...) #-}
+
+infixl 6 ..@
+(..@) s h ij = h ij $ s ij
+{-# INLINE (..@) #-}
+
+infixl 9 ~~
+(~~) = (,)
+{-# INLINE (~~) #-}
+
+infixl 9 %
+(%) = (,)
+{-# INLINE (%) #-}
+
+
+
+-- * Apply function 'f' in '(<<<)'
+
+class Apply x where
+  type Fun x :: *
+  apply :: Fun x -> x
+
+instance Apply (ArgZ:.a -> res) where
+  type Fun (ArgZ:.a -> res) = a -> res
+  apply fun (ArgZ:.a) = fun a
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b -> res) where
+  type Fun (ArgZ:.a:.b -> res) = a->b -> res
+  apply fun (ArgZ:.a:.b) = fun a b
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c -> res) where
+  type Fun (ArgZ:.a:.b:.c -> res) = a->b->c -> res
+  apply fun (ArgZ:.a:.b:.c) = fun a b c
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d -> res) = a->b->c->d -> res
+  apply fun (ArgZ:.a:.b:.c:.d) = fun a b c d
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e -> res) = a->b->c->d->e -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e) = fun a b c d e
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f -> res) = a->b->c->d->e->f -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f) = fun a b c d e f
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g -> res) = a->b->c->d->e->f->g -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g) = fun a b c d e f g
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h -> res) = a->b->c->d->e->f->g->h -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h) = fun a b c d e f g h
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) = a->b->c->d->e->f->g->h->i -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i) = fun a b c d e f g h i
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) = a->b->c->d->e->f->g->h->i->j -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j) = fun a b c d e f g h i j
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) = a->b->c->d->e->f->g->h->i->j->k -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k) = fun a b c d e f g h i j k
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) = a->b->c->d->e->f->g->h->i->j->k->l -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l) = fun a b c d e f g h i j k l
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m) = fun a b c d e f g h i j k l m
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n) = fun a b c d e f g h i j k l m n
+  {-# INLINE apply #-}
+
+instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) where
+  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n->o -> res
+  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o) = fun a b c d e f g h i j k l m n o
+  {-# INLINE apply #-}
+
diff --git a/ADP/Fusion/GAPlike/Criterion.hs b/ADP/Fusion/GAPlike/Criterion.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/GAPlike/Criterion.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PackageImports #-}
+
+module ADP.Fusion.GAPlike.Criterion where
+
+import Control.Monad.ST
+import Criterion.Main
+import Data.Char
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Fusion.Stream as SP
+
+import Data.PrimitiveArray
+import Data.PrimitiveArray.Unboxed.VectorZero as UVZ
+import Data.PrimitiveArray.Unboxed.Zero as UZ
+import "PrimitiveArray" Data.Array.Repa.Index
+import "PrimitiveArray" Data.Array.Repa.Shape
+
+import ADP.Fusion.GAPlike
+import ADP.Fusion.GAPlike.DevelCommon
+
+
+
+criterionMain = defaultMain
+  [ bgroup "testTTT3"
+    [ bench "  10" (whnf (testTTT 0)   10)
+    , bench " 100" (whnf (testTTT 0)  100)
+    , bench "1000" (whnf (testTTT 0) 1000)
+    ]
+  , bgroup "testTTTT4"
+    [ bench "  10" (whnf (testTTTT 0)   10)
+    , bench " 100" (whnf (testTTTT 0)  100)
+    , bench "1000" (whnf (testTTTT 0) 1000)
+    ]
+  , bgroup "testTTTT4ga"
+    [ bench "  10" (whnf (testTTTTga 0)   10)
+    , bench " 100" (whnf (testTTTTga 0)  100)
+    , bench "1000" (whnf (testTTTTga 0) 1000)
+    ]
+  , bgroup "testTTTT4gaPA"
+    [ bench "  10" (whnf (testTTTTgaPA 0)   10)
+    , bench " 100" (whnf (testTTTTgaPA 0)  100)
+    , bench "1000" (whnf (testTTTTgaPA 0) 1000)
+    ]
+  , bgroup "testTTTT4gaImmu"
+    [ bench "  10" (whnf (testTTTTgaImmu 0)   10)
+    , bench " 100" (whnf (testTTTTgaImmu 0)  100)
+    , bench "1000" (whnf (testTTTTgaImmu 0) 1000)
+    ]
+  , bgroup "testTTTT4gaImmuPA"
+    [ bench "  10" (whnf (testTTTTgaImmuPA 0)   10)
+    , bench " 100" (whnf (testTTTTgaImmuPA 0)  100)
+    , bench "1000" (whnf (testTTTTgaImmuPA 0) 1000)
+    ]
+  ]
+
+
+
+-- * Criterion tests
+
+testC :: Int -> Int -> Int
+testC i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    let c = Chr dvu
+    (gord1 <<< c ... ghsum) (i,j)
+{-# NOINLINE testC #-}
+
+gTestC (ord1,hsum) c =
+  (ord1 <<< c ... hsum)
+
+aTestC = (ord1,hsum) where
+  ord1 = gord1
+  hsum = ghsum
+
+testCC :: Int -> Int -> Int
+testCC i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    let c = Chr dvu
+    let d = Chr dvu
+    (gord2 <<< c % d ... ghsum) (i,j)
+{-# NOINLINE testCC #-}
+
+type TBL s = Tbl N (UVZ.MArr0 s DIM2 Int)
+
+testT :: Int -> Int -> Int
+testT i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) 1 []
+    (id <<< tbl ... ghsum) (i,j)
+{-# NOINLINE testT #-}
+
+testTT :: Int -> Int -> Int
+testTT i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) 1 []
+    (gplus2 <<< tbl % tbl ... ghsum) (i,j)
+  {-# INLINE doST #-}
+{-# NOINLINE testTT #-}
+
+testTTT :: Int -> Int -> Int
+testTTT i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) 1 []
+    (gplus3 <<< tbl % tbl % tbl ... ghsum) (i,j)
+{-# NOINLINE testTTT #-}
+
+testTTTT :: Int -> Int -> Int
+testTTTT i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) (1::Int) []
+    (gplus4 <<< tbl % tbl % tbl % tbl ... ghsum) (i,j)
+  {-# INLINE doST #-}
+{-# NOINLINE testTTTT #-}
+
+testTTTTga :: Int -> Int -> Int
+testTTTTga i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) (1::Int) []
+    gTTTga aTTTga tbl (i,j)
+  {-# INLINE doST #-}
+{-# NOINLINE testTTTTga #-}
+
+testTTTTgaPA :: Int -> Int -> Int
+testTTTTgaPA i j = runST doST where
+  doST :: ST s Int
+  doST = do
+    tbl :: Tbl N (UZ.MArr0 s DIM2 Int) <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) (1::Int) []
+    gTTTga aTTTga tbl (i,j)
+  {-# INLINE doST #-}
+{-# NOINLINE testTTTTgaPA #-}
+
+testTTTTgaImmu :: Int -> Int -> Int
+testTTTTgaImmu i j =
+    let tbl = (Tbl $ fromAssocs (Z:.0:.0) (Z:.j:.j) 1 []) :: Tbl N (UVZ.Arr0 DIM2 Int) 
+    in tbl `seq` gTTTga aTTTgaImmu tbl (i,j)
+{-# NOINLINE testTTTTgaImmu #-}
+
+testTTTTgaImmuPA :: Int -> Int -> Int
+testTTTTgaImmuPA i j =
+    let tbl = (Tbl $ fromAssocs (Z:.0:.0) (Z:.j:.j) 1 []) :: Tbl N (UZ.Arr0 DIM2 Int) 
+    in tbl `seq` gTTTga aTTTgaImmu tbl (i,j)
+{-# NOINLINE testTTTTgaImmuPA #-}
+
+gTTTga (plus4, hsum) tbl =
+  (plus4 <<< tbl % tbl % tbl % tbl ... hsum)
+{-# INLINE gTTTga #-}
+
+aTTTga = (plus4, hsum) where
+  plus4 = gplus4
+  hsum = ghsum
+
+aTTTgaImmu = (plus4, hsum) where
+  plus4 = gplus4
+  hsum = gihsum
+{-# INLINE aTTTgaImmu #-}
+
+gord1 a = ord a
+
+gord2 a b = ord a + ord b
+
+gord3 a b c = ord a + ord b + ord c
+
+gplus2 a b = a+b
+
+gplus3 a b c = a+b+c
+
+gplus4 a b c d = a+b+c+d
+
+ghsum :: S.Stream (ST s) Int -> ST s Int
+ghsum = S.foldl' (+) 0
+
+gihsum :: SP.Stream Int -> Int
+gihsum = SP.foldl' (+) 0
diff --git a/ADP/Fusion/GAPlike/DevelCommon.hs b/ADP/Fusion/GAPlike/DevelCommon.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/GAPlike/DevelCommon.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE PackageImports #-}
+
+module ADP.Fusion.GAPlike.DevelCommon where
+
+import qualified Data.PrimitiveArray as PA
+import qualified Data.Vector.Unboxed as VU
+
+import Data.PrimitiveArray.Unboxed.VectorZero as UVZ
+import Data.PrimitiveArray.Unboxed.Zero as UZ
+import "PrimitiveArray" Data.Array.Repa.Index
+import "PrimitiveArray" Data.Array.Repa.Shape
+
+
+
+dvu = VU.fromList $ concat $ replicate 10 ['a'..'z']
+{-# NOINLINE dvu #-}
+
+type PAT = UVZ.Arr0 DIM2 Int
+pat :: PAT
+pat = PA.fromAssocs (Z:.0:.0) (Z:.1000:.1000) 0 [(Z:.i:.j,j-i) | i <-[0..1000], j<-[i..1000] ]
+{-# NOINLINE pat #-}
+
diff --git a/ADP/Fusion/GAPlike/QuickCheck.hs b/ADP/Fusion/GAPlike/QuickCheck.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/GAPlike/QuickCheck.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module ADP.Fusion.GAPlike.QuickCheck where
+
+import Test.QuickCheck
+import Test.QuickCheck.All
+import qualified Data.Vector.Fusion.Stream as SP
+import qualified Data.Vector.Unboxed as VU
+
+import "PrimitiveArray" Data.Array.Repa.Index
+import "PrimitiveArray" Data.Array.Repa.Shape
+import Data.PrimitiveArray
+
+import ADP.Fusion.QuickCheck.Arbitrary
+import ADP.Fusion.GAPlike.DevelCommon
+import ADP.Fusion.GAPlike
+
+
+
+-- * QuickCheck
+
+checkC_fusion (i,j) = id <<< Chr dvu ... SP.toList $ (i,j)
+checkC_list   (i,j) = [dvu VU.! i | i+1==j]
+prop_checkC = checkC_fusion === checkC_list
+
+checkCC_fusion (i,j) = (,) <<< Chr dvu % Chr dvu ... SP.toList $ (i,j)
+checkCC_list   (i,j) = [ (dvu VU.! i, dvu VU.! (i+1)) | i+2==j ]
+prop_checkCC = checkCC_fusion === checkCC_list
+
+checkP_fusion (i,j) = id <<< (Tbl pat :: Tbl E PAT)  ... SP.toList $ (i,j)
+checkP_list   (i,j) = [ (pat!(Z:.i:.j)) | i<=j ]
+prop_checkP = checkP_fusion === checkP_list
+
+checkPP_fusion (i,j) = let tbl = Tbl pat :: Tbl E PAT
+                       in  (,) <<< tbl % tbl ... SP.toList $ (i,j)
+checkPP_list   (i,j) = [ (pat!(Z:.i:.k), pat!(Z:.k:.j)) | k<-[i..j] ]
+prop_checkPP = checkPP_fusion === checkPP_list
+
+checkCPC_fusion (i,j) = let tbl = Tbl pat :: Tbl E PAT
+                        in  (,,) <<< Chr dvu % tbl % Chr dvu ... SP.toList $ (i,j)
+checkCPC_list (i,j) = [ (dvu VU.! i, pat!(Z:.i+1:.j-1), dvu VU.! (j-1)) | i+2<=j ]
+prop_checkCPC = checkCPC_fusion === checkCPC_list
+
+checkNN_fusion (i,j) = let tbl = Tbl pat :: Tbl N PAT
+                       in  (,) <<< tbl % tbl ... SP.toList $ (i,j)
+checkNN_list   (i,j) = [ (pat!(Z:.i:.k), pat!(Z:.k:.j)) | k<-[i+1..j-1] ]
+prop_checkNN = checkNN_fusion === checkNN_list
+
+
+
+options = stdArgs {maxSuccess = 1000}
+
+customCheck = quickCheckWithResult options
+
+allProps = $forAllProperties customCheck
+
diff --git a/ADP/Fusion/Monadic/Internal.hs b/ADP/Fusion/Monadic/Internal.hs
--- a/ADP/Fusion/Monadic/Internal.hs
+++ b/ADP/Fusion/Monadic/Internal.hs
@@ -39,7 +39,7 @@
 import Text.Printf
 
 import qualified Data.PrimitiveArray as PA
-import qualified Data.PrimitiveArray.Unboxed.Zero as UZ
+import qualified Data.PrimitiveArray.Zero.Unboxed as ZU
 import qualified Data.PrimitiveArray.Zero as Z
 
 
@@ -62,8 +62,8 @@
 mkStreamGen(DIM2 -> ScalarM elm)
 mkStreamGen(DIM2 -> Vect elm)
 mkStreamGen(DIM2 -> VectM elm)
-mkStreamGen(UZ.MArr0 s sh elm)
-mkStreamGen(UZ.Arr0 sh elm)
+mkStreamGen(ZU.MArr0 s sh elm)
+mkStreamGen(ZU.Arr0 sh elm)
 
 mkStreamGen(Z.MArr0 s sh (VU.Vector elm))
 mkStreamGen(Z.Arr0 sh (VU.Vector elm))
@@ -114,8 +114,8 @@
 mkPreStreamGen(DIM2 -> ScalarM elm)
 mkPreStreamGen(DIM2 -> Vect elm)
 mkPreStreamGen(DIM2 -> VectM elm)
-mkPreStreamGen(UZ.MArr0 s sh elm)
-mkPreStreamGen(UZ.Arr0 sh elm)
+mkPreStreamGen(ZU.MArr0 s sh elm)
+mkPreStreamGen(ZU.Arr0 sh elm)
 
 mkPreStreamGen(Z.MArr0 s sh (VU.Vector elm))
 mkPreStreamGen(Z.Arr0 sh (VU.Vector elm))
@@ -178,12 +178,12 @@
 
 instance
   ( PrimMonad m
-  , Prim elm
+  , VU.Unbox elm
   , PrimState m ~ s
   , DIM2 ~ sh
-  ) => ExtractValue m (UZ.MArr0 s sh elm) where
-  type Asor (UZ.MArr0 s sh elm) = Z
-  type Elem (UZ.MArr0 s sh elm) = elm
+  ) => ExtractValue m (ZU.MArr0 s sh elm) where
+  type Asor (ZU.MArr0 s sh elm) = Z
+  type Elem (ZU.MArr0 s sh elm) = elm
   extractValue cnt ij z = do
     x <- PA.readM cnt ij
     x `seq` return x
@@ -203,11 +203,11 @@
 
 instance
   ( Monad m
-  , Prim elm
+  , VU.Unbox elm
   , DIM2 ~ sh
-  ) => ExtractValue m (UZ.Arr0 sh elm) where
-  type Asor (UZ.Arr0 sh elm) = Z
-  type Elem (UZ.Arr0 sh elm) = elm
+  ) => ExtractValue m (ZU.Arr0 sh elm) where
+  type Asor (ZU.Arr0 sh elm) = Z
+  type Elem (ZU.Arr0 sh elm) = elm
   extractValue cnt ij z = do
     let x = PA.index cnt ij
     x `seq` return x
diff --git a/ADPfusion.cabal b/ADPfusion.cabal
--- a/ADPfusion.cabal
+++ b/ADPfusion.cabal
@@ -1,5 +1,5 @@
 name:           ADPfusion
-version:        0.0.1.2
+version:        0.1.0.0
 author:         Christian Hoener zu Siederdissen, 2011-2012
 copyright:      Christian Hoener zu Siederdissen, 2011-2012
 homepage:       http://www.tbi.univie.ac.at/~choener/adpfusion
@@ -31,10 +31,27 @@
                 tables can be strict, removing indirections present in lazy,
                 boxed tables.
                 .
-                As an example, even rather complex ADP code tends to be
-                completely optimized to loops that use only unboxed variables
-                (Int# and others, indexIntArray# and others).
+                As a simple benchmark, consider the Nussinov78 algorithm which
+                translates to three nested for loops (for C). In the figure,
+                four different approaches are compared using inputs with size
+                100 characters to 1000 characters in increments of 100
+                characters. "C" is an implementation ("./C/" directory) in "C"
+                using "gcc -O3". "ADP" is the original ADP approach (see link
+                above), while "GAPC" uses the "GAP" language
+                (<http://gapc.eu/>).
+                <<https://github.com/choener/ADPfusion/gaplike-performance.png>>
                 .
+                Please note that actual performance will depend much on table
+                layout and data structures accessed during calculations, but in
+                general performance is very good: close to C and better than
+                other high-level approaches (that I know of).
+                .
+                .
+                .
+                Even complex ADP code tends to be completely optimized to loops
+                that use only unboxed variables (Int# and others,
+                indexIntArray# and others).
+                .
                 Completely novel (compared to ADP), is the idea of allowing
                 efficient monadic combinators. This facilitates writing code
                 that performs backtracking, or samples structures
@@ -44,6 +61,29 @@
                 multiple recent improvements in GHC. This is particularly true
                 for the monadic interface.
                 .
+                .
+                .
+                Newley added are the ADP.Fusion.GAPlike modules. These allow
+                for writing grammars with only one (non)-terminal combinator.
+                The logic for index manipulation is now moved into data types
+                for terminals and non-terminals.
+                .
+                While this change leads to slightly more complicated instances
+                for each new terminal or non-terminal, the overall code
+                complexity is significantly lower. In addition, Constraint
+                Kinds make complex interactions between (non)-terminals
+                possible, while still managing to produce high-performance
+                code.
+                .
+                The final goal would, of course, be to have no inter-terminal
+                combinators anymore.
+                .
+                * GHC 7.6, LLVM, and -fnew-codegen recommended: gives a speedup
+                  of x2 for GAPcriterion
+                .
+                .
+                .
+                .
                 Long term goals: Outer indices with more than two dimensions,
                 specialized table design, a combinator library, a library for
                 computational biology.
@@ -54,11 +94,28 @@
                 <http://hackage.haskell.org/package/Nussinov78> and
                 <http://hackage.haskell.org/package/RNAFold>.
                 .
+                Changes since 0.0.1.2:
+                .
+                * require GHC 7.6
+                .
+                * ADP.Fusion.GAPlike module for (almost) combinator-less grammars
+                .
+                * ConstraintKinds for constrained parsers in GAPlike.
+                .
+                .
+                .
                 Changes since 0.0.1.0:
                 .
                 * compatibility with GHC 7.4
                 .
                 * note: still using fundeps & and TFs together. The TF-only version does not optimize as well (I know why but not yet how to fix it)
+                .
+                .
+                .
+                Using the new code generator?
+                .
+                The new code generator is not official yet, but I recommend trying it out:
+                <<https://github.com/choener/ADPfusion/gaplike-newcodegen.png>>
 
 
 
@@ -68,21 +125,47 @@
   ADP/Fusion/QuickCheck/Arbitrary.hs
 
 
+Flag devel
+  description: build criterion benchmarks and pull in QuickCheck
+  default: False
 
+
 library
   build-depends:
     base >= 4 && < 5,
-    primitive      == 0.4.*   ,
-    vector         == 0.9.*   ,
-    PrimitiveArray == 0.2.2.0
+    ghc-prim,
+    primitive      == 0.5.*   ,
+    vector         == 0.10.*  ,
+    PrimitiveArray == 0.4.*
   exposed-modules:
     ADP.Fusion
     ADP.Fusion.Monadic
     ADP.Fusion.Monadic.Internal
+    ADP.Fusion.GAPlike
 
   ghc-options:
     -O2 -funbox-strict-fields
 
+executable GAPcriterion
+  buildable:
+    False
+  if flag(devel)
+    buildable:
+      True
+    build-depends:
+      criterion  == 0.6.* ,
+      QuickCheck == 2.5
+  other-modules:
+    ADP.Fusion.GAPlike.DevelCommon
+    ADP.Fusion.GAPlike.Criterion
+    ADP.Fusion.GAPlike.QuickCheck
+  main-is:
+    Tests/GAPcriterion.hs
+  ghc-options:
+    -fllvm -O2 -funbox-strict-fields -optlo-O3 -optlo-std-compile-opts
+  if impl(GHC > 7.4)
+    ghc-options:
+      -fnew-codegen
 
 
 source-repository head
diff --git a/Tests/GAPcriterion.hs b/Tests/GAPcriterion.hs
new file mode 100644
--- /dev/null
+++ b/Tests/GAPcriterion.hs
@@ -0,0 +1,9 @@
+
+module Main where
+
+import ADP.Fusion.GAPlike2.Criterion
+
+
+
+main = criterionMain
+