Resolve #46

CloogleServer.icl

@@ -51,6 +51,7 @@ import Levenshtein
 :: BasicResult = { library  :: String
                  , filename :: String
                  , modul    :: String
+                 , dcl_line :: Maybe Int
                  , distance :: Int
                  , builtin  :: Maybe Bool
                  }
@@ -208,17 +209,17 @@ where
 		// Search macros
 		# macros = case name of
 			Nothing  = []
-			(Just n) = findMacro` (\(ML lib mod m) _ -> isNameMatch (size n-2) n (FL lib mod m)) db
+			(Just n) = findMacro` (\(ML lib mod m _) _ -> isNameMatch (size n-2) n (FL lib mod m Nothing)) db
 		# macros = map (\(lhs,rhs) -> makeMacroResult name lhs rhs) macros
 		// Search class members
 		# filts = catMaybes [ (\t _ _ _ _->isUnifiable t) <$> mbType
-		                    , (\n (CL lib mod _) _ _ f _ -> isNameMatch
-		                      (size n-2) n (FL lib mod f)) <$> name
+		                    , (\n (CL lib mod _ _) _ _ f _ -> isNameMatch
+		                      (size n-2) n (FL lib mod f Nothing)) <$> name
 		                    , isModMatchC <$> modules
 		                    ]
 		# members = findClassMembers`` filts db
-		# members = map (\(CL lib mod cls,vs,_,f,et) -> makeFunctionResult name mbType
-			(Just {cls_name=cls,cls_vars=vs}) (FL lib mod f,et) db) members
+		# members = map (\(CL lib mod cls line,vs,_,f,et) -> makeFunctionResult name mbType
+			(Just {cls_name=cls,cls_vars=vs}) (FL lib mod f line,et) db) members
 		// Search types
 		# lcTypeName = if (isJust mbType && isType (fromJust mbType))
 			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
@@ -230,20 +231,21 @@ where
 		// Search classes
 		# classes = case (isNothing mbType, toLowerCase <$> name) of
 			(True, Just c) = map (flip makeClassResult db) $
-				findClass` (\(CL _ _ c`) _ _ _ -> toLowerCase c` == c) db
+				findClass` (\(CL _ _ c` _) _ _ _ -> toLowerCase c` == c) db
 			_ = []
 		// Merge results
 		= sort $ funs ++ members ++ types ++ classes ++ macros
 	where
-		getName (TL _ _ t)     = t
+		getName (TL _ _ t _)   = t
 		getName (TL_Builtin t) = t
 
 	makeClassResult :: (ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])
 		TypeDB -> Result
-	makeClassResult (CL lib mod cls, vars, cc, funs) db
+	makeClassResult (CL lib mod cls line, vars, cc, funs) db
 		= ClassResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
+		    , dcl_line = line
 		    , modul    = mod
 		    , distance = -100
 		    , builtin  = Nothing
@@ -258,10 +260,11 @@ where
 		  )
 
 	makeTypeResult :: (Maybe String) TypeLocation TypeDef -> Result
-	makeTypeResult mbName (TL lib mod t) td
+	makeTypeResult mbName (TL lib mod t line) td
 		= TypeResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
+		    , dcl_line = line
 		    , modul    = mod
 		    , distance
 		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
