<div dir="ltr"><div>I need a custom stream that supports insertion of include files and expansions of macros.</div><div>I also want to be able to give nice error messages (think of clang macro-expansion backtrace), so I cannot use the standard trick of concatenating included files and expanded macros to the current input with setInput/getInput (I think I can't maybe there's a way of keeping a more complex "position" and since the use in producing an error backtrac is rare, it migth be worth exploring; if anybody has ideas here, I'm listening)</div><div><br></div><div>Assuming I need a more compelx stream, this is what I have (Macro and File both have a string argument, but it will be more compicated, a list of expansions for Macro for instance).</div><div><br></div><div>Is there a better way for doing this?</div><div>What are the performance implications with backtracking? I'll be benchmarking it, but if people see obvious problems, let me know.</div><div><br></div><div>Thanks a lot,</div><div>  Maurizio</div><div><br></div><div>{-# LANGUAGE FlexibleInstances #-}</div><div>{-# LANGUAGE FlexibleContexts #-}</div><div>{-# LANGUAGE InstanceSigs #-}</div><div>{-# LANGUAGE MultiParamTypeClasses #-}</div><div><br></div><div>module Parsing where</div><div><br></div><div>import Text.Parsec</div><div><br></div><div>type Parser s m = ParsecT s () m</div><div><br></div><div>data VStream = File String | Macro String deriving Show</div><div><br></div><div>newtype StreamStack = StreamStack [VStream] deriving Show</div><div><br></div><div>instance (Monad m) ⇒ Stream VStream m Char where</div><div>  uncons ∷ VStream -> m (Maybe (Char, VStream))</div><div>  uncons (File (a:as)) = return $ Just (a, File as)</div><div>  uncons (File []) = return Nothing</div><div>  uncons (Macro (a:as)) = return $ Just (a, File as)</div><div>  uncons (Macro []) = return Nothing</div><div><br></div><div>    </div><div>  </div><div>instance (Monad m) => Stream StreamStack  m Char where</div><div>  uncons (StreamStack []) = return Nothing</div><div>  uncons (StreamStack (s:ss)) =</div><div>    case uncons s of</div><div>     Nothing → uncons $ StreamStack ss</div><div>     Just Nothing → uncons $ StreamStack ss</div><div>     Just (Just (c, File s')) → return $ Just (c, StreamStack (File s': ss))</div><div>     Just (Just (c, Macro s')) → return $ Just (c, StreamStack (Macro s':ss))</div><div><br></div></div>