How to pass a function as argument to a generated Happy parser?

Question

Happy generates a parser with signature :: [Token] -> a

I would like to generate a parameterized parser, i.e., a function that needs a function as argument to deliver a parser. So I would like the signature :: (x->y) -> [Token] -> a. Yet, I can also work with the signature :: [Token] -> (x->y) -> a.

When the function is fixed, I can solve it by importing and assigning the function.

import Functions (fixedFunction)

Root : Production Rule
       { $$.argument = fixedFunction
       }

When the argument is an instance of Show, I can solve it as follows

Alex:
   data Token = ...
              |  Carg            ArgType
Happy:
    %token 
        ...
        Argument { Carg $$ }

    Root : Argument Production Rule
           {  $$.argument = $1
           }

See e.g. my project TorXakis for more details, in particular the folder https://github.com/TorXakis/TorXakis/tree/develop/sys/front/src

However, I am unable to pass a variable argument that is a function since a function does not derive from Show! Since Haskell is a functional language, I have the strong suspicion that I am missing something trivial, yet I don't see it... Can anybody please provide an example of passing a function to a happy-generated parser? Thanks in advance!

Pierre

Answer 1

This example is based on the standard happy example ( see e.g. https://www.haskell.org/happy/doc/html/sec-using.html) This example uses no monads and no attributes.

The Expression parser needs a function to "standardize" the variable names. For example, make them case insensitive or, like in old programming languages, consider only the first 8 characters.

The parser is:

{
module Calc
( calc
, lexer
)
where
import Data.Char
}
%name calc
%tokentype { Token }
%error { parseError }

%token 
      let             { TokenLet }
      in              { TokenIn }
      int             { TokenInt $$ }
      var             { TokenVar $$ }
      '='             { TokenEq }
      '+'             { TokenPlus }
      '-'             { TokenMinus }
      '*'             { TokenTimes }
      '/'             { TokenDiv }
      '('             { TokenOB }
      ')'             { TokenCB }

%%

Exp   :: { (String -> String) -> Exp } 
      : let var '=' Exp in Exp  { \p -> Let (p $2) ($4 p) ($6 p) }
      | Exp1                    { \p -> Exp1 ($1 p) }

Exp1  :: { (String -> String) -> Exp1 } 
      : Exp1 '+' Term           { \p -> Plus ($1 p) ($3 p) }
      | Exp1 '-' Term           { \p -> Minus ($1 p) ($3 p) }
      | Term                    { \p -> Term ($1 p) }

Term  :: { (String -> String) -> Term } 
      : Term '*' Factor         { \p -> Times ($1 p) ($3 p) }
      | Term '/' Factor         { \p -> Div ($1 p) ($3 p) }
      | Factor                  { \p -> Factor ($1 p) }

Factor:: { (String -> String) -> Factor }
      : int                     { \p -> Int $1 }
      | var                     { \p -> Var (p $1) }
      | '(' Exp ')'             { \p -> Brack ($2 p) }

{
parseError :: [Token] -> a
parseError _ = error "Parse error"

data Exp  
      = Let String Exp Exp
      | Exp1 Exp1
      deriving Show

data Exp1 
      = Plus Exp1 Term 
      | Minus Exp1 Term 
      | Term Term
      deriving Show

data Term 
      = Times Term Factor 
      | Div Term Factor 
      | Factor Factor
      deriving Show

data Factor 
      = Int Int 
      | Var String 
      | Brack Exp
      deriving Show

data Token
      = TokenLet
      | TokenIn
      | TokenInt Int
      | TokenVar String
      | TokenEq
      | TokenPlus
      | TokenMinus
      | TokenTimes
      | TokenDiv
      | TokenOB
      | TokenCB
 deriving Show


lexer :: String -> [Token]
lexer [] = []
lexer (c:cs) 
      | isSpace c = lexer cs
      | isAlpha c = lexVar (c:cs)
      | isDigit c = lexNum (c:cs)
lexer ('=':cs) = TokenEq : lexer cs
lexer ('+':cs) = TokenPlus : lexer cs
lexer ('-':cs) = TokenMinus : lexer cs
lexer ('*':cs) = TokenTimes : lexer cs
lexer ('/':cs) = TokenDiv : lexer cs
lexer ('(':cs) = TokenOB : lexer cs
lexer (')':cs) = TokenCB : lexer cs

lexNum cs = TokenInt (read num) : lexer rest
      where (num,rest) = span isDigit cs

lexVar cs =
   case span isAlpha cs of
      ("let",rest) -> TokenLet : lexer rest
      ("in",rest)  -> TokenIn : lexer rest
      (var,rest)   -> TokenVar var : lexer rest

}

and the Main using the parser is

module Main

where 
import Data.Char
import Calc

caseSensitive :: String -> String
caseSensitive = id

caseInsensitive :: String -> String
caseInsensitive = map toUpper

firstEight :: String -> String
firstEight = take 8

main :: IO ()
main = getContents >>= (\a -> print (calc (lexer a) caseInsensitive) )

Using the expression parser with the caseInsensitive function and the input

let aap = 7 in Aap + AAP

result in the output

Let "AAP" (Exp1 (Term (Factor (Int 7)))) (Exp1 (Plus (Term (Factor (Var "AAP"))) (Factor (Var "AAP"))))

This answers my own question partly: I would like to pass the function around using attributes and not explicitly as in this example...

Answer 2

happy allows you to work over Monad. It can consume lexer functions with one of the next two signatures:

1. [Token] -> a
2. Monad m => (Token -> m a) -> m a

First option is context-free and second is context-aware. If you need to pass extra arguments to lexer function you can do one of two things:

1. Partially apply lexer to you function in .y file like this:

   %lexer { lexer fixedFunction }

   And your lexer function will have type T -> [Token] -> a where T is type of fixedFunction.

2. Pass function inside some context, like Reader monad. I used State monad to track token positions. You can see my examples here: my monad and my lexer.

With any solution you can add extra arguments and some extra context to your lexer.