<commit_before>>{-# LINE 1 "GLR_Lib.lhs" #-}

{-
   GLR_Lib.lhs
   $Id: GLR_Lib.lhs,v 1.3 2004/09/07 15:53:48 paulcc Exp $
-}

> {-
> Parser driver for the GLR parser.
> 
> (c) University of Durham, <NAME> 2001
>         -- initial code, for structure parsing
> (c) University of Durham, <NAME> 2004
>         -- extension to semantic rules
>         -- shifting to chart data structure
>         -- supporting hidden left recursion
>         -- many optimisations
> -}

{- supplied by Happy 
<> module XYZ ( 
<>              lexer	-- conditional
-}

>	-- probable, but might want to parametrise
>           , doParse
>           , TreeDecode(..), decode	-- only for tree decode
>           , LabelDecode(..)		-- only for label decode

>	-- standard exports
>           , Tokens
>           , GLRResult(..)
>           , NodeMap
>           , RootNode
>           , ForestId
>           , GSymbol(..)
>           , Branch(..)
>           , GSem(..)
>           )
>  where

<> import IOExts 

>import Char
>import System
>import Data.FiniteMap

>import Monad (foldM)
>import Maybe ( fromJust )
>import List ( insertBy , nub , maximumBy, partition , find )

>{- these inserted by Happy -}

>fakeimport DATA

{- borrowed from GenericTemplate.hs -}

#ifdef HAPPY_GHC
#define ILIT(n) n#
#define IBOX(n) (I# (n))
#define FAST_INT Int#
#define ULT(n,m) (n <# m)
#define GTE(n,m) (n >=# m)
#define UEQ(n,m) (n ==# m)
#define PLUS(n,m) (n +# m)
#define MINUS(n,m) (n -# m)
#define TIMES(n,m) (n *# m)
#define NEGATE(n) (negateInt# (n))
#define IF_GHC(x) (x)
#else
#define ILIT(n) (n)
#define IBOX(n) (n)
#define FAST_INT Int
#define ULT(n,m) (n < m)
#define GTE(n,m) (n >= m)
#define UEQ(n,m) (n == m)
#define PLUS(n,m) (n + m)
#define MINUS(n,m) (n - m)
#define TIMES(n,m) (n * m)
#define NEGATE(n) (negate (n))
#define IF_GHC(x)
#endif


>doParse = glr_parse


%----------------------------------------------------------------------------
Main data types

A forest is a map of `spans' to branches, where a span is a start position,
and end position, and a grammatical category for that interval. Branches
are lists of conjunctions of symbols which can be matched in that span.
Note that tokens are stored as part of the spans.

>type Forest       = FiniteMap ForestId [Branch]


---
End result of parsing: 
 - successful parse with rooted forest
 - else syntax error or premature eof

>type NodeMap = [(ForestId, [Branch])]
>type RootNode = ForestId
>type Tokens = [[(Int, GSymbol)]]	-- list of ambiguous lexemes

>data GLRResult 
> = ParseOK     RootNode NodeMap    -- forest with root
> | ParseError  Tokens   NodeMap    -- partial forest with bad input
> | ParseEOF             NodeMap    -- partial forest (missing input)
>   deriving Show

%-----------------------
Forest to simplified output

>forestResult :: Int -> Forest -> GLRResult
>forestResult length f
> = case roots of
>	[]       -> ParseEOF ns_map
>	[r]      -> ParseOK r ns_map
>	rs@(_:_) -> error $ "multiple roots in forest, = " ++ show rs
>						++ unlines (map show ns_map)
>   where
>	ns_map = fmToList f 
>	roots = [ r | (r@(0,sz,sym),_) <- ns_map
>	            , sz == length
>	            , sym == top_symbol ]


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

>glr_parse :: [[UserDefTok]] -> GLRResult
>glr_parse toks 
> = case runST emptyFM [0..] (tp toks) of
>    (f,Left ts)   -> ParseError ts (fmToList f) 
>						-- Error within sentence
>    (f,Right ss)  -> forestResult (length toks) f
>						-- Either good parse or EOF
>   where
>	tp tss = doActions [initTS 0] 
>	       $ zipWith (\i ts -> [(i, t) | t <- ts]) [0..] 
>              $ [ [ HappyTok {-j-} t | (j,t) <- zip [0..] ts ] | ts <- tss ]
>                ++ [[HappyEOF]]

---

>type PM a = ST Forest [Int] a
>type FStack = TStack ForestId


---
main function

>doActions :: [FStack] -> Tokens -> PM (Either Tokens [FStack])

>doActions ss [] 		-- no more tokens (this is ok)
> = return (Right ss)		-- return the stacks (may be empty)

>doActions stks (tok:toks)
> = do
>	stkss <- sequence [ do<commit_msg>[happy @ 2004-09-08 10:42:28 by paulcc] changed output representation to FiniteMap - much more useful.<commit_after>>{-# LINE 1 "GLR_Lib.lhs" #-}

{-
   GLR_Lib.lhs
   $Id: GLR_Lib.lhs,v 1.4 2004/09/08 10:42:28 paulcc Exp $
-}

> {-
> Parser driver for the GLR parser.
> 
> (c) University of Durham, <NAME> 2001
>         -- initial code, for structure parsing
> (c) University of Durham, <NAME> 2004
>         -- extension to semantic rules
>         -- shifting to chart data structure
>         -- supporting hidden left recursion
>         -- many optimisations
> -}

{- supplied by Happy 
<> module XYZ ( 
<>              lexer	-- conditional
-}

>	-- probable, but might want to parametrise
>           , doParse
>           , TreeDecode(..), decode	-- only for tree decode
>           , LabelDecode(..)		-- only for label decode

>	-- standard exports
>           , Tokens
>           , GLRResult(..)
>           , NodeMap
>           , RootNode
>           , ForestId
>           , GSymbol(..)
>           , Branch(..)
>           , GSem(..)
>           )
>  where

<> import IOExts 

>import Char
>import System
>import Data.FiniteMap

>import Monad (foldM)
>import Maybe ( fromJust )
>import List ( insertBy , nub , maximumBy, partition , find )

>{- these inserted by Happy -}

>fakeimport DATA

{- borrowed from GenericTemplate.hs -}

#ifdef HAPPY_GHC
#define ILIT(n) n#
#define IBOX(n) (I# (n))
#define FAST_INT Int#
#define ULT(n,m) (n <# m)
#define GTE(n,m) (n >=# m)
#define UEQ(n,m) (n ==# m)
#define PLUS(n,m) (n +# m)
#define MINUS(n,m) (n -# m)
#define TIMES(n,m) (n *# m)
#define NEGATE(n) (negateInt# (n))
#define IF_GHC(x) (x)
#else
#define ILIT(n) (n)
#define IBOX(n) (n)
#define FAST_INT Int
#define ULT(n,m) (n < m)
#define GTE(n,m) (n >= m)
#define UEQ(n,m) (n == m)
#define PLUS(n,m) (n + m)
#define MINUS(n,m) (n - m)
#define TIMES(n,m) (n * m)
#define NEGATE(n) (negate (n))
#define IF_GHC(x)
#endif


>doParse = glr_parse


%----------------------------------------------------------------------------
Main data types

A forest is a map of `spans' to branches, where a span is a start position,
and end position, and a grammatical category for that interval. Branches
are lists of conjunctions of symbols which can be matched in that span.
Note that tokens are stored as part of the spans.

>type Forest       = FiniteMap ForestId [Branch]

---
End result of parsing: 
 - successful parse with rooted forest
 - else syntax error or premature eof

>type NodeMap = [(ForestId, [Branch])]
>type RootNode = ForestId
>type Tokens = [[(Int, GSymbol)]]	-- list of ambiguous lexemes

>data GLRResult 
> = ParseOK     RootNode Forest    -- forest with root
> | ParseError  Tokens   Forest    -- partial forest with bad input
> | ParseEOF             Forest    -- partial forest (missing input)

%-----------------------
Forest to simplified output

>forestResult :: Int -> Forest -> GLRResult
>forestResult length f
> = case roots of
>	[]       -> ParseEOF f
>	[r]      -> ParseOK r f
>	rs@(_:_) -> error $ "multiple roots in forest, = " ++ show rs
>						++ unlines (map show ns_map)
>   where
>	ns_map = fmToList f 
>	roots = [ r | (r@(0,sz,sym),_) <- ns_map
>	            , sz == length
>	            , sym == top_symbol ]


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

>glr_parse :: [[UserDefTok]] -> GLRResult
>glr_parse toks 
> = case runST emptyFM [0..] (tp toks) of
>    (f,Left ts)   -> ParseError ts f 
>						-- Error within sentence
>    (f,Right ss)  -> forestResult (length toks) f
>						-- Either good parse or EOF
>   where
>	tp tss = doActions [initTS 0] 
>	       $ zipWith (\i ts -> [(i, t) | t <- ts]) [0..] 
>              $ [ [ HappyTok {-j-} t | (j,t) <- zip [0..] ts ] | ts <- tss ]
>                ++ [[HappyEOF]]

---

>type PM a = ST Forest [Int] a
>type FStack = TStack ForestId


---
main function

>doActions :: [FStack] -> Tokens -> PM (Either Tokens [FStack])

>doActions ss [] 		-- no more tokens (this is ok)
> = return (Right ss)		-- return the stacks (may be empty)

>doActions stks (tok:toks)
> = do
>	stkss <- sequence [ do
{'fraction_non_alphanumeric': 0.185546875, 'fraction_numerical': 0.009033203125, 'mean_word_length': 2.151153846153846, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 192, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2810953', 'n_tokens_mistral': 3017, 'n_tokens_neox': 2851, 'n_words': 924}