mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-12 06:19:33 -06:00
106 lines
2.7 KiB
Haskell
106 lines
2.7 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(..)
|
|
|
|
-- * Name
|
|
, FName
|
|
, isCoercionF
|
|
|
|
-- * Grammar
|
|
, 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 qualified GF.GFCC.CId as AbsGFCC
|
|
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 #-} !FCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int
|
|
| FSymTok FToken
|
|
|
|
|
|
------------------------------------------------------------
|
|
-- Name
|
|
type FName = NameProfile AbsGFCC.CId
|
|
|
|
isCoercionF :: FName -> Bool
|
|
isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.wildCId
|
|
isCoercionF _ = False
|
|
|
|
|
|
------------------------------------------------------------
|
|
-- Grammar
|
|
|
|
type FPointPos = Int
|
|
type FGrammar = ([FRule], Map.Map AbsGFCC.CId [FCat])
|
|
data FRule = FRule FName [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
|
|
|
|
------------------------------------------------------------
|
|
-- pretty-printing
|
|
|
|
instance Print AbsGFCC.CId where
|
|
prt = AbsGFCC.prCId
|
|
|
|
instance Print FSymbol where
|
|
prt (FSymCat c 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 name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
|
|
" =\n [" ++ prtSep "\n " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
|
|
prtList = prtSep "\n"
|