Fix "function may fail" errors

src/libraries/OS-Independent/Clean/Doc.dcl

@@ -253,7 +253,7 @@ parseDoc :: !String -> Either ParseError (!d, ![ParseWarning]) | docBlockToDoc{|
  */
 generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
 
-derive docBlockToDoc UNIT, PAIR, EITHER, CONS, OBJECT, FIELD of d, RECORD
+derive docBlockToDoc UNIT, PAIR, EITHER, CONS, OBJECT, FIELD of {gfd_name}, RECORD
 derive docBlockToDoc String, [], Maybe, Type
 derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
 	ConstructorDoc, TypeDoc

src/libraries/OS-Independent/Clean/Doc.icl

@@ -114,14 +114,18 @@ parseDoc s = docBlockToDoc{|*|} (Left [s])
 generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
 docBlockToDoc{|String|} (Left []) = Left InternalNoDataError
 docBlockToDoc{|String|} (Left ss) = Right (trim $ last ss, [])
+docBlockToDoc{|String|} _         = abort "error in docBlockToDoc{|String|}\n"
 docBlockToDoc{|[]|} fx (Left ss) = (\vws -> (map fst vws, flatten (map snd vws)) ) <$> mapM fx (map (Left o pure) ss)
-docBlockToDoc{|Maybe|} fx (Left []) = Right (Nothing, [])
+docBlockToDoc{|[]|} _  _         = abort "error in docBlockToDoc{|[]|}\n"
+docBlockToDoc{|Maybe|} fx (Left [])    = Right (Nothing, [])
 docBlockToDoc{|Maybe|} fx ss=:(Left _) = appFst Just <$> fx ss
+docBlockToDoc{|Maybe|} _  _            = abort "error in docBlockToDoc{|Maybe|}\n"
 docBlockToDoc{|UNIT|} _ = Right (UNIT, [])
 docBlockToDoc{|PAIR|} fx fy db=:(Right _) = liftA2 (\(x,ws) (y,ws`) -> (PAIR x y, ws ++ ws`)) (fx db) (fy db)
-docBlockToDoc{|FIELD of d|} fx (Right db) = case fx (Left [v \\ (k,v) <- db | k matches d.gfd_name]) of
+docBlockToDoc{|PAIR|} _  _  _             = abort "error in docBlockToDoc{|PAIR|}\n"
+docBlockToDoc{|FIELD of {gfd_name}|} fx (Right db) = case fx (Left [v \\ (k,v) <- db | k matches gfd_name]) of
 	Right (f, ws)            -> Right (FIELD f, ws)
-	Left InternalNoDataError -> Left (MissingField d.gfd_name)
+	Left InternalNoDataError -> Left (MissingField gfd_name)
 	Left e                   -> Left e
 where
 	(matches) infix 4 :: !String !String -> Bool
@@ -132,6 +136,7 @@ where
 		k` == "return" && name == "results"
 	where
 		k` = {if (c == '-') '_' c \\ c <-: k}
+docBlockToDoc{|FIELD of {gfd_name}|} _ _ = abort "error in docBlockToDoc{|FIELD|}\n"
 docBlockToDoc{|RECORD|} fx (Left [s]) = case parseDocBlock s of
 	Right (db, ws) -> case fx (Right db) of
 		Right (v, ws`) -> Right (RECORD v, ws ++ ws`)
@@ -147,6 +152,7 @@ docBlockToDoc{|EITHER|} fl fr doc = case fl doc of
 docBlockToDoc{|OBJECT|} fx doc = appFst OBJECT <$> fx doc
 
 docBlockToDoc{|MultiLineString|} (Left [s]) = Right (MultiLine $ trimMultiLine $ split "\n" s, [])
+docBlockToDoc{|MultiLineString|} _          = abort "error in docBlockToDoc{|MultiLineString|}\n"
 
 docBlockToDoc{|ParamDoc|} (Left [s]) = case findName (fromString s) of
 	Just (name,rest) -> Right (
@@ -162,11 +168,13 @@ where
 	| not (isEmpty name) && not (isEmpty cs) && hd cs == ':'
 		= Just (toString name, dropWhile isSpace (tl cs))
 		= Nothing
+docBlockToDoc{|ParamDoc|} _ = abort "error in docBlockToDoc{|ParamDoc|}\n"
 
 docBlockToDoc{|Type|} (Left []) = Left InternalNoDataError
 docBlockToDoc{|Type|} (Left ss) = case [v \\ Just v <- map ('T'.parseType o fromString) ss] of
 	[] -> Left (UnknownError "no parsable type")
 	vs -> Right (last vs, [])
+docBlockToDoc{|Type|} _ = abort "error in docBlockToDoc{|Type|}\n"
 
 docBlockToDoc{|Property|} (Left [s]) = let [signature:property] = split "\n" s in
 		parseSignature signature >>= \(sig,ws1) ->
@@ -199,18 +207,21 @@ where
 
 	parseProperty :: ![String] -> Either ParseError (!String, ![ParseWarning])
 	parseProperty ss = Right (trimMultiLine ss, [])
+docBlockToDoc{|Property|} _ = abort "error in docBlockToDoc{|Property|}\n"
 
 docBlockToDoc{|PropertyVarInstantiation|} (Left [s]) = case split "=" s of
 	[var:type:[]] -> case 'T'.parseType (fromString type) of
 		Just t -> Right (PropertyVarInstantiation (trim var, t), [])
 		Nothing -> Left (UnknownError "type could not be parsed")
 	_ -> Left (UnknownError "property var instantiation could not be parsed")
+docBlockToDoc{|PropertyVarInstantiation|} _ = abort "error in docBlockToDoc{|PropertyVarInstantiation|}\n"
 
 docBlockToDoc{|PropertyTestGenerator|} (Left [s]) = case 'T'.parseType (fromString sig) of
 	Just t -> Right (PropertyTestGenerator t (trimMultiLine imp), [])
 	Nothing -> Left (UnknownError "type could not be parsed")
 where
 	[sig:imp] = split "\n" s
+docBlockToDoc{|PropertyTestGenerator|} _ = abort "error in docBlockToDoc{|PropertyTestGenerator|}\n"
 
 derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ConstructorDoc,
 	ClassDoc, TypeDoc
@@ -225,31 +236,40 @@ printDoc d = join "\n * "
 	] +++
 	"\n */"
 where
-	(Right fields`) = docToDocBlock{|*|} False d
+	fields` = case docToDocBlock{|*|} False d of
+		Right fs -> fs
+		_        -> abort "error in printDoc\n"
 	fields = filter ((<>) "description" o fst) fields`
 	desc = lookup "description" fields`
 
 generic docToDocBlock a :: Bool a -> Either [String] DocBlock
 docToDocBlock{|String|} True s = Left [s]
+docToDocBlock{|String|} _    _ = abort "error in docToDocBlock{|String|}\n"
 docToDocBlock{|[]|} fx True xs = Left [x \\ Left xs` <- map (fx True) xs, x <- xs`]
+docToDocBlock{|[]|} _  _    _  = abort "error in docToDocBlock{|[]|}\n"
 docToDocBlock{|Maybe|} fx True mb = case mb of
 	Nothing -> Left []
 	Just x  -> fx True x
-
-docToDocBlock{|PAIR|} fx fy False (PAIR x y) = Right (xs ++ ys)
-where
-	(Right xs) = fx False x
-	(Right ys) = fy False y
-docToDocBlock{|FIELD of d|} fx False (FIELD x) = Right [(name,x) \\ x <- xs]
+docToDocBlock{|Maybe|} _  _    _  = abort "error in docToDocBlock{|Maybe|}\n"
+
+docToDocBlock{|PAIR|} fx fy False (PAIR x y) = case fx False x of
+	Right xs -> case fy False y of
+		Right ys -> Right (xs ++ ys)
+		_        -> abort "error in docToDocBlock{|PAIR|}\n"
+	_            -> abort "error in docToDocBlock{|PAIR|}\n"
+docToDocBlock{|PAIR|} _  _  _      _         = abort "error in docToDocBlock{|PAIR|}\n"
+docToDocBlock{|FIELD of d|} fx False (FIELD x) = case fx True x of
+	Left xs -> Right [(name,x) \\ x <- xs]
+	_       -> abort "error in docToDocBlock{|FIELD|}\n"
 where
-	(Left xs) = fx True x
-
 	name = {if (c=='_') '-' c \\ c <-: name`}
 	name`
 	| endsWith "ies" d.gfd_name = d.gfd_name % (0,size d.gfd_name-4) +++ "y"
 	| endsWith "s" d.gfd_name   = d.gfd_name % (0,size d.gfd_name-2)
 	| otherwise                 = d.gfd_name
+docToDocBlock{|FIELD|} _ _ _ = abort "error in docToDocBlock{|FIELD|}\n"
 docToDocBlock{|RECORD|} fx False (RECORD x) = fx False x
+docToDocBlock{|RECORD|} _  _     _          = abort "error in docToDocBlock{|RECORD|}\n"
 
 docToDocBlock{|ParamDoc|} True pd = case pd.ParamDoc.name of
 	Nothing -> case pd.ParamDoc.description of
@@ -258,12 +278,18 @@ docToDocBlock{|ParamDoc|} True pd = case pd.ParamDoc.name of
 	Just n -> case pd.ParamDoc.description of
 		Nothing -> Left [n]
 		Just d -> Left [n +++ ": " +++ d]
+docToDocBlock{|ParamDoc|} _ _ = abort "error in docToDocBlock{|ParamDoc|}\n"
 docToDocBlock{|MultiLineString|} True (MultiLine s) = Left [s]
+docToDocBlock{|MultiLineString|} _    _             = abort "error in docToDocBlock{|MultiLineString|}\n"
 docToDocBlock{|Type|} True t = Left [toString t]
+docToDocBlock{|Type|} _    _ = abort "error in docToDocBlock{|Type|}\n"
 docToDocBlock{|Property|} True (ForAll name args impl) = Left
 	[name +++ ": A." +++ join "; " [a +++ " :: " <+ t \\ (a,t) <- args] +++ ":\n" +++ impl]
+docToDocBlock{|Property|} _ _ = abort "error in docToDocBlock{|Property|}\n"
 docToDocBlock{|PropertyVarInstantiation|} True (PropertyVarInstantiation (a,t)) = Left [a +++ " = " <+ t]
+docToDocBlock{|PropertyVarInstantiation|} _    _                                = abort "error in docToDocBlock{|PropertyVarInstantiation|}\n"
 docToDocBlock{|PropertyTestGenerator|} True (PropertyTestGenerator t impl) = Left [t <+ "\n" +++ impl]
+docToDocBlock{|PropertyTestGenerator|} _    _                              = abort "error in docToDocBlock{|PropertyTestGenerator|}\n"
 
 derive docToDocBlock ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
 	ConstructorDoc, TypeDoc
@@ -302,6 +328,8 @@ where
 
 		parseFs :: ![Char] ![Char] !DocBlock -> Either ParseError (!DocBlock, ![ParseWarning])
 		parseFs field val d = Right ([(toString field,toString (rtrim val)):d], [])
+	parseFields _
+		= abort "error in parseDocBlock\n"
 
 prepareString :: (String -> Either ParseError [[Char]])
 prepareString = checkAsterisks o map trim o break '\n' o fromString
@@ -340,6 +368,7 @@ where
 	toString (MissingAsterisk l) = "Doc error: missing leading asterisk in '" +++ l +++ "'"
 	toString (MissingField f)    = "Doc error: required field '" +++ f +++ "' was missing"
 	toString (UnknownError e)    = "Doc error: " +++ e
+	toString InternalNoDataError = "Doc error: internal parsing error"
 
 traceParseWarnings :: ![ParseWarning] !a -> a
 traceParseWarnings []     x = x

src/libraries/OS-Independent/Clean/Types.icl

@@ -3,6 +3,7 @@ implementation module Clean.Types
 from StdOverloaded import class ==(..), class length(..)
 from StdClass import class Eq
 import StdList
+import StdMisc
 import StdTuple
 from StdString import instance == {#Char}
 import StdBool
@@ -45,6 +46,7 @@ where
 	name :: !Type -> TypeVar
 	name (Cons v _) = v
 	name (Var v) = v
+	name _ = abort "error in allVars\n"
 
 allUniversalVars :: !Type -> [TypeVar]
 allUniversalVars (Forall vs t tc) = removeDup (flatten (map allVars vs) ++ allUniversalVars t)
@@ -58,47 +60,60 @@ allUniversalVars (Arrow Nothing)  = []
 allUniversalVars (Strict t) = allUniversalVars t
 
 isVar :: !Type -> Bool
-isVar (Var _) = True; isVar _ = False
+isVar t = t=:(Var _)
 
 fromVar :: !Type -> TypeVar
-fromVar (Var v) = v
+fromVar t = case t of
+	Var v -> v
+	_     -> abort "error in fromVar\n"
 
 fromVarLenient :: !Type -> TypeVar
-fromVarLenient (Var v) = v
-fromVarLenient (Cons v _) = v
-fromVarLenient (Uniq t) = fromVarLenient t
+fromVarLenient t = case t of
+	Var v    -> v
+	Cons v _ -> v
+	Uniq t   -> fromVarLenient t
+	Strict t -> fromVarLenient t
+	_        -> abort "missing case in fromVarLenient\n"
+
 
 isCons :: !Type -> Bool
-isCons (Cons _ _) = True; isCons _ = False
+isCons t = t=:(Cons _ _)
 
 isCons` :: TypeVar !Type -> Bool
-isCons` v (Cons v` _) = v == v`; isCons` _ _ = False
+isCons` v t = case t of
+	Cons v` _ -> v == v`
+	_         -> False
 
 isVarOrCons` :: TypeVar !Type -> Bool
-isVarOrCons` v (Var v`)    = v == v`
-isVarOrCons` v (Cons v` _) = v == v`
-isVarOrCons` _ _           = False
+isVarOrCons` v t = case t of
+	Var v`    -> v == v`
+	Cons v` _ -> v == v`
+	_         -> False
 
 isType :: !Type -> Bool
-isType (Type _ _) = True; isType _ = False
+isType t = t=:(Type _ _)
 
 isFunc :: !Type -> Bool
-isFunc (Func _ _ _) = True; isFunc _ = False
+isFunc t = t=:(Func _ _ _)
 
 isUniq :: !Type -> Bool
-isUniq (Uniq _) = True; isUniq _ = False
+isUniq t = t=:(Uniq _)
 
 isForall :: !Type -> Bool
-isForall (Forall _ _ _) = True; isForall _ = False
+isForall t = t=:(Forall _ _ _)
 
 fromForall :: !Type -> Type
-fromForall (Forall _ t _) = t
+fromForall t = case t of
+	Forall _ t _ -> t
+	_            -> abort "fromForall called on non-Forall\n"
 
 isArrow :: !Type -> Bool
-isArrow (Arrow _) = True; isArrow _ = False
+isArrow t = t=:(Arrow _)
 
 fromArrow :: !Type -> Maybe Type
-fromArrow (Arrow t) = t
+fromArrow t = case t of
+	Arrow t -> t
+	_       -> abort "fromArrow called on non-Arrow\n"
 
 fromUnifyingAssignment :: !UnifyingAssignment -> TVAssignment
 fromUnifyingAssignment (LeftToRight x) = x
@@ -110,7 +125,9 @@ arity (Func is _ _) = length is
 arity (Var _) = 0
 arity (Cons _ ts) = length ts
 arity (Strict t) = arity t
-//TODO arity of Uniq / Forall / Arrow?
+arity (Uniq _) = abort "what is the arity of Uniq?\n" // TODO
+arity (Forall _ _ _) = abort "what is the arity of Forall?\n" // TODO
+arity (Arrow _) = abort "what is the arity of Arrow?\n" // TODO
 
 removeTypeContexts :: !Type -> Type
 removeTypeContexts (Type s ts) = Type s $ map removeTypeContexts ts

src/libraries/OS-Independent/Clean/Types/Parse.icl

@@ -2,6 +2,7 @@ implementation module Clean.Types.Parse
 
 from StdFunc import o
 import StdList
+import StdMisc
 import StdString
 import StdTuple
 
@@ -46,8 +47,12 @@ from Text.Parsers.Simple.Core import :: Parser, :: Error,
 
 instance == Token
 where
-	== (TIdent a)  (TIdent b) = a == b
-	== (TVar a)    (TVar b)   = a == b
+	== (TIdent a) b = case b of
+		TIdent b -> a == b
+		_        -> False
+	== (TVar a) b = case b of
+		TVar b   -> a == b
+		_        -> False
 	== TArrow      b          = b=:TArrow
 	== TComma      b          = b=:TComma
 	== TStar       b          = b=:TStar
@@ -140,10 +145,10 @@ where
 		<|> liftM Var var
 
 	ident :: Parser Token String
-	ident = (\(TIdent id)->id) <$> pSatisfy isTIdent
+	ident = (\tk -> case tk of TIdent id -> id; _ -> abort "error in type parser\n") <$> pSatisfy isTIdent
 
 	var :: Parser Token TypeVar
-	var = (\(TVar var)->var) <$> pSatisfy isTVar
+	var = (\tk -> case tk of TVar id -> id; _ -> abort "error in type parser\n") <$> pSatisfy isTVar
 	cons = var
 	unqvar = var
 

src/libraries/OS-Independent/Clean/Types/Util.icl

@@ -3,6 +3,7 @@ implementation module Clean.Types.Util
 import StdArray
 import StdBool
 from StdFunc import flip, id, o
+import StdMisc
 import StdOrdList
 import StdString
 import StdTuple
@@ -95,15 +96,9 @@ where
 
 instance print TypeDefRhs
 where
-	print _ (TDRCons ext cs)         = "\n\t= " -- makeADT ext cs
-	where
-		makeADT :: !Bool ![Constructor] -> String
-		makeADT exten [] = if exten " .." ""
-		makeADT False [c1:cs]
-			= concat (c1 -- "\n" --
-				concat [concat ("\t| " -- c -- "\n") \\ c <- cs])
-		makeADT True cs = concat (makeADT False cs -- "\t| ..")
-	print _ (TDRNewType c) = " =: " -- c
+	print _ (TDRCons ext cs)         = "\n\t= " -- printADT ext cs
+	print _ (TDRMoreConses cs)       = "\n\t| " -- printADT False cs
+	print _ (TDRNewType c)           = " =: " -- c
 	print _ (TDRRecord _ exi fields) = " =" --
 		if (isEmpty exi) [] (" E." -- printersperse False " " exi -- ":") --
 		"\n\t" -- makeRecord exi fields
@@ -124,6 +119,15 @@ where
 	print _ (TDRAbstract (Just rhs)) = " /*" -- rhs -- " */"
 	print _ (TDRAbstractSynonym t)   = " (:== " -- t -- ")"
 
+printADT :: !Bool ![Constructor] -> String
+printADT True cs = case cs of
+	[] -> ".."
+	cs -> concat (printADT False cs -- "\t| ..")
+printADT False cs = case cs of
+	[]      -> ""
+	[c1:cs] -> concat (c1 -- "\n" --
+		concat [concat ("\t| " -- c -- "\n") \\ c <- cs])
+
 typeConstructorName :: !Bool !Bool !String ![Type] -> [String]
 typeConstructorName isInfix isArg t as
 # isInfix = isInfix && not (isEmpty as)
@@ -191,24 +195,28 @@ resolve_synonyms :: ('M'.Map String [TypeDef]) !Type -> ([TypeDef], Type)
 resolve_synonyms tds (Type t ts)
 	# (syns, ts) = appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) ts
 	= case candidates of
-		[] = (syns, Type t ts)
+		[] -> (syns, Type t ts)
 		[syn=:{td_args, td_rhs=TDRSynonym synt}:_]
 			# newargs = map ((+++) "__" o fromVar) td_args
-			# (Just t)
-				= assignAll [(fromVar a, Var n) \\ a <- td_args & n <- newargs] synt
-				>>= assignAll [(a,r) \\ a <- newargs & r <- ts]
-			| length td_args <> length ts
-				# (Type r rs) = t
-				# t = Type r $ rs ++ drop (length td_args) ts
-				= appFst ((++) [syn:syns]) $ resolve_synonyms tds t
-			= appFst ((++) [syn:syns]) $ resolve_synonyms tds t
+			# t = case assignAll [(fromVar a, Var n) \\ a <- td_args & n <- newargs] synt
+					>>= assignAll [(a,r) \\ a <- newargs & r <- ts] of
+				Just t -> t
+				_      -> abort "error in resolve_synonyms_Type\n"
+			| length td_args <> length ts -> case t of
+				Type r rs
+					# t = Type r $ rs ++ drop (length td_args) ts
+					-> appFst ((++) [syn:syns]) $ resolve_synonyms tds t
+				_   -> abort "error in resolve_synonyms_Type\n"
+			-> appFst ((++) [syn:syns]) $ resolve_synonyms tds t
+		_ -> abort "error in resolve_synonyms_Type\n"
 where
 	candidates = [td \\ td=:{td_rhs=TDRSynonym syn} <- fromMaybe [] $ 'M'.get t tds
 		| length td.td_args <= tslen && (isType syn || length td.td_args == tslen)]
 	where tslen = length ts
 resolve_synonyms tds (Func is r tc)
-	# (syns, [r:is]) = appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) [r:is]
-	= (syns, Func is r tc)
+	= case appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) [r:is] of
+		(syns, [r:is]) -> (syns, Func is r tc)
+		_              -> abort "error in resolve_synonyms_Func\n"
 resolve_synonyms _ (Var v)
 	= ([], Var v)
 resolve_synonyms tds (Cons v ts)

src/libraries/OS-Independent/Codec/Archive/Tar.icl

@@ -103,16 +103,18 @@ where
 	isOctDigit c = '0' <= c && c <= '7'
 
 parseType :: TarParser TarFileType
-parseType = StateT $ \[c:cs] -> case c of
-	'0' = Ok (NormalFile, cs)
-	'1' = Ok (HardLink, cs)
-	'2' = Ok (SymLink, cs)
-	'3' = Ok (CharSpecial, cs)
-	'4' = Ok (BlockSpecial, cs)
-	'5' = Ok (Directory, cs)
-	'6' = Ok (FIFO, cs)
-	'7' = Ok (Contiguous, cs)
-	c   = Error $ UnsupportedFileTypeId c
+parseType = StateT $ \cs -> case cs of
+	[]     -> Error UnexpectedEOS
+	[c:cs] -> case c of
+		'0' = Ok (NormalFile, cs)
+		'1' = Ok (HardLink, cs)
+		'2' = Ok (SymLink, cs)
+		'3' = Ok (CharSpecial, cs)
+		'4' = Ok (BlockSpecial, cs)
+		'5' = Ok (Directory, cs)
+		'6' = Ok (FIFO, cs)
+		'7' = Ok (Contiguous, cs)
+		c   = Error $ UnsupportedFileTypeId c
 
 skip :: Int -> TarParser ()
 skip i = StateT $ \cs -> Ok ((), drop i cs)

src/libraries/OS-Independent/Control/GenFMap.icl

@@ -37,16 +37,20 @@ bimap{|{}|} bma = {map_to = mapArray bma.map_to, map_from = mapArray bma.map_fro
 generic gLookupFMap key :: key (FMap value) -> FMap value
 gLookupFMap{|Char|} key (FMChar xs) = lookupAssocList key FMEmpty xs
 gLookupFMap{|Char|} key FMEmpty 	= FMEmpty
+gLookupFMap{|Char|} _   _           = abort "error in gLookupFMap{|Char|}\n"
 
 gLookupFMap{|Int|} key (FMInt xs) = lookupAssocList key FMEmpty xs
-gLookupFMap{|Int|} key FMEmpty 	= FMEmpty
+gLookupFMap{|Int|} key FMEmpty    = FMEmpty
+gLookupFMap{|Int|} _   _          = abort "error in gLookupFMap{|Int|}\n"
 
 gLookupFMap{|Real|} key (FMReal xs) = lookupAssocList key FMEmpty xs
-gLookupFMap{|Real|} key FMEmpty 	= FMEmpty
+gLookupFMap{|Real|} key FMEmpty     = FMEmpty
+gLookupFMap{|Real|} _   _           = abort "error in gLookupFMap{|Real|}\n"
 
-gLookupFMap{|Bool|} False (FMEither ls rs) 	= ls
-gLookupFMap{|Bool|} True  (FMEither ls rs) 	= rs
-gLookupFMap{|Bool|} key FMEmpty 			= FMEmpty
+gLookupFMap{|Bool|} False (FMEither ls rs) = ls
+gLookupFMap{|Bool|} True  (FMEither ls rs) = rs
+gLookupFMap{|Bool|} key   FMEmpty          = FMEmpty
+gLookupFMap{|Bool|} _     _                = abort "error in gLookupFMap{|Bool|}\n"
 
 //gLookupFMap{|UNIT|} key (FMValue v)	= (FMValue v)
 //gLookupFMap{|UNIT|} key FMEmpty		= FMEmpty
@@ -54,9 +58,10 @@ gLookupFMap{|UNIT|} key fm		= fm
 
 gLookupFMap{|PAIR|} fx fy (PAIR kx ky) fm = fy ky (fx kx fm)
 
-gLookupFMap{|EITHER|} fl fr (LEFT key) (FMEither ls rs) = fl key ls
+gLookupFMap{|EITHER|} fl fr (LEFT key)  (FMEither ls rs) = fl key ls
 gLookupFMap{|EITHER|} fl fr (RIGHT key) (FMEither ls rs) = fr key rs
-gLookupFMap{|EITHER|} fl fr key FMEmpty 	= FMEmpty 
+gLookupFMap{|EITHER|} fl fr key         FMEmpty          = FMEmpty
+gLookupFMap{|EITHER|} _  _  _           _                = abort "error in gLookupFMap{|EITHER|}\n"
 
 gLookupFMap{|CONS|} f (CONS key) fm = f key fm
 gLookupFMap{|FIELD|} f (FIELD key) fm = f key fm
@@ -86,23 +91,27 @@ gInsertFMap{|Char|} key (new_val, FMChar xs)
 	= (old_val, FMChar xs)
 gInsertFMap{|Char|} key (new_val, FMEmpty) 	
 	= (FMEmpty, FMChar [(key, new_val)])
+gInsertFMap{|Char|} _ _ = abort "error in gInsertFMap{|Char|}\n"
 
 gInsertFMap{|Int|} key (new_val, FMInt xs) 
 	# (old_val, xs) = updateAssocList key new_val FMEmpty xs
 	= (old_val, FMInt xs)
 gInsertFMap{|Int|} key (new_val, FMEmpty) 	
 	= (FMEmpty, FMInt [(key, new_val)])
+gInsertFMap{|Int|} _ _ = abort "error in gInsertFMap{|Int|}\n"
 
 gInsertFMap{|Real|} key (new_val, FMReal xs) 
 	# (old_val, xs) = updateAssocList key new_val FMEmpty xs
 	= (old_val, FMReal xs)
 gInsertFMap{|Real|} key (new_val, FMEmpty) 	
 	= (FMEmpty, FMReal [(key, new_val)])
+gInsertFMap{|Real|} _ _ = abort "error in gInsertFMap{|Real|}\n"
 
-gInsertFMap{|Bool|} False (v, FMEither ls rs)	= (ls, FMEither v rs)
-gInsertFMap{|Bool|} False (v, FMEmpty) 			= (FMEmpty, FMEither v FMEmpty)
-gInsertFMap{|Bool|} True  (v, FMEither ls rs)	= (rs, FMEither ls v)
-gInsertFMap{|Bool|} True  (v, FMEmpty)			= (FMEmpty, FMEither FMEmpty v)
+gInsertFMap{|Bool|} False (v, FMEither ls rs) = (ls, FMEither v rs)
+gInsertFMap{|Bool|} False (v, FMEmpty)        = (FMEmpty, FMEither v FMEmpty)
+gInsertFMap{|Bool|} True  (v, FMEither ls rs) = (rs, FMEither ls v)
+gInsertFMap{|Bool|} True  (v, FMEmpty)        = (FMEmpty, FMEither FMEmpty v)
+gInsertFMap{|Bool|} _     _                   = abort "error in gInsertFMap{|Bool|}\n"
 	
 gInsertFMap{|UNIT|} key (x, y) 		= (y, x)
 
@@ -124,6 +133,7 @@ gInsertFMap{|EITHER|} fl fr (RIGHT key) (v, FMEither ls rs)
 gInsertFMap{|EITHER|} fl fr (RIGHT key) (v, FMEmpty)
 	# (old_val, new_rs) = fr key (v,FMEmpty)
 	= (FMEmpty, FMEither FMEmpty new_rs)
+gInsertFMap{|EITHER|} _ _ _ _ = abort "error in gInsertFMap{|EITHER|}\n"
 	
 gInsertFMap{|CONS|} f (CONS key) x = f key x
 gInsertFMap{|FIELD|} f (FIELD key) x = f key x

src/libraries/OS-Independent/Control/GenMonad.icl

@@ -37,6 +37,7 @@ instance Monad [] where
 	ret x = [x]
 	//(>>=) xs f = flatten (map f xs)	// uniqueness typing makes it a problem because f is shared
 	(>>=) [x:xs] f = f x
+	(>>=) []     _ = []
 
 //-----------------------
 // state monad 

src/libraries/OS-Independent/Data/Encoding/RunLength.icl

 implementation module Data.Encoding.RunLength
 
-import StdOverloaded, StdList
+import StdList
+import StdMisc
+import StdOverloaded
 
 encodeInt :: ![Int] -> [Int]
 encodeInt xs = reverse (rleInt` xs [])
@@ -11,6 +13,7 @@ encodeInt xs = reverse (rleInt` xs [])
   rleInt` [x:xs] [y : n : ys]
     | x == y    = rleInt` xs [y : n + 1 : ys]
     | otherwise = rleInt` xs [x : 1 : y : n : ys]
+  rleInt` _ _ = abort "error in encodeInt\n"
 
 decodeInt :: ![Int] -> [Int]
 decodeInt xs = reverse (rldInt` xs [])
@@ -19,6 +22,7 @@ decodeInt xs = reverse (rldInt` xs [])
   rldInt` []           acc = acc
   rldInt` [0 : x : xs] acc = rldInt` xs acc
   rldInt` [n : x : xs] acc = rldInt` [n - 1 : x : xs] [x : acc]
+  rldInt` _ _ = abort "error in encodeInt\n"
 
 encode :: ![a] -> [(Int, a)] | == a
 encode xs = reverse (rle` xs [])

src/libraries/OS-Independent/Data/GenEq.icl

@@ -26,5 +26,6 @@ derive gEq [], (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
 eqArray f xs ys = size xs == size ys && eq 0 (size xs) xs ys
 where