forked from GitHub/gf-core
100 lines
2.5 KiB
Haskell
100 lines
2.5 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- Maintainer : Krasimir Angelov
|
|
-- Stability : (stable)
|
|
-- Portability : (portable)
|
|
--
|
|
-- Definitions of fast multiple context-free grammars
|
|
-----------------------------------------------------------------------------
|
|
|
|
module GF.Formalism.FCFG
|
|
(
|
|
-- * Token
|
|
FToken
|
|
|
|
-- * Category
|
|
, FPath
|
|
, FCat
|
|
|
|
, fcatString, fcatInt, fcatFloat, fcatVar
|
|
|
|
-- * Symbol
|
|
, FIndex
|
|
, FSymbol(..)
|
|
|
|
-- * Grammar
|
|
, Profile
|
|
, FPointPos
|
|
, FGrammar
|
|
, FRule(..)
|
|
) where
|
|
|
|
import Control.Monad (liftM)
|
|
import Data.List (groupBy)
|
|
import Data.Array
|
|
import qualified Data.Map as Map
|
|
|
|
import GF.Formalism.Utilities
|
|
import GF.GFCC.CId
|
|
import GF.Infra.PrintClass
|
|
|
|
------------------------------------------------------------
|
|
-- Token
|
|
type FToken = String
|
|
|
|
|
|
------------------------------------------------------------
|
|
-- Category
|
|
type FPath = [FIndex]
|
|
type FCat = Int
|
|
|
|
fcatString, fcatInt, fcatFloat, fcatVar :: Int
|
|
fcatString = (-1)
|
|
fcatInt = (-2)
|
|
fcatFloat = (-3)
|
|
fcatVar = (-4)
|
|
|
|
|
|
------------------------------------------------------------
|
|
-- Symbol
|
|
type FIndex = Int
|
|
data FSymbol
|
|
= FSymCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int
|
|
| FSymTok FToken
|
|
|
|
|
|
------------------------------------------------------------
|
|
-- Grammar
|
|
|
|
type Profile = [Int]
|
|
type FPointPos = Int
|
|
type FGrammar = ([FRule], Map.Map CId [FCat])
|
|
data FRule = FRule CId [Profile] [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
|
|
|
|
------------------------------------------------------------
|
|
-- pretty-printing
|
|
|
|
instance Print CId where
|
|
prt = prCId
|
|
|
|
instance Print FSymbol where
|
|
prt (FSymCat l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
|
|
prt (FSymTok t) = simpleShow (prt t)
|
|
where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
|
|
mkEsc '\\' = "\\\\"
|
|
mkEsc '\"' = "\\\""
|
|
mkEsc '\n' = "\\n"
|
|
mkEsc '\t' = "\\t"
|
|
mkEsc chr = [chr]
|
|
prtList = prtSep " "
|
|
|
|
instance Print FRule where
|
|
prt (FRule fun profile args res lins) =
|
|
prt fun ++ prtProf profile ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
|
|
" =\n [" ++ prtSep "\n " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
|
|
where
|
|
prtProf [] = "?"
|
|
prtProf args = prtSep "=" args
|
|
|
|
prtList = prtSep "\n"
|