TreeWalk.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Tree-walking interpreter
module Jacinda.Backend.TreeWalk ( runJac
                                ) where

-- TODO: normalize before mapping?

import           Control.Exception          (Exception, throw)
import           Control.Monad.State.Strict (State, get, modify, runState)
import           Data.Bifunctor             (bimap)
import qualified Data.ByteString            as BS
import           Data.Containers.ListUtils  (nubIntOn, nubOrdOn)
import           Data.Foldable              (foldl', traverse_)
import qualified Data.IntMap                as IM
import           Data.List                  (scanl', transpose, unzip4)
import           Data.List.Ext
import           Data.Maybe                 (mapMaybe)
import           Data.Semigroup             ((<>))
import qualified Data.Vector                as V
import           Intern.Name                (Name (Name))
import           Intern.Unique              (Unique (Unique))
import           Jacinda.AST
import           Jacinda.Backend.Normalize
import           Jacinda.Backend.Printf
import           Jacinda.Regex              (captures', find', findCapture, isMatch', splitBy, substr)
import           Jacinda.Ty.Const
import           Regex.Rure                 (RurePtr)

data StreamError = NakedField
                 | UnevalFun
                 | TupOfStreams -- ^ Reject a tuple of streams
                 | BadCtx
                 | InternalError
                 deriving (Show)

instance Exception StreamError where

(!) :: V.Vector a -> Int -> a
v ! ix = case v V.!? ix of
    Just x  -> x
    Nothing -> throw $ IndexOutOfBounds ix

noRes :: E b -> String -> a
noRes e ty = error ("Internal error: " ++ show e ++ " did not normalize to appropriate type, expected " ++ ty)

badSugar :: a
badSugar = error "Internal error: dfn syntactic sugar at a stage where it should not be."

asInt :: E a -> Integer
asInt (IntLit _ i) = i
asInt e            = noRes e "Int"

asBool :: E a -> Bool
asBool (BoolLit _ b) = b
asBool e             = noRes e "Bool"

asStr :: E a -> BS.ByteString
asStr (StrLit _ str) = str
asStr e              = noRes e "Str"

asFloat :: E a -> Double
asFloat (FloatLit _ f) = f
asFloat e              = noRes e "Float"

asRegex :: E a -> RurePtr
asRegex (RegexCompiled re) = re
asRegex e                  = noRes e "Regex"

asArr :: E a -> V.Vector (E a)
asArr (Arr _ es) = es
asArr e          = noRes e "List"

asOpt :: E a -> Maybe (E a)
asOpt (OptionVal _ e) = e
asOpt e               = noRes e "Option"

-- eval
eEval :: (Int, BS.ByteString, V.Vector BS.ByteString) -- ^ Field context (for that line)
      -> E (T K)
      -> E (T K)
eEval (ix, line, ctx) = go where
    go b@BoolLit{} = b
    go i@IntLit{} = i
    go f@FloatLit{} = f
    go str@StrLit{} = str
    go rr@RegexLit{} = rr
    go reϵ@RegexCompiled{} = reϵ
    go op@BBuiltin{} = op
    go op@UBuiltin{} = op
    go op@TBuiltin{} = op
    go (NBuiltin _ Nf) = mkI (fromIntegral $ V.length ctx)
    go (EApp ty op@BBuiltin{} e) = EApp ty op (go e)
    go (NBuiltin _ Ix) = mkI (fromIntegral ix)
    go (NBuiltin _ None) = OptionVal undefined Nothing
    go (EApp ty (UBuiltin _ Some) e) =
        let eI = go e
            in OptionVal ty (Just eI)
    go AllField{} = StrLit tyStr line
    go (Field _ i) = StrLit tyStr (ctx ! (i-1)) -- cause vector indexing starts at 0
    go LastField{} = StrLit tyStr (V.last ctx)
    go (EApp _ (UBuiltin _ IParse) e) =
        let eI = asStr (go e)
            in parseAsEInt eI
    go (EApp _ (UBuiltin (TyArr _ (TyB _ TyInteger) _) Negate) e) =
        let eI = asInt (go e)
            in mkI (negate eI)
    go (EApp _ (UBuiltin (TyArr _ (TyB _ TyFloat) _) Negate) e) =
        let eI = asFloat (go e)
            in mkF (negate eI)
    go (EApp _ (UBuiltin _ FParse) e) =
        let eI = asStr (go e)
            in parseAsF eI
    go (EApp _ (UBuiltin (TyArr _ _ (TyB _ TyInteger)) Parse) e) =
        let eI = asStr (go e)
            in parseAsEInt eI
    go (EApp _ (UBuiltin (TyArr _ _ (TyB _ TyFloat)) Parse) e) =
        let eI = asStr (go e)
            in parseAsF eI
    go (EApp _ (EApp _ (BBuiltin _ Matches) e) e') =
        let eI = go e
            eI' = go e'
        in case (eI, eI') of
            (StrLit _ strϵ, RegexCompiled reϵ) -> BoolLit tyBool (isMatch' reϵ strϵ)
            (StrLit{}, _)                      -> noRes eI' "Regex"
            _                                  -> noRes eI "Str"
    go (EApp _ (EApp _ (BBuiltin _ NotMatches) e) e') =
        let eI = go e
            eI' = go e'
        in case (eI, eI') of
            (StrLit _ strϵ, RegexCompiled reϵ) -> BoolLit tyBool (not $ isMatch' reϵ strϵ)
            (StrLit{}, _)                      -> noRes eI' "Regex"
            _                                  -> noRes eI "Str"
    go (EApp _ (EApp _ (BBuiltin _ Match) e) e') =
        let eI = asRegex (go e)
            eI' = asStr (go e')
        in asTup (find' eI eI')
    go (EApp _ (EApp _ (EApp _ (TBuiltin _ Captures) e0) e1) e2) =
        let e0' = asStr (go e0)
            e1' = asInt (go e1)
            e2' = asRegex (go e2)
            in OptionVal (tyOpt tyStr) (mkStr <$> findCapture e2' e0' (fromIntegral e1'))
    go (EApp _ (EApp _ (EApp _ (TBuiltin _ AllCaptures) e0) e1) e2) =
        let e0' = asStr (go e0)
            e1' = asInt (go e1)
            e2' = asRegex (go e2)
            in Arr (mkVec tyStr) (mkStr <$> V.fromList (captures' e2' e0' (fromIntegral e1')))
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Plus) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in mkI (eI + eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Minus) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in mkI (eI - eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Times) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in mkI (eI * eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyStr) _) Plus) e) e') =
        let eI = asStr (go e)
            eI' = asStr (go e')
            -- TODO: copy??
            in mkStr (eI <> eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyStr) _) Eq) e) e') =
        let eI = asStr (go e)
            eI' = asStr (go e')
            in BoolLit tyBool (eI == eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Gt) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in BoolLit tyBool (eI > eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Lt) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in BoolLit tyBool (eI < eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Eq) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in BoolLit tyBool (eI == eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Neq) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in BoolLit tyBool (eI == eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyStr) _) Neq) e) e') =
        let eI = asStr (go e)
            eI' = asStr (go e')
            in BoolLit tyBool (eI /= eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Leq) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in BoolLit tyBool (eI <= eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Geq) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in BoolLit tyBool (eI <= eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Eq) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in BoolLit tyBool (eI == eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Neq) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in BoolLit tyBool (eI /= eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Lt) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in BoolLit tyBool (eI < eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Gt) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in BoolLit tyBool (eI > eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Geq) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in BoolLit tyBool (eI >= eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Leq) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in BoolLit tyBool (eI <= eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Plus) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in mkF (eI + eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Minus) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in mkF (eI - eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Times) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in FloatLit tyF (eI * eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyBool) _) Eq) e) e') =
        let eI = asBool (go e)
            eI' = asBool (go e')
            in BoolLit tyBool (eI == eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyBool) _) Neq) e) e') =
        let eI = asBool (go e)
            eI' = asBool (go e')
            in BoolLit tyBool (eI /= eI')
    go (EApp _ (EApp _ (BBuiltin _ Div) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in FloatLit tyF (eI / eI')
    go (EApp _ (EApp _ (BBuiltin _ And) e) e') =
        let b = asBool (go e)
            b' = asBool (go e')
            in BoolLit tyBool (b && b')
    go (EApp _ (EApp _ (BBuiltin _ Or) e) e') =
        let b = asBool e
            b' = asBool e'
            in BoolLit tyBool (b || b')
    go (EApp _ (UBuiltin _ Tally) e) =
        mkI (fromIntegral $ BS.length str)
        where str = asStr (go e)
    go (EApp _ (UBuiltin _ Floor) e) =
        let f = asFloat e
        in mkI (floor f)
    go (EApp _ (UBuiltin _ Ceiling) e) =
        let f = asFloat e
        in mkI (ceiling f)
    go (Tup ty es) = Tup ty (go <$> es)
    go (EApp _ (EApp _ (BBuiltin _ Split) e) e') =
        let str = asStr (go e)
            re = asRegex (go e')
            bss = splitBy re str
            in Arr undefined (mkStr <$> bss)
    go (EApp _ (EApp _ (BBuiltin _ Splitc) e) e') =
        let str = asStr (go e)
            c = the (asStr (go e'))
            bss = BS.split c str
            in Arr undefined (mkStr <$> V.fromList bss)
    go (EApp _ (EApp _ (EApp _ (TBuiltin _ Substr) e0) e1) e2) =
        let eI0 = asStr (go e0)
            eI1 = asInt (go e1)
            eI2 = asInt (go e2)
        in mkStr (substr eI0 (fromIntegral eI1) (fromIntegral eI2))
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Max) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in mkF (max eI eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Min) e) e') =
        let eI = asFloat (go e)
            eI' = asFloat (go e')
            in mkF (min eI eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Max) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in mkI (max eI eI')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Min) e) e') =
        let eI = asInt (go e)
            eI' = asInt (go e')
            in mkI (min eI eI')
    go (EApp _ (UBuiltin _ Not) e) =
        let eI = asBool (go e)
        in BoolLit tyBool (not eI)
    go (EApp _ (UBuiltin _ (At i)) e) =
        let eI = go e
            in case eI of
                (Arr _ es) -> go (es V.! (i-1))
                _          -> noRes eI "List"
    go (EApp _ (UBuiltin _ (Select i)) e) =
        let eI = go e
            in case eI of
                (Tup _ es) -> go (es !! (i-1))
                _          -> noRes eI "Tuple"
    go (EApp _ (EApp _ (BBuiltin _ Sprintf) e) e') =
        let eI = asStr (go e)
            eI' = go e'
        in mkStr (sprintf eI eI')
    go (OptionVal ty e) =
        OptionVal ty (go <$> e)
    go (EApp _ (EApp _ (EApp _ (TBuiltin _ Option) e0) e1) e2) =
        let e0' = go e0
            e1' = go e1
            e2' = go e2
        in case asOpt e2' of
                Nothing -> e0'
                Just e  -> go (EApp undefined e1' e)
    go (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyVec) _))) Map) x) y) =
        let x' = go x
            y' = asArr (go y)
        in Arr undefined (applyUn' x' <$> y')
        where applyUn' :: E (T K) -> E (T K) -> E (T K)
              applyUn' e e' = go (EApp undefined e e')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyOption) _))) Map) x) y) =
        let x' = go x
            y' = asOpt (go y)
        in OptionVal undefined (applyUn' x' <$> y')
        where applyUn' :: E (T K) -> E (T K) -> E (T K)
              applyUn' e e' = go (EApp undefined e e')
    go (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyVec) _) _))) Fold) f) seed) xs) =
        let f' = go f
            seed' = go seed
            xs' = asArr (go xs)
        in foldE f' seed' xs'
        where foldE op = V.foldl' (applyOp' op)
              applyOp' op e e' = go (EApp undefined (EApp undefined op e) e')
    go (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyVec) _) _)) Fold1) f) xs) =
        let f' = go f
            xs' = asArr (go xs)
        in
            case V.uncons xs' of
                Just (y, ys) -> foldE f' y ys
                Nothing      -> throw EmptyFold
        where foldE op = V.foldl' (applyOp' op)
              applyOp' op e e' = go (EApp undefined (EApp undefined op e) e')
    go (Arr ty es) = Arr ty (go <$> es)
    go (Cond _ p e0 e1) =
        let p' = asBool (go p)
            in if p' then go e0 else go e1
    go (EApp _ (UBuiltin _ TallyList) e) =
        let xs = asArr (go e)
            in mkI $ fromIntegral $ V.length xs
    go e = error ("Internal error: " ++ show e)

-- just shove some big number into the renamer and hope it doesn't clash (bad,
-- hack, this is why we got kicked out of the garden of Eden)
reprehensible :: Int
reprehensible = (maxBound :: Int) `div` 2

