Verified Commit 12d1a74a authored by Camil Staps's avatar Camil Staps 🚀

Avoid run-time errors

parent 94c4bb99
......@@ -74,6 +74,7 @@ where
// PD_Derive [GenericCaseDef]
// PD_Documentation DocType String
// PD_Erroneous
_ -> abort "idents of unknown ParsedDefinition\n"
instance idents ParsedExpr
where
......@@ -118,6 +119,7 @@ where
instance idents Rhs
where
idents ICExpression rhs = noLocals (idents ICExpression rhs.rhs_alts + idents ICPattern rhs.rhs_locals)
idents ICPattern _ = abort "idents Rhs must be called as ICExpression\n"
instance idents LocalDefs
where
......@@ -129,6 +131,7 @@ where
idents ICExpression alts = case alts of
UnGuardedExpr e -> idents ICExpression e
GuardedAlts es oth -> idents ICExpression es + idents ICExpression oth
idents ICPattern _ = abort "idents OptGuardedAlts must be called as ICExpression\n"
instance idents ExprWithLocalDefs
where
......@@ -136,6 +139,7 @@ where
idents ICExpression e.ewl_locals +
idents ICExpression e.ewl_expr +
idents ICExpression e.ewl_nodes
idents ICPattern _ = abort "idents ExprWithLocalDefs must be called as ICExpression\n"
instance idents NodeDefWithLocals
where
......@@ -148,10 +152,12 @@ where
idents ICExpression e.alt_guard +
idents ICExpression e.alt_expr +
idents ICPattern e.alt_nodes
idents ICPattern _ = abort "idents GuardedExpr must be called as ICExpression\n"
instance idents CaseAlt
where
idents ICExpression a = noLocals (idents ICPattern a.calt_pattern + idents ICExpression a.calt_rhs)
idents ICPattern _ = abort "idents CaseAlt must be called as ICExpression\n"
instance idents Qualifier
where
......@@ -159,6 +165,7 @@ where
idents ICPattern q.qual_generators +
idents ICPattern q.qual_let_defs +
idents ICExpression q.qual_filter
idents ICExpression _ = abort "idents Qualifier must be called as ICPattern\n"
instance idents FieldNameOrQualifiedFieldName
where
......@@ -168,6 +175,7 @@ where
instance idents Generator
where
idents ICPattern g = idents ICPattern g.gen_pattern + idents ICExpression g.gen_expr
idents ICExpression _ = abort "idents Generator must be called as ICPattern\n"
instance idents Sequence
where
......@@ -176,6 +184,7 @@ where
SQ_FromThenTo _ a b c -> idents ICExpression [a,b]
SQ_From _ a -> idents ICExpression a
SQ_FromTo _ a b -> idents ICExpression [a,b]
idents ICPattern _ = abort "idents Sequence must be called as ICExpression\n"
instance idents ParsedSelection
where
......
Subproject commit 38ddb57139493f82fbb31eaedf1b5eeaea002eb9
Subproject commit 526028f7fc2d5a10db66d65ef911466fd888cab8
......@@ -172,10 +172,12 @@ getIclLine _ = Nothing
getName :: !Location -> Name
getName (Location _ _ _ _ _ name) = name
getName (Builtin name _) = name
getName NoLocation = abort "getName NoLocation called\n"
setName :: !Name !Location -> Location
setName n (Location lib mod fname dcl icl _) = Location lib mod fname dcl icl n
setName n (Builtin _ doc) = Builtin n doc
setName _ NoLocation = abort "setName NoLocation called\n"
isBuiltin :: !Location -> Bool
isBuiltin (Builtin _ _) = True
......@@ -468,7 +470,7 @@ where
// Efficient union on sorted lists
mergeUnion :: !['Database.Native'.Index] !['Database.Native'.Index] -> ['Database.Native'.Index]
mergeUnion [] is = is
mergeUnion is [] = is
mergeUnion is=:[_:_] [] = is
mergeUnion orgis=:[i:is] orgjs=:[j:js]
| i < j = [i:mergeUnion is orgjs]
| i > j = [j:mergeUnion orgis js]
......@@ -476,7 +478,7 @@ where
mergeUnionWithAnnots :: ![('Database.Native'.Index,a)] ![('Database.Native'.Index,a)] -> [('Database.Native'.Index,a)]
mergeUnionWithAnnots [] is = is
mergeUnionWithAnnots is [] = is
mergeUnionWithAnnots is=:[_:_] [] = is
mergeUnionWithAnnots orgis=:[a=:(i,_):is] orgjs=:[b=:(j,_):js]
| i < j = [a:mergeUnionWithAnnots is orgjs]
| i > j = [b:mergeUnionWithAnnots orgis js]
......@@ -485,7 +487,7 @@ where
// Efficient intersection on sorted lists
mergeIntersect :: !['Database.Native'.Index] !['Database.Native'.Index] -> ['Database.Native'.Index]
mergeIntersect [] is = []
mergeIntersect is [] = []
mergeIntersect is=:[_:_] [] = []
mergeIntersect orgis=:['Database.Native'.Index i:is] orgjs=:['Database.Native'.Index j:js]
| i < j = mergeIntersect is orgjs
| i > j = mergeIntersect orgis js
......@@ -495,12 +497,15 @@ allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms wrap=:{db}
# (es,db) = 'Database.Native'.allEntries db
= (fromList
$ map (\syns=:[(t,_):_] -> (t,map snd syns))
$ map collect
$ groupBy ((==) `on` fst)
$ sortBy ((<) `on` fst)
[(td.td_name, td) \\ TypeDefEntry {tde_typedef=td=:{td_rhs=TDRSynonym t}} <- es]
, {wrap & db=db}
)
where
collect syns=:[(t,_):_] = (t,[s \\ (_,s) <- syns])
collect [] = abort "internal error in allTypeSynonyms\n"
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
alwaysUniquePredicate wrap=:{always_unique} = (isJust o flip get always_unique, wrap)
......@@ -551,6 +556,8 @@ where
where (match,nomatch) = partition (\a->a=:MatchingNGramsResult _) m
updateAnnots [a=:Unifier _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:Unifier _)]]
updateAnnots [a=:ExactResult:as] m = updateAnnots as [a:[a \\ a <- m | not a=:ExactResult]]
updateAnnots [a=:UsedSynonyms _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:UsedSynonyms _)]]
updateAnnots [a=:RequiredContext _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:RequiredContext _)]]
getEntries :: !*CloogleDB -> *([(CloogleEntry, [Annotation])], *CloogleDB)
getEntries wrap=:{db}
......
......@@ -180,16 +180,19 @@ finaliseDB extra tdb =
, library_map = libmap
, module_map = modmap
, derive_map = 'Data.Map'.fromList
$ map (\ds=:[(g,_):_] -> (g,{i \\ (_,i) <- ds}))
$ map collect_snds
$ groupBy ((==) `on` fst) $ sort
[(de.de_generic, i) \\ (i,DeriveEntry de) <- entridxs]
, instance_map = 'Data.Map'.fromList
$ map (\is=:[(c,_):_] -> (c,{i \\ (_,i) <- is}))
$ map collect_snds
$ groupBy ((==) `on` fst) $ sort
[(ie.ie_class, i) \\ (i,InstanceEntry ie) <- entridxs]
, always_unique = always_unique
}
where
collect_snds xys=:[(x,_):_] = (x,{#y \\ (_,y) <- xys})
collect_snds [] = abort "collect_snds requires at least one element\n"
link :: !Int !CloogleEntry -> CloogleEntry
link i e = case e of
TypeDefEntry tde -> TypeDefEntry
......@@ -204,7 +207,7 @@ where
DeriveEntry {de_type='Clean.Types'.Arrow _} -> name == "(->)"
DeriveEntry {de_type='Clean.Types'.Func _ _ _} -> name == "(->)"
_ -> False
, tde_usages={u \\ u <- fromMaybe [] ('Data.Map'.get name type_usages_map)}
, tde_usages=fromMaybe {} ('Data.Map'.get name type_usages_map)
}
with name = 'Clean.Types'.td_name $ 'Cloogle.DB'.getTypeDef tde
ClassEntry ce -> ClassEntry
......@@ -215,7 +218,7 @@ where
, ce_members=idxarr \e -> case e of
FunctionEntry fe -> fe.fe_class == Just (Index i)
_ -> False
, ce_usages={u \\ u <- fromMaybe [] ('Data.Map'.get name class_usages_map)}
, ce_usages=fromMaybe {} ('Data.Map'.get name class_usages_map)
}
with name = 'Cloogle.DB'.getName ce.ce_loc
FunctionEntry fe -> FunctionEntry
......@@ -225,19 +228,19 @@ where
Just _ -> Just $ idxarr \e -> case e of
DeriveEntry de -> de.de_generic == name
_ -> False
, fe_usages={u \\ u <- fromMaybe [] ('Data.Map'.get name function_usages_map)}
, fe_usages=fromMaybe {} ('Data.Map'.get name function_usages_map)
}
with name = 'Cloogle.DB'.getName fe.fe_loc
ModuleEntry me -> ModuleEntry
{ me
& me_usages={u \\ u <- fromMaybe [] ('Data.Map'.get name module_usages_map)}
& me_usages=fromMaybe {} ('Data.Map'.get name module_usages_map)
}
with name = 'Cloogle.DB'.getName me.me_loc
e -> e
make_usage_map :: ([[(a,b)]] -> 'Data.Map'.Map a [b]) | <, == a
make_usage_map :: ([[(a,Index)]] -> 'Data.Map'.Map a {#Index}) | <, == a
make_usage_map = 'Data.Map'.fromList
o map (\gidxs=:[(g,_):_] -> (g,map snd gidxs))
o map collect_snds
o groupBy ((==) `on` fst)
o sortBy ((<) `on` fst)
o flatten
......@@ -266,7 +269,10 @@ where
function_entries = flatten tdb.temp_functions ++
[({ fun
& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
& fe_kind=case fun.fe_kind of
Function -> ClassMember
Macro -> ClassMacro
_ -> abort "error while transforming class members to function entries\n"
, fe_loc='Cloogle.DB'.setName fname cls.ce_loc
, fe_class=Just $ idxhd \ce -> case ce of
ClassEntry ce -> ce.ce_loc == cls.ce_loc
......@@ -327,8 +333,7 @@ where
classes = sortBy contextOrd [cls \\ clss <- tdb.temp_classes, (cls,_) <- clss]
where
contextOrd :: ClassEntry ClassEntry -> Bool
contextOrd a b = isMember aname [c \\ 'Clean.Types'.Instance c _ <- classContext b]
where [aname,bname:_] = map 'Cloogle.DB'.getName [a.ce_loc,b.ce_loc]
contextOrd a b = isMember ('Cloogle.DB'.getName a.ce_loc) [c \\ 'Clean.Types'.Instance c _ <- classContext b]
instanceEq :: (String, [('Cloogle.DB'.Type, a)], b) (String, [('Cloogle.DB'.Type, a)], b) -> Bool
instanceEq (s, ts, _) (s2, ts2, _) = s == s2 && all (uncurry (isomorphic_to)) (zip2 (map fst ts) (map fst ts2))
......@@ -365,7 +370,7 @@ where
where mods = removeDup [fromJust ('Cloogle.DB'.getModule me.me_loc) \\ (me,_) <- tdb.temp_modules]
synonymmap = 'Data.Map'.fromList
$ map (\syns=:[(t,_):_] -> (t,map snd syns))
$ map (appSnd (\is->[i\\i<-:is]) o collect_snds)
$ groupBy ((==) `on` fst)
$ sortBy ((<) `on` fst)
[let td = 'Cloogle.DB'.getTypeDef tde in ('Clean.Types'.td_name td, td)
......@@ -594,7 +599,9 @@ where
signature _ (Just pd) (Just t) = cpp pd <+ " :: " <+ t <+ "\n"
findPrio :: Ident -> Maybe Priority
findPrio id = (\(PD_TypeSpec _ _ p _ _) -> p) <$> findTypeSpec id defs
findPrio id = (\pd -> case pd of
PD_TypeSpec _ _ p _ _ -> p
_ -> abort "error in findPrio\n") <$> findTypeSpec id defs
findTypeSpec :: Ident [ParsedDefinition] -> Maybe ParsedDefinition
findTypeSpec _ [] = Nothing
......@@ -690,6 +697,7 @@ where
| otherwise = flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe,_) <- members]
<$> findDoc hideIsUsedReturn pd comments
parseClassDoc _ _ _ = abort "parseClassDoc called with non-PD_Class\n"
isSingleFunction :: [(LocationInModule, 'Cloogle.DB'.FunctionEntry, a)] Ident -> Bool
isSingleFunction members id = length members == 1
......
......@@ -4,6 +4,7 @@ import StdArray
import StdBool
from StdFunc import const, id, flip, o
import StdList
import StdMisc
import StdOrdList
import StdString
import StdTuple
......@@ -123,8 +124,9 @@ where
([Derivation (getName fe.fe_loc) (snd $ prep (const False) $ Var v) \\ v <- fromJust fe.fe_generic_vars], db)
= case fe.fe_class of
Nothing -> ([], db)
Just ci -> let ({value=ClassEntry ce},db`) = getIndex ci db in
([Instance (getName ce.ce_loc) (map (snd o prep (const False) o Var) ce.ce_vars)], db`)
Just ci -> case getIndex ci db of
({value=ClassEntry ce},db) -> ([Instance (getName ce.ce_loc) (map (snd o prep (const False) o Var) ce.ce_vars)], db)
(_,db) -> ([], db)
findContext :: [TypeRestriction] Type [TVAssignment] *CloogleDB -> *(Maybe [(String, [LocationResult])], *CloogleDB)
findContext trs t tvas db
......@@ -167,7 +169,7 @@ where
# (ies,db) = getInstances c db
= (removeDup $ flatten
[ ie.ie_locations \\ ie <- ies
| and [norm t1 generalises t2 \\ t1 <- map fst ie.ie_types & t2 <- ts]], db)
| and [norm t1 generalises t2 \\ (t1,_) <- ie.ie_types & t2 <- ts]], db)
findLocations (Derivation g t) db
# (des,db) = getDerivations g db
= (removeDup $ flatten
......@@ -176,132 +178,129 @@ where
makeResult :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef]
!(!CloogleEntry, ![Annotation]) !*CloogleDB
-> *(!Maybe Result, !*CloogleDB)
makeResult orgsearchtype allsyns usedsyns (entry, annots) db
| entry =: (FunctionEntry _)
# (FunctionEntry fe) = entry
// Parent class
# (cls,db) = case fe.fe_class of
Nothing -> (Nothing, db)
Just i -> case getIndex i db of
({value=ClassEntry ce}, db) -> (Just {cls_name=getName ce.ce_loc, cls_vars=ce.ce_vars}, db)
// Unifier
# (unif,usedsyns,required_context,db) = unifyInformation orgsearchtype allsyns usedsyns fe db
# annots = [RequiredContext required_context,UsedSynonyms (length usedsyns):annots]
# annots = case unif of
Just unif -> [Unifier unif:annots]
Nothing -> annots
// Derivations
# (derivs,db) = case fe.fe_derivations of
Nothing -> (Nothing, db)
Just ds -> appFst Just $ getIndices` ds db
= (Just $ FunctionResult (
{ general
& distance = distance entry annots
, documentation = docDescription =<< fe.fe_documentation
},
{ kind = fe.fe_kind
, func = fromJust (fe.fe_representation <|> pure (concat $ print False (name,fe)))
, unifier = toStrUnifier <$> unif
, required_context = required_context
, cls = cls
, constructor_of = case fe.fe_kind of
Constructor -> let (Just (Func _ r _)) = fe.fe_type in Just $ concat $ print False r
_ -> Nothing
, recordfield_of = case fe.fe_kind of
RecordField -> let (Just (Func [t:_] _ _)) = fe.fe_type in Just $ concat $ print False t
_ -> Nothing
, generic_derivations = sortBy ((<) `on` fst) <$>
map (\{value=DeriveEntry de} -> (de.de_type_representation, map locResult de.de_locations)) <$> derivs
, param_doc = map toString <$> docParams <$> fe.fe_documentation
, generic_var_doc = docVars <$> fe.fe_documentation
, result_doc = docResults <$> fe.fe_documentation
, type_doc = concat <$> print False <$> (docType =<< fe.fe_documentation)
, throws_doc = docThrows <$> fe.fe_documentation
}), db)
with
toStrUnifier :: Unifier -> StrUnifier
toStrUnifier unif =
{ StrUnifier
| left_to_right = map toStr [a \\ LeftToRight a <- unif.assignments]
, right_to_left = map toStr [a \\ RightToLeft a <- unif.assignments]
, used_synonyms = [
( concat $ [td.td_name," ":intersperse " " $ print False td.td_args]
, concat $ print False s)
\\ td=:{td_rhs=TDRSynonym s} <- unif.Unifier.used_synonyms]
}
where
toStr (var, type) = (var, concat $ print False type)
makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
FunctionEntry fe
// Parent class
# (cls,db) = case fe.fe_class of
Nothing -> (Nothing, db)
Just i -> case getIndex i db of
({value=ClassEntry ce}, db) -> (Just {cls_name=getName ce.ce_loc, cls_vars=ce.ce_vars}, db)
(_, db) -> (Nothing, db)
// Unifier
# (unif,usedsyns,required_context,db) = unifyInformation orgsearchtype allsyns usedsyns fe db
# annots = [RequiredContext required_context,UsedSynonyms (length usedsyns):annots]
# annots = case unif of
Just unif -> [Unifier unif:annots]
Nothing -> annots
// Derivations
# (derivs,db) = case fe.fe_derivations of
Nothing -> (Nothing, db)
Just ds -> appFst Just $ getIndices` ds db
-> (Just $ FunctionResult (
{ general
& distance = distance entry annots
, documentation = docDescription =<< fe.fe_documentation
},
{ kind = fe.fe_kind
, func = fromJust (fe.fe_representation <|> pure (concat $ print False (name,fe)))
, unifier = toStrUnifier <$> unif
, required_context = required_context
, cls = cls
, constructor_of = case (fe.fe_kind,fe.fe_type) of
(Constructor, Just (Func _ r _)) -> Just $ concat $ print False r
_ -> Nothing
, recordfield_of = case (fe.fe_kind,fe.fe_type) of
(RecordField, Just (Func [t:_] _ _)) -> Just $ concat $ print False t
_ -> Nothing
, generic_derivations = sortBy ((<) `on` fst) <$>
map (\e -> case e.value of
DeriveEntry de -> (de.de_type_representation, map locResult de.de_locations)
_ -> abort "internal error in makeResult_FunctionEntry\n") <$> derivs
, param_doc = map toString <$> docParams <$> fe.fe_documentation
, generic_var_doc = docVars <$> fe.fe_documentation
, result_doc = docResults <$> fe.fe_documentation
, type_doc = concat <$> print False <$> (docType =<< fe.fe_documentation)
, throws_doc = docThrows <$> fe.fe_documentation
}), db)
with
toStrUnifier :: Unifier -> StrUnifier
toStrUnifier unif =
{ StrUnifier
| left_to_right = map toStr [a \\ LeftToRight a <- unif.assignments]
, right_to_left = map toStr [a \\ RightToLeft a <- unif.assignments]
, used_synonyms = [
( concat $ [td.td_name," ":intersperse " " $ print False td.td_args]
, concat $ print False s)
\\ td=:{td_rhs=TDRSynonym s} <- unif.Unifier.used_synonyms]
}
where
toStr (var, type) = (var, concat $ print False type)
| entry =: (TypeDefEntry _)
# (TypeDefEntry tde) = entry
# (insts,db) = getIndices` tde.tde_instances db
# (derivs,db) = getIndices` tde.tde_derivations db
= (Just $ TypeResult (
{ general
& documentation = docDescription =<< tde.tde_doc
},
{ type = concat $ print False tde.tde_typedef
, type_instances = sortBy ((<) `on` fst3)
[(ie.ie_class, map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- insts]
, type_derivations = sortBy ((<) `on` fst)
[(de.de_generic, map locResult de.de_locations) \\ {value=DeriveEntry de} <- derivs]
, type_field_doc = docFields =<< tde.tde_doc
, type_constructor_doc = map ((=<<) docDescription) <$> (docConstructors =<< tde.tde_doc)
, type_representation_doc = join (docRepresentation =<< tde.tde_doc)
}), db)
TypeDefEntry tde
# (insts,db) = getIndices` tde.tde_instances db
# (derivs,db) = getIndices` tde.tde_derivations db
-> (Just $ TypeResult (
{ general
& documentation = docDescription =<< tde.tde_doc
},
{ type = concat $ print False tde.tde_typedef
, type_instances = sortBy ((<) `on` fst3)
[(ie.ie_class, map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- insts]
, type_derivations = sortBy ((<) `on` fst)
[(de.de_generic, map locResult de.de_locations) \\ {value=DeriveEntry de} <- derivs]
, type_field_doc = docFields =<< tde.tde_doc
, type_constructor_doc = map ((=<<) docDescription) <$> (docConstructors =<< tde.tde_doc)
, type_representation_doc = join (docRepresentation =<< tde.tde_doc)
}), db)
| entry =: (ModuleEntry _)
# (ModuleEntry me) = entry
= (Just $ ModuleResult (
{ general
& documentation = docDescription =<< me.me_documentation
},
{ module_is_core = me.me_is_core
}), db)
ModuleEntry me
-> (Just $ ModuleResult (
{ general
& documentation = docDescription =<< me.me_documentation
},
{ module_is_core = me.me_is_core
}), db)
| entry =: (ClassEntry _)
# (ClassEntry ce) = entry
# (ies,db) = getIndices` ce.ce_instances db
# (mems,db) = getIndices` ce.ce_members db
= (Just $ ClassResult (
{ general
& documentation = docDescription =<< ce.ce_documentation
},
{ class_name = name
, class_heading = foldl ((+) o (flip (+) " ")) name ce.ce_vars +
if (isEmpty ce.ce_context) "" " | " + concat (print False ce.ce_context)
, class_funs = [fromJust fe.fe_representation \\ {value=FunctionEntry fe} <- mems]
, class_fun_doc = Just [printDoc <$> fe.fe_documentation \\ {value=FunctionEntry fe} <- mems]
, class_instances = sortBy ((<) `on` fst)
[(map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- ies]
}), db)
ClassEntry ce
# (ies,db) = getIndices` ce.ce_instances db
# (mems,db) = getIndices` ce.ce_members db
-> (Just $ ClassResult (
{ general
& documentation = docDescription =<< ce.ce_documentation
},
{ class_name = name
, class_heading = foldl ((+) o (flip (+) " ")) name ce.ce_vars +
if (isEmpty ce.ce_context) "" " | " + concat (print False ce.ce_context)
, class_funs = [fromJust fe.fe_representation \\ {value=FunctionEntry fe} <- mems]
, class_fun_doc = Just [printDoc <$> fe.fe_documentation \\ {value=FunctionEntry fe} <- mems]
, class_instances = sortBy ((<) `on` fst)
[(map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- ies]
}), db)
| entry =: (SyntaxEntry _)
# (SyntaxEntry se) = entry
= (Just $ SyntaxResult (
{ general
& documentation = Just se.syntax_description
},
{ SyntaxResultExtras
| syntax_title = se.SyntaxEntry.syntax_title
, syntax_code = se.SyntaxEntry.syntax_code
, syntax_examples = se.SyntaxEntry.syntax_examples
}), db)
SyntaxEntry se
-> (Just $ SyntaxResult (
{ general
& documentation = Just se.syntax_description
},
{ SyntaxResultExtras
| syntax_title = se.SyntaxEntry.syntax_title
, syntax_code = se.SyntaxEntry.syntax_code
, syntax_examples = se.SyntaxEntry.syntax_examples
}), db)
| entry =: (ABCInstructionEntry _)
# (ABCInstructionEntry aie) = entry
= (Just $ ABCInstructionResult (
{ general
& documentation = Just aie.aie_description
},
{ abc_instruction = aie.aie_instruction
, abc_arguments = aie.aie_arguments
}), db)
ABCInstructionEntry aie
-> (Just $ ABCInstructionResult (
{ general
& documentation = Just aie.aie_description
},
{ abc_instruction = aie.aie_instruction
, abc_arguments = aie.aie_arguments
}), db)
| otherwise // InstanceEntry / DeriveEntry cannot be returned
= (Nothing, db)
_ // InstanceEntry / DeriveEntry cannot be returned
-> (Nothing, db)
where
mbLoc = getLocation entry
name = getName $ fromJust mbLoc
......@@ -385,6 +384,7 @@ where
locResult :: Location -> LocationResult
locResult (Location lib mod filename dcl icl _) = (lib,mod,filename,dcl,icl)
locResult _ = abort "locResult called for non-Location\n"
isModMatch :: ![String] Location -> Bool
isModMatch mods (Location _ mod _ _ _ _) = isMember mod mods
......
......@@ -174,6 +174,7 @@ where
"rs_resolved_context" -> {rs & rs_resolved_context =val}
"rs_unresolved_context" -> {rs & rs_unresolved_context=val}
"rs_lib_stdenv" -> {rs & rs_lib_stdenv =val}
_ -> abort ("unknown setting " +++ name +++ "\n")
= findSettings ss rs
findSettings [s:ss] rs = findSettings ss rs
findSettings [] rs = rs
......@@ -252,4 +253,5 @@ where
sum [t:ts]
# s = sum ts
= "+ (" +++ t +++ ") (" +++ s +++ ")"
sum [] = abort "error in findConstraints\n"
findConstraints [] _ cdb = ([],cdb)
Subproject commit 2dacc462b44da3a54599fcf4622bc287cb85c640
Subproject commit 9b3230c26b83eb59d2d6e26930803b5aa198e79b
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