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