CloogleDBFactory.icl 34 KB
Newer Older
Camil Staps's avatar
Camil Staps committed
1
implementation module CloogleDBFactory
2
3
4

import StdArray
import StdBool
5
import StdDebug
6
import StdFile
7
from StdFunc import const, flip, id, o
8
import StdList
Camil Staps's avatar
Camil Staps committed
9
import StdOrdList
10
import StdOverloadedList
11
12
13
14
15
16
17
import StdString
import StdTuple

import Control.Applicative
import Control.Monad
import Data.Either
import Data.Error
18
from Data.Func import $, mapSt, on, `on`
19
import Data.Functor
Camil Staps's avatar
Camil Staps committed
20
import Data.GenDefault
21
import Data.List
22
23
from Data.Map import :: Map
import qualified Data.Map as M
24
import Data.Maybe
Camil Staps's avatar
Camil Staps committed
25
import qualified Data.Set as S
26
27
import Data.Tuple
import System.Directory
Camil Staps's avatar
Camil Staps committed
28
import System.FilePath
Camil Staps's avatar
Camil Staps committed
29
30
from Text import class Text(concat,indexOf,replaceSubString,startsWith),
	instance Text String, <+
31

32
import CleanPrettyPrint
33
34

from compile import :: DclCache{hash_table}, empty_cache
Camil Staps's avatar
Camil Staps committed
35
from hashtable import :: BoxedIdent{boxed_ident}, :: HashTable{hte_symbol_heap},
36
	:: IdentClass(IC_Module), :: QualifiedIdents(NoQualifiedIdents),
Camil Staps's avatar
Camil Staps committed
37
38
	putIdentInHashTable, set_hte_mark, newHashTable
from Heap import :: Heap, newHeap, sreadPtr
39
40
41
42
from parse import wantModule
from predef import init_identifiers
from syntax import :: ClassDef{class_args,class_context,class_ident,class_pos},
	:: FileName, :: FunctName, :: FunKind(FK_Macro), :: FunSpecials, :: GCF,
43
	:: GenericCaseDef{gc_gcf,gc_pos,gc_type}, :: GenericCaseFunctions(GCF,GCFC),
Camil Staps's avatar
Camil Staps committed
44
45
46
	:: GenericDef{gen_ident,gen_pos,gen_type,gen_vars},
	:: Ident{id_name,id_info}, :: LineNr, :: Module{mod_defs,mod_ident},
	:: Optional(Yes,No), :: SymbolPtr, :: Ptr, :: SymbolTableEntry{ste_doc},
Camil Staps's avatar
Camil Staps committed
47
	:: ParsedDefinition(PD_Class,PD_Derive,PD_Function,PD_Generic,PD_Instance,
48
		PD_Instances,PD_Type,PD_TypeSpec,PD_Documentation,PD_GenericCase,
49
		PD_NodeDef,PD_Import),
50
51
	:: ParsedExpr(PE_Ident,PE_List),
	:: ParsedInstance{pi_ident,pi_pos,pi_types},
52
	:: ParsedInstanceAndMembers{pim_pi}, :: ParsedModule, :: ParsedTypeDef,
53
	:: Position(FunPos,LinePos,NoPos), :: Priority, :: Rhs, :: ATypeVar,
54
	:: RhsDefsOfType(ConsList,ExtensibleConses,SelectorList,TypeSpec,EmptyRhs,
55
		AbstractTypeSpec,NewTypeCons,MoreConses),
56
57
	:: SymbolTable, :: SymbolTableEntry, :: SymbolType, :: Type, :: BITVECT,
	:: TypeContext, :: TypeDef{td_ident,td_pos,td_rhs}, :: TypeVar,
58
59
60
	:: ParsedConstructor{pc_doc}, :: ParsedSelector{ps_doc},
	:: ParsedImport, :: Import{import_module},
	:: DocType, :: OptionalDoc
61

62
63
64
65
import CoclUtils
import qualified Type as T
from Type import instance == Type,
	class print(print), instance print Type, instance print Priority
66
from TypeUnify import isomorphic_to
Camil Staps's avatar
Camil Staps committed
67
from Cloogle import :: FunctionKind(..)
Camil Staps's avatar
Camil Staps committed
68
from DB import :: DB, :: Index(..), newDB, instance == Index, instance < Index
69
70
71
import qualified DB
import qualified CloogleDB as CDB
from NGramIndex import :: NGramIndex, newNGramIndex, index
Camil Staps's avatar
Camil Staps committed
72
from TypeTree import :: TypeTree, instance zero (TypeTree v), addType
73
from CloogleDB import
Camil Staps's avatar
Camil Staps committed
74
	:: CloogleDB{..}, :: AnnotationKey,
Camil Staps's avatar
Camil Staps committed
75
76
	:: Library,
	:: Location(Builtin,NoLocation),
Camil Staps's avatar
Camil Staps committed
77
	:: CleanLangReportLocation,
78
	:: CloogleEntry(..),
79
	:: ModuleEntry{..},
80
	:: FunctionEntry{..},
81
	:: TypeDefEntry{tde_loc,tde_instances,tde_derivations,tde_usages},
Camil Staps's avatar
Camil Staps committed
82
	:: ClassEntry{ce_loc,ce_instances,ce_is_meta,ce_members,ce_usages},
Camil Staps's avatar
Camil Staps committed
83
	classContext, :: TypeRestriction,
Camil Staps's avatar
Camil Staps committed
84
85
	:: SyntaxEntry, :: DeriveEntry,
	:: InstanceEntry{ie_class,ie_types,ie_locations},
86
	:: DeriveEntry{..},
87
	instance zero FunctionEntry, instance zero ModuleEntry,
88
	class getLocation, instance getLocation CloogleEntry,
Camil Staps's avatar
Camil Staps committed
89
90
	instance == Location,
	location
