Commit 3e468e4b authored by Camil Staps's avatar Camil Staps
Browse files

POC array database implementation (clean-cloogle/cloogle.org#158, clean-cloogle/cloogle.org#143)

parent 705b5d7a
definition module CloogleDB
/**
* A database with information about Clean modules.
*
* The functions here follow a general guideline about nomenclature:
* - get* expects that you already know the location of the value you seek and
* will only return an exact result, if it can be found. This runs in
* O(log n) where n is the number of elements of that type in the database.
* - find* searches by name, but can return results from multiple libraries.
* This is O(n).
* - find*` searches using a property function, similar to StdEnv's filter.
* This is O(n).
* - find*`` accepts a list of property functions that all have to match for
* the entry to be included in the result. It essentially folds the
* properties on the database with the single-backtick version. This is O(n).
* - put* adds a single entry to the database.
* - put*s adds a number of entries to the database.
*/
// Standard libraries
from StdOverloaded import class ==, class <, class zero
from StdClass import class Ord
......@@ -26,19 +7,46 @@ from Data.Generics.GenEq import generic gEq
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
// CleanTypeUnifier
from Type import :: Type, :: TypeVar, :: TVAssignment, :: TypeDef,
:: TypeContext, :: TypeRestriction, :: Priority, class print(..)
from Cloogle import :: FunctionKind, :: SyntaxExample, :: CleanLangReportLocation
from Doc import :: FunctionDoc, :: TypeDoc, :: ClassDoc, :: ModuleDoc
from DB import :: DB, :: Index
from NGramIndex import :: NGramIndex
/**
* A storage for function types, class definitions, type definitions, etc.
*/
:: CloogleDB
:: *CloogleDB =
{ db :: *DB CloogleEntry AnnotationKey Annotation
, name_ngrams :: NGramIndex Index
, module_index :: !Map Location Index
}
:: AnnotationKey
= MatchingNGrams
instance == AnnotationKey
instance < AnnotationKey
:: Annotation
= NGrams Int
:: CloogleEntry
= FunctionEntry FunctionEntry
| TypeDefEntry TypeDefEntry
| ModuleEntry ModuleEntry
| ClassEntry ClassEntry
| InstanceEntry InstanceEntry
| DeriveEntry DeriveEntry
| SyntaxEntry SyntaxEntry
derive JSONEncode CloogleEntry
derive JSONDecode CloogleEntry
/**
* A location in the Clean libraries
......@@ -46,33 +54,39 @@ from Doc import :: FunctionDoc, :: TypeDoc, :: ClassDoc, :: ModuleDoc
:: Location
= Location !Library !Module !FilePath !LineNr !LineNr !Name //* A normal location
| Builtin !Name ![CleanLangReportLocation] //* A language builtin
| NoLocation //* Only used internally
/**
* Not-type information that is often associated with things that have a type
*/
:: FunctionEntry
= { fe_kind :: !FunctionKind //* The type of entry
= { fe_loc :: !Location //* The location
, fe_kind :: !FunctionKind //* The type of entry
, fe_type :: !Maybe Type //* The type, Nothing for macros
, fe_priority :: !Maybe Priority //* The infix priority
, fe_generic_vars :: !Maybe [String] //* The names of the type variables of a generic function
// Using TypeVar causes import clashes in CloogleDBFactory
, fe_representation :: !Maybe String //* A string representation of the entry
, fe_documentation :: !Maybe FunctionDoc //* Documentation on this entry
, fe_class :: !Maybe Index //* The class, for class members
}
/**
* A TypeDef with meta-data
*/
:: TypeDefEntry
= { tde_typedef :: !TypeDef //* The TypeDef
, tde_doc :: !Maybe TypeDoc //* Documentation on the TypeDef
= { tde_loc :: !Location //* The location
, tde_typedef :: !TypeDef //* The TypeDef
, tde_doc :: !Maybe TypeDoc //* Documentation on the TypeDef
, tde_instances :: ![Index] //* Instances of this type
}
/**
* Information about a Clean module
*/
:: ModuleEntry
= { me_is_core :: !Bool //* Whether this is a core module (e.g. the os* modules in ObjectIO and TCPIP)
= { me_loc :: !Location //* The location
, me_is_core :: !Bool //* Whether this is a core module (e.g. the os* modules in ObjectIO and TCPIP)
, me_is_app :: !Bool //* Whether this module is not actually a library but an app
, me_documentation :: !Maybe ModuleDoc //* Documentation on this module
}
......@@ -81,13 +95,14 @@ from Doc import :: FunctionDoc, :: TypeDoc, :: ClassDoc, :: ModuleDoc
* Information about a Clean class
*/
:: ClassEntry
= { ce_vars :: ![String] //* The type variables of the class
= { ce_loc :: !Location //* The location
, ce_vars :: ![String] //* The type variables of the class
// Using TypeVar causes import clashes in CloogleDBFactory
, ce_context :: !TypeContext //* A class context
, ce_documentation :: !Maybe ClassDoc //* Documentation on this class
, ce_members :: ![(!Name, !FunctionEntry)] //* Class members: function name and type information
, ce_instances :: ![InstanceEntry] //* All instances of the class
, ce_derivations :: ![DeriveEntry] //* Derivations of generic meta-classes like iTask
, ce_context :: !TypeContext //* A class context
, ce_documentation :: !Maybe ClassDoc //* Documentation on this class
, ce_members :: ![Index] //* Class members (FunctionEntries)
, ce_instances :: ![Index] //* All instances of the class
, ce_derivations :: ![Index] //* Derivations of generic meta-classes like iTask
}
/**
......@@ -133,21 +148,31 @@ patternMatches :: SyntaxPattern String -> Bool
:: Module :== String
:: LineNr :== Maybe Int
instance zero CloogleDB
instance zero Location
instance zero FunctionEntry
instance zero ModuleEntry
instance == Location
instance print (Name, FunctionEntry)
class getLocation a :: a -> Maybe Location
instance getLocation FunctionEntry
instance getLocation TypeDefEntry
instance getLocation ModuleEntry
instance getLocation ClassEntry
instance getLocation CloogleEntry
getLibrary :: Location -> Maybe Name
getModule :: Location -> Maybe Name
getFilename :: Location -> Maybe String
getDclLine :: Location -> Maybe Int
getIclLine :: Location -> Maybe Int
getName :: Location -> Name
setName :: Name Location -> Location
isBuiltin :: Location -> Bool
isCore :: Location CloogleDB -> Bool
isApp :: Location CloogleDB -> Bool
isCore :: !Location !*CloogleDB -> *(Bool, *CloogleDB)
isApp :: !Location !*CloogleDB -> *(Bool, *CloogleDB)
toTypeDefEntry :: TypeDef (Maybe TypeDoc) -> TypeDefEntry
toTypeDefEntry :: Location TypeDef (Maybe TypeDoc) -> TypeDefEntry
getTypeDef :: TypeDefEntry -> TypeDef
getTypeDefDoc :: TypeDefEntry -> Maybe TypeDoc
mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
......@@ -155,104 +180,13 @@ mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
/**
* Wrapper around the Class record field to work around name clashes
*
* @param The location of the class
* @param The type variables of the class
* @param The class context
* @param The documentation
* @param The names and types of the class members
* @result A Class record with those data
*/
toClass :: [String] TypeContext (Maybe ClassDoc) [(Name, FunctionEntry)] -> ClassEntry
functionCount :: CloogleDB -> Int
classCount :: CloogleDB -> Int
typeCount :: CloogleDB -> Int
instanceCount :: CloogleDB -> Int
deriveCount :: CloogleDB -> Int
moduleCount :: CloogleDB -> Int
syntaxCount :: CloogleDB -> Int
typeTreeStats :: CloogleDB -> (Int, Int, Int)
/**
* Filter the whole database on locations using a property function
*/
filterLocations :: (Location -> Bool) CloogleDB -> CloogleDB
getFunction :: !Location !CloogleDB -> Maybe FunctionEntry
putFunction :: !Location !FunctionEntry !CloogleDB -> CloogleDB
putFunctions :: ![(!Location, !FunctionEntry)] !CloogleDB -> CloogleDB
findFunction :: !Name !CloogleDB -> [(!Location, !FunctionEntry)]
findFunction` :: !(Location FunctionEntry -> Bool) !CloogleDB
-> [(!Location, !FunctionEntry)]
findFunction`` :: ![(Location FunctionEntry -> Bool)] !CloogleDB
-> [(!Location, !FunctionEntry)]
findUnifying :: !Type !CloogleDB -> [(!Location, !FunctionEntry)]
getInstances :: !Location !CloogleDB -> [InstanceEntry]
putInstance :: !Name ![(!Type,!String)] !Location !CloogleDB -> CloogleDB
putInstances :: ![(!Name, ![(!Type,!String)], !Location)] !CloogleDB -> CloogleDB
getClassDerivations :: !Name !CloogleDB -> [DeriveEntry]
putClassDerivation :: !Name !Type !String !Location !CloogleDB -> CloogleDB
putClassDerivations :: ![(!Name, !Type, !String, !Location)] !CloogleDB -> CloogleDB
getClass :: !Location !CloogleDB -> Maybe ClassEntry
putClass :: !Location !ClassEntry !CloogleDB -> CloogleDB
putClasses :: ![(!Location, !ClassEntry)] !CloogleDB -> CloogleDB
findClass :: !Name !CloogleDB -> [(!Location, !ClassEntry)]
findClass` :: !(Location ClassEntry -> Bool) !CloogleDB -> [(!Location, !ClassEntry)]
findClass`` :: ![(Location ClassEntry -> Bool)] !CloogleDB -> [(!Location, !ClassEntry)]
findClassMembers` :: !(Location [String] TypeContext Name FunctionEntry -> Bool) !CloogleDB
-> [(!Location, ![String], !TypeContext, !Name, !FunctionEntry)]
findClassMembers`` :: ![(Location [String] TypeContext Name FunctionEntry -> Bool)]
!CloogleDB -> [(!Location, ![String], !TypeContext, !Name, !FunctionEntry)]
getType :: !Location !CloogleDB -> Maybe TypeDefEntry
putType :: !Location !TypeDefEntry !CloogleDB -> CloogleDB
putTypes :: ![(!Location, !TypeDefEntry)] !CloogleDB -> CloogleDB
findType :: !Name !CloogleDB -> [(!Location, !TypeDefEntry)]
findType` :: !(Location TypeDefEntry -> Bool) !CloogleDB -> [(!Location, !TypeDefEntry)]
findType`` :: ![(Location TypeDefEntry -> Bool)] !CloogleDB -> [(!Location, !TypeDefEntry)]
allTypes :: (CloogleDB -> [TypeDefEntry])
getDerivations :: !Name !CloogleDB -> [DeriveEntry]
putDerivation :: !Name !Type !String !Location !CloogleDB -> CloogleDB
putDerivations :: !Name ![(!Type, !String, !Location)] !CloogleDB -> CloogleDB
putDerivationss :: ![(!Name, ![(!Type, !String, !Location)])] !CloogleDB -> CloogleDB
getModule :: !Location !CloogleDB -> Maybe ModuleEntry
putModule :: !Location !ModuleEntry !CloogleDB -> CloogleDB
findModule` :: !(Location ModuleEntry -> Bool) !CloogleDB -> [(!Location, !ModuleEntry)]
putSyntaxElem :: ![SyntaxPattern] !SyntaxEntry !CloogleDB -> CloogleDB
putSyntaxElems :: ![(![SyntaxPattern], !SyntaxEntry)] !CloogleDB -> CloogleDB
findSyntaxElems :: !String !CloogleDB -> [SyntaxEntry]
/**
* Get all the class instances of a type
*
* @param The name of the type
* @param The database
* @result A list of class instances (name of the class, the full list of types
* instantiating the class (type and string representation) and all the
* locations where the class is instantiated for those types)
*/
getTypeInstances :: !Name !CloogleDB -> [(!Name, !InstanceEntry)]
/**
* Get all the generic derivations of a type
*
* @param The name of the type
* @param The database
* @result A list of derivations (name of the generic, whether it is a class,
* and all the locations where it is derived for that type)
*/
getTypeDerivations :: !Name !CloogleDB -> [(!Name, !Bool, ![Location])]
/**
* Initialise an empty database
*/
newDb :: CloogleDB
toClass :: Location [String] TypeContext (Maybe ClassDoc) -> ClassEntry
/**
* Synchronise the database. Should be called after updating data, to update
......@@ -261,19 +195,14 @@ newDb :: CloogleDB
* @param The database
* @result The new database
*/
syncDb :: !Int !CloogleDB -> CloogleDB
syncDB :: !Int !*CloogleDB -> *CloogleDB
/**
* Read the database from a file. The file should be opened for reading.
*/
openDb :: !*File -> *(!CloogleDB, !*File)
saveDB :: *CloogleDB *File -> *(*CloogleDB, *File)
openDB :: !*File -> *(!Maybe *CloogleDB, !*File)
/**
* Save the database to a file. The file should be opened for writing.
*/
saveDb :: !CloogleDB !*File -> *File
filterLocations :: (Location -> Bool) !*CloogleDB -> *CloogleDB
filterName :: !String !*CloogleDB -> *CloogleDB
/**
* For debugging: write the type tree to a file in Graphviz format.
*/
writeTypeTree :: !CloogleDB !*File -> *File
allModules :: !*CloogleDB -> *([ModuleEntry], *CloogleDB)
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Annotation)], *CloogleDB)
This diff is collapsed.
......@@ -9,7 +9,7 @@ import CloogleDB
:: TemporaryDB
newTemporaryDb :: TemporaryDB
finaliseDb :: !TemporaryDB !CloogleDB -> CloogleDB
finaliseDb :: !TemporaryDB -> *CloogleDB
/**
* Find all modules that could be indexed
......
......@@ -19,6 +19,8 @@ from Data.Func import $, mapSt, on
import Data.Functor
import Data.Generics.GenDefault
import Data.List
from Data.Map import :: Map
import qualified Data.Map as M
import Data.Maybe
import Data.Tuple
import System.Directory
......@@ -59,11 +61,21 @@ import qualified Type as T
from Type import instance == Type,
class print(print), instance print Type, instance print Priority
from Cloogle import :: FunctionKind(..)
import qualified CloogleDB as DB
from CloogleDB import :: Location(Location), filterLocations,
:: ModuleEntry{me_is_core,me_is_app,me_documentation},
:: FunctionEntry{fe_type,fe_kind,fe_generic_vars,fe_priority,fe_representation,fe_documentation},
instance zero FunctionEntry, instance zero ModuleEntry
from DB import :: DB, :: Index, newDB, instance == Index
import qualified DB
import qualified CloogleDB as CDB
from NGramIndex import :: NGramIndex, newNGramIndex, index
from CloogleDB import
:: CloogleDB{..}, :: Annotation, :: AnnotationKey,
:: Location(Location,NoLocation),
:: CloogleEntry(..),
:: ModuleEntry{me_loc,me_is_core,me_is_app,me_documentation},
:: FunctionEntry{fe_loc,fe_type,fe_kind,fe_generic_vars,fe_priority,fe_representation,fe_documentation},
:: TypeDefEntry{tde_loc},
:: ClassEntry{ce_loc},
:: SyntaxEntry, :: DeriveEntry, :: InstanceEntry,
instance zero FunctionEntry, instance zero ModuleEntry,
class getLocation, instance getLocation CloogleEntry
from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
:: ConstructorDoc, :: ClassMemberDoc, :: Description,
:: ParseWarning(UsedReturn,IllegalField), :: ParseError,
......@@ -75,13 +87,13 @@ from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
constructorToFunctionDoc, functionToClassMemberDoc, addClassMemberDoc
:: TemporaryDB
= { temp_functions :: ![[(!'DB'.Location, !'DB'.FunctionEntry)]]
, temp_classes :: ![[(!'DB'.Location, !'DB'.ClassEntry)]]
, temp_instances :: ![[(!'DB'.Name, ![(!'DB'.Type, !String)], !'DB'.Location)]]
, temp_types :: ![[(!'DB'.Location, !'DB'.TypeDefEntry)]]
, temp_derivations :: ![[(!'DB'.Name, ![(!'DB'.Type, !String, !'DB'.Location)])]]
, temp_class_derivations :: ![[(!'DB'.Name, !'DB'.Type, !String, !'DB'.Location)]]
, temp_modules :: ![(!'DB'.Location, !ModuleEntry)]
= { temp_functions :: ![['CDB'.FunctionEntry]]
, temp_classes :: ![['CDB'.ClassEntry]]
, 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)]]
, temp_modules :: ![ModuleEntry]
}
newTemporaryDb :: TemporaryDB
......@@ -95,25 +107,27 @@ newTemporaryDb
, temp_modules = []
}
finaliseDb :: !TemporaryDB !'DB'.CloogleDB -> 'DB'.CloogleDB
finaliseDb tdb db
#! db = filterLocations (filterFun tdb.temp_modules) db
#! db = foldr (uncurry 'DB'.putModule) db tdb.temp_modules
#! db = foldr 'DB'.putFunctions db tdb.temp_functions
#! db = foldr 'DB'.putClasses db tdb.temp_classes
#! db = foldr 'DB'.putTypes db tdb.temp_types
#! db = foldr 'DB'.putInstances db tdb.temp_instances
#! db = foldr 'DB'.putClassDerivations db tdb.temp_class_derivations
#! db = foldr 'DB'.putDerivationss db tdb.temp_derivations
= 'DB'.syncDb 3 db
finaliseDb :: !TemporaryDB -> *'CDB'.CloogleDB
finaliseDb tdb
# db = newDB $
[FunctionEntry fun \\ funs <- tdb.temp_functions, fun <- funs] ++
[TypeDefEntry td \\ tds <- tdb.temp_types, td <- tds] ++
[ModuleEntry mod \\ mod <- tdb.temp_modules] ++
[ClassEntry cls \\ clss <- tdb.temp_classes, cls <- clss]
# (names,db) = collectNames db
# name_ngrams = foldr (uncurry index) (newNGramIndex 3 True) names
= { db = db
, module_index = 'M'.newMap
, name_ngrams = name_ngrams
}
where
filterFun :: ![(!'DB'.Location, !ModuleEntry)] Location -> Bool
filterFun mods ('DB'.Location l m _ _ _ _) = any (\(Location l` m` _ _ _ _,_) -> l` == l && m` == m) mods
filterFun _ ('DB'.Builtin _ _) = True
collectNames = 'DB'.scan (\i v ivs -> case 'CDB'.getLocation v of
Nothing -> ivs
Just loc -> [('CDB'.getName loc, i):ivs]) []
// Exclude Root Library Aux Base module
findModules :: ![String] !String !'DB'.Library !a !String !*World
-> *(![('DB'.Library, 'DB'.Module, a)], !*World)
findModules :: ![String] !String !'CDB'.Library !a !String !*World
-> *(![('CDB'.Library, 'CDB'.Module, a)], !*World)
findModules ex root lib aux base w
| any ((<>) -1 o flip indexOf path) ex = ([], w)
#! (fps, w) = readDirectory path w
......@@ -145,8 +159,8 @@ where
removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)]
removeDupBy _ [] = []
indexModule :: !Bool !String !'DB'.Module !'DB'.Library
!(String 'DB'.ModuleEntry -> 'DB'.ModuleEntry) !TemporaryDB !*World
indexModule :: !Bool !String !'CDB'.Module !'CDB'.Library
!(String 'CDB'.ModuleEntry -> 'CDB'.ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
indexModule include_locals root mod lib modf db w
#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,modentry),w)
......@@ -155,31 +169,27 @@ indexModule include_locals root mod lib modf db w
#! db =
{ db
& temp_functions =
[ castLocFst modname functions
, castLocFst modname macros
, castLocFst modname generics
, [(castLoc modname {loc & name=Just n}, f)
[ [{f & fe_loc=castLoc modname loc} \\ (loc,f) <- functions ++ macros ++ generics]
, [{f & fe_loc=castLoc modname {loc & name=Just n}}
\\ (loc,td) <- typedefs
, (n,f) <- constructor_functions td ++ record_functions td]
: db.temp_functions
]
, temp_classes = [castLocFst modname clss:db.temp_classes]
, temp_types = [castLocFst modname typedefs:db.temp_types]
, temp_classes = [[{ce & ce_loc=castLoc modname loc} \\ (loc,ce) <- clss]:db.temp_classes]
, temp_types = [[{td & tde_loc=castLoc modname loc} \\ (loc,td) <- typedefs]:db.temp_types]
, 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]
, temp_modules = [(Location lib modname dclpath (Just 1) (Just 1) modname,modf mod modentry):db.temp_modules]
, temp_modules = [modf mod {modentry & me_loc=Location lib modname dclpath (Just 1) (Just 1) modname}:db.temp_modules]
}
= (db,w)
where
castLocFst :: String -> ([(LocationInModule, a)] -> [('DB'.Location, a)])
castLocFst m = map (appFst (castLoc m))
castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'DB'.Location)])
castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'CDB'.Location)])
castLocThd3 m = map (appThd3 (castLoc m))
castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l))
castLoc :: String LocationInModule -> 'DB'.Location
castLoc m l = 'DB'.Location lib m dclpath l.dcl_line l.icl_line (fromJust (l.name <|> Just "")) // TODO
castLoc :: String LocationInModule -> 'CDB'.Location
castLoc m l = 'CDB'.Location lib m dclpath l.dcl_line l.icl_line (fromJust (l.name <|> Just "")) // TODO
dclpath = mkdir mod +++ ".dcl"
mkdir :: String -> String
......@@ -189,15 +199,15 @@ instance zero LocationInModule
where zero = {dcl_line=Nothing, icl_line=Nothing, name=Nothing}
findModuleContents :: !Bool !String !*World
-> *( ![(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)
-> *( ![(LocationInModule, 'CDB'.FunctionEntry)]
, ![(LocationInModule, 'CDB'.FunctionEntry)]
, ![(LocationInModule, 'CDB'.FunctionEntry)]
, ![(LocationInModule, 'CDB'.TypeDefEntry)]
, ![(LocationInModule, 'CDB'.ClassEntry)]
, ![('CDB'.Name, [('CDB'.Type, String)], LocationInModule)]
, ![('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
, ![('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
, !('CDB'.Name, 'CDB'.ModuleEntry)
, !*World
)
findModuleContents include_locals path w
......@@ -257,17 +267,17 @@ where
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)
joinTypeDefs :: (LocationInModule, 'CDB'.TypeDefEntry) (LocationInModule, 'CDB'.TypeDefEntry) -> (LocationInModule, 'CDB'.TypeDefEntry)
joinTypeDefs (a,t) (b,u) = (joinLoc a b, 'CDB'.mergeTypeDefEntries t u)
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)])])
([('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
[('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
-> [('CDB'.Name, [('CDB'.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))
......@@ -290,7 +300,7 @@ where
}
pd_module _ = zero
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.FunctionEntry)]
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry)]
pd_rewriterules dcl defs st
= [( setLine dcl pos {zero & name=Just id.id_name}
, let doc = findDoc hideIsUsedReturn id st in
......@@ -326,13 +336,13 @@ where
| isJust fe.fe_type = fe
| otherwise = trace_n ("Doc warning: expected @type for '" +++ id.id_name +++ "'") fe
pd_derivations :: !Bool ![ParsedDefinition] -> [('DB'.Name, [('DB'.Type, String, LocationInModule)])]
pd_derivations :: !Bool ![ParsedDefinition] -> [('CDB'.Name, [('CDB'.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 :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry)]
pd_generics dcl defs st
= [( setLine dcl gen_pos {zero & name=Just id_name}
, { zero
......@@ -343,7 +353,7 @@ where
}
) \\ 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 :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry)]
pd_typespecs dcl defs st
= [( setLine dcl pos {zero & name=Just id_name}
, { zero
......@@ -354,12 +364,12 @@ where
}
) \\ 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 :: !Bool ![ParsedDefinition] SymbolTable -> [('CDB'.Name, 'CDB'.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