{-
    BNF Converter: Java 1.5 Cup Generator
    Copyright (C) 2004  Author:  Markus Forsberg, Michael Pellauer,
                                 Bjorn Bringert

    Description   : This module generates the CUP input file. It
                    follows the same basic structure of CFtoHappy.

    Author        : Michael Pellauer
                    Bjorn Bringert

    Created       : 26 April, 2003
    Modified      : 5 Aug, 2004

-}

module BNFC.Backend.Java.CFtoCup15 ( cf2Cup, definedRules ) where

import BNFC.CF
import Data.List
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Java.CFtoJavaAbs15 (typename)
import BNFC.Options (RecordPositions(..))
import BNFC.Utils ( (+++) )
import BNFC.TypeChecker  -- We need to (re-)typecheck to figure out list instances in
                    -- defined rules.
import Data.Char

type Rules   = [(NonTerminal,[(Pattern,Action)])]
type Pattern = String
type Action  = String
type MetaVar = String

--The environment comes from the CFtoJLex
cf2Cup :: String -> String -> CF -> RecordPositions -> KeywordEnv -> String
cf2Cup :: [Char] -> [Char] -> CF -> RecordPositions -> KeywordEnv -> [Char]
cf2Cup [Char]
packageBase [Char]
packageAbsyn CF
cf RecordPositions
rp KeywordEnv
env = [[Char]] -> [Char]
unlines
    [ [Char]
header
    , [Char] -> [Cat] -> [Char]
declarations [Char]
packageAbsyn (CF -> [Cat]
forall f. CFG f -> [Cat]
allParserCats CF
cf)
    , KeywordEnv -> [Char]
tokens KeywordEnv
env
    , CF -> [Char]
specialToks CF
cf
    , CF -> [Char]
specialRules CF
cf
    , CF -> [Char]
prEntryPoint CF
cf
    , Rules -> [Char]
prRules ([Char] -> CF -> RecordPositions -> KeywordEnv -> Rules
rulesForCup [Char]
packageAbsyn CF
cf RecordPositions
rp KeywordEnv
env)
    ]
  where
    header :: String
    header :: [Char]
