content: {-
      BNF Converter: C++ Skeleton generation
      Copyright (C) 2004  Author:  Michael Pellauer
  
      Description   : This module generates the C++ Skeleton functions.
  
                      The generated files use the Visitor design pattern.
  
      Author        : Michael Pellauer
      Created       : 9 August, 2003
      Modified      : 29 August, 2006 Aarne Ranta
  
  -}
  
  module BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL (cf2CVisitSkel) where
  
  import Data.Char
  
  import BNFC.CF
  import BNFC.Utils ((+++), unless)
  import BNFC.Backend.Common.OOAbstract
  import BNFC.Backend.CPP.Naming
  import BNFC.Backend.CPP.STL.STLUtils
  
  --Produces (.H file, .C file)
  cf2CVisitSkel :: Bool -> Maybe String -> CF -> (String, String)
  cf2CVisitSkel useSTL inPackage cf =
   ( mkHFile useSTL inPackage cab
   , mkCFile useSTL inPackage cab
   )
   where
      cab = cf2cabs cf
  
  -- **** Header (.H) File Functions ****
  
  --Generates the Header File
  mkHFile :: Bool -> Maybe String -> CAbs -> String
  mkHFile useSTL inPackage cf = unlines [
    "#ifndef " ++ hdef,
    "#define " ++ hdef,
    "/* You might want to change the above name. */",
    "",
    "#include \"Absyn.H\"",
    "",
    nsStart inPackage,
    "class Skeleton : public Visitor",
    "{",
    "public:",
    unlines ["  void visit" ++ b ++ "(" ++ b ++ " *p);" |
              b <- classes, notElem b (defineds cf), useSTL || notElem b (postokens cf) ],
    unlines ["  void visit" ++ b ++ "(" ++ b ++  " x);" | b <- basics useSTL cf ],
    "};",
    nsEnd inPackage,
    "",
    "#endif"
   ]
   where
     hdef = nsDefine inPackage "SKELETON_HEADER"
     classes = allClasses cf
  
  -- CPP/NoSTL treats 'position token' as just 'token'.
  basics :: Bool -> CAbs -> [String]
  basics useSTL cf = concat
    [ map fst basetypes
    , tokentypes cf
    , unless useSTL $ postokens cf
    ]
  
  
  -- **** Implementation (.C) File Functions ****
  
  --Makes the .C File
  mkCFile :: Bool -> Maybe String -> CAbs -> String
  mkCFile useSTL inPackage cf = unlines [
    headerC,
    nsStart inPackage,
    unlines [
      "void Skeleton::visit" ++ t ++ "(" ++
         t ++ " *t) {} //abstract class" | t <- absclasses cf],
    unlines [ prCon   r  | (_,rs)  <- signatures cf, r <- rs, useSTL || not (posRule r) ],
    unlines [ prList useSTL cb | cb <- listtypes cf ],
    unlines [ prBasic b  | b  <- base ],
    nsEnd inPackage
   ]
    where
    -- See OOAbstract 'posdata':
    posRule (c, _) = c `elem` postokens cf
    base = basics useSTL cf
    prCon (f,cs) = unlines [
      "void Skeleton::visit" ++ f ++ "(" ++ f ++ " *" ++ v ++ ")",
      "{",
      "  /* Code For " ++ f ++ " Goes Here */",
      "",
      unlines ["  " ++ visitArg c | c <- cs],
      "}"
     ]
     where
       v = mkVariable f
       visitArg (cat,isPt,var)
         | isPt && (useSTL || cat `notElem` base)
                     = "if (" ++ field ++ ") " ++ field ++ "->accept(this);"
         | otherwise = "visit" ++ cat ++ "(" ++ field ++ ");"
         where field = v ++ "->" ++ var
  
  headerC :: String
  headerC = unlines [
        "/*** Visitor Design Pattern Skeleton. ***/",
        "/* This implements the common visitor design pattern.",
        "   Note that this method uses Visitor-traversal of lists, so",
        "   List->accept() does NOT traverse the list. This allows different",
        "   algorithms to use context information differently. */",
        "",
        "#include \"Skeleton.H\"",
        ""
        ]
  
  prBasic :: String -> String
  prBasic c = unlines [
    "void Skeleton::visit" ++ c ++ "(" ++ c ++ " x)",
    "{",
    "  /* Code for " ++ c ++ " Goes Here */",
    "}"
    ]
  
  prList :: Bool -> (String, Bool) -> String
  prList True (cl,b) = unlines [
    "void Skeleton::visit" ++ cl ++ "("++ cl +++ "*" ++ vname ++ ")",
    "{",
    "  for ("++ cl ++"::iterator i = " ++
         vname++"->begin() ; i != " ++vname ++"->end() ; ++i)",
    "  {",
    if b
      then "    (*i)->accept(this);"
      else "    visit" ++ drop 4 cl ++ "(*i) ;",
    "  }",
    "}"
    ]
   where
     vname = mkVariable cl
  
  prList False (cl,b) = unlines
    [ "void Skeleton::visit" ++ cl ++ "("++ cl +++ "*" ++ vname ++ ")"
    , "{"
    , "  while (" ++ vname ++ ")"
    , "  {"
    , "    /* Code For " ++ cl ++ " Goes Here */"
    , if b
        then "    if (" ++ field ++ ") " ++ field ++ "->accept(this);"
        else "    visit" ++ ecl ++ "(" ++ field ++ ");"
    , "    " ++ vname ++ " = " ++ vname ++ "->" ++ next ++ "_;"
    , "  }"
    , "}"
    ]
    where
    ecl    = drop 4 cl  -- drop "List"
    vname  = mkVariable cl
    next   = map toLower cl
    member = map toLower ecl ++ "_"
    field  = vname ++ "->" ++ member
  