More implementation module locations

CloogleServer.icl

@@ -83,7 +83,7 @@ import Cache
                        , macro_representation :: String
                        }
 
-:: LocationResult :== (String, String, Maybe Int)
+:: LocationResult :== (String, String, Maybe Int, Maybe Int)
 
 :: StrUnifier :== ([(String,String)], [(String,String)])
 
@@ -251,12 +251,12 @@ where
 		# macros = map (\(lhs,rhs) -> makeMacroResult name lhs rhs) macros
 		// Search class members
 		# filts = catMaybes [ (\t _ _ _ _->isUnifiable t) <$> mbType
-		                    , (\n (Location lib mod _ _) _ _ f _ -> isNameMatch
-		                      (size n*2/3) n (Location lib mod Nothing f)) <$> name
+		                    , (\n (Location lib mod _ _ _) _ _ f _ -> isNameMatch
+		                      (size n*2/3) n (Location lib mod Nothing Nothing f)) <$> name
 		                    ]
 		# members = findClassMembers`` filts db
-		# members = map (\(Location lib mod line cls,vs,_,f,et) -> makeFunctionResult name mbType
-			(Just {cls_name=cls,cls_vars=vs}) (Location lib mod line f,et) db) members
+		# members = map (\(Location lib mod line iclline cls,vs,_,f,et) -> makeFunctionResult name mbType
+			(Just {cls_name=cls,cls_vars=vs}) (Location lib mod line iclline f,et) db) members
 		// Search types
 		# lcName = if (isJust mbType && isType (fromJust mbType))
 			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
@@ -287,12 +287,12 @@ where
 		    }
 		  , makeClassResultExtras rec db
 		  )
-	makeClassResult rec=:(Location lib mod line cls, vars, cc, funs) db
+	makeClassResult rec=:(Location lib mod line iclline cls, vars, cc, funs) db
 		= ClassResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
 		    , dcl_line = line
-		    , icl_line = Nothing
+		    , icl_line = iclline
 		    , modul    = mod
 		    , distance = -100
 		    , builtin  = Nothing
@@ -314,19 +314,19 @@ where
 	where
 		cls = case l of
 			Builtin c = c
-			Location _ _ _ c = c
+			Location _ _ _ _ c = c
 
 		print_fun :: (Name,ExtendedType) -> String
 		print_fun f=:(_,ET _ et) = fromJust $
 			et.te_representation <|> (pure $ concat $ print False f)
 
 	makeTypeResult :: (Maybe String) Location TypeDef TypeDB -> Result
-	makeTypeResult mbName (Location lib mod line t) td db
+	makeTypeResult mbName (Location lib mod line iclline t) td db
 		= TypeResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
 		    , dcl_line = line
-		    , icl_line = line
+		    , icl_line = iclline
 		    , modul    = mod
 		    , distance
 		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
@@ -357,12 +357,12 @@ where
 		  )
 
 	makeMacroResult :: (Maybe String) Location Macro -> Result
-	makeMacroResult mbName (Location lib mod line m) mac
+	makeMacroResult mbName (Location lib mod line iclline m) mac
 		= MacroResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
 		    , dcl_line = line
