mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-09-13 22:06:01 -06:00
eliminate repeated rules
This commit is contained in:
@@ -22,6 +22,7 @@ import Control.Monad (foldM,zipWithM,liftM,liftM2,forM,MonadPlus(..))
|
|||||||
import Control.Monad.Fix
|
import Control.Monad.Fix
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.List(mapAccumL,sortBy,intersperse)
|
import Data.List(mapAccumL,sortBy,intersperse)
|
||||||
|
import Data.Containers.ListUtils(nubOrd)
|
||||||
import Prelude hiding ((<>))
|
import Prelude hiding ((<>))
|
||||||
|
|
||||||
|
|
||||||
@@ -73,7 +74,7 @@ pmcfgForm g t ctxt ty = do
|
|||||||
let (ms,s',t',arg_params) = apply 0 Map.empty unit ctxt t []
|
let (ms,s',t',arg_params) = apply 0 Map.empty unit ctxt t []
|
||||||
let v = eval g [] s' t' []
|
let v = eval g [] s' t' []
|
||||||
(ms,_,_,fn) <- breakDown g ms unit 0 [] v ty (return []) empty
|
(ms,_,_,fn) <- breakDown g ms unit 0 [] v ty (return []) empty
|
||||||
runGenM g ms [] $ do
|
fmap nubOrd $ runGenM g ms [] $ do
|
||||||
(r,rs,v,res_params) <- fn
|
(r,rs,v,res_params) <- fn
|
||||||
arg_params <- mapM params2int arg_params
|
arg_params <- mapM params2int arg_params
|
||||||
res_params <- params2int res_params
|
res_params <- params2int res_params
|
||||||
|
|||||||
@@ -231,7 +231,6 @@ setConcreteFlag name value = Transaction $ \c_db _ c_revision c_exn ->
|
|||||||
|
|
||||||
type Token = String
|
type Token = String
|
||||||
|
|
||||||
type SeqId = Int
|
|
||||||
type LIndex = Int
|
type LIndex = Int
|
||||||
type LVar = Int
|
type LVar = Int
|
||||||
data LParam = LParam {-# UNPACK #-} !LIndex [(LIndex,LVar)]
|
data LParam = LParam {-# UNPACK #-} !LIndex [(LIndex,LVar)]
|
||||||
@@ -253,14 +252,11 @@ data Symbol
|
|||||||
|
|
||||||
type Quantifiers = [(LVar,Int)]
|
type Quantifiers = [(LVar,Int)]
|
||||||
data Rule = Rule Quantifiers LParam [LParam] LParam [Symbol]
|
data Rule = Rule Quantifiers LParam [LParam] LParam [Symbol]
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
|
data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
data Production = Production [(LVar,LIndex)] [PArg] LParam [SeqId]
|
|
||||||
deriving (Eq,Show)
|
|
||||||
|
|
||||||
createLincat :: Cat -> [String] -> [Rule] -> [Rule] -> Transaction Concr ()
|
createLincat :: Cat -> [String] -> [Rule] -> [Rule] -> Transaction Concr ()
|
||||||
createLincat name fields lindefs linrefs = Transaction $ \c_db c_abstr c_revision c_exn ->
|
createLincat name fields lindefs linrefs = Transaction $ \c_db c_abstr c_revision c_exn ->
|
||||||
let n_fields = length fields
|
let n_fields = length fields
|
||||||
|
|||||||
Reference in New Issue
Block a user