Added documentation to TypeDB

TypeDB.dcl

@@ -20,6 +20,7 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
                 , te_isrecordfield  :: Bool
                 , te_generic_vars   :: Maybe [TypeVar]
                 , te_representation :: Maybe String
+                , te_documentation  :: Maybe FunctionDocumentation
                 }
 
 :: ExtendedType = ET Type TypeExtras
@@ -39,6 +40,8 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
 :: Class        :== String
 :: LineNr       :== Maybe Int
 
+:: FunctionDocumentation :== String
+
 instance zero TypeDB
 instance zero TypeExtras
 instance zero ModuleInfo

TypeDB.icl

@@ -79,6 +79,7 @@ where
 	       , te_isrecordfield  = False
 	       , te_generic_vars   = Nothing
 	       , te_representation = Nothing
+	       , te_documentation  = Nothing
 	       }
 
 instance zero ModuleInfo where zero = {is_core = False}

TypeDBFactory.dcl

@@ -4,12 +4,9 @@ from compile import :: DclCache
 
 import TypeDB
 
-setupCache :: *World -> *(*DclCache, *World)
-
 findModules :: ![String] !String !Library (Module -> Bool) !String !*World
 	-> *(![(Library, Module, Bool)], !*World)
-getModuleTypes :: String Module Library Bool
-	*DclCache TypeDB *World -> *(TypeDB, *DclCache, *World)
+getModuleTypes :: String Module Library Bool TypeDB *World -> *(TypeDB, *World)
 
 constructor_functions :: (Location, TypeDef) -> [(Location, ExtendedType)]
 record_functions :: (Location, TypeDef) -> [(Location, ExtendedType)]

TypeDBFactory.icl

@@ -5,6 +5,7 @@ import StdBool
 import StdFile
 from StdFunc import flip, id, o
 import StdList
+import StdMisc
 import StdString
 import StdTuple
 
@@ -22,23 +23,24 @@ from Text import class Text(concat,indexOf,replaceSubString), instance Text Stri
 import CleanPrettyPrint 
 
 from compile import :: DclCache{hash_table}, empty_cache
-from hashtable import :: BoxedIdent{boxed_ident}, :: HashTable,
+from hashtable import :: BoxedIdent{boxed_ident}, :: HashTable{hte_symbol_heap},
 	:: IdentClass(IC_Module), :: QualifiedIdents(NoQualifiedIdents),
-	putIdentInHashTable
-from Heap import :: Heap, newHeap
+	putIdentInHashTable, set_hte_mark, newHashTable
+from Heap import :: Heap, newHeap, sreadPtr
 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,
 	:: GenericCaseDef{gc_gcf,gc_pos,gc_type}, :: GenericCaseFunctions(GCF),
-	:: GenericDef{gen_ident,gen_pos,gen_type,gen_vars}, :: Ident{id_name},
-	:: LineNr, :: Module{mod_defs,mod_ident}, :: Optional(Yes),
+	:: 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},
 	:: ParsedDefinition(PD_Class,PD_Derive,PD_Function,PD_Generic,PD_Instance,PD_Instances,PD_Type,PD_TypeSpec),
 	:: ParsedExpr, :: ParsedInstance{pi_ident,pi_pos,pi_types},
 	:: ParsedInstanceAndMembers{pim_pi}, :: ParsedModule, :: ParsedTypeDef,
 	:: Position(FunPos,LinePos,NoPos), :: Priority, :: Rhs, :: RhsDefsOfType,
 	:: SymbolTable, :: SymbolTableEntry, :: SymbolType, :: Type,
-	:: TypeContext, :: TypeDef{td_ident,td_pos}, :: TypeVar
+	:: TypeContext, :: TypeDef{td_ident,td_pos}, :: TypeVar, :: OptionalDoc
 
 import CoclUtils
 import qualified Type as T
@@ -47,16 +49,10 @@ from Type import instance == Type,
 import qualified TypeDB as DB
 from TypeDB import :: Macro{macro_as_string,macro_extras},
 	:: Location(Location), filterLocations,
-	:: ModuleInfo{is_core},
-	:: TypeExtras{te_generic_vars,te_isconstructor,te_isrecordfield,te_priority,te_representation},
+	:: ModuleInfo{is_core}, :: FunctionDocumentation,
+	:: TypeExtras{te_generic_vars,te_isconstructor,te_isrecordfield,te_priority,te_representation,te_documentation},
 	instance zero TypeExtras, instance zero ModuleInfo
 
-setupCache :: *World -> *(*DclCache, *World)
-setupCache w
-# (st, w) = init_identifiers newHeap w
-# cache   = empty_cache st
-= (cache, w)
-
 //             Exclude   Root    Library        Check for core       Base module
 findModules :: ![String] !String !'DB'.Library ('DB'.Module -> Bool) !String !*World
 	-> *(![('DB'.Library, 'DB'.Module, Bool)], !*World)
@@ -82,27 +78,27 @@ where
 	isDirectory :: (String -> Bool)
 	isDirectory = not o isMember '.' o fromString
 
-getModuleTypes :: String 'DB'.Module 'DB'.Library Bool
-	*DclCache 'DB'.TypeDB *World -> *('DB'.TypeDB, *DclCache, *World)
-getModuleTypes root mod lib iscore cache db w
+getModuleTypes :: String 'DB'.Module 'DB'.Library Bool 'DB'.TypeDB *World
+	-> *('DB'.TypeDB, *World)
+getModuleTypes root mod lib iscore db w
 # db = filterLocations (filterFun mod lib) db
-# (Right dcl,cache,w) = readModule False cache w
-# (icl,cache,w) = readModule True cache 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
 # lib = lib % (0, size lib - size modname + size mod - 1)
 # db  = 'DB'.putFunctions (pd_typespecs lib modname dcl.mod_defs icl) db
 # db  = 'DB'.putInstances (pd_instances lib modname dcl.mod_defs icl) db