header = [[Char]] -> [Char]
unlines
      [ [Char]
"// -*- Java -*- This Cup file was machine-generated by BNFC"
      , [Char]
"package" [Char] -> [Char] -> [Char]
+++ [Char]
packageBase [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
      , [Char]
""
      , [Char]
"action code {:"
      , [Char]
"public java_cup.runtime.ComplexSymbolFactory.Location getLeftLocation("
      , [Char]
"    java_cup.runtime.ComplexSymbolFactory.Location ... locations) {"
      , [Char]
"  for (java_cup.runtime.ComplexSymbolFactory.Location l : locations) {"
      , [Char]
"    if (l != null) {"
      , [Char]
"      return l;"
      , [Char]
"    }"
      , [Char]
"  }"
      , [Char]
"  return null;"
      , [Char]
"}"
      , [Char]
":}"
      , [Char]
"parser code {:"
      , [Char] -> Cat -> [Char]
parseMethod [Char]
packageAbsyn (CF -> Cat
firstEntry CF
cf)
      , [Char]
"public <B,A extends java.util.LinkedList<? super B>> "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"A cons_(B x, A xs) { xs.addFirst(x); return xs; }"
      , [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> CF -> [[Char]]
definedRules [Char]
packageAbsyn CF
cf
      , [Char]
"public void syntax_error(java_cup.runtime.Symbol cur_token)"
      , [Char]
"{"
      , [Char]
"  report_error(\"Syntax Error, trying to recover and continue"
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" parse...\", cur_token);"
      , [Char]
"}"
      , [Char]
""
      , [Char]
"public void unrecovered_syntax_error(java_cup.runtime.Symbol "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"cur_token) throws java.lang.Exception"
      , [Char]
"{"
      , [Char]
"  throw new Exception(\"Unrecoverable Syntax Error\");"
      , [Char]
"}"
      , [Char]
""
      , [Char]
":}"
      ]

definedRules :: String -> CF -> [String]
definedRules :: [Char] -> CF -> [[Char]]
definedRules [Char]
packageAbsyn CF
cf =
    [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ RFun -> [[Char]] -> Exp -> [[Char]]
rule RFun
f [[Char]]
xs Exp
e | FunDef RFun
f [[Char]]
xs Exp
e <- CF -> [Pragma]
forall function. CFG function -> [Pragma]
cfgPragmas CF
cf ]
  where
    ctx :: Context
ctx = CF -> Context
buildContext CF
cf

    list :: ListConstructors
list = (Base -> [Char]) -> (Base -> [Char]) -> ListConstructors
LC (\ Base
t -> [Char]
"List" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Base -> [Char]
unBase Base
t) ([Char] -> Base -> [Char]
forall a b. a -> b -> a
const [Char]
"cons")
      where
         unBase :: Base -> [Char]
unBase (ListT Base
t) = Base -> [Char]
unBase Base
t
         unBase (BaseT [Char]
x) = Cat -> [Char]
forall a. Show a => a -> [Char]
show (Cat -> [Char]) -> Cat -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat (Cat -> Cat) -> Cat -> Cat
forall a b. (a -> b) -> a -> b
$ [Char] -> Cat
strToCat [Char]
x

    rule :: RFun -> [[Char]] -> Exp -> [[Char]]
rule RFun
f [[Char]]
xs Exp
e =
        case Err (Telescope, (Exp, Base))
-> Either [Char] (Telescope, (Exp, Base))
forall a. Err a -> Either [Char] a
runTypeChecker (Err (Telescope, (Exp, Base))
 -> Either [Char] (Telescope, (Exp, Base)))
-> Err (Telescope, (Exp, Base))
-> Either [Char] (Telescope, (Exp, Base))
forall a b. (a -> b) -> a -> b
$ ListConstructors
-> Context
-> RFun
-> [[Char]]
-> Exp
-> Err (Telescope, (Exp, Base))
checkDefinition' ListConstructors
list Context
ctx RFun
f [[Char]]
xs Exp
e of
            Left [Char]
err ->
                [Char] -> [[Char]]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
"Panic! This should have been caught already:\n"
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
            Right (Telescope
args,(Exp
e',Base
t)) ->
                [ [Char]
"public " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Base -> [Char]
javaType Base
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RFun -> [Char]
forall a. IsFun a => a -> [Char]
funName RFun
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_ (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((([Char], Base) -> [Char]) -> Telescope -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Base) -> [Char]
javaArg Telescope
args) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") {"
                , [Char]
"  return " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp -> [Char]
javaExp Exp
e' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
                , [Char]
"}"
                ]
     where

       javaType :: Base -> String
       javaType :: Base -> [Char]
javaType (ListT (BaseT [Char]
x)) = [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".List"
                                   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
catToStr (Cat -> Cat
normCat (Cat -> Cat) -> Cat -> Cat
forall a b. (a -> b) -> a -> b
$ [Char] -> Cat
strToCat [Char]
x)
       javaType (ListT Base
t)         = Base -> [Char]
javaType Base
t
       javaType (BaseT [Char]
x)         = [Char] -> [[Char]] -> [Char] -> [Char]
typename [Char]
packageAbsyn (Context -> [[Char]]
ctxTokens Context
ctx) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
                                      Cat -> [Char]
catToStr (Cat -> [Char]) -> Cat -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat (Cat -> Cat) -> Cat -> Cat
forall a b. (a -> b) -> a -> b
$ [Char] -> Cat
strToCat [Char]
x

       javaArg :: (String, Base) -> String
       javaArg :: ([Char], Base) -> [Char]
javaArg ([Char]
x,Base
t) = Base -> [Char]
javaType Base
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"

       javaExp :: Exp -> String
       javaExp :: Exp -> [Char]
javaExp (App [Char]
"null" []) = [Char]
"null"
       javaExp (Var [Char]
x)         = [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"      -- argument
       javaExp (App [Char]
t [Exp
e])
           | [Char] -> Context -> Bool
isToken [Char]
t Context
ctx     = [Char] -> [Exp] -> [Char]
call [Char]
"new String" [Exp
e]
       javaExp (App [Char]
x [Exp]
es)
           | Char -> Bool
isUpper ([Char] -> Char
forall a. [a] -> a
head [Char]
x)  = [Char] -> [Exp] -> [Char]
call ([Char]
"new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x) [Exp]
es
           | Bool
otherwise         = [Char] -> [Exp] -> [Char]
call ([Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_") [Exp]
es
       javaExp (LitInt Integer
n)      = [Char]
"new Integer(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
       javaExp (LitDouble Double
x)   = [Char]
"new Double(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
       javaExp (LitChar Char
c)     = [Char]
"new Character(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
       javaExp (LitString [Char]
s)   = [Char]
"new String(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

       call :: [Char] -> [Exp] -> [Char]
call [Char]
x [Exp]
es = [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((Exp -> [Char]) -> [Exp] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> [Char]
javaExp [Exp]
es) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"


-- peteg: FIXME JavaCUP can only cope with one entry point AFAIK.
prEntryPoint :: CF -> String
prEntryPoint :: CF -> [Char]
prEntryPoint CF
cf = [[Char]] -> [Char]
unlines [[Char]
"", [Char]
"start with " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat (CF -> Cat
firstEntry CF
cf) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";", [Char]
""]
--                  [ep]  -> unlines ["", "start with " ++ ep ++ ";", ""]
--                  eps   -> error $ "FIXME multiple entry points." ++ show eps

--This generates a parser method for each entry point.
parseMethod :: String -> Cat -> String
parseMethod :: [Char] -> Cat -> [Char]
parseMethod [Char]
packageAbsyn Cat
cat = [[Char]] -> [Char]
unlines
             [ [Char]
"  public" [Char] -> [Char] -> [Char]
+++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
+++ [Char]
"p" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cat' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"()"
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" throws Exception"
             , [Char]
"  {"
             , [Char]
"    java_cup.runtime.Symbol res = parse();"
             , [Char]
"    return (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") res.value;"
             , [Char]
"  }"
             ]
    where
    dat :: [Char]
dat  = Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
cat)
    cat' :: [Char]
cat' = Cat -> [Char]
identCat Cat
cat

--non-terminal types
declarations :: String -> [Cat] -> String
declarations :: [Char] -> [Cat] -> [Char]
declarations [Char]
packageAbsyn [Cat]
ns = [[Char]] -> [Char]
unlines ((Cat -> [Char]) -> [Cat] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Cat -> [Char]
forall {p}. p -> Cat -> [Char]
typeNT [Char]
packageAbsyn) [Cat]
ns)
 where
   typeNT :: p -> Cat -> [Char]
typeNT p
_nm Cat
nt = [Char]
"nonterminal" [Char] -> [Char] -> [Char]
+++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
nt) [Char] -> [Char] -> [Char]
+++ Cat -> [Char]
identCat Cat
nt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"

--terminal types
tokens :: KeywordEnv -> String
tokens :: KeywordEnv -> [Char]
tokens KeywordEnv
ts = [[Char]] -> [Char]
unlines ((([Char], [Char]) -> [Char]) -> KeywordEnv -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
declTok KeywordEnv
ts)
 where
  declTok :: ([Char], [Char]) -> [Char]
declTok ([Char]
s,[Char]
r) = [Char]
"terminal" [Char] -> [Char] -> [Char]
+++ [Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";    //   " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s

specialToks :: CF -> String
specialToks :: CF -> [Char]
specialToks CF
cf = [[Char]] -> [Char]
unlines
  [ [Char] -> [Char] -> [Char]
forall {p}. IsString p => [Char] -> p -> p
ifC [Char]
catString  [Char]
"terminal String _STRING_;"
  , [Char] -> [Char] -> [Char]
forall {p}. IsString p => [Char] -> p -> p
ifC [Char]
catChar    [Char]
"terminal Character _CHAR_;"
  , [Char] -> [Char] -> [Char]
forall {p}. IsString p => [Char] -> p -> p
ifC [Char]
catInteger [Char]
"terminal Integer _INTEGER_;"
  , [Char] -> [Char] -> [Char]
forall {p}. IsString p => [Char] -> p -> p
ifC [Char]
catDouble  [Char]
"terminal Double _DOUBLE_;"
  , [Char] -> [Char] -> [Char]
forall {p}. IsString p => [Char] -> p -> p
ifC [Char]
catIdent   [Char]
"terminal String _IDENT_;"
  ]
   where
    ifC :: [Char] -> p -> p
ifC [Char]
cat p
s = if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf ([Char] -> Cat
TokenCat [Char]
cat) then p
s else p
""

specialRules:: CF -> String
specialRules :: CF -> [Char]
specialRules CF
cf =
    [[Char]] -> [Char]
unlines [[Char]
"terminal String " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";" | [Char]
name <- CF -> [[Char]]
forall f. CFG f -> [[Char]]
tokenNames CF
cf]

--The following functions are a (relatively) straightforward translation
--of the ones in CFtoHappy.hs
rulesForCup :: String -> CF -> RecordPositions -> KeywordEnv -> Rules
rulesForCup :: [Char] -> CF -> RecordPositions -> KeywordEnv -> Rules
rulesForCup [Char]
packageAbsyn CF
cf RecordPositions
rp KeywordEnv
env = ((Cat, [Rule]) -> (Cat, KeywordEnv)) -> [(Cat, [Rule])] -> Rules
forall a b. (a -> b) -> [a] -> [b]
map (Cat, [Rule]) -> (Cat, KeywordEnv)
mkOne ([(Cat, [Rule])] -> Rules) -> [(Cat, [Rule])] -> Rules
forall a b. (a -> b) -> a -> b
$ CF -> [(Cat, [Rule])]
ruleGroups CF
cf where
  mkOne :: (Cat, [Rule]) -> (Cat, KeywordEnv)
mkOne (Cat
cat,[Rule]
rules) = [Char]
-> CF
-> RecordPositions
-> KeywordEnv
-> [Rule]
-> Cat
-> (Cat, KeywordEnv)
constructRule [Char]
packageAbsyn CF
cf RecordPositions
rp KeywordEnv
env [Rule]
rules Cat
cat

-- | For every non-terminal, we construct a set of rules. A rule is a sequence of
-- terminals and non-terminals, and an action to be performed.
constructRule :: String -> CF -> RecordPositions -> KeywordEnv -> [Rule] -> NonTerminal
    -> (NonTerminal,[(Pattern,Action)])
constructRule :: [Char]
-> CF
-> RecordPositions
-> KeywordEnv
-> [Rule]
-> Cat
-> (Cat, KeywordEnv)
constructRule [Char]
packageAbsyn CF
cf RecordPositions
rp KeywordEnv
env [Rule]
rules Cat
nt =
    (Cat
nt, [ ([Char]
p, [Char]
-> Cat -> [Char] -> [[Char]] -> Bool -> RecordPositions -> [Char]
generateAction [Char]
packageAbsyn Cat
nt (RFun -> [Char]
forall a. IsFun a => a -> [Char]
funName (RFun -> [Char]) -> RFun -> [Char]
forall a b. (a -> b) -> a -> b
$ Rule -> RFun
forall function. Rul function -> function
funRule Rule
r) (Bool -> [[Char]] -> [[Char]]
forall {a}. Bool -> [a] -> [a]
revM Bool
b [[Char]]
m) Bool
b RecordPositions
rp)
          | Rule
r0 <- [Rule]
rules,
          let (Bool
b,Rule
r) = if RFun -> Bool
forall a. IsFun a => a -> Bool
isConsFun (Rule -> RFun
forall function. Rul function -> function
funRule Rule
r0) Bool -> Bool -> Bool
&& Cat -> [Cat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Rule -> Cat
forall fun. Rul fun -> Cat
valCat Rule
r0) [Cat]
revs
                          then (Bool
True, Rule -> Rule
forall f. Rul f -> Rul f
revSepListRule Rule
r0)
                          else (Bool
False, Rule
r0)
              ([Char]
p,[[Char]]
m) = KeywordEnv -> Rule -> ([Char], [[Char]])
generatePatterns KeywordEnv
env Rule
r])
 where
   revM :: Bool -> [a] -> [a]
revM Bool
False = [a] -> [a]
forall a. a -> a
id
   revM Bool
True  = [a] -> [a]
forall a. [a] -> [a]
reverse
   revs :: [Cat]
revs       = CF -> [Cat]
forall f. CFG f -> [Cat]
cfgReversibleCats CF
cf

-- Generates a string containing the semantic action.
generateAction :: String -> NonTerminal -> Fun -> [MetaVar]
               -> Bool   -- ^ Whether the list should be reversed or not.
                         --   Only used if this is a list rule.
               -> RecordPositions   -- ^ Record line and column info.
               -> Action
generateAction :: [Char]
-> Cat -> [Char] -> [[Char]] -> Bool -> RecordPositions -> [Char]
generateAction [Char]
packageAbsyn Cat
nt [Char]
fun [[Char]]
ms Bool
rev RecordPositions
rp
    | [Char] -> Bool
forall a. IsFun a => a -> Bool
isNilFun [Char]
f      = [Char]
"RESULT = new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"();"
    | [Char] -> Bool
forall a. IsFun a => a -> Bool
isOneFun [Char]
f      = [Char]
"RESULT = new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(); RESULT.addLast("
                           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
    | [Char] -> Bool
forall a. IsFun a => a -> Bool
isConsFun [Char]
f     = [Char]
"RESULT = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; "
                           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
add [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
    | [Char] -> Bool
forall a. IsFun a => a -> Bool
isCoercion [Char]
f    = [Char]
"RESULT = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
    | [Char] -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule [Char]
f = [Char]
"RESULT = parser." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," [[Char]]
ms [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
    | Bool
otherwise       = [Char]
"RESULT = new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," [[Char]]
ms [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lineInfo
   where
     f :: [Char]
f   = [Char] -> [Char]
forall a. IsFun a => a -> [Char]
funName [Char]
fun
     c :: [Char]
c   = [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
           if [Char] -> Bool
forall a. IsFun a => a -> Bool
isNilFun [Char]
f Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. IsFun a => a -> Bool
isOneFun [Char]
f Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. IsFun a => a -> Bool
isConsFun [Char]
f
             then Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
nt) else [Char]
f
     p_1 :: [Char]
p_1 = [[Char]]
ms [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! Int
0
     p_2 :: [Char]
p_2 = [[Char]]
ms [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! Int
1
     add :: [Char]
add = if Bool
rev then [Char]
"addLast" else [Char]
"addFirst"
     lineInfo :: [Char]
lineInfo =
        if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions
          then case [[Char]]
ms of
            [] -> [Char]
"\n((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).line_num = -1;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).col_num = -1;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).offset = -1;"
            [[Char]]
_  -> [Char]
"\njava_cup.runtime.ComplexSymbolFactory.Location leftLoc = getLeftLocation(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"xleft") [[Char]]
ms) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\nif (leftLoc != null) {" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n  ((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).line_num = leftLoc.getLine();" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n  ((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).col_num = leftLoc.getColumn();" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n  ((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).offset = leftLoc.getOffset();" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n} else {" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n  ((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).line_num = -1;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n  ((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).col_num = -1;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n  ((" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")RESULT).offset = -1;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                  [Char]
"\n}"
          else [Char]
""


-- | Generate patterns and a set of metavariables indicating
-- where in the pattern the non-terminal.
--
-- >>> generatePatterns [] (npRule "myfun" (Cat "A") [] Parsable)
-- (" /* empty */ ",[])
--
-- >>> generatePatterns [("def", "_SYMB_1")] (npRule "myfun" (Cat "A") [Right "def", Left (Cat "B")] Parsable)
-- ("_SYMB_1:p_1 B:p_2 ",["p_2"])

generatePatterns :: KeywordEnv -> Rule -> (Pattern,[MetaVar])
generatePatterns :: KeywordEnv -> Rule -> ([Char], [[Char]])
generatePatterns KeywordEnv
env Rule
r = case Rule -> SentForm
forall function. Rul function -> SentForm
rhsRule Rule
r of
    []  -> ([Char]
" /* empty */ ", [])
    SentForm
its -> (Int -> SentForm -> [Char]
mkIt Int
1 SentForm
its, SentForm -> [[Char]]
forall {a} {b}. [Either a b] -> [[Char]]
metas SentForm
its)
 where
    mkIt :: Int -> SentForm -> [Char]
mkIt Int
_ [] = []
    mkIt Int
n (Either Cat [Char]
i:SentForm
is) =
      case Either Cat [Char]
i of
        Left Cat
c -> [Char]
c' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":p_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
n :: Int) [Char] -> [Char] -> [Char]
+++ Int -> SentForm -> [Char]
mkIt (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SentForm
is
          where
              c' :: [Char]
c' = case Cat
c of
                  TokenCat [Char]
"Ident"   -> [Char]
"_IDENT_"
                  TokenCat [Char]
"Integer" -> [Char]
"_INTEGER_"
                  TokenCat [Char]
"Char"    -> [Char]
"_CHAR_"
                  TokenCat [Char]
"Double"  -> [Char]
"_DOUBLE_"
                  TokenCat [Char]
"String"  -> [Char]
"_STRING_"
                  Cat
_ -> Cat -> [Char]
identCat Cat
c
        Right [Char]
s -> case [Char] -> KeywordEnv -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
s KeywordEnv
env of
            Just [Char]
x  -> ([Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":p_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
n :: Int)) [Char] -> [Char] -> [Char]
+++ Int -> SentForm -> [Char]
mkIt (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SentForm
is
            Maybe [Char]
Nothing -> Int -> SentForm -> [Char]
mkIt Int
n SentForm
is
    metas :: [Either a b] -> [[Char]]
metas [Either a b]
its = [[Char]
"p_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i | (Int
i,Left a
_) <- [Int] -> [Either a b] -> [(Int, Either a b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [Either a b]
its]

-- We have now constructed the patterns and actions,
-- so the only thing left is to merge them into one string.
prRules :: Rules -> String
prRules :: Rules -> [Char]
prRules []                    = []
prRules ((Cat
_ , []      ) : Rules
rs) = Rules -> [Char]
prRules Rules
rs --internal rule
prRules ((Cat
nt, ([Char]
p,[Char]
a):KeywordEnv
ls) : Rules
rs) =
    [[Char]] -> [Char]
unwords [ [Char]
nt', [Char]
"::=", [Char]
p, [Char]
"{:", [Char]
a, [Char]
":}", Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: KeywordEnv -> [Char]
pr KeywordEnv
ls ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Rules -> [Char]
prRules Rules
rs
  where
    nt' :: [Char]
nt' = Cat -> [Char]
identCat Cat
nt
    pr :: KeywordEnv -> [Char]
pr []           = []
    pr (([Char]
p,[Char]
a):KeywordEnv
ls)   = [[Char]] -> [Char]
unlines [ [[Char]] -> [Char]
unwords [ [Char]
"  |", [Char]
p, [Char]
"{:", [Char]
a , [Char]
":}" ] ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ KeywordEnv -> [Char]
pr KeywordEnv
ls