Verified Commit 49bc6483 authored by Camil Staps's avatar Camil Staps
Browse files

Store abstract type implementation (clean-cloogle/cloogle.org#111)

parent 0ac186d6
Subproject commit a8a45f70cc7d4ca37ec10abf02ba4396eddea164
Subproject commit 2c651fe964f99952fc9e37f653665024013d390c
......@@ -151,6 +151,7 @@ isApp :: Location CloogleDB -> Bool
toTypeDefEntry :: TypeDef (Maybe Documentation) -> TypeDefEntry
getTypeDef :: TypeDefEntry -> TypeDef
getTypeDefDoc :: TypeDefEntry -> Maybe Documentation
mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
/**
* Wrapper around the Class record field to work around name clashes
......
......@@ -173,6 +173,12 @@ getTypeDef {tde_typedef} = tde_typedef
getTypeDefDoc :: TypeDefEntry -> Maybe Documentation
getTypeDefDoc {tde_doc} = tde_doc
mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
mergeTypeDefEntries a=:{tde_typedef={td_rhs=TDRAbstract Nothing}} b = case b.tde_typedef.td_rhs of
TDRAbstract _ -> a
rhs -> {a & tde_typedef.td_rhs=TDRAbstract (Just rhs)}
mergeTypeDefEntries a b = b
toClass :: [String] TypeContext (Maybe Documentation) [(Name, FunctionEntry)] -> ClassEntry
toClass vs cc doc mems
= { ce_vars = vs
......
......@@ -210,7 +210,7 @@ findModuleContents include_locals path w
( combine cmpLocFst joinLocFst pd_typespecs dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_rewriterules dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_generics dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_types dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinTypeDefs pd_types dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_classes dcl dcl_symbols icl icl_symbols
, combine cmpInsts joinInsts pd_instances dcl dcl_symbols icl icl_symbols
, combineDerivs (pd_derivations True dcl) (pd_derivations False icl)
......@@ -252,7 +252,12 @@ where
cmpLocFst :: ((LocationInModule, a) (LocationInModule, a) -> Bool)
cmpLocFst = on cmpLoc fst
joinLocFst (la,x) (lb,_) = (joinLoc la lb,x)
joinLocFst :: (LocationInModule, a) (LocationInModule, b) -> (LocationInModule, a)
joinLocFst (l1,a) (l2,_) = (joinLoc l1 l2, a)
joinTypeDefs :: (LocationInModule, 'DB'.TypeDefEntry) (LocationInModule, 'DB'.TypeDefEntry) -> (LocationInModule, 'DB'.TypeDefEntry)
joinTypeDefs (a,t) (b,u) = (joinLoc a b, 'DB'.mergeTypeDefEntries t u)
cmpInsts :: (a, b, LocationInModule) (a, b, LocationInModule) -> Bool | == a & == b
cmpInsts (ca, tsa, _) (cb, tsb, _) = ca == cb && tsa == tsb
......
......@@ -181,40 +181,18 @@ where
fe.fe_representation <|> (pure $ concat $ print False f)
makeTypeResult :: (Maybe String) Location TypeDefEntry CloogleDB -> Result
makeTypeResult mbName (Location lib mod fname line iclline t) etd db
makeTypeResult mbName location etd db
= TypeResult
( { library = lib
, filename = fname
, dcl_line = line
, dcl_line = dclline
, icl_line = iclline
, modul = mod
, distance
= if (isNothing mbName) -100 (levenshtein` (fromJust mbName) t)
, builtin = Nothing
, documentation = getDocDescription =<< etd.tde_doc
, langrep_documentation = Nothing
}
, { type = concat $ print False etd.tde_typedef
, type_instances = sortBy (\(a,_,_) (b,_,_) -> a < b)
[(c, map snd ie.ie_types, map loc ie.ie_locations) \\ (c,ie) <- getTypeInstances etd.tde_typedef.td_name db]
, type_derivations = [(if c "class " "" + g, map loc l) \\ (g,c,l) <- getTypeDerivations etd.tde_typedef.td_name db]
, type_field_doc = getFieldDoc =<< etd.tde_doc
, type_constructor_doc = map ((=<<) getDocDescription) <$> (getConstructorDoc =<< etd.tde_doc)
, type_representation_doc = getRepresentationDoc =<< etd.tde_doc
}
)
makeTypeResult mbName (Builtin t langdoc) etd db
= TypeResult
( { library = ""
, filename = ""
, dcl_line = Nothing
, icl_line = Nothing
, modul = ""
, distance
= if (isNothing mbName) -100 (levenshtein` (fromJust mbName) t)
, builtin = Just True
, builtin = builtin
, documentation = getDocDescription =<< etd.tde_doc
, langrep_documentation = Just langdoc
, langrep_documentation = langdoc
}
, { type = concat $ print False etd.tde_typedef
, type_instances = sortBy (\(a,_,_) (b,_,_) -> a < b)
......@@ -225,6 +203,10 @@ makeTypeResult mbName (Builtin t langdoc) etd db
, type_representation_doc = getRepresentationDoc =<< etd.tde_doc
}
)
where
(lib,mod,fname,dclline,iclline,t,langdoc,builtin) = case location of
Location lib mod fname dclline iclline t -> (lib,mod,fname,dclline,iclline,t,Nothing, Nothing)
Builtin t langdoc -> ("", "", "", Nothing,Nothing,t,Just langdoc,Just True)
makeFunctionResult :: (Maybe String) (Maybe Type) [TypeDef] (Maybe ShortClassResult)
(Location, FunctionEntry) CloogleDB -> Result
......
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