applyOp :: E (T K) -- ^ Operator
        -> E (T K)
        -> E (T K)
        -> E (T K)
applyOp op e e' = eClosed reprehensible (EApp undefined (EApp undefined op e) e') -- FIXME: undefined is ??

atField :: RurePtr
        -> Int
        -> BS.ByteString -- ^ Line
        -> BS.ByteString
atField re i = (! (i-1)) . splitBy re

mkCtx :: RurePtr -> Int -> BS.ByteString -> (Int, BS.ByteString, V.Vector BS.ByteString)
mkCtx re ix line = (ix, line, splitBy re line)

applyUn :: E (T K)
        -> E (T K)
        -> E (T K)
applyUn unOp e =
    case eLoc unOp of
        TyArr _ _ res -> eClosed reprehensible (EApp res unOp e)
        _             -> error "Internal error?"

-- | Turn an expression representing a stream into a stream of expressions (using line as context)
ir :: RurePtr
   -> E (T K)
   -> [BS.ByteString]
   -> [E (T K)] -- TODO: include chunks/context too?
ir _ AllColumn{} = fmap mkStr
ir re (Column _ i) = fmap (mkStr . atField re i)
ir re (IParseCol _ i) = fmap (parseAsEInt . atField re i)
ir re (FParseCol _ i) = fmap (parseAsF . atField re i)
ir re (ParseCol ty@(TyApp _ _ (TyB _ TyFloat)) i) = ir re (FParseCol ty i)
ir re (ParseCol ty@(TyApp _ _ (TyB _ TyInteger)) i) = ir re (IParseCol ty i)
ir re (Implicit _ e) =
    imap (\ix line -> eEval (mkCtx re ix line) e)