@@ -273,6 +276,7 @@ where
 		= TypeResult
 		  ( { library  = ""
 		    , filename = ""
+		    , dcl_line = Nothing
 		    , modul    = ""
 		    , distance
 		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
@@ -282,10 +286,11 @@ where
 		  )
 
 	makeMacroResult :: (Maybe String) MacroLocation Macro -> Result
-	makeMacroResult mbName (ML lib mod m) mac
+	makeMacroResult mbName (ML lib mod m line) mac
 		= MacroResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
+		    , dcl_line = line
 		    , modul    = mod
 		    , distance
 		        = if (isNothing mbName) -100 (levenshtein` (fromJust mbName) m)
@@ -303,6 +308,7 @@ where
 		= FunctionResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
+		    , dcl_line = line
 		    , modul    = mod
 		    , distance = distance
 		    , builtin  = builtin
@@ -324,9 +330,9 @@ where
 		    }
 		  )
 	where
-		(lib,mod,fname,builtin) = case fl of
-			(FL l m f)     = (l, m, f,Nothing)
-			(FL_Builtin f) = ("","",f,Just True)
+		(lib,mod,fname,line,builtin) = case fl of
+			(FL l m f ln)  = (l, m, f,ln,     Nothing)
+			(FL_Builtin f) = ("","",f,Nothing,Just True)
 
 		toStrUnifier :: Unifier -> StrUnifier
 		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
@@ -367,13 +373,13 @@ where
 		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName fl})
 		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein n1 n2 <= maxdist
 	where
-		getName (FL _ _ n) = n; getName (FL_Builtin n) = n
+		getName (FL _ _ n _) = n; getName (FL_Builtin n) = n
 
 	isModMatchF :: ![String] FunctionLocation ExtendedType -> Bool
-	isModMatchF mods (FL _ mod _) _ = isMember mod mods
+	isModMatchF mods (FL _ mod _ _) _ = isMember mod mods
 
 	isModMatchC :: ![String] ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool
-	isModMatchC mods (CL _ mod _) _ _ _ _ = isMember mod mods
+	isModMatchC mods (CL _ mod _ _) _ _ _ _ = isMember mod mods
 
 	log :: (LogMessage (Maybe Request) Response) IPAddress *World
 	       -> *(IPAddress, *World)

TypeDB.dcl

@@ -14,32 +14,27 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
   ::ClassContext, ::ClassRestriction, ::ClassOrGeneric
 
 :: TypeDB
-instance zero TypeDB
-derive gEq TypeDB
 
-:: FunctionLocation = FL Library Module FunctionName | FL_Builtin FunctionName
+:: TE_Priority = LeftAssoc Int | RightAssoc Int | NoAssoc Int
 
 :: TypeExtras = { te_priority      :: Maybe TE_Priority
                 , te_isconstructor :: Bool
                 , te_isrecordfield :: Bool
                 , te_generic_vars  :: Maybe [TypeVar]
                 }
-instance zero TypeExtras
-
-:: TE_Priority = LeftAssoc Int | RightAssoc Int | NoAssoc Int
-instance print TE_Priority
 
 :: ExtendedType = ET Type TypeExtras
 
-instance print (FunctionName, ExtendedType)
-
-:: MacroLocation = ML Library Module MacroName
-
 :: Macro = { macro_as_string :: String
            , macro_extras :: TypeExtras
            }
 
-:: ClassLocation = CL Library Module Class
+:: FunctionLocation = FL         Library Module FunctionName LineNr
+                    | FL_Builtin                FunctionName
+:: MacroLocation    = ML         Library Module MacroName    LineNr
+:: ClassLocation    = CL         Library Module Class        LineNr
+:: TypeLocation     = TL         Library Module TypeName     LineNr
+                    | TL_Builtin                TypeName
 
 :: Library      :== String
 :: Module       :== String
@@ -47,10 +42,16 @@ instance print (FunctionName, ExtendedType)
 :: MacroName    :== String
 :: Class        :== String
 :: GenericName  :== String
+:: TypeName     :== String
+:: LineNr       :== Maybe Int
+
+derive gEq TypeDB
 
-:: TypeLocation = TL Library Module TypeName | TL_Builtin TypeName
+instance zero TypeDB
+instance zero TypeExtras
 
-:: TypeName :== String
+instance print TE_Priority
+instance print (FunctionName, ExtendedType)
 
 getFunction :: FunctionLocation TypeDB -> Maybe ExtendedType
 putFunction :: FunctionLocation ExtendedType TypeDB -> TypeDB

TypeDB.icl

@@ -47,20 +47,32 @@ where
 	       , derivemap     = newMap
 	       }
 
+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 < (Maybe a) | < a
+where
+	(<) (Just a) (Just b) = a < b
+	(<) (Just _) Nothing  = True
+	(<) Nothing  _        = False
+
 instance < FunctionLocation
 where
-	(<) (FL a b c)     (FL d e f)     = (a,b,c) < (d,e,f)
+	(<) (FL a b c d)   (FL e f g h)   = (a,b,c,d) < (e,f,g,h)
 	(<) (FL_Builtin a) (FL_Builtin b) = a < b
 	(<) (FL_Builtin _) _              = True
 	(<) _              _              = False
 
-instance < MacroLocation where (<) (ML a b c) (ML d e f) = (a,b,c) < (d,e,f)
+instance < MacroLocation
+where (<) (ML a b c d) (ML e f g h) = (a,b,c,d) < (e,f,g,h)
 
-instance < ClassLocation where (<) (CL a b c) (CL d e f) = (a,b,c) < (d,e,f)
+instance < ClassLocation
+where (<) (CL a b c d) (CL e f g h) = (a,b,c,d) < (e,f,g,h)
 
 instance < TypeLocation
 where
-	(<) (TL a b c)     (TL d e f)     = (a,b,c) < (d,e,f)
+	(<) (TL a b c d)   (TL e f g h)   = (a,b,c,d) < (e,f,g,h)
 	(<) (TL_Builtin a) (TL_Builtin b) = a < b
 	(<) (TL_Builtin _) _              = True
 	(<) _              _              = False
@@ -109,7 +121,7 @@ findFunction :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
 findFunction f db=:{functionmap}
 	= toList $ filterWithKey (\fl _-> f == getName fl) functionmap
 where
-	getName (FL _ _ f)     = f
+	getName (FL _ _ f _)   = f
 	getName (FL_Builtin f) = f
 
 findFunction` :: (FunctionLocation ExtendedType -> Bool) TypeDB
@@ -157,7 +169,7 @@ putClasses cs db = foldr (\(cl,tvs,cc,fs) db -> putClass cl tvs cc fs db) db cs
 
 findClass :: Class TypeDB -> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])]
 findClass c {classmap} = map (\(k,(x,y,z))->(k,x,y,z)) results
