summaryrefslogtreecommitdiff
path: root/src-3.0
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2008-05-29 11:00:21 +0000
committerkrasimir <krasimir@chalmers.se>2008-05-29 11:00:21 +0000
commitbc578a087112a2d6bb6216ad44dadd776bb1b349 (patch)
tree482efffc58a3c068c6751e12fc5b366ebd2eac7e /src-3.0
parent64d3a1226da712bcf3c2744bcc141ebd40acac27 (diff)
remove Symbol type
Diffstat (limited to 'src-3.0')
-rw-r--r--src-3.0/GF/Compile/GenerateFCFG.hs10
-rw-r--r--src-3.0/GF/Formalism/Utilities.hs29
2 files changed, 5 insertions, 34 deletions
diff --git a/src-3.0/GF/Compile/GenerateFCFG.hs b/src-3.0/GF/Compile/GenerateFCFG.hs
index 89e4d3ef0..2ad45e25f 100644
--- a/src-3.0/GF/Compile/GenerateFCFG.hs
+++ b/src-3.0/GF/Compile/GenerateFCFG.hs
@@ -160,7 +160,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
| lbl' == lbl = listArray (0,length syms-1) (map instSym syms)
| otherwise = translateLin idxArgs lbl' lins
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)
| nr == idx = let (fcat, PFCat _ rcs _) = xargs !! 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 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
@@ -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)
convertTerm cnc_defs selector (K (KS str)) ((lbl_path,lin) : lins) =
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) =
do projectHead lbl_path
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 term lins
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
projectHead lbl_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
guard (index `elem` indices)
diff --git a/src-3.0/GF/Formalism/Utilities.hs b/src-3.0/GF/Formalism/Utilities.hs
index ea1f1eeca..37e9d1577 100644
--- a/src-3.0/GF/Formalism/Utilities.hs
+++ b/src-3.0/GF/Formalism/Utilities.hs
@@ -25,25 +25,6 @@ import GF.Data.Utilities (sameLength, foldMerge, splitBy)
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
data Edge s = Edge Int Int s
@@ -313,16 +294,6 @@ forest2trees (FMeta) = [TMeta]
------------------------------------------------------------
-- 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
prt input = "input " ++ prt (inputEdges input)