ir re (Guarded _ pe e) =
    -- TODO: normalize before stream
    fmap (\(ix, line) -> eEval (mkCtx re ix line) e) . ifilter' (\ix line -> asBool (eEval (mkCtx re ix line) pe))
ir re (EApp _ (EApp _ (BBuiltin _ Map) op) stream) = fmap (applyUn op) . ir re stream
ir re (EApp _ (EApp _ (BBuiltin _ Filter) op) stream) =
    filter (asBool . applyUn op) . ir re stream
ir re (EApp _ (EApp _ (BBuiltin _ MapMaybe) op) stream) =
    mapMaybe (asOpt . applyUn op) . ir re stream
ir re (EApp _ (UBuiltin _ CatMaybes) stream) =
    mapMaybe asOpt . ir re stream
ir re (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp op) . ir re stream
ir re (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream ->
    let
        irl = ir re streaml lineStream
        irr = ir re streamr lineStream
    in zipWith (applyOp op) irl irr
ir re (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) op) seed) xs) =
    scanl' (applyOp op) seed . ir re xs
ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyStr)) _) Dedup) e) =
    nubOrdOn asStr . ir re e
ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyInteger)) _) Dedup) e) =
    nubIntOn (fromIntegral . asInt) . ir re e
ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyFloat)) _) Dedup) e) =
    nubIntOn (fromEnum . asFloat) . ir re e
ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyBool)) _) Dedup) e) =
    nubIntOn (fromEnum . asBool) . ir re e

