normalise paths and fix self export handling

9 files changed, 929 insertions, 0 deletions

diff --git a/testdata/later.ignore/DemoUtils.lc b/testdata/later.ignore/DemoUtils.lc
new file mode 100644
index 00000000..bcde1467
--- /dev/null
+++ b/testdata/later.ignore/DemoUtils.lc
@@ -0,0 +1,48 @@
+module DemoUtils
+    ( module DemoUtils
+    , module Prelude
+    ) where
+
+time = Uniform "Time" :: Float
+
+--v3v4 = PrimV3FToV4F
+
+-- example combinators
+image color = FrameBuffer (DepthImage @1 1000.0, ColorImage @1 color)
+
+triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+colorFragmentCtx = accumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+
+rasterizeWith = Rasterize
+triangles = triangleRasterCtx
+
+cubeVertexStream = fetch "stream4" Triangle (Attribute "position4" :: Vec 4 Float)
+mapFragments s fs bg = accumulate colorFragmentCtx PassAll (FragmentShaderRastDepth $ \a -> fs a) s bg
+transform s f =  Transform (\v -> VertexOut (f v) 1.0 () (Smooth v)) s
+
+cube v f bg = (cubeVertexStream         -- cube vertices
+    `transform`    v    -- scale them
+     &             rasterizeWith triangles  -- rasterize
+    `mapFragments` f) bg
+
+
+
+withCoords f a = f (a%x) (a%y)
+
+fragmentTest f =   quadVertexStream
+    `transformQ`    id
+     &             rasterizeWith triangles
+    `mapFragmentsQ` withCoords f
+  where
+    clearQ = FrameBuffer $ ColorImage @1 $ V4 1 0 0 0.5
+
+    colorFragmentCtxQ = accumulationContext (ColorOp NoBlending (V4 True True True True))
+    mapFragmentsQ s fs = accumulate colorFragmentCtxQ PassAll (FragmentShader $ \a -> fs a) s clearQ
+
+    quadVertexStream = fetch "quad" Triangle (Attribute "position" :: Vec 2 Float)
+
+    tr :: Vec 2 Float -> Vec 4 Float
+    tr a = V4 a%x a%y 1 1
+
+    transformQ s f =  Transform (\v -> VertexOut (tr $ f v ) 1 () (Smooth v)) s
+    
diff --git a/testdata/later.ignore/DepPrelude.lc b/testdata/later.ignore/DepPrelude.lc
new file mode 100644
index 00000000..facb4b7b
--- /dev/null
+++ b/testdata/later.ignore/DepPrelude.lc
@@ -0,0 +1,568 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoTypeNamespace #-}
+{-# LANGUAGE NoConstructorNamespace #-}
+-- contains the lambda-pi prelude (http://www.andres-loeh.de/LambdaPi/prelude.lp) adatpted to the lc compiler prototype
+builtintycons
+    Int :: Type
+
+data Unit = TT
+
+builtins
+    cstr :: Type -> Type -> Type      -- TODO
+--  cstr :: forall (a :: Type) (b :: Type) -> a -> b -> Type
+--    reflCstr :: forall (a :: Type) -> cstr a a
+    coe :: forall (a :: Type) (b :: Type) -> cstr a b -> a -> b
+
+tyType (a :: Type) = a
+id a = a
+const x y = x
+const' :: forall a b . a -> b -> a
+const' x y = x
+const'' :: forall b a . a -> b -> a
+const'' x y = x
+id' a = id a
+id'' = id id
+app f x = f x
+comp f g x = f (g x)
+app2 f x y = f x y
+flip f x y = f y x
+scomb a b c = a c (b c)
+
+builtins fix :: forall a . (a -> a) -> a
+builtins f_i_x :: forall a . (a -> a) -> a
+
+data Sigma a (b :: a -> Type) = Pair (x :: a) (b x)
+
+-- undefined = undefined
+builtins
+    undefined :: forall (a :: Type) . a
+
+data Empty
+--data T2 a b = T2C a b
+builtins
+    T2 :: Type -> Type -> Type
+    T2C :: Unit -> Unit -> Unit
+
+-- identity function, used for type annotations internally
+typeAnn = \(A :: Type) (a :: A) -> a
+
+data Bool = False | True
+
+otherwise = True
+
+if' b t f = case b of True -> t
+                      False -> f
+
+-- higher-order unification test
+htest b = if' b id
+htest' b = if' b id :: (forall a . a -> a) -> _
+htest'' b = if' b id :: _ -> (forall a . a -> a)
+
+data List a = Nil' | Cons' a (List a)
+
+builtins
+    primAdd, primSub, primMod
+              :: Int -> Int -> Int
+    primSqrt  :: Int -> Int
+    primIntEq, primIntLess
+              :: Int -> Int -> Bool
+
+dcomp
+    (X :: Type)
+    (Y :: X -> Type)
+    (Z :: forall (x :: X) -> Y x -> Type)
+    (f :: forall x (y :: Y x) -> Z x y)
+    (g :: forall (x :: X) -> Y x)
+    (x :: X)
+        = f x (g x)
+dcomp'
+    @X
+    @(Y :: X -> _)
+    @(Z :: forall x -> Y x -> _)
+    (f :: forall x . forall y -> Z x y)
+    (g :: forall x -> Y x)
+    x
+        = f (g x)
+dcomp''
+    :: forall
+        X
+        (Y :: X -> _)
+        (Z :: forall x -> Y x -> _)
+    . forall
+        (f :: forall x . forall y -> Z x y)
+        (g :: forall x -> Y x) x
+    -> Z x (g x)
+dcomp'' f g x = f (g x)
+
+listMap f xs =
+    | Nil'       <- xs -> Nil'
+    | Cons' x xs <- xs -> Cons' (f x) (listMap f xs)
+foldr c n xs = case xs of
+      Nil' -> n
+      Cons' x xs -> c x (foldr c n xs)
+
+concat xs ys = foldr Cons' ys xs
+
+from n = Cons' n (from (primAdd #1 n))
+head x = case x of
+             Nil' -> undefined
+             Cons' x _ -> x
+tail    = listCase (\_ -> _) undefined (\_ xs -> xs)
+nth n xs =
+    | primIntEq #0 n -> head xs
+    | otherwise      -> nth (primSub n #1) (tail xs)
+filter p xs =
+    | Nil'       <- xs -> Nil'
+    | Cons' x xs <- xs ->
+        | p x       -> Cons' x (filter p xs)
+        | otherwise -> filter p xs
+takeWhile p xs =
+    | Nil'       <- xs -> Nil'
+    | Cons' x xs <- xs ->
+        | p x -> Cons' x (takeWhile p xs)
+        | otherwise -> Nil'
+and' a b = boolCase (\_ -> _) False b a
+or'  a b = boolCase (\_ -> _) b True a
+not'    = boolCase (\_ -> _) True False
+all p = listCase (\_ -> _) True (\x xs -> and' (p x) (all p xs))
+intLEq n m = or' (primIntLess n m) (primIntEq n m)
+{- todo
+primes =
+   Cons' #2 (Cons' #3 (filter (\x -> all (\i -> not' (primIntEq #0 (primMod x i))) (
+        takeWhile (\p -> (\m -> or' (primIntLess p m) (primIntEq p m)) (primSqrt x)) primes
+    )) (from #5)))
+
+nthPrimes n = nth n primes
+main = nthPrimes #10
+-}
+data Nat = Zero | Succ Nat
+data Fin :: Nat -> Type where
+    FZero :: Fin (Succ n)
+    FSucc :: Fin n -> Fin (Succ n)
+data Vec a :: Nat -> Type where
+    Nil  :: Vec a Zero
+    Cons :: a -> Vec a n -> Vec a (Succ n)
+data Eq @a :: a -> a -> Type where
+    Refl :: Eq x x
+
+wrong
+    x = 1 1
+
+vec = Vec _
+
+builtins
+    natElim :: forall m -> m Zero -> (forall n -> m n -> m (Succ n)) -> forall b -> m b
+
+--natElim (m :: Nat -> Type) (z :: m Zero) (s :: forall n -> m n -> m (Succ n)) = fix (\natElim -> natCase m z (\n -> s n (natElim n)))
+
+builtins
+    finElim ::
+      forall (m :: forall n -> Fin n -> _)
+       -> (forall n . m (Succ n) FZero)
+       -> (forall n . forall f -> m n f -> m (Succ n) (FSucc f))
+       -> forall n f -> m n f
+
+-- addition of natural numbers
+plus =
+  natElim
+    (\_ -> _)           -- motive
+    (\n -> n)                    -- case for Zero
+    (\p rec n -> Succ (rec n))   -- case for Succ
+
+-- predecessor, mapping 0 to 0
+pred =
+  natElim
+    (\_ -> _)
+    Zero
+    (\n' _ -> n')
+
+-- a simpler elimination scheme for natural numbers
+natFold =
+    \mz ms -> natElim
+                   (\_ -> _)
+                   mz
+                   (\_ rec -> ms rec)
+
+-- an eliminator for natural numbers that has special
+-- cases for 0 and 1
+nat1Elim = \m m0 m1 ms -> natElim m m0
+                            (\p rec -> natElim (\n -> m (Succ n)) m1 ms p)
+
+-- an eliminator for natural numbers that has special
+-- cases for 0, 1 and 2
+nat2Elim = \m m0 m1 m2 ms -> nat1Elim m m0 m1
+                                (\p rec -> natElim (\n -> m (Succ (Succ n))) m2 ms p)
+
+-- increment by one
+inc = natFold (Succ Zero) Succ
+
+-- embed Fin into Nat
+finNat = finElim (\_ _ -> Nat)
+                     Zero
+                     (\_ rec -> Succ rec)
+
+-- unit type
+Unit' = Fin 1
+-- constructor
+U = FZero :: Unit'
+-- eliminator
+
+unitElim = \m mu -> finElim (nat1Elim (\n -> Fin n -> Type)
+                                 (\_ -> Unit')
+                                 (\x -> m x)
+                                 (\_ _ _ -> Unit'))
+                      (\ @n -> natElim (\n -> natElim (\n -> Fin (Succ n) -> Type)
+                                                (\x -> m x)
+                                                (\_ _ _ -> Unit')
+                                                n FZero)
+                                mu
+                                (\_ _ -> U) n)
+                      (\ @n f _ -> finElim (\n f -> natElim (\n -> Fin (Succ n) -> Type)
+                                                             (\x -> m x)
+                                                             (\_ _ _ -> Unit')
+                                                             n (FSucc f))
+                                           U
+                                           (\_ _ -> U)
+                                           n f)
+                      1
+
+-- empty type
+Void = Fin 0
+-- eliminator
+voidElim m = finElim (natElim (\n -> Fin n -> Type)
+                            (\x -> m x)
+                            (\_ _ _ -> _))
+                   U
+                   (\_ _ -> U)
+                   0
+
+-- type of booleans 
+Bool' = Fin 2 
+-- constructors
+False' = FZero :: Bool'
+True'  = FSucc FZero :: Bool'
+-- eliminator
+
+boolElim = \m mf mt -> finElim ( nat2Elim (\n -> Fin n -> Type)
+                                    (\_ -> Unit') (\_ -> Unit')
+                                    (\x -> m x)
+                                    (\_ _ _ -> Unit'))
+                         (\ @n -> nat1Elim (\n -> nat1Elim (\n -> Fin (Succ n) -> Type)
+                                                      (\_ -> Unit')
+                                                      (\x -> m x)
+                                                      (\_ _ _ -> Unit')
+                                                      n FZero)
+                                    U mf (\_ _ -> U) n)
+                         (\ @n f _ -> finElim (\n f -> nat1Elim (\n -> Fin (Succ n) -> Type)
+                                                                  (\_ -> Unit')
+                                                                  (\x -> m x)
+                                                                  (\_ _ _ -> Unit')
+                                                                  n (FSucc f))
+                                              (\ @n -> natElim
+                                                  (\n -> natElim
+                                                             (\n -> Fin (Succ (Succ n)) -> Type)
+                                                             (\x -> m x)
+                                                             (\_ _ _ -> Unit')
+                                                             n (FSucc FZero))
+                                                  mt (\_ _ -> U) n)
+                                              (\ @n f _ -> finElim
+                                                             (\n f -> natElim
+                                                                         (\n -> Fin (Succ (Succ n)) -> Type)
+                                                                         (\x -> m x)
+                                                                         (\_ _ _ -> Unit')
+                                                                         n (FSucc (FSucc f)))
+                                                             U
+                                                             (\_ _ -> U)
+                                                             n f)
+                                              n f)
+                         2
+
+
+-- boolean not, and, or, equivalence, xor
+not = boolElim (\_ -> _) True' False'
+and = boolElim (\_ -> _) (const False') id
+or  = boolElim (\_ -> _) id (const True')
+iff = boolElim (\_ -> _) not id
+xor = boolElim (\_ -> _) id not
+
+-- even, odd, isZero, isSucc
+even    = natFold True' not
+odd     = natFold False' not
+isZero  = natFold True' (const False')
+isSucc  = natFold False' (const True')
+
+-- equality on natural numbers
+natEq =
+  natElim
+    (\_ -> _)
+    (natElim
+        (\_ -> _)
+        True'
+        (\n' _ -> False'))
+    (\m' rec_m' -> natElim
+                       (\_ -> _)
+                       False'
+                       (\n' _ -> rec_m' n'))
+
+-- "oh so true"
+Prop = boolElim (\_ -> _) Void Unit'
+
+-- reflexivity of equality on natural numbers
+pNatEqRefl =
+  natElim
+    (\n -> Prop (natEq n n))
+    U
+    (\_ rec -> rec)
+ --  :: forall (n :: Nat) -> Prop (natEq n n)
+
+-- alias for type-level negation 
+Not a = a -> Void
+
+-- Leibniz prinicple:  forall a b . (a -> b) -> forall (x :: a) (y :: a) -> Eq x y -> Eq (f x) (f y)
+leibniz f x y = eqCase
+                 (\x y _ -> Eq (f x) (f y))
+                 Refl @x @y
+
+-- symmetry of (general) equality
+symm x y = eqCase (\x y _ -> Eq y x) Refl @x @y
+
+-- transitivity of (general) equality
+tran eq_x_y = eqCase
+    (\x y _ -> forall z -> Eq y z -> Eq x z)
+    (\_ x -> x)
+    eq_x_y _
+
+-- apply an equality proof on two types
+apply = eqCase (\a b _ -> a -> b) id
+
+p1IsNot0 p = apply
+                (leibniz
+                         (natElim (\_ -> _) Void (\_ _ -> Unit'))
+                         1 0 p)
+                U
+
+-- proof that 0 is not 1
+p0IsNot1 p = p1IsNot0 (symm 0 1 p)
+
+-- proof that zero is not a successor
+p0IsNoSucc = 
+  natElim
+    (\n -> Not (Eq 0 (Succ n)))
+    p0IsNot1
+    (\n' rec_n' eq_0_SSn' ->
+      rec_n' (leibniz pred Zero (Succ (Succ n')) eq_0_SSn'))
+
+-- generate a vector of given length from a specified element (replicate)
+
+replicate =
+    natElim
+      (\n -> forall a -> a -> Vec a n)
+      (\_ _ -> Nil)
+      (\n' rec_n' a x -> Cons x (rec_n' a x))
+
+-- alternative definition of replicate
+replicate' =
+    natElim
+      (\n -> _ -> vec n)
+      (\_ -> Nil)
+      (\n' rec_n' x -> Cons x (rec_n' x))
+
+replicate'' x = natElim vec Nil (\n' rec_n' -> Cons x rec_n')
+
+-- generate a vector of given length n, containing the natural numbers smaller than n
+fromto = natElim vec Nil (\n' rec_n' -> Cons n' rec_n')
+
+builtins
+    vecElim ::
+      forall (m :: forall k -> vec k -> _) ->
+         m Zero Nil
+         -> (forall l . forall x xs -> m l xs -> m (Succ l) (Cons x xs))
+         -> forall k xs -> m k xs
+
+-- append two vectors
+append = vecElim
+             (\m _ -> forall n -> vec n -> vec (plus m n))
+             (\_ v -> v)
+             (\v vs rec n w -> Cons v (rec n w))
+
+-- helper function for tail, see below
+tail' a = vecElim (\m v -> forall n -> Eq m (Succ n) -> Vec a n)
+                    (\n eq_0_SuccN -> voidElim (\_ -> _)
+                                                 (p0IsNoSucc n eq_0_SuccN))
+                    (\ @m' v vs rec_m' n eq_SuccM'_SuccN ->
+                      eqCase
+                             (\m' n e -> Vec a m' -> Vec a n)
+                             id
+                             @m' @n
+                             (leibniz pred (Succ m') (Succ n) eq_SuccM'_SuccN) vs)
+
+-- compute the tail of a vector
+tailVec = \n v -> tail' _ (Succ n) v n Refl
+
+-- projection out of a vector
+at =
+    vecElim (\n v -> Fin n -> _)
+                    (\f -> voidElim (\_ -> _) f)
+                    (\ @n' v vs rec_n' f_SuccN' ->
+                      finElim (\n _ -> Eq n (Succ n') -> _)
+                              (\e -> v)
+                              (\ @n f_N _ eq_SuccN_SuccN' ->
+                                rec_n' (eqCase
+                                               (\x y e -> Fin x -> Fin y)
+                                               id
+                                               @n @n'
+                                               (leibniz pred
+                                                        (Succ n) (Succ n') eq_SuccN_SuccN')
+                                               f_N))
+                              (Succ n')
+                              f_SuccN'
+                              Refl)
+
+-- head of a vector
+headVec n v = at (Succ n) v FZero
+
+-- vector map
+map f = vecElim (\n _ -> vec n) Nil (\x _ rec -> Cons (f x) rec)
+
+-- proofs that 0 is the neutral element of addition
+-- one direction is trivial by definition of plus:
+p0PlusNisN = Refl :: forall n . Eq (plus 0 n) n
+
+-- the other direction requires induction on N:
+pNPlus0isN =
+  natElim (\n -> Eq (plus n 0) n)
+          Refl
+          (\n' rec -> leibniz Succ (plus n' 0) n' rec)
+
+testNoNorm = Refl :: Eq (primIntEq #3 #3) True
+
+True''  = FSucc FZero :: Bool'
+
+
+data EqD a = EqDC (a -> a -> Bool)
+
+eqInt = EqDC primIntEq
+
+builtins
+    matchInt  :: Type -> (Type -> Type) -> Type -> Type
+    matchList :: (Type -> Type) -> (Type -> Type) -> Type -> Type
+
+Eq_ :: Type -> Type
+Eq_ a = matchInt Unit (matchList Eq_ (\_ -> Empty)) a
+
+builtins eqD :: Eq_ a => EqD a
+
+eq = eqDCase (\_ -> _) id eqD
+
+eq' = eqDCase (\_ -> _) id
+
+eqList = EqDC (\as bs -> listCase (\_ -> _) (listCase (\_ -> _) True (\_ _ -> False) bs) (\a as -> listCase (\_ -> _) False (\b bs -> and' (eq a b) (eq as bs)) bs) as)
+
+main_ = eq' eqList (Cons' #3 Nil') Nil'
+main'' = eq (Cons' #3 Nil') Nil'
+
+data MonadD (m :: Type -> Type) = MonadDC (forall a . a -> m a) (forall a b . m a -> (a -> m b) -> m b)
+
+data Identity a = IdentityC a
+
+identityMonad = MonadDC IdentityC (\m f -> identityCase (\_ -> _) f m)
+
+Char = Int
+
+data IO a where
+   IORet :: a -> IO a
+   PutChar :: Char -> IO a -> IO a
+   GetChar :: (Char -> IO a) -> IO a
+
+data ReaderT r (m :: Type -> Type) a = ReaderTC (r -> m a)
+
+-----------------------------
+
+builtins
+    ifIdentity1 :: forall a . a -> ((Type -> Type) -> a) -> (Type -> Type) -> a
+    ifReaderT1 :: forall a . (Type -> (Type -> Type) -> a) -> ((Type -> Type) -> a) -> (Type -> Type) -> a
+
+builtins
+    Monad :: (Type -> Type) -> Type
+--let Monad = fix (\Monad -> ifIdentity1 Unit (ifReaderT1 (\r m -> Monad m) (\_ -> Empty)))
+
+----------------- recursive definition
+builtins monadD :: forall m . Monad m => MonadD m
+-- let monadD = fix (\monadD @t -> ifIdentity_1 identityMonad (ifReaderT_1 (\r m -> monadReaderT) undefined t))
+
+return = monadDCase (\_ -> _) (\r _ -> r) monadD
+bind = monadDCase (\_ -> _) (\_ b -> b) monadD
+
+monadReaderT = MonadDC (\a -> ReaderTC (\r -> return a))
+     (\m f -> ReaderTC (\r -> 
+        readerTCase (\_ -> _)
+            (\g -> bind
+                (g r)
+                (\a -> readerTCase (\_ -> _) (\h -> h r) (f a))) 
+            m))
+  --    :: forall r m . Monad m => MonadD (ReaderT r m)
+
+IOBind ma f = case ma of
+    IORet a -> f a
+    PutChar i r -> PutChar i (bind r f)
+    GetChar g -> GetChar (\i -> bind (g i) f)
+
+monadIO = MonadDC IORet IOBind
+-------------------------- end of recursive definition
+
+liftReaderT m = ReaderTC (\r -> m)
+
+bind' m m' = bind m (const m')
+fmap f m = bind m (comp return f)
+
+sequence = listCase (\_ -> _) (return Nil') (\x xs -> bind x (\vx -> fmap (Cons' vx) (sequence xs)))
+sequence_ = listCase (\_ -> _) (return TT) (\x xs -> bind' x (sequence_ xs))
+
+mapM f = comp sequence (listMap f)
+mapM_ f = comp sequence_ (listMap f)
+
+putChar i = PutChar i (return TT)
+getChar = GetChar return
+
+putStr = mapM_ putChar
+putStrLn = comp putStr (flip concat (Cons' #0 Nil'))
+
+-- todo -- getLine = bind getChar (\c -> boolCase (\_ -> _) (bind getLine (\cs -> return (Cons' c cs))) (return Nil') (eq c #0))
+
+--let mex_ = return' monadReaderT #3
+mex = return #3 :: IO Int
+mex' = return #3 :: ReaderT Bool IO Int
+
+-- todo -- main' = bind getLine putStrLn
+
+
+data Exp :: Type -> Type where
+    EInt :: Int -> Exp Int
+    EApp :: Exp (a -> b) -> Exp a -> Exp b
+    ECond :: Exp Bool -> Exp a -> Exp a -> Exp a
+
+expCase' :: forall
+       (c :: forall a -> Exp a -> Type)
+    -> (forall d -> c Int (EInt d))
+    -> (forall f g . forall i j -> c g (EApp @f @g i j))
+    -> (forall l . forall m n o -> c l (ECond @l m n o))
+    -> forall q
+       (r :: Exp q) -> c q r
+expCase' m i a c x e = expCase m i a c @x e
+
+expCase'' :: forall
+       (c :: forall a -> Exp a -> Type)
+    -> (forall d -> c Int (EInt d))
+    -> (forall f g . forall i j -> c g (EApp @f @g i j))
+    -> (forall l . forall m n o -> c l (ECond @l m n o))
+    -> forall q
+    . forall (r :: Exp q) -> c q r
+expCase'' m i a c @x e = expCase' m i a c x e
+
+-- todo -- eval  :: forall a . Exp a -> a
+eval = expCase (\b _ -> b)      -- todo: how to guess the motive
+            (\i -> i)
+            (\f a -> eval f (eval a))
+            (\b m n -> boolCase (\_ -> _) (eval n) (eval m) (eval b))
+  :: forall a . Exp a -> a
+
diff --git a/testdata/later.ignore/ShadowMapping.lc b/testdata/later.ignore/ShadowMapping.lc
new file mode 100644
index 00000000..e9bd2daa
--- /dev/null
+++ b/testdata/later.ignore/ShadowMapping.lc
@@ -0,0 +1,223 @@
+shadowMapSize = 512
+
+triangleCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+
+gaussFilter7 :: [(Float, Float)]
+gaussFilter7 = 
+    [ (-3.0,   0.015625)
+    , (-2.0,   0.09375)
+    , (-1.0,   0.234375)
+    , (0.0,    0.3125)
+    , (1.0,    0.234375)
+    , (2.0,    0.09375)
+    , (3.0,    0.015625)
+    ]
+
+gaussFilter9 :: [(Float, Float)]
+gaussFilter9 = 
+    [ (-4.0,   0.05)
+    , (-3.0,   0.09)
+    , (-2.0,   0.12)
+    , (-1.0,   0.15)
+    , (0.0,    0.16)
+    , (1.0,    0.15)
+    , (2.0,    0.12)
+    , (3.0,    0.09)
+    , (4.0,    0.05)
+    ]
+
+blurCoefficients :: [(Float, Float)]
+blurCoefficients = gaussFilter9
+
+blur :: [(Float, Float)] -> Image 1 (Color (Vec 4 Float)) -> FrameBuffer 1 (Color (Vec 4 Float))
+blur coefficients img = filter1D dirH (PrjImage (filter1D dirV img))
+  where
+    dirH v = V2 (v / shadowMapSize) 0.0
+    dirV v = V2 0.0 (v / shadowMapSize)
+
+    filter1D :: (Float -> Vec 2 Float) -> Image 1 (Color (Vec 4 Float)) -> FrameBuffer 1 (Color (Vec 4 Float))
+    filter1D dir img = accumulate accCtx PassAll frag
+                                 (Rasterize triangleCtx prims) clearBuf
+      where
+        accCtx = accumulationContext
+                                    (ColorOp NoBlending (V4 True True True True))
+        clearBuf = FrameBuffer (ColorImage @1 (V4 0 0 0 0.0))
+        vert :: Vec 2 Float -> VertexOut (Vec 2 Float)
+        vert uv = VertexOut pos 1 () (NoPerspective uv')
+          where
+            uv'    = uv *! 0.5 +! 0.5
+            pos    = V4 uv%x uv%y 1.0 1.0
+
+        prims = Transform vert (fetch "postSlot" Triangle (Attribute "position" :: Vec 2 Float))
+
+        frag :: FragmentShader (Vec 2 Float -> Color (Vec 4 Float))
+        frag = FragmentShader $ \uv -> sample
+          where
+            tex = Texture2D (V2 shadowMapSize shadowMapSize) img
+            smp = Sampler LinearFilter ClampToEdge tex
+            sample = foldr1 (\a b -> a + b) [ texture2D smp (uv + dir ofs) *! coeff
+                                            | (ofs, coeff) <- coefficients
+                                            ]
+
+moments :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float))
+moments = accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = accumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+    clearBuf = FrameBuffer (DepthImage @1 1000, ColorImage @1 (V4 0.0 0.0 0.0 1.0{-todo: use 1-}))
+
+    lightMatrix = Uniform "lightMatrix" :: Mat 4 4 Float
+    modelMatrix = Uniform "modelMatrix" :: Mat 4 4 Float
+
+    vert :: Vec 3 Float -> VertexOut Float
+    vert pos = VertexOut lightPos 1 () (Smooth depth)
+      where
+        lightPos = lightMatrix *. modelMatrix *. v3FToV4F pos
+        depth = lightPos%z
+
+    prims = Transform vert (fetch "geometrySlot" Triangle (Attribute "position" :: Vec 3 Float))
+
+    frag :: FragmentShader (Float -> (Depth Float,Color (Vec 4 Float)))
+    frag = FragmentShaderRastDepth $ \depth -> (V4 moment1 moment2 0 1)
+      where
+        dx = dFdx depth
+        dy = dFdy depth
+        moment1 = depth
+        moment2 = depth *! depth +! 0.25 *! (dx *! dx +! dy *! dy)
+
+depth :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float))
+depth = accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = accumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+    clearBuf = FrameBuffer (DepthImage @1 1000, ColorImage @1 (V4 0.0 0.0 0.0 1.0))
+
+    lightMatrix = Uniform "lightMatrix" :: Mat 4 4 Float
+    modelMatrix = Uniform "modelMatrix" :: Mat 4 4 Float
+
+    vert :: Vec 3 Float -> VertexOut Float
+    vert pos = VertexOut lightPos 1 () (Smooth depth)
+      where
+        lightPos = lightMatrix *. modelMatrix *. v3FToV4F pos
+        depth = lightPos%z
+
+    prims = Transform vert (fetch "geometrySlot" Triangle (Attribute "position" :: Vec 3 Float))
+
+    frag :: FragmentShader (Float -> (Depth Float, Color (Vec 4 Float)))
+    frag = FragmentShaderRastDepth $ \depth -> (V4 depth 0 0 1)
+
+failhere
+{- todo
+vsm :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float))
+vsm = accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = accumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+    cameraMatrix = Uniform "cameraMatrix" :: Mat 4 4 Float
+    lightMatrix = Uniform "lightMatrix" :: Mat 4 4 Float
+    modelMatrix = Uniform "modelMatrix" :: Mat 4 4 Float
+    lightPosition = Uniform "lightPosition" :: Vec 3 Float
+
+    shadowMap = Texture2D (V2 shadowMapSize shadowMapSize) (PrjImageColor moments)
+    shadowMapBlur = Texture2D (V2 shadowMapSize shadowMapSize) (PrjImage blurredMoments)
+      where
+        blurredMoments = blur blurCoefficients (PrjImageColor moments)
+    sampler = Sampler LinearFilter ClampToEdge shadowMapBlur
+
+    frag :: FragmentShader ((Vec 3 Float, Vec 4 Float, Vec 3 Float) -> (Depth Float, Color (Vec 4 Float)))
+    frag = FragmentShaderRastDepth $ \(worldPos, lightPos, worldNormal) -> (luminance)
+      where
+        clampUV x = clampS x 0.0 1.0
+        scaleUV x = x *! 0.5 +! 0.5
+        lightU = lightPos%x
+        lightV = lightPos%y
+        lightDepth = lightPos%z
+        lightW = lightPos%w
+        uv = clampUV (scaleUV ((V2 lightU lightV) /! lightW))
+        
+        val = texture2D sampler uv
+        moment1 = val%x
+        moment2 = val%y
+        variance = max 0.002 (moment2 -! moment1 *! moment1)
+        distance = max 0.0 (lightDepth -! moment1)
+        lightProbMax = variance /! (variance +! distance *! distance)
+        
+        lambert = max 0.0 (dot worldNormal (normalize (lightPosition - worldPos)))
+        
+        uv' = uv -! 0.5
+        spotShape = 1.0 -! length uv *! 4.0
+        intensity = max 0 (spotShape *! lambert)
+        
+        val2 = scaleUV (round (uv' *! 10.0)) *! intensity
+        spotR = val2%x
+        spotG = val2%y
+        
+        luminance = (V4 spotR spotG intensity 1.0) *! pow lightProbMax 2.0
+        
+
+    clearBuf = FrameBuffer ( DepthImage @1 1000
+                           , ColorImage @1 (V4 0.1 0.2 0.6 1))
+
+    vert :: (Vec 3 Float, Vec 3 Float) -> VertexOut (Vec 3 Float, Vec 4 Float, Vec 3 Float)
+    vert (localPos, localNormal) = VertexOut viewPos 1 () (Smooth worldPos%xyz, Smooth lightPos, Smooth worldNormal)
+      where
+        worldPos = modelMatrix *. v3FToV4F localPos
+        viewPos = cameraMatrix *. worldPos
+        lightPos = lightMatrix *. worldPos
+        worldNormal = normalize ((modelMatrix *. v3FToV4F localNormal)%xyz)
+
+    prims = Transform vert (fetch "geometrySlot" Triangle (Attribute "position" :: Vec 3 Float, Attribute "normal" :: Vec 3 Float))
+
+
+sm :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float))
+sm = accumulate accCtx PassAll frag (Rasterize triangleCtx prims) clearBuf
+  where
+    accCtx = accumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+    clearBuf = FrameBuffer (DepthImage @1 1000, ColorImage @1 (V4 0.1 0.2 0.6 1))
+    cameraMatrix = Uniform "cameraMatrix" :: Mat 4 4 Float
+    lightMatrix = Uniform "lightMatrix" :: Mat 4 4 Float
+    modelMatrix = Uniform "modelMatrix" :: Mat 4 4 Float
+    lightPosition = Uniform "lightPosition" :: Vec 3 Float
+
+    vert :: (Vec 3 Float, Vec 3 Float) -> VertexOut (Vec 3 Float, Vec 4 Float, Vec 3 Float)
+    vert (localPos, localNormal) = VertexOut viewPos 1 () (Smooth (worldPos%xyz), Smooth lightPos, Smooth worldNormal)
+      where
+        worldPos = modelMatrix *. v3FToV4F localPos
+        viewPos = cameraMatrix *. worldPos
+        lightPos = lightMatrix *. worldPos
+        worldNormal = normalize ((modelMatrix *. v3FToV4F localNormal)%xyz)
+
+    prims = Transform vert (fetch "geometrySlot" Triangle (Attribute "position" :: Vec 3 Float, Attribute "normal" :: Vec 3 Float))
+
+    --shadowMap :: Exp Obj (Texture Tex2D SingleTex (Regular Float) Red)
+    shadowMap = Texture2D (V2 shadowMapSize shadowMapSize) (PrjImageColor depth)
+    sampler = Sampler PointFilter ClampToEdge shadowMap
+    
+    frag :: FragmentShader ((Vec 3 Float, Vec 4 Float, Vec 3 Float) -> (Depth Float, Color (Vec 4 Float)))
+    frag = FragmentShaderRastDepth $ \(worldPos, lightPos, worldNormal) -> (luminance)
+      where
+        lightU = lightPos%x
+        lightV = lightPos%y
+        lightDepth = lightPos%z
+        lightW = lightPos%w
+        clampUV x = clampS x 0 1
+        scaleUV x = x *! 0.5 +! 0.5
+        uv = clampUV (scaleUV ((V2 lightU lightV) /! lightW))
+        
+        surfaceDistance = (texture2D sampler uv)%x
+        lightPortion = if (lightDepth <= surfaceDistance +! 0.01) then 1 else 0
+        
+        lambert = max 0 (dot worldNormal (normalize (lightPosition - worldPos)))
+        
+        --intensity = lambert @* lightPortion
+        --luminance = pack' (V4 intensity intensity intensity (floatF 1))
+        
+        uv' = uv -! 0.5
+        spotShape = 1 -! length uv' *! 4
+        intensity = max 0 (spotShape *! lambert)
+
+        val = scaleUV (round (uv' *! 10)) *! intensity
+        spotR = val%x
+        spotG = val%y
+        
+        luminance = (V4 spotR spotG intensity 1) *! lightPortion
+        
+main = ScreenOut sm
+-}
diff --git a/testdata/later.ignore/fragment02tuple.lc b/testdata/later.ignore/fragment02tuple.lc
new file mode 100644
index 00000000..33a89b5d
--- /dev/null
+++ b/testdata/later.ignore/fragment02tuple.lc
@@ -0,0 +1,21 @@
+clear = FrameBuffer $ ColorImage @1 $ V4 1 0 0 0.5
+
+triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+colorFragmentCtx = accumulationContext (ColorOp NoBlending (V4 True True True True))
+
+rasterizeWith = Rasterize
+triangles = triangleRasterCtx
+
+quadVertexStream = fetch "quad" Triangle (Attribute "position" :: Vec 4 Float)
+
+transform s f =  Transform (\v -> VertexOut v 1 () (f v)) s
+
+mapFragments s fs = accumulate colorFragmentCtx PassAll (FragmentShader $ \a -> fs a) s clear
+
+render f = quadVertexStream                 -- id vertices
+    `transform`    (\a -> (Smooth a,Smooth a))
+     &             rasterizeWith triangles  -- rasterize
+    `mapFragments` f
+     &             ScreenOut                --  draw into screen
+
+main = render $ \(a,b) -> a `PrimAdd` b
diff --git a/testdata/later.ignore/fragment02vectorpattern.lc b/testdata/later.ignore/fragment02vectorpattern.lc
new file mode 100644
index 00000000..0e533a75
--- /dev/null
+++ b/testdata/later.ignore/fragment02vectorpattern.lc
@@ -0,0 +1,21 @@
+clear = FrameBuffer $ ColorImage @1 $ V4 1 0 0 0.5
+
+triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+colorFragmentCtx = accumulationContext (ColorOp NoBlending (V4 True True True True))
+
+rasterizeWith = Rasterize
+triangles = triangleRasterCtx
+
+quadVertexStream = fetch "quad" Triangle (Attribute "position" :: Vec 4 Float)
+
+transform s f =  Transform (\v -> VertexOut (f v) 1 () (Smooth v)) s
+
+mapFragments s fs = accumulate colorFragmentCtx PassAll (FragmentShader $ \a -> fs a) s clear
+
+render f = quadVertexStream                 -- id vertices
+    `transform`    id
+     &             rasterizeWith triangles  -- rasterize
+    `mapFragments` f
+     &             ScreenOut                --  draw into screen
+
+main = render $ \(V4 r g b a) -> V4 0 0 b 1
diff --git a/testdata/later.ignore/fragment05uniform.lc b/testdata/later.ignore/fragment05uniform.lc
new file mode 100644
index 00000000..7a8378f7
--- /dev/null
+++ b/testdata/later.ignore/fragment05uniform.lc
@@ -0,0 +1,22 @@
+time = Uniform "Time" :: Float
+clear = FrameBuffer $ ColorImage @1 $ V4 1 0 0 0.5
+
+triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+colorFragmentCtx = accumulationContext (ColorOp NoBlending (V4 True True True True))
+
+rasterizeWith = Rasterize
+triangles = triangleRasterCtx
+
+quadVertexStream = fetch "quad" Triangle (Attribute "position" :: Vec 4 Float)
+
+transform s f =  Transform (\v -> VertexOut (f v) 1 () (Smooth v)) s
+
+mapFragments s fs = accumulate colorFragmentCtx PassAll (FragmentShader $ \a -> fs a) s clear
+
+render f = quadVertexStream                 -- id vertices
+    `transform`    id
+     &             rasterizeWith triangles  -- rasterize
+    `mapFragments` f
+     &             ScreenOut                --  draw into screen
+
+main = render $ \(V4 r g b a) -> V4 0 (0.5 +! (0.5 *! sin time)) b 1
diff --git a/testdata/later.ignore/fragment06tailrecursion.lc b/testdata/later.ignore/fragment06tailrecursion.lc
new file mode 100644
index 00000000..2fa86d15
--- /dev/null
+++ b/testdata/later.ignore/fragment06tailrecursion.lc
@@ -0,0 +1,24 @@
+time = Uniform "Time" :: Float
+clear = FrameBuffer $ ColorImage @1 $ V4 1 0 0 0.5
+
+triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
+colorFragmentCtx = accumulationContext (ColorOp NoBlending (V4 True True True True))
+
+rasterizeWith = Rasterize
+triangles = triangleRasterCtx
+
+quadVertexStream = fetch "quad" Triangle (Attribute "position" :: Vec 4 Float)
+
+transform s f =  Transform (\v -> VertexOut (f v) 1 () (Smooth v)) s
+
+mapFragments s fs = accumulate colorFragmentCtx PassAll (FragmentShader $ \a -> fs a) s clear
+
+render f = quadVertexStream                 -- id vertices
+    `transform`    id
+     &             rasterizeWith triangles  -- rasterize
+    `mapFragments` f
+     &             ScreenOut                --  draw into screen
+
+fun x = if x < 0 then 0 else x +! fun (x -! 0.3)
+
+main' = render $ \c -> if fun time < 0.5 then c else blue
diff --git a/testdata/later.ignore/fragmenttest.lc b/testdata/later.ignore/fragmenttest.lc
new file mode 100644
index 00000000..47ef3ebe
--- /dev/null
+++ b/testdata/later.ignore/fragmenttest.lc
@@ -0,0 +1 @@
+main = ScreenOut $ fragmentTest $ \x y -> if x *! x +! y *! y > 0.5 then blue else green
diff --git a/testdata/later.ignore/fragmenttest.out b/testdata/later.ignore/fragmenttest.out
new file mode 100644
index 00000000..2034e78e
--- /dev/null
+++ b/testdata/later.ignore/fragmenttest.out
@@ -0,0 +1 @@
+Pipeline {backend = WebGL1, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("v",Parameter {name = "position", ty = V2F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 100\nprecision highp float;\nprecision highp int;\nattribute vec2 v ;\nvarying vec2 v0 ;\nvoid main() {\nv0 = v;\ngl_Position = vec4 ( ( v ).x,( v ).y,1.0,1.0 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 100\nprecision highp float;\nprecision highp int;\nvarying vec2 v0 ;\nvoid main() {\ngl_FragColor = ( ( ( ( v0 ).x ) * ( ( v0 ).x ) ) + ( ( ( v0 ).y ) * ( ( v0 ).y ) ) ) > ( 0.5 ) ? vec4 ( 0.0,0.0,1.0,1.0 ) : vec4 ( 0.0,0.5,0.0,1.0 );\n}\n"}], slots = [Slot {slotName = "quad", slotStreams = fromList [("position",V2F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 1.0 0.0 0.0 0.5)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file