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