-- | Output stream that prints each entry (expression)
printStream :: [E (T K)] -> IO ()
printStream = traverse_ print

foldWithCtx :: RurePtr
            -> E (T K)
            -> E (T K)
            -> E (T K)
            -> [BS.ByteString]
            -> E (T K)
foldWithCtx re op seed streamExpr = foldl' (applyOp op) seed . ir re streamExpr

fold1 :: RurePtr
      -> E (T K)
      -> E (T K)
      -> [BS.ByteString]
      -> E (T K)
fold1 re op streamExpr bs =
    case ir re streamExpr bs of
        e:es -> foldl' (applyOp op) e es
        _    -> throw EmptyFold

runJac :: RurePtr -- ^ Record separator
       -> Int
       -> Program (T K)
       -> Either StreamError ([BS.ByteString] -> IO ())
runJac re i e = fileProcessor re (closedProgram i e)

foldAll :: RurePtr
        -> [(Int, E (T K), E (T K), E (T K))]
        -> [BS.ByteString]
        -> [(Int, E (T K))]
foldAll re foldExprs bs = evalAll seeds (mkStreams streamExprs) where
    (is, ops, seeds, streamExprs) = unzip4 foldExprs
    mkStreams = fmap (\streamExpr -> ir re streamExpr bs)

    evalAll seedsϵ ess | not (any null ess) = let es' = zipWith3 applyOp' ops seedsϵ (headMaybe <$> ess) in es' `seqAll` evalAll es' (tail' <$> ess)
                       -- if I try to use the (all null ess) criterion it space
                       -- leaks like crazy so... inspect only when we need?
                       --
                       -- (still leaks space... but less)
                       | not (all null ess) = let es' = zipWith3 applyOp' ops seedsϵ (headMaybe <$> ess) in es' `seqAll` evalAll es' (tail' <$> ess)
                       | otherwise = zip is seedsϵ

    seqAll (e:es) z = foldr seq e es `seq` z
    seqAll [] z     = z

    applyOp' op seed (Just e) = applyOp op seed e
    applyOp' _ seed Nothing   = seed

    headMaybe []    = Nothing
    headMaybe (x:_) = Just x

    tail' []     = []
    tail' (_:xs) = xs

ungather :: IM.IntMap (E (T K)) -> E (T K) -> E (T K)
ungather st (Var _ (Name _ (Unique i) _)) =
    case IM.lookup i st of
        Just res -> res
        Nothing  -> throw InternalError
ungather st (EApp ty e0 e1)  = EApp ty (ungather st e0) (ungather st e1)
ungather st (Tup ty es)      = Tup ty (ungather st <$> es)
ungather st (Arr ty es)      = Arr ty (ungather st <$> es)
ungather st (OptionVal ty e) = OptionVal ty (ungather st <$> e)
ungather _ e@BBuiltin{}      = e
ungather _ e@UBuiltin{}      = e
ungather _ (NBuiltin _ None) = OptionVal undefined Nothing
ungather _ e@NBuiltin{}      = e
ungather _ e@TBuiltin{}      = e
ungather _ e@StrLit{}        = e
ungather _ e@BoolLit{}       = e
ungather _ e@FloatLit{}      = e
ungather _ e@IntLit{}        = e

mkFoldVar :: Int -> b -> E b
mkFoldVar i l = Var l (Name "fold_placeholder" (Unique i) l)

gatherFoldsM :: E (T K) -> State (Int, [(Int, E (T K), E (T K), E (T K))]) (E (T K))
gatherFoldsM (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = do
    (i,_) <- get
    modify (bimap (+1) ((i, op, seed, stream) :))
    pure $ mkFoldVar i undefined
gatherFoldsM (EApp ty e0 e1) = EApp ty <$> gatherFoldsM e0 <*> gatherFoldsM e1
gatherFoldsM (Tup ty es) = Tup ty <$> traverse gatherFoldsM es
gatherFoldsM (Arr ty es) = Arr ty <$> traverse gatherFoldsM es
gatherFoldsM (OptionVal ty e) = OptionVal ty <$> traverse gatherFoldsM e
gatherFoldsM (Cond ty p e e') = Cond ty <$> gatherFoldsM p <*> gatherFoldsM e <*> gatherFoldsM e'
gatherFoldsM (NBuiltin _ None) = pure $ OptionVal undefined Nothing
gatherFoldsM e@BBuiltin{} = pure e
gatherFoldsM e@TBuiltin{} = pure e
gatherFoldsM e@UBuiltin{} = pure e
gatherFoldsM e@NBuiltin{} = pure e
gatherFoldsM e@StrLit{} = pure e
gatherFoldsM e@FloatLit{} = pure e
gatherFoldsM e@IntLit{} = pure e
gatherFoldsM e@BoolLit{} = pure e

eWith :: RurePtr -> E (T K) -> [BS.ByteString] -> E (T K)
eWith re (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = foldWithCtx re op seed stream
eWith re (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _)) Fold1) op) stream)                          = fold1 re op stream
eWith _ e@BBuiltin{}                                                                                                                 = const e
eWith _ e@UBuiltin{}                                                                                                                 = const e
eWith _ e@TBuiltin{}                                                                                                                 = const e
eWith _ e@StrLit{}                                                                                                                   = const e
eWith _ e@FloatLit{}                                                                                                                 = const e
eWith _ e@IntLit{}                                                                                                                   = const e
eWith _ e@BoolLit{}                                                                                                                  = const e
eWith re e = \bs ->
    let (eHoles, (_, folds)) = runState (gatherFoldsM e) (0, []) -- 0 state, should contain no vars by now
        in eClosed undefined $ ungather (IM.fromList $ foldAll re folds bs) eHoles

takeConcatMap :: (a -> [b]) -> [a] -> [b]
takeConcatMap f = concat . transpose . fmap f

-- | Given an expression, turn it into a function which will process the file.
fileProcessor :: RurePtr
              -> E (T K)
              -> Either StreamError ([BS.ByteString] -> IO ())
fileProcessor _ AllField{}    = Left NakedField
fileProcessor _ Field{}       = Left NakedField
fileProcessor _ (NBuiltin _ Ix) = Left NakedField
fileProcessor re e@AllColumn{} = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@Column{} = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@IParseCol{} = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@FParseCol{} = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@ParseCol{} = Right $ \inp -> printStream $ ir re e inp
fileProcessor re e@Guarded{} = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@Implicit{} = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (EApp _ (BBuiltin _ Filter) _) _) = Right $ \inp ->
    printStream $ ir re e inp