-		    , icl_line = Nothing
+		    , icl_line = iclline
 		    , modul    = mod
 		    , distance
 		        = if (isNothing mbName) -100 (levenshtein` (fromJust mbName) m)
@@ -381,7 +381,7 @@ where
 		  ( { library  = lib
 		    , filename = modToFilename mod
 		    , dcl_line = line
-		    , icl_line = tes.te_iclline
+		    , icl_line = iclline
 		    , modul    = mod
 		    , distance = distance
 		    , builtin  = builtin
@@ -405,9 +405,9 @@ where
 		    }
 		  )
 	where
-		(lib,mod,fname,line,builtin) = case fl of
-			(Location l m ln f) = (l,  m,  f, ln,      Nothing)
-			(Builtin f)         = ("", "", f, Nothing, Just True)
+		(lib,mod,fname,line,iclline,builtin) = case fl of
+			(Location l m ln iln f) = (l,  m,  f, ln,      iln,     Nothing)
+			(Builtin f)             = ("", "", f, Nothing, Nothing, Just True)
 
 		toStrUnifier :: Unifier -> StrUnifier
 		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
@@ -454,15 +454,15 @@ where
 		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein [c \\ c <-: n1] [c \\ c <-: n2] <= maxdist
 
 	isModMatch :: ![String] Location -> Bool
-	isModMatch mods (Location _ mod _ _) = isMember mod mods
-	isModMatch _    (Builtin _)          = False
+	isModMatch mods (Location _ mod _ _ _) = isMember mod mods
+	isModMatch _    (Builtin _)            = False
 
 	isLibMatch :: (![String], !Bool) Location -> Bool
-	isLibMatch (libs,_) (Location lib _ _ _) = any (\l -> indexOf l lib == 0) libs
-	isLibMatch (_,blti) (Builtin _)          = blti
+	isLibMatch (libs,_) (Location lib _ _ _ _) = any (\l -> indexOf l lib == 0) libs
+	isLibMatch (_,blti) (Builtin _)            = blti
 
 	loc :: Location -> LocationResult
-	loc (Location lib mod ln _) = (lib, mod, ln)
+	loc (Location lib mod ln iln _) = (lib, mod, ln, iln)
 
 	log :: (LogMessage (Maybe Request) Response CacheKey) IPAddress *World
 		-> *(IPAddress, *World)

TypeDB.dcl

@@ -20,7 +20,6 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
                 , te_isrecordfield  :: Bool
                 , te_generic_vars   :: Maybe [TypeVar]
                 , te_representation :: Maybe String
-                , te_iclline        :: Maybe Int
                 }
 
 :: ExtendedType = ET Type TypeExtras
@@ -29,8 +28,8 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
            , macro_extras :: TypeExtras
            }
 
-:: Location = Location Library Module LineNr Name
-            | Builtin                        Name
+:: Location = Location Library Module LineNr LineNr Name
+            | Builtin                               Name
 
 :: Name         :== String
 :: Library      :== String

TypeDB.icl

@@ -55,24 +55,12 @@ where
 	       , derivemap`   = newMap
 	       }
 
-instance < (Maybe a) | < a
-where
-	(<) (Just a) (Just b) = a < b
-	(<) (Just _) Nothing  = True
-	(<) Nothing  _        = False
-
-instance < Location
-where
-	(<) (Location a b c d) (Location e f g h) = ((a,b),(c,d)) < ((e,f),(g,h))
-	(<) (Location _ _ _ _) (Builtin _)        = True
-	(<) (Builtin _)        (Location _ _ _ _) = False
-	(<) (Builtin a)        (Builtin b)        = a < b
-
-derive gLexOrd Maybe, ClassOrGeneric, Kind, Type
+derive gLexOrd Location, Maybe, ClassOrGeneric, Kind, Type
+instance < Location where (<) a b = (a =?= b) === LT
+instance < (Maybe a) | gLexOrd{|*|} a where (<) a b = (a =?= b) === LT
 instance < Type where (<) a b = (a =?= b) === LT
-
-instance < (a,b,c,d) | Ord a & Ord b & Ord c & Ord d
-where (<) (a,b,c,d) (e,f,g,h) = ((a,b),(c,d)) < ((e,f),(g,h))
+instance < (a,b,c,d) | gLexOrd{|*|} a & gLexOrd{|*|} b & gLexOrd{|*|} c & gLexOrd{|*|} d
+	where (<) a b = (a =?= b) === LT
 
 instance == Location
 where
@@ -85,7 +73,6 @@ where
 	       , te_isrecordfield  = False
 	       , te_generic_vars   = Nothing
 	       , te_representation = Nothing
-	       , te_iclline        = Nothing
 	       }
 
 instance print TypeExtras
@@ -106,8 +93,8 @@ where
 		| otherwise            = f
 
 getName :: Location -> Name
-getName (Location _ _ _ name) = name
-getName (Builtin name)        = name
+getName (Location _ _ _ _ name) = name
+getName (Builtin name)          = name
 
 functionCount :: TypeDB -> Int
 functionCount {functionmap} = mapSize functionmap

