Verified Commit 9ab3e2fd authored by Camil Staps's avatar Camil Staps 🚀

Be able to index local functions as well (clean-cloogle/cloogle-tags#2)

parent e1beb5a7
Subproject commit 60e7faff9975790a9a5717a329f1db94511f08e4
Subproject commit 1a9e842bb4c58ec4ff270b843d878f3fce8e0c22
Subproject commit 8f142b4e5d5c3289e13e4517fb2d2b5c382a8195
Subproject commit 6df6f49aa6aed68bcb46cfb1aa4290c6967cee6a
......@@ -32,6 +32,7 @@ findModules :: ![String] !String !Library !a !String !*World
/**
* Update a database with all the information found in a module
*
* @param Whether local definitions (that only exist in the icl) should be indexed.
* @param The root of the library directory (typically $CLEAN_HOME/lib).
* @param The module to index.
* @param The library the module to index is in.
......@@ -39,10 +40,11 @@ findModules :: ![String] !String !Library !a !String !*World
* @param The old database.
* @result The new database.
*/
indexModule :: !String !Module !Library !(String ModuleEntry -> ModuleEntry) !TemporaryDB !*World
indexModule :: !Bool !String !Module !Library
!(String ModuleEntry -> ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
:: LocationInFile =
:: LocationInModule =
{ dcl_line :: Maybe Int
, icl_line :: Maybe Int
, name :: Maybe String
......@@ -66,14 +68,14 @@ indexModule :: !String !Module !Library !(String ModuleEntry -> ModuleEntry) !Te
* - The module
*/
findModuleContents :: !String !*World
-> *( ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, TypeDefEntry)]
, ![(LocationInFile, ClassEntry)]
, ![(Name, [(Type, String)], LocationInFile)]
, ![(Name, [(Type, String, LocationInFile)])]
, ![(Name, Type, String, LocationInFile)]
-> *( ![(LocationInModule, FunctionEntry)]
, ![(LocationInModule, FunctionEntry)]
, ![(LocationInModule, FunctionEntry)]
, ![(LocationInModule, TypeDefEntry)]
, ![(LocationInModule, ClassEntry)]
, ![(Name, [(Type, String)], LocationInModule)]
, ![(Name, [(Type, String, LocationInModule)])]
, ![(Name, Type, String, LocationInModule)]
, !(Name, ModuleEntry)
, !*World
)
......
......@@ -14,8 +14,9 @@ import Control.Applicative
import Control.Monad
import Data.Either
import Data.Error
from Data.Func import $, mapSt
from Data.Func import $, mapSt, on
import Data.Functor
import Data.List
import Data.Maybe
import Data.Tuple
import System.Directory
......@@ -38,12 +39,12 @@ from syntax import :: ClassDef{class_args,class_context,class_ident,class_pos},
:: Ident{id_name,id_info}, :: LineNr, :: Module{mod_defs,mod_ident},
:: Optional(Yes,No), :: SymbolPtr, :: Ptr, :: SymbolTableEntry{ste_doc},
:: ParsedDefinition(PD_Class,PD_Derive,PD_Function,PD_Generic,PD_Instance,
PD_Instances,PD_Type,PD_TypeSpec,PD_Documentation),
PD_Instances,PD_Type,PD_TypeSpec,PD_Documentation,PD_GenericCase),
:: ParsedExpr, :: ParsedInstance{pi_ident,pi_pos,pi_types},
:: ParsedInstanceAndMembers{pim_pi}, :: ParsedModule, :: ParsedTypeDef,
:: Position(FunPos,LinePos,NoPos), :: Priority, :: Rhs, :: ATypeVar,
:: RhsDefsOfType(ConsList,ExtensibleConses,SelectorList,TypeSpec,EmptyRhs,
AbstractTypeSpec),
AbstractTypeSpec,NewTypeCons,MoreConses),
:: SymbolTable, :: SymbolTableEntry, :: SymbolType, :: Type, :: BITVECT,
:: TypeContext, :: TypeDef{td_ident,td_pos,td_rhs}, :: TypeVar,
:: ParsedConstructor{pc_doc}, :: ParsedSelector{ps_doc}, :: DocType,
......@@ -139,11 +140,24 @@ where
removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)]
removeDupBy _ [] = []
indexModule :: !String !'DB'.Module !'DB'.Library !(String 'DB'.ModuleEntry -> 'DB'.ModuleEntry) !TemporaryDB !*World
indexModule :: !Bool !String !'DB'.Module !'DB'.Library
!(String 'DB'.ModuleEntry -> 'DB'.ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
indexModule root mod lib modf db w
indexModule include_locals root mod lib modf db w
#! (functions, macros, generics, typedefs, clss, insts, derivs, clsderivs, (modname, modentry), w)
= findModuleContents (root </> lib </> mkdir mod) w
#! (functions, macros, generics, typedefs, clss, insts, derivs, clsderivs) =
if include_locals
(functions, macros, generics, typedefs, clss, insts, derivs, clsderivs)
( filter (hasDcl o fst) functions
, filter (hasDcl o fst) macros
, filter (hasDcl o fst) generics
, filter (hasDcl o fst) typedefs
, filter (hasDcl o fst) clss
, filter (hasDcl o thd3) insts
, filter (not o isEmpty o snd) (map (appSnd (filter (hasDcl o thd3))) derivs)
, filter (hasDcl o (\(_,_,_,x)->x)) clsderivs
)
#! lib = lib % (0, size lib - size modname + size mod - 1)
#! db =
{ db
......@@ -165,48 +179,98 @@ indexModule root mod lib modf db w
}
= (db,w)
where
castLocFst :: String -> ([(LocationInFile, a)] -> [('DB'.Location, a)])
castLocFst :: String -> ([(LocationInModule, a)] -> [('DB'.Location, a)])
castLocFst m = map (appFst (castLoc m))
castLocThd3 :: String -> ([(a, b, LocationInFile)] -> [(a, b, 'DB'.Location)])
castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'DB'.Location)])
castLocThd3 m = map (appThd3 (castLoc m))
castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l))
castLoc :: String LocationInFile -> 'DB'.Location
castLoc :: String LocationInModule -> 'DB'.Location
castLoc m l = 'DB'.Location lib m l.dcl_line l.icl_line (fromJust (l.name <|> Just "")) // TODO
hasDcl loc = isJust loc.dcl_line
mkdir :: String -> String
mkdir s = { if (c == '.') '/' c \\ c <-: s }
instance zero LocationInModule
where zero = {dcl_line=Nothing, icl_line=Nothing, name=Nothing}
findModuleContents :: !String !*World
-> *( ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.TypeDefEntry)]
, ![(LocationInFile, 'DB'.ClassEntry)]
, ![('DB'.Name, [('DB'.Type, String)], LocationInFile)]
, ![('DB'.Name, [('DB'.Type, String, LocationInFile)])]
, ![('DB'.Name, 'DB'.Type, String, LocationInFile)]
-> *( ![(LocationInModule, 'DB'.FunctionEntry)]
, ![(LocationInModule, 'DB'.FunctionEntry)]
, ![(LocationInModule, 'DB'.FunctionEntry)]
, ![(LocationInModule, 'DB'.TypeDefEntry)]
, ![(LocationInModule, 'DB'.ClassEntry)]
, ![('DB'.Name, [('DB'.Type, String)], LocationInModule)]
, ![('DB'.Name, [('DB'.Type, String, LocationInModule)])]
, ![('DB'.Name, 'DB'.Type, String, LocationInModule)]
, !('DB'.Name, 'DB'.ModuleEntry)
, !*World
)
findModuleContents path w
#! (Right dcl,symbols,w) = readModule False w
#! (icl,_,w) = readModule True w
#! icl = case icl of (Left _) = Nothing; (Right x) = Just x
#! modname = dcl.mod_ident.id_name
#! typedefs = pd_types dcl.mod_defs icl symbols
= ( pd_typespecs dcl.mod_defs icl symbols
, pd_macros dcl.mod_defs symbols
, pd_generics dcl.mod_defs icl symbols
, typedefs
, pd_classes dcl.mod_defs icl symbols
, pd_instances dcl.mod_defs icl
, pd_derivations dcl.mod_defs
, pd_class_derivations dcl.mod_defs icl
, (modname,pd_module dcl.mod_defs)
#! (dcl,dcl_symbols,w) = readModule False w
#! (dcl,modname) = case dcl of
Left _ -> ([], "")
Right dcl -> (dcl.mod_defs, dcl.mod_ident.id_name)
#! (icl,icl_symbols,w) = readModule True w
#! icl = case icl of Left _ -> []; Right icl -> icl.mod_defs
= ( combine cmpLocFst joinLocFst pd_typespecs dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_macros 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 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)
, combine cmpClsDeriv joinClsDeriv pd_class_derivations dcl dcl_symbols icl icl_symbols
, (modname,pd_module dcl)
, w
)
where
combine :: (a a -> Bool) (a a -> a)
(Bool [ParsedDefinition] SymbolTable -> [a])
![ParsedDefinition] !SymbolTable
![ParsedDefinition] SymbolTable
-> [a]
combine eq join find dcl dclsym [] _ // Special case for things like _library.dcl
= find True dcl dclsym
combine eq join find dcl dclsym icl iclsym
= unionBy eq join (find True dcl dclsym) (find False icl iclsym)
unionBy :: (a a -> Bool) (a a -> a) [a] [a] -> [a]
unionBy eq join xs [] = xs
unionBy eq join xs [y:ys] = case partition (eq y) xs of
([], xs) -> [y :unionBy eq join xs ys]
(found,xs) -> let (foundys,ys`) = partition (eq y) ys in
[foldr join y (found ++ foundys):unionBy eq join xs ys`]
cmpLocFst :: (LocationInModule, a) (LocationInModule, a) -> Bool
cmpLocFst (x,_) (y,_) = x.name == y.name
joinLocFst (la,x) (lb,_) = (joinLoc la lb,x)
cmpInsts :: (a, b, LocationInModule) (a, b, LocationInModule) -> Bool | == a & == b
cmpInsts (ca, tsa, _) (cb, tsb, _) = ca == cb && tsa == tsb
joinInsts (c,ts,la) (_,_,lb) = (c,ts,joinLoc la lb)
combineDerivs ::
([('DB'.Name, [('DB'.Type, String, LocationInModule)])]
[('DB'.Name, [('DB'.Type, String, LocationInModule)])]
-> [('DB'.Name, [('DB'.Type, String, LocationInModule)])])
combineDerivs = unionBy (on (==) fst) (\(n,ts) (_,us) -> (n,combineTypes ts us))
where
combineTypes = unionBy (on (==) fst3) (\(t,s,la) (_,_,lb) -> (t,s,joinLoc la lb))
cmpClsDeriv :: (a, b, c, LocationInModule) (a, b, c, LocationInModule) -> Bool | == a & == b
cmpClsDeriv (ca,ta,_,_) (cb,tb,_,_) = ca == cb && ta == tb
joinClsDeriv (c,t,s,la) (_,_,_,lb) = (c,t,s,joinLoc la lb)
joinLoc :: LocationInModule LocationInModule -> LocationInModule
joinLoc a b =
{ dcl_line = a.dcl_line <|> b.dcl_line
, icl_line = a.icl_line <|> b.icl_line
, name = a.name <|> b.name
}
pd_module :: ![ParsedDefinition] -> ModuleEntry
pd_module [PD_Documentation _ doc:_]
= { zero
......@@ -214,10 +278,9 @@ where
}
pd_module _ = zero
pd_macros :: ![ParsedDefinition] SymbolTable
-> [(LocationInFile, 'DB'.FunctionEntry)]
pd_macros dcl st
= [( {dcl_line=toLine pos, icl_line=Nothing, name=Just id.id_name}
pd_macros :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.FunctionEntry)]
pd_macros dcl defs st
= [( setLine dcl pos {zero & name=Just id.id_name}
, let doc = findDoc parseFunctionDoc id st in
{ zero
& fe_kind=Macro
......@@ -226,154 +289,96 @@ where
, fe_priority=findPrio id >>= 'T'.toMaybePriority
, fe_documentation=doc
}
) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- dcl]
) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- defs]
where
priostring :: Ident -> String
priostring id = case findTypeSpec id dcl of
priostring id = case findTypeSpec id defs of
Nothing = ""
(Just pri) = cpp pri +++ "\n"
findPrio :: Ident -> Maybe Priority
findPrio id = (\(PD_TypeSpec _ _ p _ _) -> p) <$> findTypeSpec id dcl
findPrio id = (\(PD_TypeSpec _ _ p _ _) -> p) <$> findTypeSpec id defs
findTypeSpec :: Ident [ParsedDefinition] -> Maybe ParsedDefinition
findTypeSpec _ [] = Nothing
findTypeSpec id [pd=:(PD_TypeSpec _ id` prio _ _):dcl]
findTypeSpec id [pd=:(PD_TypeSpec _ id` prio _ _):defs]
| id`.id_name == id.id_name = Just pd
findTypeSpec id [_:dcl] = findTypeSpec id dcl
pd_derivations :: ![ParsedDefinition]
-> [('DB'.Name, [('DB'.Type, String, LocationInFile)])]
pd_derivations dcl
= [( id.id_name
, [('T'.toType gc_type, cpp gc_type, {dcl_line=toLine gc_pos, icl_line=Nothing, name=Nothing})]
) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]
pd_generics :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.FunctionEntry)]
pd_generics dcl icl st
= [( {dcl_line=toLine gen_pos, icl_line=findIclLine id_name =<< icl, name=Just id_name}
findTypeSpec id [_:defs] = findTypeSpec id defs
pd_derivations :: !Bool ![ParsedDefinition] -> [('DB'.Name, [('DB'.Type, String, LocationInModule)])]
pd_derivations dcl defs
= [( id.id_name, [('T'.toType gc_type, cpp gc_type, setLine dcl gc_pos zero)])
\\ gcdefs <- [ds \\ PD_Derive ds <- defs] ++ [[d] \\ PD_GenericCase d _ <- defs]
, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]
pd_generics :: !Bool ![ParsedDefinition] !SymbolTable -> [(LocationInModule, 'DB'.FunctionEntry)]
pd_generics dcl defs st
= [( setLine dcl gen_pos {zero & name=Just id_name}
, { zero
& fe_type=Just $ 'T'.toType gen_type
, fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
, fe_representation=Just $ cpp gen
, fe_documentation=findDoc parseFunctionDoc id st
}
) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- dcl]
where
findIclLine :: String ParsedModule -> Maybe Int
findIclLine name {mod_defs=pms}
= case [g.gen_pos \\ PD_Generic g <- pms | g.gen_ident.id_name == name] of
[FunPos _ l _:_] = Just l
[LinePos _ l:_] = Just l
_ = Nothing
pd_typespecs :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.FunctionEntry)]
pd_typespecs dcl icl st
= [( {dcl_line=toLine pos, icl_line=findIclLine id_name =<< icl, name=Just id_name}
) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- defs]
pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.FunctionEntry)]
pd_typespecs dcl defs st
= [( setLine dcl pos {zero & name=Just id_name}
, { zero
& fe_type=Just $ 'T'.toType t
, fe_priority = 'T'.toMaybePriority p
, fe_representation = Just $ cpp ts
, fe_documentation = findDoc parseFunctionDoc id st
}
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- dcl]
where
findIclLine :: String ParsedModule -> Maybe Int
findIclLine name {mod_defs=pms}
= case [pos \\ PD_TypeSpec pos id _ _ _ <- pms | id.id_name == name] of
[FunPos _ l _:_] = Just l
[LinePos _ l:_] = Just l
_ = Nothing
pd_class_derivations :: ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, 'DB'.Type, String, LocationInFile)]
pd_class_derivations dcl icl
= [( id.id_name
, 'T'.toType gc_type
, cpp gc_type
, {dcl_line=toLine gc_pos, icl_line=findIclLine id.id_name ('T'.toType gc_type) =<< icl, name=Nothing}
) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCFC id _} <- gcdefs]
where
findIclLine :: String 'T'.Type ParsedModule -> Maybe Int
findIclLine name type {mod_defs=pms}
= case [gc_pos
\\ PD_Derive gcdefs <- pms, {gc_type,gc_pos,gc_gcf=GCFC id _} <- gcdefs
| id.id_name == name && 'T'.toType gc_type == type] of
[LinePos _ l:_] = Just l
_ = Nothing
pd_instances :: ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, [('DB'.Type, String)], LocationInFile)]
pd_instances dcl icl
= [( id
, types
, {dcl_line=toLine pos, icl_line=findIclLine id (map fst types) =<< icl, name=Nothing}
) \\ (id,types,pos) <- instances]
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs]
pd_class_derivations :: !Bool ![ParsedDefinition] SymbolTable -> [('DB'.Name, 'DB'.Type, String, LocationInModule)]
pd_class_derivations dcl defs _
= [(id.id_name, 'T'.toType gc_type, cpp gc_type, setLine dcl gc_pos zero)
\\ PD_Derive gcdefs <- defs, {gc_type,gc_pos,gc_gcf=GCFC id _} <- gcdefs]
pd_instances :: !Bool ![ParsedDefinition] SymbolTable -> [('DB'.Name, [('DB'.Type, String)], LocationInModule)]
pd_instances dcl defs _
= [(id, types, setLine dcl pos zero) \\ (id,types,pos) <- instances]
where
instances = map (appSnd3 (map (\t -> ('T'.toType t, cppp t)))) $
[(i.pi_ident.id_name, i.pi_types, i.pi_pos) \\ PD_Instance {pim_pi=i} <- dcl]
++ [(i.pi_ident.id_name, i.pi_types, i.pi_pos) \\ PD_Instances pis <- dcl, {pim_pi=i} <- pis]
findIclLine :: String ['T'.Type] ParsedModule -> Maybe Int
findIclLine name types {mod_defs=pms}
= case [pi_pos
\\ PD_Instance {pim_pi={pi_pos,pi_ident,pi_types}} <- pms
| (pi_ident.id_name == name && map 'T'.toType pi_types == types)] of
[LinePos _ l:_] = Just l
_ = Nothing
pd_classes :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.ClassEntry)]
pd_classes dcl icl st
# dcl = filter (\pd->case pd of (PD_Class _ _)=True; _=False) dcl
= map (\(PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} dcl)
-> let
typespecs = pd_typespecs dcl icl st
macros = pd_macros dcl st
getMacro n = case filter ((==) n o (\l->fromJust l.name) o fst) macros of
[] = Nothing
[(_,m):_] = m.fe_representation
updateRepresentation n fe
= { fe
& fe_kind=if (isNothing $ getMacro n) fe.fe_kind Macro
, fe_representation=getMacro n <|> fe.fe_representation
}
in ( {dcl_line=toLine class_pos, icl_line=findIclLine id_name =<< icl, name=Just id_name}
, 'DB'.toClass
(map 'T'.toTypeVar class_args)
(flatten $ map 'T'.toTypeContext class_context)
(flip (foldl addClassMemberDoc)
[(i.pi_ident.id_name, i.pi_types, i.pi_pos) \\ PD_Instance {pim_pi=i} <- defs]
++ [(i.pi_ident.id_name, i.pi_types, i.pi_pos) \\ PD_Instances pis <- defs, {pim_pi=i} <- pis]
pd_classes :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.ClassEntry)]
pd_classes dcl defs st
= [ let
typespecs = pd_typespecs True clsdefs st
macros = [(n,r) \\ ({name=Just n},{fe_representation=Just r}) <- pd_macros dcl clsdefs st]
updateRepresentation n fe
= { fe
& fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro
, fe_representation=lookup n macros <|> fe.fe_representation
}
in ( setLine dcl class_pos {zero & name=Just id_name}
, 'DB'.toClass
(map 'T'.toTypeVar class_args)
(flatten $ map 'T'.toTypeContext class_context)
(flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe) <- typespecs]
<$> (findDoc parseClassDoc id st))
[(f,updateRepresentation f et) \\ ({name=Just f}, et) <- typespecs]
)) dcl
where
findIclLine :: String ParsedModule -> Maybe Int
findIclLine name {mod_defs=pms}
= case [class_pos \\ PD_Class {class_ident,class_pos} _ <- pms | class_ident.id_name == name] of
[LinePos _ l:_] = Just l
_ = Nothing
pd_types :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.TypeDefEntry)]
pd_types dcl icl st
[(f,updateRepresentation f et) \\ ({name=Just f}, et) <- typespecs]
)
\\ PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} clsdefs <- defs
]
pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.TypeDefEntry)]
pd_types dcl defs st
= [let name = 'T'.td_name td in
( {dcl_line=toLine ptd.td_pos, icl_line=findIclLine name =<< icl, name=Just name}
( setLine dcl ptd.td_pos {zero & name=Just name}
, 'DB'.toTypeDefEntry td $ findRhsDoc ptd =<<
(case findDoc (parsef ptd.td_rhs) ptd.td_ident st of
Just d -> Just d
Nothing -> docParseResultToMaybe $ parsef ptd.td_rhs ""
)
) \\ PD_Type ptd <- dcl, td <- ['T'.toTypeDef ptd]]
) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]]
where
findIclLine :: String ParsedModule -> Maybe Int
findIclLine name {mod_defs=pms}
= case [td_pos \\ PD_Type {td_ident,td_pos} <- pms | td_ident.id_name == name] of
[LinePos _ l:_] = Just l
_ = Nothing
parsef :: RhsDefsOfType -> String -> Either ParseError (Documentation, [ParseWarning])
parsef (ConsList _) = parseADTypeDoc
parsef (ExtensibleConses _) = parseADTypeDoc
......@@ -381,6 +386,8 @@ where
parsef (TypeSpec _) = parseSynonymTypeDoc
parsef (EmptyRhs _) = parseAbstractTypeDoc
parsef (AbstractTypeSpec _ _) = parseAbstractTypeDoc
parsef (MoreConses _ _ ) = parseADTypeDoc
parsef (NewTypeCons _ ) = const $ Left $ IllegalState "Unknown RhsDefsOfType: NewTypeCons"
parsef _ = const $ Left $ IllegalState "Unknown RhsDefsOfType"
findRhsDoc :: ParsedTypeDef Documentation -> Maybe Documentation
......@@ -445,6 +452,10 @@ where
isUsedReturn :: ParseWarning -> Bool
isUsedReturn UsedReturn = True; isUsedReturn _ = False
setLine :: !Bool !Position !LocationInModule -> LocationInModule
setLine True pos loc = {loc & dcl_line=toLine pos}
setLine False pos loc = {loc & icl_line=toLine pos}
constructor_functions :: 'DB'.TypeDefEntry -> [('DB'.Name, 'DB'.FunctionEntry)]
constructor_functions etd
= [(c,
......@@ -455,10 +466,10 @@ constructor_functions etd
, fe_priority=p
})
\\ (c,f,p) <- 'T'.constructorsToFunctions ('DB'.getTypeDef etd)]
print_prio :: (Maybe 'T'.Priority) -> [String]
print_prio Nothing = []
print_prio (Just p) = [" "] ++ print False p
where
print_prio :: (Maybe 'T'.Priority) -> [String]
print_prio Nothing = []
print_prio (Just p) = [" "] ++ print False p
record_functions :: 'DB'.TypeDefEntry -> [('DB'.Name, 'DB'.FunctionEntry)]
record_functions etd
......
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