mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
remove Symbol type
This commit is contained in:
@@ -160,7 +160,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
|
|||||||
| lbl' == lbl = listArray (0,length syms-1) (map instSym syms)
|
| lbl' == lbl = listArray (0,length syms-1) (map instSym syms)
|
||||||
| otherwise = translateLin idxArgs lbl' lins
|
| otherwise = translateLin idxArgs lbl' lins
|
||||||
where
|
where
|
||||||
instSym = symbol (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
|
instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
|
||||||
instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
|
instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
|
||||||
| nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr
|
| nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr
|
||||||
in FSymCat fcat (index lbl rcs 0) (nr'+xnr)
|
in FSymCat fcat (index lbl rcs 0) (nr'+xnr)
|
||||||
@@ -177,7 +177,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
|
|||||||
type CnvMonad a = BacktrackM Env a
|
type CnvMonad a = BacktrackM Env a
|
||||||
|
|
||||||
type Env = (ProtoFCat, [(ProtoFCat,[FPath])], Term, [Term])
|
type Env = (ProtoFCat, [(ProtoFCat,[FPath])], Term, [Term])
|
||||||
type LinRec = [(FPath, [Symbol (FPath, FIndex, Int) FToken])]
|
type LinRec = [(FPath, [Either (FPath, FIndex, Int) FToken])]
|
||||||
|
|
||||||
type TermMap = Map.Map CId Term
|
type TermMap = Map.Map CId Term
|
||||||
|
|
||||||
@@ -194,11 +194,11 @@ convertTerm cnc_defs selector (S ts) ((lbl_path,lin) : lins) = do projectH
|
|||||||
foldM (\lins t -> convertTerm cnc_defs selector t lins) ((lbl_path,lin) : lins) (reverse ts)
|
foldM (\lins t -> convertTerm cnc_defs selector t lins) ((lbl_path,lin) : lins) (reverse ts)
|
||||||
convertTerm cnc_defs selector (K (KS str)) ((lbl_path,lin) : lins) =
|
convertTerm cnc_defs selector (K (KS str)) ((lbl_path,lin) : lins) =
|
||||||
do projectHead lbl_path
|
do projectHead lbl_path
|
||||||
return ((lbl_path,Tok str : lin) : lins)
|
return ((lbl_path,Right str : lin) : lins)
|
||||||
convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) =
|
convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) =
|
||||||
do projectHead lbl_path
|
do projectHead lbl_path
|
||||||
toks <- member (strs:[strs' | Var strs' _ <- vars])
|
toks <- member (strs:[strs' | Var strs' _ <- vars])
|
||||||
return ((lbl_path, map Tok toks ++ lin) : lins)
|
return ((lbl_path, map Right toks ++ lin) : lins)
|
||||||
convertTerm cnc_defs selector (F id) lins = do term <- Map.lookup id cnc_defs
|
convertTerm cnc_defs selector (F id) lins = do term <- Map.lookup id cnc_defs
|
||||||
convertTerm cnc_defs selector term lins
|
convertTerm cnc_defs selector term lins
|
||||||
convertTerm cnc_defs selector (W s t) ((lbl_path,lin) : lins) = do
|
convertTerm cnc_defs selector (W s t) ((lbl_path,lin) : lins) = do
|
||||||
@@ -224,7 +224,7 @@ convertArg (ConSel indices) nr path lbl_path lin lins = do
|
|||||||
convertArg StrSel nr path lbl_path lin lins = do
|
convertArg StrSel nr path lbl_path lin lins = do
|
||||||
projectHead lbl_path
|
projectHead lbl_path
|
||||||
xnr <- projectArg nr path
|
xnr <- projectArg nr path
|
||||||
return ((lbl_path, GF.Formalism.Utilities.Cat (path, nr, xnr) : lin) : lins)
|
return ((lbl_path, Left (path, nr, xnr) : lin) : lins)
|
||||||
|
|
||||||
convertCon (ConSel indices) index lbl_path lin lins = do
|
convertCon (ConSel indices) index lbl_path lin lins = do
|
||||||
guard (index `elem` indices)
|
guard (index `elem` indices)
|
||||||
|
|||||||
@@ -24,25 +24,6 @@ import GF.Data.Utilities (sameLength, foldMerge, splitBy)
|
|||||||
|
|
||||||
import GF.Infra.PrintClass
|
import GF.Infra.PrintClass
|
||||||
|
|
||||||
------------------------------------------------------------
|
|
||||||
-- * symbols
|
|
||||||
|
|
||||||
data Symbol c t = Cat c | Tok t
|
|
||||||
deriving (Eq, Ord, Show)
|
|
||||||
|
|
||||||
symbol :: (c -> a) -> (t -> a) -> Symbol c t -> a
|
|
||||||
symbol fc ft (Cat cat) = fc cat
|
|
||||||
symbol fc ft (Tok tok) = ft tok
|
|
||||||
|
|
||||||
mapSymbol :: (c -> d) -> (t -> u) -> Symbol c t -> Symbol d u
|
|
||||||
mapSymbol fc ft = symbol (Cat . fc) (Tok . ft)
|
|
||||||
|
|
||||||
filterCats :: [Symbol c t] -> [c]
|
|
||||||
filterCats syms = [ cat | Cat cat <- syms ]
|
|
||||||
|
|
||||||
filterToks :: [Symbol c t] -> [t]
|
|
||||||
filterToks syms = [ tok | Tok tok <- syms ]
|
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
-- * edges
|
-- * edges
|
||||||
|
|
||||||
@@ -313,16 +294,6 @@ forest2trees (FMeta) = [TMeta]
|
|||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
-- pretty-printing
|
-- pretty-printing
|
||||||
|
|
||||||
instance (Print c, Print t) => Print (Symbol c t) where
|
|
||||||
prt = symbol prt (simpleShow . prt)
|
|
||||||
where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
|
|
||||||
mkEsc '\\' = "\\\\"
|
|
||||||
mkEsc '\"' = "\\\""
|
|
||||||
mkEsc '\n' = "\\n"
|
|
||||||
mkEsc '\t' = "\\t"
|
|
||||||
mkEsc chr = [chr]
|
|
||||||
prtList = prtSep " "
|
|
||||||
|
|
||||||
instance Print t => Print (Input t) where
|
instance Print t => Print (Input t) where
|
||||||
prt input = "input " ++ prt (inputEdges input)
|
prt input = "input " ++ prt (inputEdges input)
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user