91
from Cloogle import instance == FunctionKind
92
93
94
95
96
97
98
99
100
from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
	:: ConstructorDoc, :: ClassMemberDoc, :: Description,
	:: ParseWarning(UsedReturn,IllegalField), :: ParseError,
	generic docBlockToDoc, parseDoc, parseSingleLineDoc, :: DocBlock,
	class docType(..), instance docType FunctionDoc,
	class docConstructors(..), instance docConstructors TypeDoc,
	class docFields(..), instance docFields TypeDoc,
	traceParseError, traceParseWarnings,
	constructorToFunctionDoc, functionToClassMemberDoc, addClassMemberDoc
Camil Staps's avatar
Camil Staps committed
101
import Idents
102

103
:: TemporaryDB
Camil Staps's avatar
Camil Staps committed
104
105
	= { temp_functions         :: ![[('CDB'.FunctionEntry, 'S'.Set String)]]
	  , temp_classes           :: ![[('CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, 'S'.Set String)])]]
106
107
108
109
	  , temp_instances         :: ![[(!'CDB'.Name, ![(!'CDB'.Type, !String)], !'CDB'.Location)]]
	  , temp_types             :: ![['CDB'.TypeDefEntry]]
	  , temp_derivations       :: ![[(!'CDB'.Name, ![(!'CDB'.Type, !String, !'CDB'.Location)])]]
	  , temp_class_derivations :: ![[(!'CDB'.Name, !'CDB'.Type, !String, !'CDB'.Location)]]
Camil Staps's avatar
Camil Staps committed
110
	  , temp_modules           :: ![(ModuleEntry, 'S'.Set String)]
111
	  }
112
	  // TODO function usages in instances/derivations
113

114
115
newTemporaryDB :: TemporaryDB
newTemporaryDB
116
117
118
119
120
121
122
	= { temp_functions         = []
	  , temp_classes           = []
	  , temp_instances         = []
	  , temp_types             = []
	  , temp_derivations       = []
	  , temp_class_derivations = []
	  , temp_modules           = []
123
124
	  }

Camil Staps's avatar
Camil Staps committed
125
126
127
128
129
130
131
132
instance < (Maybe a) | < a
where
	< (Just x) (Just y) = x < y
	< (Just _) Nothing  = True
	< _        _        = False

instance < Location
where
Camil Staps's avatar
Camil Staps committed
133
	< ('CDB'.Location l1 m1 _ d1 i1 n1) ('CDB'.Location l2 m2 _ d2 i2 n2)
Camil Staps's avatar
Camil Staps committed
134
		= ((l1,m1,n1),(d1,i1)) < ((l2,m2,n2), (d2,i2))
Camil Staps's avatar
Camil Staps committed
135
	< ('CDB'.Location _ _ _ _ _ _) _
Camil Staps's avatar
Camil Staps committed
136
		= True
Camil Staps's avatar
Camil Staps committed
137
	< _ ('CDB'.Location _ _ _ _ _ _)
Camil Staps's avatar
Camil Staps committed
138
139
140
141
142
143
144
145
		= False
	< (Builtin a _) (Builtin b _)
		= a < b
	< (Builtin _ _) _
		= True
	< _ _
		= False

Camil Staps's avatar
Camil Staps committed
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
class match a :: !a !FilePath -> Bool

instance match PathPattern
where
	match (PStartsWith s) fp = startsWith s fp
	match (PNot p) fp = not (match p fp)
	match PWildcard _ = True

instance match (Maybe m) | match m
where
	match Nothing  s = False
	match (Just m) s = match m s

instance match [PathPattern] where match ps fp = any (flip match fp) ps

161
162
finaliseDB :: ![CloogleEntry] !TemporaryDB -> *'CDB'.CloogleDB
finaliseDB extra tdb =
Camil Staps's avatar
Camil Staps committed
163
	{ db = 'DB'.mapInPlace link $ newDB entries
Camil Staps's avatar
Camil Staps committed
164
165
	, name_ngrams = foldr (uncurry index) (newNGramIndex 3 True)
		[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
166
167
168
169
	, name_map = foldr (\(name,i) -> flip 'M'.alter name \is -> case is of
			Nothing -> Just [i]
			Just is -> Just [i:is]) 'M'.newMap
		[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
Camil Staps's avatar
Camil Staps committed
170
	, types = foldr (uncurry addType) zero
171
		[(snd $ 'T'.prepare_unification False alwaysUnique synonymmap $ 'T'.removeTypeContexts t,i)
Camil Staps's avatar
Camil Staps committed
172
			\\ (i,FunctionEntry fe) <- entridxs, Just t <- [fe.fe_type <|> (docType =<< fe.fe_documentation)]]
Camil Staps's avatar
Camil Staps committed
173
174
	, core = coreidxs
	, apps = appidxs
Camil Staps's avatar
Camil Staps committed
175
	, builtins = idxfilter \e -> fromMaybe False ('CDB'.isBuiltin <$> 'CDB'.getLocation e)
Camil Staps's avatar
Camil Staps committed
176
	, syntax = idxfilter \e -> e=:(SyntaxEntry _)
177
178
	, library_map = libmap
	, module_map = modmap
Camil Staps's avatar
Camil Staps committed
179
180
181
182
183
184
185
186
	, derive_map = 'M'.fromList
		$ map (\ds=:[(g,_):_] -> (g,map snd ds))
		$ groupBy ((==) `on` fst) $ sort
		[(de.de_generic, i) \\ (i,DeriveEntry de) <- entridxs]
	, instance_map = 'M'.fromList
		$ map (\is=:[(c,_):_] -> (c,map snd is))
		$ groupBy ((==) `on` fst) $ sort
		[(ie.ie_class, i) \\ (i,InstanceEntry ie) <- entridxs]
187
	, always_unique = always_unique
Camil Staps's avatar
Camil Staps committed
188
	}
189
where
Camil Staps's avatar
Camil Staps committed
190
	link :: !Int !CloogleEntry -> CloogleEntry
191
	link i e = case e of
Camil Staps's avatar
Camil Staps committed
192
		TypeDefEntry tde -> TypeDefEntry
193
194
			{ tde
			& tde_instances=idxfilter \e -> case e of
195
196
197
				InstanceEntry ie -> case name of
					"(->)" -> any (\t -> t=:('T'.Func _ _ _) || t=:('T'.Arrow _)) $ concatMap ('T'.subtypes o fst) ie.ie_types
					_      -> or [t == name \\ 'T'.Type t _ <- concatMap ('T'.subtypes o fst) ie.ie_types]
198
199
				_                -> False
			, tde_derivations=idxfilter \e -> case e of
200
201
202
203
				DeriveEntry {de_type='T'.Type t _}   -> t == name
				DeriveEntry {de_type='T'.Arrow _}    -> name == "(->)"
				DeriveEntry {de_type='T'.Func _ _ _} -> name == "(->)"
				_                                    -> False
204
			, tde_usages=fromMaybe [] ('M'.get name type_usages_map)
205
			}
206
			with name = 'T'.td_name $ 'CDB'.getTypeDef tde
Camil Staps's avatar
Camil Staps committed
207
		ClassEntry ce -> ClassEntry
208
209
			{ ce
			& ce_instances=idxfilter \e -> case e of
Camil Staps's avatar
Camil Staps committed
210
				InstanceEntry ie -> ie.ie_class == name
211
				_                -> False
Camil Staps's avatar
Camil Staps committed
212
213
214
			, ce_members=idxfilter \e -> case e of
				FunctionEntry fe -> fe.fe_class == Just (Index i)
				_                -> False
215
			, ce_usages=fromMaybe [] ('M'.get name class_usages_map)
216
			}
217
			with name = 'CDB'.getName ce.ce_loc
Camil Staps's avatar
Camil Staps committed
218
		FunctionEntry fe -> FunctionEntry
219
			{ fe
220
221
222
			& fe_derivations=case fe.fe_derivations of
				Nothing -> Nothing
				Just _  -> Just $ idxfilter \e -> case e of
Camil Staps's avatar
Camil Staps committed
223
					DeriveEntry de -> de.de_generic == name
224
					_              -> False
225
			, fe_usages=fromMaybe [] ('M'.get name function_usages_map)
226
			}
Camil Staps's avatar
Camil Staps committed
227
228
			with name = 'CDB'.getName fe.fe_loc
		ModuleEntry me -> ModuleEntry
229
			{ me
230
			& me_usages=fromMaybe [] ('M'.get name module_usages_map)
231
			}
Camil Staps's avatar
Camil Staps committed
232
233
234
			with name = 'CDB'.getName me.me_loc
		e -> e

235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
	make_usage_map :: ([[(a,b)]] -> 'M'.Map a [b]) | <, == a
	make_usage_map = 'M'.fromList
		o map (\gidxs=:[(g,_):_] -> (g,map snd gidxs))
		o groupBy ((==) `on` fst)
		o sortBy ((<) `on` fst)
		o flatten

	type_usages_map = make_usage_map
		[[(t,idx) \\ 'T'.Type t _ <- 'T'.subtypes t] \\ (idx,FunctionEntry {fe_type=Just t}) <- entridxs]

	class_usages_map = make_usage_map
		[[(cls,idx) \\ 'T'.Instance cls _ <- context e] \\ (idx,e) <- entridxs]
	where
		context :: 'CDB'.CloogleEntry -> ['T'.TypeRestriction]
		context (FunctionEntry {fe_type=Just t}) = 'T'.allRestrictions t
		context (TypeDefEntry tde) = 'T'.typeRhsRestrictions $ 'T'.td_rhs $ 'CDB'.getTypeDef tde
		context (ClassEntry ce) = classContext ce
		context _ = []

	function_usages_map = make_usage_map
		[[(g,idx) \\ g <- 'S'.toList globs]
			\\ idx <- fidxs
			 & (fe,globs) <- [(fe, 'S'.newSet) \\ FunctionEntry fe <- extra] ++ function_entries]
	where fidxs = [idx \\ (idx,FunctionEntry _) <- entridxs]

	module_usages_map = make_usage_map
		[[(i,idx) \\ i <- 'S'.toList imps] \\ idx <- midxs & (_, imps) <- tdb.temp_modules]
	where midxs = [idx \\ (idx,ModuleEntry _) <- entridxs]

	function_entries = flatten tdb.temp_functions ++ [(
		{ fun
		& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
		, fe_loc='CDB'.setName fname cls.ce_loc
		, fe_class=Just $ idxhd \ce -> case ce of
			ClassEntry ce -> ce.ce_loc == cls.ce_loc
			_             -> False
		}, ids) \\ clss <- tdb.temp_classes, (cls,funs) <- clss, (fname,fun,ids) <- funs]

Camil Staps's avatar
Camil Staps committed
273
	entries = [e \\ Right e <- entries`]
274
	entries` = map Right (
Camil Staps's avatar
Camil Staps committed
275
		extra ++
Camil Staps's avatar
Camil Staps committed
276
		[TypeDefEntry tde \\ tds <- tdb.temp_types, tde <- tds] ++
277
		[ModuleEntry mod \\ (mod,_) <- tdb.temp_modules] ++
278
		map ClassEntry classes ++
279
		map (FunctionEntry o fst) function_entries ++
280
		// Normal instances
Camil Staps's avatar
Camil Staps committed
281
		[InstanceEntry {ie_class=cls,ie_types=types,ie_locations=map thd3 is}
Camil Staps's avatar
Camil Staps committed
282
283
			\\ is=:[(cls,types,_):_] <- groupBy instanceEq
				$ sortBy ((<) `on` (\(c,ts,_) -> (c,map snd ts)))
284
285
				$ flatten tdb.temp_instances] ++
		// Derivations
286
		[DeriveEntry {de_generic=gn, de_type=t, de_type_representation=tr, de_locations=map fth4 ds}
287
288
289
			\\ ds=:[(gn,t,tr,_):_] <- groupBy ((==) `on` (\(g,_,tr,_) -> (g,tr)))
				$ sortBy ((<) `on` (\(g,_,tr,_) -> (g,tr)))
				[(g,t,tr,l) \\ ds <- tdb.temp_derivations, (g,ts) <- ds, (t,tr,l) <- ts]] ++
290
		[InstanceEntry {ie_class=gn, ie_types=[(t,tr)], ie_locations=map fth4 ds}
291
292
293
294
295
			\\ ds=:[(gn,t,tr,_):_] <- groupBy ((==) `on` (\(g,_,tr,_) -> (g,tr)))
				$ sortBy ((<) `on` (\(g,_,tr,_) -> (g,tr)))
				$ flatten tdb.temp_class_derivations]) ++
		// Meta-class instances
		concatMap metainstances classes
Camil Staps's avatar
Camil Staps committed
296
	where
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
		metainstances :: ClassEntry -> [Either String CloogleEntry]
		metainstances {ce_is_meta=False} = []
		metainstances ce = [Left cls:[Right $ InstanceEntry {ie_class=cls,ie_types=[(t,tr)],ie_locations=locs} \\ (t,tr,locs) <- types`]]
		where
			crestrs = [c \\ 'T'.Instance c ['T'.Var _] <- classContext ce | c <> "TC"] // TC class is implicit
			grestrs = [g \\ 'T'.Derivation g ('T'.Var _) <- classContext ce]
			ctypes = [[(hd ie.ie_types,ie.ie_locations) \\ InstanceEntry ie <- entries | ie.ie_class == c && length ie.ie_types == 1] \\ c <- crestrs]
			gtypes = [[((de.de_type,de.de_type_representation),de.de_locations) \\ DeriveEntry de <- entries | de.de_generic == g] \\ g <- grestrs]
			types = case ctypes ++ gtypes of
				[] -> []
				ts -> foldr1 intersect $ map (map fst) ts
			types` = [(t,tr,flatten [locs \\ rts <- ctypes ++ gtypes, ((t`,_),locs) <- rts | t == t`]) \\ (t,tr) <- types]
			cls = 'CDB'.getName ce.ce_loc

			// Ideally we would use entries, but that causes a cycle in spine.
			// So we use entries up to the point where the class itself is defined.
			// This requires keeping an Either where Left holds the class under evaluation.
			// It also requires sorting the classes, see below with contextOrd.
			entries = [e \\ Right e <- takeWhile (\e -> case e of
				Left c  -> c <> cls
				Right _ -> True) entries`]

		classes = sortBy contextOrd [cls \\ clss <- tdb.temp_classes, (cls,_) <- clss]
		where
			contextOrd :: ClassEntry ClassEntry -> Bool
			contextOrd a b = isMember aname [c \\ 'T'.Instance c _ <- classContext b]
			where [aname,bname:_] = map 'CDB'.getName [a.ce_loc,b.ce_loc]

		instanceEq :: (String, [('CDB'.Type, a)], b) (String, [('CDB'.Type, a)], b) -> Bool
326
		instanceEq (s, ts, _) (s2, ts2, _) = s == s2 && all (uncurry (isomorphic_to)) (zip2 (map fst ts) (map fst ts2))
Camil Staps's avatar
Camil Staps committed
327

Camil Staps's avatar
Camil Staps committed
328
	entridxs = zip2 [Index i \\ i <- [0..]] entries
Camil Staps's avatar
Camil Staps committed
329
330
	idxfilter f = [idx \\ (idx,e) <- entridxs | f e]
	idxhd = hd o idxfilter
Camil Staps's avatar
Camil Staps committed
331

Camil Staps's avatar
Camil Staps committed
332
333
334
335
336
337
	coreidxs = idxfilter \e -> case 'CDB'.getLocation e of
		Nothing -> False
		Just l -> case ('CDB'.getLibrary l, 'CDB'.getModule l) of
			(Just l, Just m) -> isMember (l,m) coremods
			_                -> False
	where
338
		coremods = [(fromJust $ 'CDB'.getLibrary me.me_loc, fromJust $ 'CDB'.getModule me.me_loc) \\ (me,_) <- tdb.temp_modules | me.me_is_core]
Camil Staps's avatar
Camil Staps committed
339
340
341
342
343
344
	appidxs = idxfilter \e -> case 'CDB'.getLocation e of
		Nothing -> False
		Just l -> case ('CDB'.getLibrary l, 'CDB'.getModule l) of
			(Just l, Just m) -> isMember (l,m) appmods
			_                -> False
	where
345
		appmods = [(fromJust $ 'CDB'.getLibrary me.me_loc, fromJust $ 'CDB'.getModule me.me_loc) \\ (me,_) <- tdb.temp_modules | me.me_is_app]
Camil Staps's avatar
Camil Staps committed
346

347
348
349
350
	libmap = 'M'.fromList
		[(l,idxfilter \e -> case 'CDB'.getLocation e >>= 'CDB'.getLibrary of
			Nothing -> False
			Just l` -> l == l`) \\ l <- libs]
351
	where libs = removeDup [fromJust ('CDB'.getLibrary me.me_loc) \\ (me,_) <- tdb.temp_modules]
352
	modmap = 'M'.fromList
Camil Staps's avatar
Camil Staps committed
353
		[(m,idxfilter \e -> case 'CDB'.getLocation e >>= 'CDB'.getModule of
354
355
			Nothing -> False
			Just m` -> m == m`) \\ m <- mods]
356
	where mods = removeDup [fromJust ('CDB'.getModule me.me_loc) \\ (me,_) <- tdb.temp_modules]
357

358
359
360
361
362
363
364
365
	synonymmap = 'M'.fromList
		$ map (\syns=:[(t,_):_] -> (t,map snd syns))
		$ groupBy ((==) `on` fst)
		$ sortBy ((<) `on` fst)
		[let td = 'CDB'.getTypeDef tde in ('T'.td_name td, td)
			\\ TypeDefEntry tde <- entries
			| ('T'.td_rhs ('CDB'.getTypeDef tde))=:('T'.TDRSynonym _)]

366
367
368
369
	always_unique = 'M'.fromList
		[('T'.td_name $ 'CDB'.getTypeDef tde, ()) \\ TypeDefEntry tde <- entries | 'T'.td_uniq $ 'CDB'.getTypeDef tde]
	alwaysUnique = isJust o flip 'M'.get always_unique

Camil Staps's avatar
Camil Staps committed
370
371
372
373
findModules :: !String !IndexItem !String !*World -> *(!['CDB'.ModuleEntry], !*World)
findModules root item base w
| match item.pattern_exclude path = ([], w)
#! (fps, w)   = readDirectory fullpath w
374
| isError fps = ([], w)
375
#! (Ok fps)   = fps
Camil Staps's avatar
Camil Staps committed
376
377
378
#! mods       = map makeEntry $ filter included $ filter isIclModule fps
#! (moremodss,w) = mapSt (findModules root item o ((+++) basedot)) (filter isDirectory fps) w
= (removeDupBy (\m -> 'CDB'.getName m.me_loc) (mods ++ flatten moremodss), w)
379
where
380
	basedot = if (base == "") "" (base +++ ".")
Camil Staps's avatar
Camil Staps committed
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
	path = replaceSubString "." {pathSeparator} base
	fullpath = root </?> item.IndexItem.name </?> path

	(</?>) infixr 5 :: !FilePath !FilePath -> FilePath
	(</?>) "" p  = p
	(</?>) p  "" = p
	(</?>) p1 p2 = p1 </> p2

	makeEntry :: String -> 'CDB'.ModuleEntry
	makeEntry fn =
		{ me_loc           = location item.IndexItem.name modname (base </?> fn) (Just 1) (Just 1) modname
		, me_is_core       = match item.pattern_core (path </> fn)
		, me_is_app        = match item.pattern_app  (path </> fn)
		, me_documentation = Nothing
		, me_usages        = []
		}
Camil Staps's avatar
Camil Staps committed
397
	where
Camil Staps's avatar
Camil Staps committed
398
		modname = basedot +++ fn % (0, size fn - 5)
399
400

	included :: String -> Bool
Camil Staps's avatar
Camil Staps committed
401
	included s = not (match item.pattern_exclude (path </> s))
402

403
404
	isIclModule :: String -> Bool
	isIclModule s = s % (size s - 4, size s - 1) == ".icl"
405

406
407
	isDirectory :: (String -> Bool)
	isDirectory = not o isMember '.' o fromString
408

409
410
411
412
	removeDupBy :: (a -> b) [a] -> [a] | Eq b
	removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)]
	removeDupBy _ []     = []

Camil Staps's avatar
Camil Staps committed
413
indexModule :: !Bool !String !'CDB'.ModuleEntry !TemporaryDB !*World
414
	-> *(!TemporaryDB, !*World)
Camil Staps's avatar
Camil Staps committed
415
416
417
indexModule include_locals root mod db w
#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,_,imports),w)
	= findModuleContents include_locals (root </> lib </> mkdir ('CDB'.getName mod.me_loc)) w
Camil Staps's avatar
Camil Staps committed
418
#! typedefs = [{td & tde_loc=castLoc modname loc} \\ (loc,td) <- typedefs]
Camil Staps's avatar
Camil Staps committed
419
#! lib = lib % (0, size lib - size modname + size ('CDB'.getName mod.me_loc) - 1)
420
421
422
#! db  =
	{ db
	& temp_functions =
423
		[ [({f & fe_loc=castLoc modname loc},idents) \\ (loc,f,idents) <- functions ++ macros ++ generics]
Camil Staps's avatar
Camil Staps committed
424
		, [(f, 'S'.newSet) \\ td <- typedefs, f <- constructor_functions td ++ record_functions td]
425
426
		: db.temp_functions
		]
427
	, temp_classes = [[({ce & ce_loc=castLoc modname loc}, fs) \\ (loc,ce,fs) <- clss]:db.temp_classes]
Camil Staps's avatar
Camil Staps committed
428
	, temp_types = [typedefs:db.temp_types]
Camil Staps's avatar
Camil Staps committed
429
430
431
	, temp_instances = [castLocThd3 modname insts:db.temp_instances]
	, temp_derivations = [map (appSnd (castLocThd3 modname)) derivs:db.temp_derivations]
	, temp_class_derivations = [castLocFrth modname clsderivs:db.temp_class_derivations]
Camil Staps's avatar
Camil Staps committed
432
	, temp_modules = [(mod,imports):db.temp_modules]
433
	}
Camil Staps's avatar
Camil Staps committed
434
= (db,w)
435
where
Camil Staps's avatar
Camil Staps committed
436
437
	lib = fromJust ('CDB'.getLibrary mod.me_loc)

438
	castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'CDB'.Location)])
Camil Staps's avatar
Camil Staps committed
439
440
441
	castLocThd3 m = map (appThd3 (castLoc m))
	castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l))

442
	castLoc :: String LocationInModule -> 'CDB'.Location
Camil Staps's avatar
Camil Staps committed
443
444
	castLoc m l = location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.LocationInModule.name
	dclpath = mkdir ('CDB'.getName mod.me_loc) +++ ".dcl"
Camil Staps's avatar
Camil Staps committed
445
446
447

	mkdir :: String -> String
	mkdir s = { if (c == '.') '/' c \\ c <-: s }
Camil Staps's avatar
Camil Staps committed
448

449
450
451
instance zero LocationInModule
where zero = {dcl_line=Nothing, icl_line=Nothing, name=Nothing}

452
findModuleContents :: !Bool !String !*World
Camil Staps's avatar
Camil Staps committed
453
454
455
	-> *( ![(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
	    , ![(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
	    , ![(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
456
	    , ![(LocationInModule, 'CDB'.TypeDefEntry)]
Camil Staps's avatar
Camil Staps committed
457
	    , ![(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, 'S'.Set String)])]
458
459
460
	    , ![('CDB'.Name, [('CDB'.Type, String)], LocationInModule)]
	    , ![('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
	    , ![('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
Camil Staps's avatar
Camil Staps committed
461
	    , !('CDB'.Name, 'CDB'.ModuleEntry, 'S'.Set String)
Camil Staps's avatar
Camil Staps committed
462
463
	    , !*World
	    )
464
findModuleContents include_locals path w
465
466
467
468
469
470
#! (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
471
#! imports = 'S'.fromList [i.import_module.id_name \\ PD_Import is <- dcl ++ icl, i <- is]
472
#! contents=:(functions,rules,generics,typedefs,clss,insts,derivs,clsderivs) =
473
474
475
476
477
478
	( combine cmpLocFst3  joinLocFstIds pd_typespecs    dcl dcl_symbols icl icl_symbols
	, combine cmpLocFst3  joinLocFstIds pd_rewriterules dcl dcl_symbols icl icl_symbols
	, combine cmpLocFst3  joinLocFstIds pd_generics     dcl dcl_symbols icl icl_symbols
	, combine cmpLocFst   joinTypeDefs  pd_types        dcl dcl_symbols icl icl_symbols
	, combine cmpLocFst3  joinLocFst3   pd_classes      dcl dcl_symbols icl icl_symbols
	, combine cmpInsts    joinInsts     pd_instances    dcl dcl_symbols icl icl_symbols
479
480
481
	, combineDerivs (pd_derivations True dcl) (pd_derivations False icl)
	, combine cmpClsDeriv joinClsDeriv pd_class_derivations dcl dcl_symbols icl icl_symbols
	)
482
#! (functions,rules,generics,typedefs,clss,insts,derivs,clsderivs) =
483
484
	if include_locals
	contents
485
486
487
	( filter (hasDcl o fst3)            functions
	, filter (hasDcl o fst3)            rules
	, filter (hasDcl o fst3)            generics
488
	, filter (hasDcl o fst)             typedefs
489
	, filter (hasDcl o fst3)            clss
490
491
492
493
	, filter (hasDcl o thd3)            insts
	, filter (not o isEmpty o snd) (map (appSnd (filter (hasDcl o thd3))) derivs)
	, filter (hasDcl o (\(_,_,_,x)->x)) clsderivs
	) with hasDcl loc = isJust loc.dcl_line
Camil Staps's avatar
Camil Staps committed
494
#! rules = filter (\(r,_,_) -> not $ any (\(l,_,_)->fromJust l.LocationInModule.name == fromJust r.LocationInModule.name) functions) rules
495
= (functions,rules,generics,typedefs,clss,insts,derivs,clsderivs,(modname,pd_module dcl,imports),w)
Camil Staps's avatar
Camil Staps committed
496
where
497
498
	combine :: (a a -> Bool) (a a -> a)
		(Bool [ParsedDefinition] SymbolTable -> [a])
499
500
		![ParsedDefinition] SymbolTable
		![ParsedDefinition] SymbolTable
501
502
503
504
505
506
507
508
509
		-> [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
510
		([],   xs) -> [y:unionBy eq join xs  ys]
511
512
513
		(found,xs) -> let (foundys,ys`) = partition (eq y) ys in
			[foldr join y (found ++ foundys):unionBy eq join xs ys`]

Camil Staps's avatar
Camil Staps committed
514
	cmpLoc x y = x.LocationInModule.name == y.LocationInModule.name
515
516

	cmpLocFst :: ((LocationInModule, a) (LocationInModule, a) -> Bool)
517
518
519
520
	cmpLocFst = cmpLoc `on` fst

	cmpLocFst3 :: ((LocationInModule, a, b) (LocationInModule, a, b) -> Bool)
	cmpLocFst3 = cmpLoc `on` fst3
521
522
523
524

	joinLocFst :: (LocationInModule, a) (LocationInModule, b) -> (LocationInModule, a)
	joinLocFst (l1,a) (l2,_) = (joinLoc l1 l2, a)

525
526
527
	joinLocFst3 :: (LocationInModule, a, b) (LocationInModule, c, d) -> (LocationInModule, a, b)
	joinLocFst3 (l1,a,b) (l2,_,_) = (joinLoc l1 l2, a, b)

Camil Staps's avatar
Camil Staps committed
528
529
	joinLocFstIds :: (LocationInModule, a, 'S'.Set String) (LocationInModule, b, 'S'.Set String) -> (LocationInModule, a, 'S'.Set String)
	joinLocFstIds (l1,a,idsa) (l2,_,idsb) = (joinLoc l1 l2, a, 'S'.union idsa idsb)
530

531
532
	joinTypeDefs :: (LocationInModule, 'CDB'.TypeDefEntry) (LocationInModule, 'CDB'.TypeDefEntry) -> (LocationInModule, 'CDB'.TypeDefEntry)
	joinTypeDefs (a,t) (b,u) = (joinLoc a b, 'CDB'.mergeTypeDefEntries t u)
533
534
535
536
537
538

	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 ::
539
540
541
		([('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
		 [('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
		 -> [('CDB'.Name, [('CDB'.Type, String, LocationInModule)])])
542
543
544
545
546
547
548
549
550
551
	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 =
Camil Staps's avatar
Camil Staps committed
552
553
554
		{ dcl_line = a.dcl_line              <|> b.dcl_line
		, icl_line = a.icl_line              <|> b.icl_line
		, name     = a.LocationInModule.name <|> b.LocationInModule.name
555
556
		}

Camil Staps's avatar
Camil Staps committed
557
558
559
	pd_module :: ![ParsedDefinition] -> ModuleEntry
	pd_module [PD_Documentation _ doc:_]
		= { zero
560
		  & me_documentation = docParseResultToMaybe (const True) $ parseDoc doc
Camil Staps's avatar
Camil Staps committed
561
		  }
Camil Staps's avatar
Camil Staps committed
562
	pd_module _ = zero
Camil Staps's avatar
Camil Staps committed
563

Camil Staps's avatar
Camil Staps committed
564
	pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
565
	pd_rewriterules dcl defs st
Camil Staps's avatar
Camil Staps committed
566
		= [( setLine dcl pos {LocationInModule | zero & name=Just id.id_name}
567
		   , let doc = findDoc hideIsUsedReturn id st in
Camil Staps's avatar
Camil Staps committed
568
		     trace_type_warning id
569
		     { zero
Camil Staps's avatar
Camil Staps committed
570
		     & fe_kind=Macro
571
		     , fe_type=(docType =<< doc) <|> pdType pd
Camil Staps's avatar
Camil Staps committed
572
		     , fe_representation=Just $ priostring id pd +++ cpp pd
Camil Staps's avatar
Camil Staps committed
573
		     , fe_priority=findPrio id >>= 'T'.toMaybePriority
574
		     , fe_documentation=doc
575
		     }
Camil Staps's avatar
Camil Staps committed
576
		   , (idents ICExpression pd).globals
577
		   ) \\ pd=:(PD_Function pos id isinfix args rhs _) <- defs]
Camil Staps's avatar
Camil Staps committed
578
	where
Camil Staps's avatar
Camil Staps committed
579
580
581
582
583
584
		priostring :: Ident ParsedDefinition -> String
		priostring id pd = case findTypeSpec id defs of
			Just td -> cpp td +++ "\n"
			Nothing -> case pdType pd of
				Just t  -> id.id_name +++ " :: " +++ concat (print False t) +++ "\n"
				Nothing -> ""
Camil Staps's avatar
Camil Staps committed
585
586

		findPrio :: Ident -> Maybe Priority
587
		findPrio id = (\(PD_TypeSpec _ _ p _ _) -> p) <$> findTypeSpec id defs
Camil Staps's avatar
Camil Staps committed
588
589
590

		findTypeSpec :: Ident [ParsedDefinition] -> Maybe ParsedDefinition
		findTypeSpec _  []          = Nothing
591
		findTypeSpec id [pd=:(PD_TypeSpec _ id` prio _ _):defs]
Camil Staps's avatar
Camil Staps committed
592
		| id`.id_name == id.id_name = Just pd
593
594
		findTypeSpec id [_:defs]    = findTypeSpec id defs

Camil Staps's avatar
Camil Staps committed
595
596
597
598
599
600
		trace_type_warning :: !Ident !FunctionEntry -> FunctionEntry
		trace_type_warning id fe
		| isJust (findTypeSpec id defs) = fe
		| isJust fe.fe_type             = fe
		| otherwise                     = trace_n ("Doc warning: expected @type for '" +++ id.id_name +++ "'") fe

601
	pd_derivations :: !Bool ![ParsedDefinition] -> [('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
602
603
604
605
606
	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]

Camil Staps's avatar
Camil Staps committed
607
	pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
608
	pd_generics dcl defs st
Camil Staps's avatar
Camil Staps committed
609
		= [( setLine dcl gen_pos {LocationInModule | zero & name=Just id_name}
Camil Staps's avatar
Camil Staps committed
610
611
612
613
		   , { zero
		     & fe_type=Just $ 'T'.toType gen_type
		     , fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
		     , fe_representation=Just $ cpp gen
614
		     , fe_documentation=findDoc hideIsUsedReturn id st
615
		     , fe_derivations=Just []
Camil Staps's avatar
Camil Staps committed
616
		     }
Camil Staps's avatar
Camil Staps committed
617
		   , 'S'.newSet
618
619
		   ) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- defs]

Camil Staps's avatar
Camil Staps committed
620
	pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
621
	pd_typespecs dcl defs st
Camil Staps's avatar
Camil Staps committed
622
		= [( setLine dcl pos {LocationInModule | zero & name=Just id_name}
Camil Staps's avatar
Camil Staps committed
623
624
625
626
		   , { zero
		     & fe_type=Just $ 'T'.toType t
		     , fe_priority = 'T'.toMaybePriority p
		     , fe_representation = Just $ cpp ts
627
		     , fe_documentation = findDoc hideIsUsedReturn id st
Camil Staps's avatar
Camil Staps committed
628
		     }
Camil Staps's avatar
Camil Staps committed
629
		   , (idents ICExpression [pd \\ pd=:(PD_Function _ id _ _ _ _) <- defs | id.id_name == id_name]).globals
630
631
		   ) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs]

632
	pd_class_derivations :: !Bool ![ParsedDefinition] SymbolTable -> [('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
633
634
635
636
	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]

637
	pd_instances :: !Bool ![ParsedDefinition] SymbolTable -> [('CDB'.Name, [('CDB'.Type, String)], LocationInModule)]
638
639
	pd_instances dcl defs _
		= [(id, types, setLine dcl pos zero) \\ (id,types,pos) <- instances]
640
	where
641
		instances = map (appSnd3 (map (\t -> ('T'.toType t, cppp t)))) $
642
643
644
			[(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]

Camil Staps's avatar
Camil Staps committed
645
	pd_classes :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, 'S'.Set String)])]
646
	pd_classes dcl defs st
647
648
		= [ let
		      typespecs = pd_typespecs True clsdefs st
Camil Staps's avatar
Camil Staps committed
649
		      macros = [(n,(r,ids)) \\ ({LocationInModule | name=Just n},{fe_representation=Just r},ids) <- pd_rewriterules dcl clsdefs st]
650
651
652
		      updateRepresentation n fe
		        = { fe
		          & fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro
653
		          , fe_representation=(fst <$> lookup n macros) <|> fe.fe_representation
654
655
656
657
		          , fe_documentation=if (isSingleFunction typespecs id)
		              ((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id st)
		              fe.fe_documentation
		          }
Camil Staps's avatar
Camil Staps committed
658
659
		      members = [(f,updateRepresentation f et,ids) \\ ({LocationInModule | name=Just f}, et, ids) <- typespecs]
		    in ( setLine dcl class_pos {LocationInModule | zero & name=Just id_name}
660
661
		       , 'CDB'.toClass
		         NoLocation
662
		         (map 'T'.toTypeVar class_args)
663
		         (all (\(_,fe,_) -> fe.fe_kind == Macro) members)
664
		         (flatten $ map 'T'.toTypeContext class_context)
665
		         (parseClassDoc typespecs id st)
666
		       , members
667
668
669
		       )
		  \\ PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} clsdefs <- defs
		  ]
670
671
672
673
674
	where
		// When the class has one member with the same name as the class, use
		// the class documentation as the function's documentation. This is the
		// case for classes like `class zero a :: a`, which do not have a where
		// clause and hence no other place for the function's documentation.
675
		parseClassDoc :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident SymbolTable -> Maybe ClassDoc
676
		parseClassDoc members id st
677
		| isSingleFunction members id = flip addClassMemberDoc
678
679
			(functionToClassMemberDoc <$> findDoc hideIsUsedReturn id st)
			<$> findDoc hideFunctionOnClass id st
680
		| otherwise = flip (foldl addClassMemberDoc)
681
			[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe,_) <- members]
682
			<$> findDoc hideIsUsedReturn id st
683

684
		isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool
685
		isSingleFunction members id = length members == 1
Camil Staps's avatar
Camil Staps committed
686
			&& fromJust (fst3 $ hd members).LocationInModule.name == id.id_name
687
688
689
690
691

		// Hide warnings about @result and @param on single function classes
		hideFunctionOnClass (IllegalField "param")  = False
		hideFunctionOnClass (IllegalField "result") = False
		hideFunctionOnClass w                       = hideIsUsedReturn w
692

693
	pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.TypeDefEntry)]
694
	pd_types dcl defs st
695
		= [let name = 'T'.td_name td in
Camil Staps's avatar
Camil Staps committed
696
			( setLine dcl ptd.td_pos {LocationInModule | zero & name=Just name}
697
			, 'CDB'.toTypeDefEntry NoLocation td $ Just $ findRhsDoc ptd $ fromMaybe gDefault{|*|} $
698
				findDoc (const True) ptd.td_ident st
699
			) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]]
700
	where
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
		findRhsDoc :: !ParsedTypeDef -> TypeDoc -> TypeDoc
		findRhsDoc {td_rhs=ConsList cs}           = addConses cs
		findRhsDoc {td_rhs=ExtensibleConses cs}   = addConses cs
		findRhsDoc {td_rhs=SelectorList _ _ _ fs} = addFields fs
		findRhsDoc _                              = id

		addFields :: ![ParsedSelector] !TypeDoc -> TypeDoc
		addFields [] doc = doc
		addFields [ps:fs] doc = {doc` & fields=Just [d:fromMaybe [] doc`.fields]}
		where
			doc` = addFields fs doc
			d = case ps.ps_doc of
				Yes d -> Just $ parseSingleLineDoc d
				No -> Nothing

		addConses :: ![ParsedConstructor] !TypeDoc -> TypeDoc
717
		addConses [] doc
718
719
720
721
722
723
724
			= {doc & constructors=Just []}
		addConses [pc:cs] doc = {doc` & constructors=Just [d:fromMaybe [] doc`.constructors]}
		where
			doc` = addConses cs doc
			d = case pc.pc_doc of
				Yes d -> docParseResultToMaybe (const True) (parseDoc d)
				No -> Nothing
725

726
	toLine :: Position -> 'CDB'.LineNr
Camil Staps's avatar
Camil Staps committed
727
728
729
730
	toLine (FunPos _ l _) = Just l
	toLine (LinePos _ l)  = Just l
	toLine _              = Nothing

Camil Staps's avatar
Camil Staps committed
731
	readModule :: Bool !*World -> *(!Either String ParsedModule, SymbolTable, !*World)
Camil Staps's avatar
Camil Staps committed
732
733
734
	readModule icl w
	# ht = newHashTable newHeap
	# ht = set_hte_mark (if icl 1 0) ht
Camil Staps's avatar
Camil Staps committed
735
	# filename = path +++ if icl ".icl" ".dcl"
736
	# (ok,f,w) = fopen filename FReadText w
Camil Staps's avatar
Camil Staps committed
737
	| not ok = (Left $ "Couldn't open " +++ filename, abort "no symboltable\n", w)
Camil Staps's avatar
Camil Staps committed
738
	# (mod_id, ht) = putIdentInHashTable path (IC_Module NoQualifiedIdents) ht
Camil Staps's avatar
Camil Staps committed
739
	# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True ht stderr) w
740
	# (ok,w) = fclose f w
Camil Staps's avatar
Camil Staps committed
741
	| not ok = (Left $ "Couldn't close " +++ filename, abort "no symboltable\n", w)
Camil Staps's avatar