-where results = toList $ filterWithKey (\(CL _ _ c`) _->c==c`) classmap
+where results = toList $ filterWithKey (\(CL _ _ c` _) _->c==c`) classmap
 
 findClass` :: (ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] -> Bool) TypeDB
 		-> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])]
@@ -189,7 +201,7 @@ findType :: TypeName TypeDB -> [(TypeLocation, TypeDef)]
 findType t db=:{typemap}
 	= toList $ filterWithKey (\tl _ -> getName tl == t) typemap
 where
-	getName (TL _ _ t)     = t
+	getName (TL _ _ t _)   = t
 	getName (TL_Builtin t) = t
 
 findType` :: (TypeLocation TypeDef -> Bool) TypeDB

builddb.icl

@@ -31,13 +31,14 @@ from predef import init_identifiers
 from compile import empty_cache, ::DclCache{hash_table}
 from general import ::Optional(..)
 from syntax import ::SymbolTable, ::SymbolTableEntry, ::Ident{..}, ::SymbolPtr,
-	::Position(NoPos), ::Module{mod_ident,mod_defs},
+	::Position(..), ::LineNr, ::FileName, ::FunctName,
+	::Module{mod_ident,mod_defs},
 	::ParsedDefinition(PD_TypeSpec,PD_Instance,PD_Class,PD_Type,PD_Generic,PD_Derive,PD_Function),
 	::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType,
 	::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_types},
-	::Type, ::ClassDef{class_ident,class_args,class_context},
-	::TypeVar, ::ParsedTypeDef, ::TypeDef,
-	::GenericDef{gen_ident,gen_type,gen_vars},
+	::Type, ::ClassDef{class_ident,class_pos,class_args,class_context},
+	::TypeVar, ::ParsedTypeDef, ::TypeDef{td_pos},
+	::GenericDef{gen_ident,gen_pos,gen_type,gen_vars},
 	::GenericCaseDef{gc_type,gc_gcf}, ::GenericCaseFunctions(GCF), ::GCF,
 	::FunKind(FK_Macro),
 	::Rhs, ::ParsedExpr
@@ -227,11 +228,11 @@ where
 
 	pd_macros :: String String [ParsedDefinition] -> [('DB'.MacroLocation, 'DB'.Macro)]
 	pd_macros lib mod pds
-		= [( 'DB'.ML lib mod id.id_name
+		= [( 'DB'.ML lib mod id.id_name (toLine pos)
 		   , { macro_as_string = priostring id +++ cpp pd
 		     , macro_extras = {zero & te_priority = findPrio id >>= toPrio}
 		     }
-		   ) \\ pd=:(PD_Function _ id isinfix args rhs FK_Macro) <- pds]
+		   ) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- pds]
 	where
 		priostring :: Ident -> String
 		priostring id = case findTypeSpec id pds of
@@ -255,14 +256,14 @@ where
 	pd_generics :: String String [ParsedDefinition]
 		-> [('DB'.FunctionLocation, 'DB'.ExtendedType)]
 	pd_generics lib mod pds
-		= [( 'DB'.FL lib mod id_name
+		= [( 'DB'.FL lib mod id_name (toLine gen_pos)
 		   , 'DB'.ET ('T'.toType gen_type) {zero & te_generic_vars=Just $ map 'T'.toTypeVar gen_vars}
-		   ) \\ PD_Generic {gen_ident={id_name},gen_type,gen_vars} <- pds]
+		   ) \\ PD_Generic {gen_ident={id_name},gen_pos,gen_type,gen_vars} <- pds]
 
 	pd_typespecs :: String String [ParsedDefinition]
 		-> [('DB'.FunctionLocation, 'DB'.ExtendedType)]
 	pd_typespecs lib mod pds
-		= [( 'DB'.FL lib mod id_name
+		= [( 'DB'.FL lib mod id_name (toLine pos)
 		   , 'DB'.ET ('T'.toType t) {zero & te_priority=toPrio p}
 		   ) \\ PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs <- pds]
 
@@ -276,28 +277,28 @@ where
 			[('DB'.FunctionName, 'DB'.ExtendedType)])]
 	pd_classes lib mod pds
 	# pds = filter (\pd->case pd of (PD_Class _ _)=True; _=False) pds
-	= map (\(PD_Class {class_ident={id_name},class_args,class_context} pds)
+	= map (\(PD_Class {class_ident={id_name},class_pos,class_args,class_context} pds)
 		-> let typespecs = pd_typespecs lib mod pds
-		in ('DB'.CL lib mod id_name, map 'T'.toTypeVar class_args, 
+		in ('DB'.CL lib mod id_name (toLine class_pos), map 'T'.toTypeVar class_args,
 		    flatten $ map 'T'.toClassContext class_context,
-			[(f,et) \\ ('DB'.FL _ _ f, et) <- typespecs])) pds
+		    [(f,et) \\ ('DB'.FL _ _ f _, et) <- typespecs])) pds
 
 	pd_types :: String String [ParsedDefinition]
 		-> [('DB'.TypeLocation, 'DB'.TypeDef)]
 	pd_types lib mod pds
-		= [('DB'.TL lib mod ('T'.td_name td), td)
+		= [('DB'.TL lib mod ('T'.td_name td) (toLine ptd.td_pos), td)
 		   \\ PD_Type ptd <- pds, td <- ['T'.toTypeDef ptd]]
 
 	constructor_functions :: ('DB'.TypeLocation, 'DB'.TypeDef)
 		-> [('DB'.FunctionLocation, 'DB'.ExtendedType)]
-	constructor_functions ('DB'.TL lib mod _, td)
-		= [('DB'.FL lib mod c, 'DB'.ET f {zero & te_isconstructor=True})
+	constructor_functions ('DB'.TL lib mod _ line, td)
+		= [('DB'.FL lib mod c line, 'DB'.ET f {zero & te_isconstructor=True})
 		   \\ (c,f) <- 'T'.constructorsToFunctions td]
 
 	record_functions :: ('DB'.TypeLocation, 'DB'.TypeDef)
 		-> [('DB'.FunctionLocation, 'DB'.ExtendedType)]
-	record_functions ('DB'.TL lib mod _, td)
-		= [('DB'.FL lib mod f, 'DB'.ET t {zero & te_isrecordfield=True})
+	record_functions ('DB'.TL lib mod _ line, td)
+		= [('DB'.FL lib mod f line, 'DB'.ET t {zero & te_isrecordfield=True})
 			\\ (f,t) <- 'T'.recordsToFunctions td]
 
 	toPrio :: Priority -> Maybe 'DB'.TE_Priority
@@ -306,6 +307,11 @@ where
 	toPrio (Prio NoAssoc i)    = Just $ 'DB'.NoAssoc i
 	toPrio _                   = Nothing
 
+	toLine :: Position -> 'DB'.LineNr
+	toLine (FunPos _ l _) = Just l
+	toLine (LinePos _ l)  = Just l
+	toLine _              = Nothing
+
 wantModule` :: !*File !{#Char} !Bool !Ident !Position !Bool !*HashTable !*File !*Files
 	-> ((!Bool,!Bool,!ParsedModule, !*HashTable, !*File), !*Files)
 wantModule` f s b1 i p b2 ht io fs