-- at the moment, catMaybes only works on streams
fileProcessor re e@(EApp _ (UBuiltin _ CatMaybes) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) Map) _) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) MapMaybe) _) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (EApp _ (BBuiltin _ Prior) _) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) _) _) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) _) _) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re e@(EApp _ (UBuiltin _ Dedup) _) = Right $ \inp ->
    printStream $ ir re e inp
fileProcessor re (Anchor _ es) = Right $ \inp ->
    printStream $ takeConcatMap (\e -> ir re e inp) es
fileProcessor _ Var{} = error "Internal error?"
fileProcessor _ e@IntLit{} = Right $ const (print e)
fileProcessor _ e@BoolLit{} = Right $ const (print e)
fileProcessor _ e@StrLit{} = Right $ const (print e)
fileProcessor _ e@FloatLit{} = Right $ const (print e)
fileProcessor _ e@RegexLit{} = Right $ const (print e)
fileProcessor _ Lam{} = Left UnevalFun
fileProcessor _ Dfn{} = badSugar
fileProcessor _ ResVar{} = badSugar
fileProcessor _ BBuiltin{} = Left UnevalFun
fileProcessor _ UBuiltin{} = Left UnevalFun
fileProcessor _ TBuiltin{} = Left UnevalFun
fileProcessor re e = Right $ print . eWith re e