Using Parsec with a recursive data as the stream

Hello, I've posted this question in StackOverflow[1], but I thought this would be a good place to ask too: I'm writing an interpreter for functional programming language with with *mixfix operators*, just like Agda[2]. I used their paper[3] as reference. if_then_else_ : Bool -> a -> a -> a if True then x else _ = x if False then _ else x = x _/\_ : Bool -> Bool -> Bool True /\ True = True _ /\ _ = False So that means I had to run a parser (I used Alex/Happy), to get an AST, with this specific part (smaller than actual `Expr`): data Expr = Id String | Apply [Expr] | Forall Type Expr data Type = TypeBind String Expr And with this `Expr`, I have to run a second parser (which I intend to use Parsec) to do the following kind of processing: λ let example = Apply [Id "if", Id "a", Id "/\\", Id "b", Id "then", Id "c", Id "else", Id "d"] λ parseMixfix example Right (Apply [Id "if_then_else_",Apply [Id "_/\\_",Id "a",Id "b"],Id "c",Id "d"]) I started with a Parser that received a `Stream` of `[Expr]`, but this only accepts the lists in a `Apply`, and doesn't go deep in the *tree*, just parses on the top level. So I'm considering the option of instead of using `[Expr]` as the `Stream`, to use `Expr`, having to do the `Stream` instance for it; this is where I'm at: data Tok a = This a | Over (Tok a) deriving (Show) instance (Monad m) => Stream Expr m (Tok Expr) where uncons ex = check ex where check :: Monad m => Expr -> m (Maybe (Tok Expr, Expr)) check ex = case ex of Id s -> return $ Just (This (Id s), Apply []) Apply (x:xs) -> do mst <- check x return $ fmap (\(a, b) -> (Over a, b)) mst Which is using `data Tok` as kind of a Zipper breadcrumb (or at least I see it that way), to indicate how deep in the tree it comes from. I know this is not the correct code, but is for you folks to get the idea. I'm wondering if I'm on the right track or if there's a better solution for this problem. I'm also missing the `Forall` case here; that's because I was making tests with an `Id | Apply` only tree before. [1]: http://stackoverflow.com/posts/32831287 [2]: http://wiki.portal.chalmers.se/agda/pmwiki.php?n=ReferenceManual.Mixfix [3]: http://www.cse.chalmers.se/~nad/publications/danielsson-norell-mixfix.pdf
participants (1)
-
Matteo Ferrando