-# db  = 'DB'.putClasses (pd_classes lib modname dcl.mod_defs icl) db
+# db  = 'DB'.putClasses (pd_classes lib modname dcl.mod_defs icl symbols) db
 # typedefs = pd_types lib modname dcl.mod_defs icl
 # db  = 'DB'.putTypes typedefs db
 # db  = 'DB'.putFunctions (flatten $ map constructor_functions typedefs) db
 # db  = 'DB'.putFunctions (flatten $ map record_functions typedefs) db
 # db  = 'DB'.putFunctions (pd_generics lib modname dcl.mod_defs icl) db
 # db  = 'DB'.putDerivationss (pd_derivations lib modname dcl.mod_defs) db
-# db  = 'DB'.putMacros (pd_macros lib modname dcl.mod_defs) db
+# db  = 'DB'.putMacros (pd_macros lib modname dcl.mod_defs symbols) db
 # db  = 'DB'.putModule lib modname {zero & is_core=iscore} db
-= (db,cache,w)
+= (db,w)
 where
 	filterFun :: 'DB'.Module 'DB'.Library Location -> Bool
 	filterFun mod lib (Location l m _ _ _) = not (mod == m && lib == l)
@@ -111,11 +107,11 @@ where
 	mkdir :: String -> String
 	mkdir s = { if (c == '.') '/' c \\ c <-: s }
 
-	pd_macros :: String String [ParsedDefinition] -> [('DB'.Location, 'DB'.Macro)]
-	pd_macros lib mod dcl
+	pd_macros :: String String [ParsedDefinition] SymbolTable -> [('DB'.Location, 'DB'.Macro)]
+	pd_macros lib mod dcl st
 		= [( 'DB'.Location lib mod (toLine pos) Nothing id.id_name
 		   , { macro_as_string = priostring id +++ cpp pd
-		     , macro_extras = {zero & te_priority = findPrio id >>= 'T'.toMaybePriority}
+		     , macro_extras = {zero & te_priority = findPrio id >>= 'T'.toMaybePriority, te_documentation = findDoc id st}
 		     }
 		   ) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- dcl]
 	where
@@ -133,6 +129,11 @@ where
 		| id`.id_name == id.id_name = Just pd
 		findTypeSpec id [_:dcl]     = findTypeSpec id dcl
 
+		findDoc :: Ident SymbolTable -> Maybe FunctionDocumentation
+		findDoc {id_info} st = case sreadPtr id_info st of
+			{ste_doc=Yes doc} = Just doc
+			_                 = Nothing
+
 	pd_derivations :: String String [ParsedDefinition]
 		-> [('DB'.Name, [('DB'.Type, String, 'DB'.Location)])]
 	pd_derivations lib mod dcl
@@ -192,15 +193,15 @@ where
 				[LinePos _ l:_] = Just l
 				_ = Nothing
 
-	pd_classes :: String String [ParsedDefinition] (Maybe ParsedModule)
+	pd_classes :: String String [ParsedDefinition] (Maybe ParsedModule) SymbolTable
 		-> [('DB'.Location, ['T'.TypeVar], 'T'.ClassContext,
 			[('DB'.Name, 'DB'.ExtendedType)])]
-	pd_classes lib mod dcl icl
+	pd_classes lib mod dcl icl st
 	# dcl = filter (\pd->case pd of (PD_Class _ _)=True; _=False) dcl
 	= map (\(PD_Class {class_ident={id_name},class_pos,class_args,class_context} dcl)
 		-> let
 			typespecs = pd_typespecs lib mod dcl icl
-			macros = pd_macros lib mod dcl
+			macros = pd_macros lib mod dcl st
 			getMacro n = case filter ((==) n o 'DB'.getName o fst) macros of
 				[]        = Nothing
 				[(_,m):_] = Just m.macro_as_string
@@ -235,18 +236,18 @@ where
 	toLine (LinePos _ l)  = Just l
 	toLine _              = Nothing
 
-	readModule :: Bool *DclCache *World -> *(Either String ParsedModule, *DclCache, *World)
-	readModule icl cache w
+	readModule :: Bool *World -> *(Either String ParsedModule, SymbolTable, *World)
+	readModule icl w
+	# ht = newHashTable newHeap
+	# ht = set_hte_mark (if icl 1 0) ht
 	# filename = root +++ "/" +++ lib +++ "/" +++ mkdir mod +++ if icl ".icl" ".dcl"
 	# (ok,f,w) = fopen filename FReadText w
-	| not ok = (Left $ "Couldn't open " +++ filename, cache, w)
-	# (mod_id, ht) = putIdentInHashTable mod (IC_Module NoQualifiedIdents) cache.hash_table
-	  cache = {cache & hash_table=ht}
-	# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True cache.hash_table stderr) w
-	  cache = {cache & hash_table=ht}
+	| not ok = (Left $ "Couldn't open " +++ filename, abort "no symboltable\n", w)
+	# (mod_id, ht) = putIdentInHashTable mod (IC_Module NoQualifiedIdents) ht
+	# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True ht stderr) w
 	# (ok,w) = fclose f w
-	| not ok = (Left $ "Couldn't open " +++ filename, cache, w)
-	= (Right pm, cache, w)
+	| not ok = (Left $ "Couldn't open " +++ filename, abort "no symboltable\n", w)
+	= (Right pm, ht.hte_symbol_heap, w)
 	where
 		wantModule` :: !*File !{#Char} !Bool !Ident !Position !Bool !*HashTable !*File !*Files
 			-> ((!Bool,!Bool,!ParsedModule, !*HashTable, !*File), !*Files)