summaryrefslogtreecommitdiff
path: root/src/GF/Compile
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-04-14 08:07:33 +0000
committerkrasimir <krasimir@chalmers.se>2009-04-14 08:07:33 +0000
commit63ccad9e857826fcb3382a1de9090d8c731b6f3a (patch)
treebc4a3f5b444d7e15ccf88738ecd05b262841da67 /src/GF/Compile
parent8bd97f9e75166ab6242be60b3f3a824063128b44 (diff)
refactor GF.Data.BacktrackM to use the MonadState and Functor classes
Diffstat (limited to 'src/GF/Compile')
-rw-r--r--src/GF/Compile/GenerateFCFG.hs24
-rw-r--r--src/GF/Compile/GeneratePMCFG.hs12
2 files changed, 18 insertions, 18 deletions
diff --git a/src/GF/Compile/GenerateFCFG.hs b/src/GF/Compile/GenerateFCFG.hs
index 108976506..a0f82218c 100644
--- a/src/GF/Compile/GenerateFCFG.hs
+++ b/src/GF/Compile/GenerateFCFG.hs
@@ -261,7 +261,7 @@ evalTerm cnc_defs path x = error ("evalTerm ("++show x++")")
unifyPType :: FIndex -> FPath -> Term -> CnvMonad FIndex
unifyPType nr path (C max_index) =
- do (_, args, _, _) <- readState
+ do (_, args, _, _) <- get
let (PFCat _ _ tcs,_) = args !! nr
case lookup path tcs of
Just index -> return index
@@ -390,7 +390,7 @@ genFCatArg cnc_defs ctype env@(GrammarEnv last_id catSet seqSet funSet prodSet)
gen_tcs (C max_index) path acc =
case List.lookup path tcs of
Just index -> return $! addConstraint path index acc
- Nothing -> do writeState True
+ Nothing -> do put True
index <- member [0..max_index]
return $! addConstraint path index acc
where
@@ -498,21 +498,21 @@ mkSelector rcs tcss =
-- updating the MCF rule
readArgCType :: FIndex -> CnvMonad Term
-readArgCType nr = do (_, _, _, ctypes) <- readState
+readArgCType nr = do (_, _, _, ctypes) <- get
return (ctypes !! nr)
restrictArg :: FIndex -> FPath -> FIndex -> CnvMonad ()
restrictArg nr path index = do
- (head, args, ctype, ctypes) <- readState
+ (head, args, ctype, ctypes) <- get
args' <- updateNthM (\(xcat,xs) -> do xcat <- restrictProtoFCat path index xcat
return (xcat,xs) ) nr args
- writeState (head, args', ctype, ctypes)
+ put (head, args', ctype, ctypes)
projectArg :: FIndex -> FPath -> CnvMonad Int
projectArg nr path = do
- (head, args, ctype, ctypes) <- readState
+ (head, args, ctype, ctypes) <- get
(xnr,args') <- updateArgs nr args
- writeState (head, args', ctype, ctypes)
+ put (head, args', ctype, ctypes)
return xnr
where
updateArgs :: FIndex -> [(ProtoFCat,[FPath])] -> CnvMonad (Int,[(ProtoFCat,[FPath])])
@@ -525,20 +525,20 @@ projectArg nr path = do
return (xnr,a:as)
readHeadCType :: CnvMonad Term
-readHeadCType = do (_, _, ctype, _) <- readState
+readHeadCType = do (_, _, ctype, _) <- get
return ctype
restrictHead :: FPath -> FIndex -> CnvMonad ()
restrictHead path term
- = do (head, args, ctype, ctypes) <- readState
+ = do (head, args, ctype, ctypes) <- get
head' <- restrictProtoFCat path term head
- writeState (head', args, ctype, ctypes)
+ put (head', args, ctype, ctypes)
projectHead :: FPath -> CnvMonad ()
projectHead path
- = do (head, args, ctype, ctypes) <- readState
+ = do (head, args, ctype, ctypes) <- get
head' <- projectProtoFCat path head
- writeState (head', args, ctype, ctypes)
+ put (head', args, ctype, ctypes)
restrictProtoFCat :: FPath -> FIndex -> ProtoFCat -> CnvMonad ProtoFCat
restrictProtoFCat path0 index0 (PFCat cat rcs tcs) = do
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs
index 6a5f9ebdf..0ae32d483 100644
--- a/src/GF/Compile/GeneratePMCFG.hs
+++ b/src/GF/Compile/GeneratePMCFG.hs
@@ -160,7 +160,7 @@ convertArg (C max) nr path lbl_path lin lins = do
restrictArg nr path index
return lins
convertArg (S _) nr path lbl_path lin lins = do
- (_, args) <- readState
+ (_, args) <- get
let PFCat _ cat rcs tcs = args !! nr
l = index path rcs 0
sym | isLiteralCat cat = FSymLit nr l
@@ -190,7 +190,7 @@ convertRec cnc_defs (index:sub_sel) ctype record lbl_path lin lins = do
-- eval a term to ground terms
evalTerm :: TermMap -> FPath -> Term -> CnvMonad FIndex
-evalTerm cnc_defs path (V nr) = do (_, args) <- readState
+evalTerm cnc_defs path (V nr) = do (_, args) <- get
let PFCat _ _ _ tcs = args !! nr
rpath = reverse path
index <- member (fromMaybe (error "evalTerm: wrong path") (lookup rpath tcs))
@@ -349,15 +349,15 @@ getFCats (GrammarEnv last_id catSet seqSet funSet crcSet prodSet) (PFCat n cat r
restrictArg :: FIndex -> FPath -> FIndex -> CnvMonad ()
restrictArg nr path index = do
- (head, args) <- readState
+ (head, args) <- get
args' <- updateNthM (restrictProtoFCat path index) nr args
- writeState (head, args')
+ put (head, args')
restrictHead :: FPath -> FIndex -> CnvMonad ()
restrictHead path term
- = do (head, args) <- readState
+ = do (head, args) <- get
head' <- restrictProtoFCat path term head
- writeState (head', args)
+ put (head', args)
restrictProtoFCat :: FPath -> FIndex -> ProtoFCat -> CnvMonad ProtoFCat
restrictProtoFCat path0 index0 (PFCat n cat rcs tcs) = do