Commit 9839d064 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Removed any calls to Maybe.fromJust

parent b7c0d57d
......@@ -16,7 +16,6 @@ module Base.TypeSubst
) where
import Data.List (nub)
import Data.Maybe (fromJust)
import Base.Subst
import Base.TopEnv
......@@ -89,4 +88,6 @@ expandAliasType tys (TypeRecord fs) = TypeRecord fs'
normalize :: Type -> Type
normalize ty = expandAliasType [TypeVariable (occur tv) | tv <- [0 ..]] ty
where tvs = zip (nub (filter (>= 0) (typeVars ty))) [0 ..]
occur tv = fromJust (lookup tv tvs)
occur tv = case lookup tv tvs of
Just t -> t
Nothing -> error "Base.TypeSubst.normalize"
......@@ -24,11 +24,11 @@
module Checks.SyntaxCheck (syntaxCheck) where
import Control.Monad (liftM, liftM2, liftM3, unless, when)
import Control.Monad (liftM, liftM2, liftM3, unless, when)
import qualified Control.Monad.State as S (State, runState, gets, modify)
import Data.List ((\\), insertBy, nub, partition)
import Data.Maybe (fromJust, isJust, isNothing, maybeToList)
import qualified Data.Set as Set (empty, insert, member)
import Data.List ((\\), insertBy, nub, partition)
import Data.Maybe (isJust, isNothing, maybeToList)
import qualified Data.Set as Set (empty, insert, member)
import Curry.Base.Ident
import Curry.Base.Position
......@@ -659,21 +659,21 @@ checkRecordPattern p fs t = do
env <- getRenameEnv
case lookupVar l env of
[RecordLabel r ls] -> do
when (isJust duplicate) $ report $ errDuplicateLabel
$ fromJust duplicate
if isNothing t
then do
case findDouble ls' of
Just l' -> report $ errDuplicateLabel l'
_ -> ok
case t of
Nothing -> do
when (not $ null missings) $ report $ errMissingLabel
(idPosition l) (head missings) r "record pattern"
flip RecordPattern t `liftM` mapM (checkFieldPatt r) fs
else if t == Just (VariablePattern anonId)
then liftM2 RecordPattern
(mapM (checkFieldPatt r) fs)
(Just `liftM` checkPattern p (fromJust t))
else do report (errIllegalRecordPattern p)
return $ RecordPattern fs t
Just pat | pat == VariablePattern anonId -> do
liftM2 RecordPattern (mapM (checkFieldPatt r) fs)
(Just `liftM` checkPattern p pat)
_ -> do
report (errIllegalRecordPattern p)
return $ RecordPattern fs t
where ls' = map fieldLabel fs
duplicate = findDouble ls'
missings = ls \\ ls'
[] -> report (errUndefinedLabel l) >> return (RecordPattern fs t)
[_] -> report (errNotALabel l) >> return (RecordPattern fs t)
......
......@@ -15,10 +15,10 @@
module Generators.GenAbstractCurry
( genTypedAbstract, genUntypedAbstract ) where
import Data.List (find, mapAccumL)
import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Set as Set
import Data.List (find, mapAccumL)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Set as Set
import Curry.AbstractCurry
import Curry.Base.Ident
......@@ -448,13 +448,11 @@ genExpr :: Position -> AbstractEnv -> Expression -> (AbstractEnv, CExpr)
genExpr pos env (Literal l) = case l of
String _ cs -> genExpr pos env $ List [] $ map (Literal . Char noRef) cs
_ -> (env, CLit $ genLiteral l)
genExpr _ env (Variable v)
| isJust midx = (env, CVar (fromJust midx, idName ident))
| v == qSuccessId = (env, CSymbol $ genQName False env qSuccessFunId)
| otherwise = (env, CSymbol $ genQName False env v)
where
ident = unqualify v
midx = getVarIndex env ident
genExpr _ env (Variable v) = case getVarIndex env ident of
Just idx -> (env, CVar (idx, idName ident))
_ | v == qSuccessId -> (env, CSymbol $ genQName False env qSuccessFunId)
| otherwise -> (env, CSymbol $ genQName False env v)
where ident = unqualify v
genExpr _ env (Constructor c) = (env, CSymbol $ genQName False env c)
genExpr pos env (Paren expr) = genExpr pos env expr
genExpr pos env (Typed expr _) = genExpr pos env expr
......@@ -722,15 +720,11 @@ buildExportTable mid _ exptab (ExportTypeWith qident ids)
(insertExportedIdent exptab (unqualify qident))
ids
| otherwise = exptab
buildExportTable mid decls exptab (ExportTypeAll qident)
| isJust ident'
= foldl insertExportedIdent
(insertExportedIdent exptab ident)
(maybe [] getConstrIdents (find (isDataDeclOf ident) decls))
| otherwise = exptab
where
ident' = localIdent mid qident
ident = fromJust ident'
buildExportTable mid ds exptab (ExportTypeAll qid) = case localIdent mid qid of
Just ident -> foldl insertExportedIdent
(insertExportedIdent exptab ident)
(maybe [] getConstrIdents (find (isDataDeclOf ident) ds))
Nothing -> exptab
buildExportTable _ _ exptab (ExportModule _) = exptab
--
......@@ -864,10 +858,10 @@ isDataDeclOf _ _ = False
-- Checks, whether a symbol is defined in the Prelude.
isPreludeSymbol :: QualIdent -> Bool
isPreludeSymbol qident
= let (mmid, ident) = (qidModule qident, qidIdent qident)
in (isJust mmid && preludeMIdent == fromJust mmid)
|| elem ident [unitId, listId, nilId, consId]
|| isTupleId ident
= let (mmid, ident) = (qidModule qident, qidIdent qident)
in mmid == Just preludeMIdent
|| elem ident [unitId, listId, nilId, consId]
|| isTupleId ident
-- Converts an infix operator to an expression
opToExpr :: InfixOp -> Expression
......
......@@ -14,7 +14,7 @@ import Control.Monad (filterM, liftM, liftM2, liftM3, mplus)
import Control.Monad.State (State, evalState, gets, modify)
import Data.List (mapAccumL, nub)
import qualified Data.Map as Map (Map, empty, insert, lookup, fromList, toList)
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust)
import Data.Maybe (catMaybes, fromMaybe, isJust)
-- curry-base
import Curry.Base.Ident as Id
......@@ -750,13 +750,10 @@ cs2ilType :: [(Ident,Int)] -> CS.TypeExpr -> ([(Ident,Int)], IL.Type)
cs2ilType ids (CS.ConstructorType qident typeexprs)
= let (ids', ilTypeexprs) = mapAccumL cs2ilType ids typeexprs
in (ids', IL.TypeConstructor qident ilTypeexprs)
cs2ilType ids (CS.VariableType ident)
= let mid = lookup ident ids
nid | null ids = 0
| otherwise = 1 + snd (head ids)
(ident1, ids') | isJust mid = (fromJust mid, ids)
| otherwise = (nid, (ident, nid):ids)
in (ids', IL.TypeVariable ident1)
cs2ilType ids (CS.VariableType ident) = case lookup ident ids of
Just i -> (ids, IL.TypeVariable i)
Nothing -> let nid = 1 + case ids of { [] -> 0; (_, j):_ -> j }
in ((ident, nid):ids, IL.TypeVariable nid)
cs2ilType ids (CS.ArrowType type1 type2)
= let (ids', ilType1) = cs2ilType ids type1
(ids'', ilType2) = cs2ilType ids' type2
......
......@@ -15,11 +15,11 @@
-}
module Imports (importInterfaces, importModules, qualifyEnv) where
import Control.Monad (liftM, unless)
import qualified Control.Monad.State as S (State, gets, modify, runState)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Control.Monad (liftM, unless)
import qualified Control.Monad.State as S (State, gets, modify, runState)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Set as Set
import Curry.Base.Ident
import Curry.Base.Monad
......@@ -438,11 +438,16 @@ importUnifyData cEnv = cEnv { tyConsEnv = importUnifyData' $ tyConsEnv cEnv }
importUnifyData' :: TCEnv -> TCEnv
importUnifyData' tcEnv = fmap (setInfo allTyCons) tcEnv
where
setInfo tcs t = fromJust $ Map.lookup (origName t) tcs
setInfo tcs t = case Map.lookup (origName t) tcs of
Nothing -> error "Imports.importUnifyData'"
Just ty -> ty
allTyCons = foldr (mergeData . snd) Map.empty $ allImports tcEnv
mergeData t tcs =
Map.insert tc (maybe t (fromJust . merge t) $ Map.lookup tc tcs) tcs
Map.insert tc (maybe t (sureMerge t) $ Map.lookup tc tcs) tcs
where tc = origName t
sureMerge x y = case merge x y of
Nothing -> error "Imports.importUnifyData'.sureMerge"
Just z -> z
-- ---------------------------------------------------------------------------
......
......@@ -25,7 +25,6 @@ import Control.Monad (liftM, liftM2)
import qualified Control.Monad.Reader as R
import Data.List (nub, partition)
import qualified Data.Map as Map (Map, empty, insert, lookup)
import Data.Maybe (fromJust)
import qualified Data.Set as Set (Set, empty, insert, delete, toList)
import Curry.Base.Position
......@@ -270,7 +269,9 @@ trArgs :: [Equation] -> [Ident] -> [Ident]
trArgs [Equation _ (FunLhs _ (t:ts)) _] (v:_) =
v : map (translArg (bindRenameEnv v t Map.empty)) ts
where
translArg env (VariablePattern v') = fromJust (Map.lookup v' env)
translArg env (VariablePattern v') = case Map.lookup v' env of
Just x -> x
Nothing -> internalError "Transformations.CurryToIL.trArgs"
translArg _ _ = internalError "Translation of arguments not defined"
trArgs _ _ = internalError "Translation of arguments not defined" -- TODO
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment