summaryrefslogtreecommitdiff
path: root/src/compiler
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2011-09-01 16:35:53 +0000
committerhallgren <hallgren@chalmers.se>2011-09-01 16:35:53 +0000
commitbfe4b0b2a4e5b761b287f9110e19af5b9430dbbb (patch)
tree13b74698ec8281ce6b860249ab5b7be1ba4d0885 /src/compiler
parent314abe733ba1e9e7de12c9c28b7d6ffc889d128b (diff)
GF.Grammar.*: generalized the type of some functions that can not fail from the Err monad to arbitrary monads
Diffstat (limited to 'src/compiler')
-rw-r--r--src/compiler/GF/Grammar/Lockfield.hs2
-rw-r--r--src/compiler/GF/Grammar/Macros.hs12
2 files changed, 7 insertions, 7 deletions
diff --git a/src/compiler/GF/Grammar/Lockfield.hs b/src/compiler/GF/Grammar/Lockfield.hs
index 3e78a48b6..8b0798527 100644
--- a/src/compiler/GF/Grammar/Lockfield.hs
+++ b/src/compiler/GF/Grammar/Lockfield.hs
@@ -32,7 +32,7 @@ lockRecType c t@(RecType rs) =
else RecType (rs ++ [(lockLabel c, RecType [])])
lockRecType c t = plusRecType t $ RecType [(lockLabel c, RecType [])]
-unlockRecord :: Ident -> Term -> Err Term
+unlockRecord :: Monad m => Ident -> Term -> m Term
unlockRecord c ft = do
let (xs,t) = termFormCnc ft
let lock = R [(lockLabel c, (Just (RecType []),R []))]
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index bdf1b5df4..bc7dfe3af 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -93,12 +93,12 @@ isHigherOrderType t = errVal True $ do -- pessimistic choice
co <- contextOfType t
return $ not $ null [x | (_,x,Prod _ _ _ _) <- co]
-contextOfType :: Type -> Err Context
+contextOfType :: Monad m => Type -> m Context
contextOfType typ = case typ of
Prod b x a t -> liftM ((b,x,a):) $ contextOfType t
_ -> return []
-termForm :: Term -> Err ([(BindType,Ident)], Term, [Term])
+termForm :: Monad m => Term -> m ([(BindType,Ident)], Term, [Term])
termForm t = case t of
Abs b x t ->
do (x', fun, args) <- termForm t
@@ -267,8 +267,8 @@ plusRecType t1 t2 = case (t1, t2) of
(RecType r1, RecType r2) -> case
filter (`elem` (map fst r1)) (map fst r2) of
[] -> return (RecType (r1 ++ r2))
- ls -> Bad $ render (text "clashing labels" <+> hsep (map ppLabel ls))
- _ -> Bad $ render (text "cannot add record types" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2)
+ ls -> fail $ render (text "clashing labels" <+> hsep (map ppLabel ls))
+ _ -> fail $ render (text "cannot add record types" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2)
plusRecord :: Term -> Term -> Err Term
plusRecord t1 t2 =
@@ -277,7 +277,7 @@ plusRecord t1 t2 =
(l,v) <- r1, not (elem l (map fst r2)) ] ++ r2))
(_, FV rs) -> mapM (plusRecord t1) rs >>= return . FV
(FV rs,_ ) -> mapM (`plusRecord` t2) rs >>= return . FV
- _ -> Bad $ render (text "cannot add records" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2)
+ _ -> fail $ render (text "cannot add records" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2)
-- | default linearization type
defLinType :: Type
@@ -444,7 +444,7 @@ strsFromTerm t = case t of
]
FV ts -> mapM strsFromTerm ts >>= return . concat
Strs ts -> mapM strsFromTerm ts >>= return . concat
- _ -> Bad (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t))
+ _ -> fail (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t))
-- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg
stringFromTerm :: Term -> String