builddb.icl

@@ -37,7 +37,7 @@ from syntax import ::SymbolTable, ::SymbolTableEntry, ::Ident{..}, ::SymbolPtr,
 	::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType,
 	::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_pos,pi_types},
 	::Type, ::ClassDef{class_ident,class_pos,class_args,class_context},
-	::TypeVar, ::ParsedTypeDef, ::TypeDef{td_pos},
+	::TypeVar, ::ParsedTypeDef, ::TypeDef{td_pos,td_ident},
 	::GenericDef{gen_ident,gen_pos,gen_type,gen_vars},
 	::GenericCaseDef{gc_type,gc_pos,gc_gcf}, ::GenericCaseFunctions(GCF), ::GCF,
 	::FunKind(FK_Macro),
@@ -234,12 +234,13 @@ getModuleTypes :: String String String *DclCache 'DB'.TypeDB *World -> *('DB'.Ty
 getModuleTypes root mod lib cache db w
 # (Right dcl,cache,w) = readModule False cache w
 # (icl,cache,w) = readModule True cache w
+# icl = case icl of (Left _) = Nothing; (Right x) = Just x
 # mod = dcl.mod_ident.id_name
 # lib = cleanlib mod lib
 # db  = 'DB'.putFunctions (pd_typespecs lib mod dcl.mod_defs icl) db
-# db  = 'DB'.putInstances (pd_instances lib mod dcl.mod_defs) db
+# db  = 'DB'.putInstances (pd_instances lib mod dcl.mod_defs icl) db
 # db  = 'DB'.putClasses (pd_classes lib mod dcl.mod_defs icl) db
-# typedefs = pd_types lib mod dcl.mod_defs
+# typedefs = pd_types lib mod 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
@@ -264,7 +265,7 @@ where
 
 	pd_macros :: String String [ParsedDefinition] -> [('DB'.Location, 'DB'.Macro)]
 	pd_macros lib mod dcl
-		= [( 'DB'.Location lib mod (toLine pos) id.id_name
+		= [( '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}
 		     }
@@ -288,65 +289,83 @@ where
 		-> [('DB'.Name, [('DB'.Type, 'DB'.Location)])]
 	pd_derivations lib mod dcl
 		= [( id.id_name
-		   , [('T'.toType gc_type, 'DB'.Location lib mod (toLine gc_pos) "")]
+		   , [('T'.toType gc_type, 'DB'.Location lib mod (toLine gc_pos) Nothing "")]
 		   ) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]
 
 	pd_generics :: String String [ParsedDefinition]
 		-> [('DB'.Location, 'DB'.ExtendedType)]
 	pd_generics lib mod dcl
-		= [( 'DB'.Location lib mod (toLine gen_pos) id_name
+		= [( 'DB'.Location lib mod (toLine gen_pos) Nothing id_name
 		   , 'DB'.ET ('T'.toType gen_type)
 		       {zero & te_generic_vars=Just $ map 'T'.toTypeVar gen_vars
 		             , te_representation=Just $ cpp gen}
 		   ) \\ gen=:(PD_Generic {gen_ident={id_name},gen_pos,gen_type,gen_vars}) <- dcl]
 
-	pd_typespecs :: String String [ParsedDefinition] (Either String ParsedModule)
+	pd_typespecs :: String String [ParsedDefinition] (Maybe ParsedModule)
 		-> [('DB'.Location, 'DB'.ExtendedType)]
 	pd_typespecs lib mod dcl icl
-		= [( 'DB'.Location lib mod (toLine pos) id_name
+		= [( 'DB'.Location lib mod (toLine pos) (findIclLine id_name =<< icl) id_name
 		   , 'DB'.ET ('T'.toType t)
 		       { zero & te_priority = 'T'.toMaybePriority p
-		              , te_representation = Just $ cpp ts
-		              , te_iclline = findIclLine id_name icl}
+		              , te_representation = Just $ cpp ts}
 		   ) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- dcl]
 	where
-		findIclLine :: String (Either String ParsedModule) -> Maybe Int
-		findIclLine _ (Left _) = Nothing
-		findIclLine name (Right {mod_defs=pms})
+		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_instances :: String String [ParsedDefinition]
+	pd_instances :: String String [ParsedDefinition] (Maybe ParsedModule)
 		-> [('DB'.Class, ['DB'.Type], 'DB'.Location)]
-	pd_instances lib mod dcl
-		= [( pi_ident.id_name
+	pd_instances lib mod dcl icl
+		= [( id_name
 		   , map 'T'.toType pi_types
-		   , 'DB'.Location lib mod (toLine pi_pos) ""
-		   ) \\ PD_Instance {pim_pi={pi_ident,pi_types,pi_pos}} <- dcl]
+		   , 'DB'.Location lib mod (toLine pi_pos) (findIclLine id_name =<< icl) ""
+		   ) \\ PD_Instance {pim_pi={pi_ident={id_name},pi_types,pi_pos}} <- dcl]
+	where
+		findIclLine :: String ParsedModule -> Maybe Int
+		findIclLine name {mod_defs=pms}
+			= case [pi_pos \\ PD_Instance {pim_pi={pi_pos,pi_ident}} <- pms | pi_ident.id_name == name] of
+				[LinePos _ l:_] = Just l
+				_ = Nothing
 
-	pd_classes :: String String [ParsedDefinition] (Either String ParsedModule)
+	pd_classes :: String String [ParsedDefinition] (Maybe ParsedModule)
 		-> [('DB'.Location, ['T'.TypeVar], 'T'.ClassContext,
 			[('DB'.Name, 'DB'.ExtendedType)])]
 	pd_classes lib mod dcl icl
 	# 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
-		in ('DB'.Location lib mod (toLine class_pos) id_name, map 'T'.toTypeVar class_args,
-		    flatten $ map 'T'.toClassContext class_context,
-		    [(f,et) \\ ('DB'.Location _ _ _ f, et) <- typespecs])) dcl
+		in ('DB'.Location lib mod (toLine class_pos) (findIclLine id_name =<< icl) id_name
+		   , map 'T'.toTypeVar class_args
+		   , flatten $ map 'T'.toClassContext class_context
+		   , [(f,et) \\ ('DB'.Location _ _ _ _ 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 :: String String [ParsedDefinition]
+	pd_types :: String String [ParsedDefinition] (Maybe ParsedModule)
 		-> [('DB'.Location, 'DB'.TypeDef)]
-	pd_types lib mod dcl
-		= [('DB'.Location lib mod (toLine ptd.td_pos) ('T'.td_name td), td)
+	pd_types lib mod dcl icl
+		= [let name = 'T'.td_name td in
+			('DB'.Location lib mod (toLine ptd.td_pos) (findIclLine name =<< icl) name, td)
 		   \\ PD_Type ptd <- dcl, 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
 
 	constructor_functions :: ('DB'.Location, 'DB'.TypeDef)
 		-> [('DB'.Location, 'DB'.ExtendedType)]
-	constructor_functions ('DB'.Location lib mod line _, td)
-		= [('DB'.Location lib mod line c, 'DB'.ET f
+	constructor_functions ('DB'.Location lib mod line iclline _, td)
+		= [('DB'.Location lib mod line iclline c, 'DB'.ET f
 			{zero & te_isconstructor=True
 			      , te_representation=Just $ concat $
 			          [c] ++ print_prio p ++ [" :: "] ++ print False f
@@ -359,8 +378,8 @@ where
 
 	record_functions :: ('DB'.Location, 'DB'.TypeDef)
 		-> [('DB'.Location, 'DB'.ExtendedType)]
-	record_functions ('DB'.Location lib mod line _, td)
-		= [('DB'.Location lib mod line f, 'DB'.ET t
+	record_functions ('DB'.Location lib mod line iclline _, td)
+		= [('DB'.Location lib mod line iclline f, 'DB'.ET t
 			{zero & te_isrecordfield=True
 			      , te_representation=Just $ concat $ [".", f, " :: " : print False t]})
 			\\ (f,t) <- 'T'.recordsToFunctions td]