<commit_before>Module for producing GLR (Tomita) parsing code.
This module is designed as an extension to the Haskell parser generator Happy.

(c) University of Durham, <NAME> 2001
	-- initial code, for structure parsing 
(c) University of Durham, <NAME> 2004
	-- extension to semantic rules, and various optimisations

$Id: ProduceGLRCode.lhs,v 1.8 2004/10/28 12:48:48 paulcc Exp $

%-----------------------------------------------------------------------------

> module ProduceGLRCode ( produceGLRParser
>                       , DecodeOption(..)
>                       , FilterOption(..)
>                       , GhcExts(..)
>                       , Options
>                       ) where

> import GenUtils ( fst3, thd3, mapDollarDollar )
> import GenUtils ( str, char, nl, brack, brack', interleave, maybestr )
> import Grammar
> import Array
> import Maybe ( fromJust )
> import Char ( isUpper, isSpace )
> import List ( nub, (\\), sort )

%-----------------------------------------------------------------------------
File and Function Names

> base_template td = td ++ "/GLR_Base"		-- NB Happy uses / too
> lib_template  td = td ++ "/GLR_Lib"		-- Windows accepts this?

---
prefix for production names, to avoid name clashes

> prefix = "G_"

%-----------------------------------------------------------------------------
This type represents choice of decoding style for the result

> data DecodeOption
>  = TreeDecode 
>  | LabelDecode

---
This type represents whether filtering done or not

> data FilterOption
>  = NoFiltering
>  | UseFiltering

---
This type represents whether GHC extensions are used or not
 - extra values are imports and ghc options reqd

> data GhcExts
>  = NoGhcExts
>  | UseGhcExts String String 		-- imports and options

---
this is where the exts matter

> show_st :: GhcExts -> {-State-}Int -> String
> show_st UseGhcExts{} = (++"#") . show
> show_st NoGhcExts    = show

---

> type Options = (DecodeOption, FilterOption, GhcExts)


%-----------------------------------------------------------------------------
Main exported function

> produceGLRParser
>        :: FilePath 	  -- Output file name
>	 -> String 	  -- Templates directory
>	 -> ActionTable   -- LR tables
>	 -> GotoTable  	  -- LR tables 
>	 -> Maybe String  -- Module header
>	 -> Maybe String  -- User-defined stuff (token DT, lexer etc.)
>	 -> Options       -- selecting code-gen style
>	 -> Grammar 	  -- Happy Grammar
>	 -> IO ()

> produceGLRParser outfilename template_dir action goto header trailer options g
>  = do
>     let basename  = takeWhile (/='.') outfilename
>     let tbls  = (action,goto)
>     (parseName,_,_) <- case starts g of
>                          [s] -> return s
>                          s:_ -> do 
>                                    putStrLn "GLR-Happy doesn't support multiple start points (yet)"
>                                    putStrLn "Defaulting to first start point."
>                                    return s
>     mkFiles basename tbls parseName template_dir header trailer options g


%-----------------------------------------------------------------------------
"mkFiles" generates the files containing the Tomita parsing code.
It produces two files - one for the data (small template), and one for 
the driver and data strs (large template).

> mkFiles :: FilePath 	  -- Root of Output file name 
>	 -> (ActionTable
>           ,GotoTable)   -- LR tables 
>	 -> String   	  -- Start parse function name
>	 -> String 	  -- Templates directory
>	 -> Maybe String  -- Module header
>	 -> Maybe String  -- User-defined stuff (token DT, lexer etc.)
>        -> Options       -- selecting code-gen style
>	 -> Grammar 	  -- Happy Grammar
>	 -> IO ()
>
> mkFiles basename tables start templdir header trailer options g
>  = do
>	let (ext,imps,opts) = case thd3 options of 
>		    		UseGhcExts is os -> ("-ghc", is, os)
>		    		_                -> ("", "", "")
>	base <- readFile (base_template templdir)
>	--writeFile (basename ++ ".si") (unlines $ map show sem_info)
>	writeFile (basename ++ "Data.hs") (content base opts $ "")

>	lib <- readFile (lib_template templdir ++ ext)
>	writeFile (basename ++ ".hs") (lib_content imps opts lib)
>  where
>   mod_name = reverse $ takeWhile (`notElem` "\\/") $ reverse basename
>   data_mod = mod_name ++ "Data"

>   (sem_def, sem_info) = mkGSemType options g
>   table_text = mkTbls tables sem_info (thd3 options) g
  
>   content tomitaStr opts 
>    = str ("{-# OPTIONS " ++ opts ++ " #-}")  .nl
>    . str ("module " ++ data_mod ++ " where") .nl 

>     . nl
>     . maybestr header  .nl 
>     . nl
>     . str tomitaStr    .nl
>     . nl

>    . let count_nls     = length . filter (=='\n')
>          pre_trailer   = maybe 0 count_nls header    -- check fmt below
>                        + count_nls tomitaStr
>                        + 8
>          post_trailer  = pre_trailer + maybe 0 count_nls trailer + 4
>      in 
>         str ("{-# LINE " ++ show pre_trailer ++ " "
>		           ++ show (basename ++ "Data.hs") ++ "#-}") 
>		-- This should show a location in basename.y -- but Happy
>		-- doesn't pass this info through. But we still avoid being
>		-- told a location in GLR_Base! 
>       . nl
>       . nl
>       . maybestr trailer 
>       .nl
>       .nl
>       . str ("{-# LINE " ++ show post_trailer ++ " "
>		           ++ show (basename ++ "Data.hs") ++ "#-}") 
>       . nl
>       . nl

>     . mkGSymbols g     .nl
>     . nl
>     . sem_def          .nl
>     . nl
>     . mkSemObjects  options (monad g) sem_info      .nl
>     . nl
>     . mkDecodeUtils options (monad g) sem_info      .nl 
>     . nl
>     . str ("type UserDefTok = " ++ token_type g)    .nl
>     . nl
>     . table_text

>   lib_content imps opts lib_text
>    = let (pre,drop_me:post) = break (== "fakeimport DATA") $ lines lib_text
>      in 
>      unlines [ "{-# OPTIONS " ++ opts ++ " #-}"
>	       , "module " ++ mod_name ++ "("
>	       , case lexer g of 
>                  Nothing     -> ""
>                  Just (lf,_) -> "\t" ++ lf ++ ","
>	       , "\t" ++ start
>	       , ""
>	       , unlines pre
>	       , imps
>	       , "import " ++ data_mod
>	       , start ++ " = glr_parse " 
>	       , "use_filtering = " ++ show use_filtering
>	       , "top_symbol = " ++ prefix ++ start_prod
>	       , unlines post
>	       ]
>   start_prod = token_names g ! (let (_,_,i) = head $ starts g in i)
>   use_filtering = case options of (_, UseFiltering,_) -> True
>                                   _                   -> False


%-----------------------------------------------------------------------------
Formats the tables as code.
<commit_msg>[happy @ 2004-11-08 15:53:31 by paulcc] GLR generator now writes comment & version info to generated files, similar to the main generator.<commit_after>Module for producing GLR (Tomita) parsing code.
This module is designed as an extension to the Haskell parser generator Happy.

(c) University of Durham, <NAME> 2001
	-- initial code, for structure parsing 
(c) University of Durham, <NAME> 2004
	-- extension to semantic rules, and various optimisations

$Id: ProduceGLRCode.lhs,v 1.9 2004/11/08 15:53:31 paulcc Exp $

%-----------------------------------------------------------------------------

> module ProduceGLRCode ( produceGLRParser
>                       , DecodeOption(..)
>                       , FilterOption(..)
>                       , GhcExts(..)
>                       , Options
>                       ) where

> import Version ( version )
> import GenUtils ( fst3, thd3, mapDollarDollar )
> import GenUtils ( str, char, nl, brack, brack', interleave, maybestr )
> import Grammar
> import Array
> import Maybe ( fromJust )
> import Char ( isUpper, isSpace )
> import List ( nub, (\\), sort )

%-----------------------------------------------------------------------------
File and Function Names

> base_template td = td ++ "/GLR_Base"		-- NB Happy uses / too
> lib_template  td = td ++ "/GLR_Lib"		-- Windows accepts this?

---
prefix for production names, to avoid name clashes

> prefix = "G_"

%-----------------------------------------------------------------------------
This type represents choice of decoding style for the result

> data DecodeOption
>  = TreeDecode 
>  | LabelDecode

---
This type represents whether filtering done or not

> data FilterOption
>  = NoFiltering
>  | UseFiltering

---
This type represents whether GHC extensions are used or not
 - extra values are imports and ghc options reqd

> data GhcExts
>  = NoGhcExts
>  | UseGhcExts String String 		-- imports and options

---
this is where the exts matter

> show_st :: GhcExts -> {-State-}Int -> String
> show_st UseGhcExts{} = (++"#") . show
> show_st NoGhcExts    = show

---

> type Options = (DecodeOption, FilterOption, GhcExts)


%-----------------------------------------------------------------------------
Main exported function

> produceGLRParser
>        :: FilePath 	  -- Output file name
>	 -> String 	  -- Templates directory
>	 -> ActionTable   -- LR tables
>	 -> GotoTable  	  -- LR tables 
>	 -> Maybe String  -- Module header
>	 -> Maybe String  -- User-defined stuff (token DT, lexer etc.)
>	 -> Options       -- selecting code-gen style
>	 -> Grammar 	  -- Happy Grammar
>	 -> IO ()

> produceGLRParser outfilename template_dir action goto header trailer options g
>  = do
>     let basename  = takeWhile (/='.') outfilename
>     let tbls  = (action,goto)
>     (parseName,_,_) <- case starts g of
>                          [s] -> return s
>                          s:_ -> do 
>                                    putStrLn "GLR-Happy doesn't support multiple start points (yet)"
>                                    putStrLn "Defaulting to first start point."
>                                    return s
>     mkFiles basename tbls parseName template_dir header trailer options g


%-----------------------------------------------------------------------------
"mkFiles" generates the files containing the Tomita parsing code.
It produces two files - one for the data (small template), and one for 
the driver and data strs (large template).

> mkFiles :: FilePath 	  -- Root of Output file name 
>	 -> (ActionTable
>           ,GotoTable)   -- LR tables 
>	 -> String   	  -- Start parse function name
>	 -> String 	  -- Templates directory
>	 -> Maybe String  -- Module header
>	 -> Maybe String  -- User-defined stuff (token DT, lexer etc.)
>        -> Options       -- selecting code-gen style
>	 -> Grammar 	  -- Happy Grammar
>	 -> IO ()
>
> mkFiles basename tables start templdir header trailer options g
>  = do
>	let (ext,imps,opts) = case thd3 options of 
>		    		UseGhcExts is os -> ("-ghc", is, os)
>		    		_                -> ("", "", "")
>	base <- readFile (base_template templdir)
>	--writeFile (basename ++ ".si") (unlines $ map show sem_info)
>	writeFile (basename ++ "Data.hs") (content base opts $ "")

>	lib <- readFile (lib_template templdir ++ ext)
>	writeFile (basename ++ ".hs") (lib_content imps opts lib)
>  where
>   mod_name = reverse $ takeWhile (`notElem` "\\/") $ reverse basename
>   data_mod = mod_name ++ "Data"

>   (sem_def, sem_info) = mkGSemType options g
>   table_text = mkTbls tables sem_info (thd3 options) g
  
>   content tomitaStr opts 
>    = str (comment "data")                    .nl .nl
>    . str ("{-# OPTIONS " ++ opts ++ " #-}")  .nl
>    . str ("module " ++ data_mod ++ " where") .nl 

>     . nl
>     . maybestr header  .nl 
>     . nl
>     . str tomitaStr    .nl
>     . nl

>    . let count_nls     = length . filter (=='\n')
>          pre_trailer   = maybe 0 count_nls header	-- check fmt below
>                        + count_nls tomitaStr
>                        + 10				-- for the other stuff
>          post_trailer  = pre_trailer + maybe 0 count_nls trailer + 4
>      in 
>         str ("{-# LINE " ++ show pre_trailer ++ " "
>		           ++ show (basename ++ "Data.hs") ++ "#-}") 
>		-- This should show a location in basename.y -- but Happy
>		-- doesn't pass this info through. But we still avoid being
>		-- told a location in GLR_Base! 
>       . nl
>       . nl
>       . maybestr trailer 
>       .nl
>       .nl
>       . str ("{-# LINE " ++ show post_trailer ++ " "
>		           ++ show (basename ++ "Data.hs") ++ "#-}") 
>       . nl
>       . nl

>     . mkGSymbols g     .nl
>     . nl
>     . sem_def          .nl
>     . nl
>     . mkSemObjects  options (monad g) sem_info      .nl
>     . nl
>     . mkDecodeUtils options (monad g) sem_info      .nl 
>     . nl
>     . str ("type UserDefTok = " ++ token_type g)    .nl
>     . nl
>     . table_text

>   lib_content imps opts lib_text
>    = let (pre,drop_me:post) = break (== "fakeimport DATA") $ lines lib_text
>      in 
>      unlines [ comment "driver" ++ "\n"
>              , "{-# OPTIONS " ++ opts ++ " #-}"
>	       , "module " ++ mod_name ++ "("
>	       , case lexer g of 
>                  Nothing     -> ""
>                  Just (lf,_) -> "\t" ++ lf ++ ","
>	       , "\t" ++ start
>	       , ""
>	       , unlines pre
>	       , imps
>	       , "import " ++ data_mod
>	       , start ++ " = glr_parse " 
>	       , "use_filtering = " ++ show use_filtering
>	       , "top_symbol = " ++ prefix ++ start_prod
>	       , unlines post
>	       ]
>   start_prod = token_names g ! (let (_,_,i) = head $ starts g in i)
>   use_filtering = case options of (_, UseFiltering,_) -> True
>                                   _                   -> False

> comment which
>  = "-- parser (" ++ which ++ ") produced by Happy (GLR) Version " ++ version


%-----------------------------------------------------------------------------
Formats the tables as code.

{'fraction_non_alphanumeric': 0.1870120394016782, 'fraction_numerical': 0.005764319591390003, 'mean_word_length': 1.5870139675349189, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 336, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4899224', 'n_tokens_mistral': 4295, 'n_tokens_neox': 4100, 'n_words': 1256}