Combine all FunctionLocation, ClassLocation etc. into one Location

backend/CloogleServer.icl

@@ -70,14 +70,14 @@ import Levenshtein
                       }
 
 :: ClassResult :== (BasicResult, ClassResultExtras)
-:: ClassResultExtras = { class_name :: String
-                       , class_heading :: String
-                       , class_funs :: [String]
+:: ClassResultExtras = { class_name      :: String
+                       , class_heading   :: String
+                       , class_funs      :: [String]
                        , class_instances :: [String]
                        }
 
 :: MacroResult :== (BasicResult, MacroResultExtras)
-:: MacroResultExtras = { macro_name :: String
+:: MacroResultExtras = { macro_name           :: String
                        , macro_representation :: String
                        }
 
@@ -114,9 +114,9 @@ where
 	where
 		basic :: Result -> BasicResult
 		basic (FunctionResult (br,_)) = br
-		basic (TypeResult (br,_)) = br
-		basic (ClassResult (br,_)) = br
-		basic (MacroResult (br,_)) = br
+		basic (TypeResult     (br,_)) = br
+		basic (ClassResult    (br,_)) = br
+		basic (MacroResult    (br,_)) = br
 
 err :: Int String -> Response
 err c m = { return         = c
@@ -126,12 +126,12 @@ err c m = { return         = c
           , suggestions    = Nothing
           }
 
-E_NORESULTS :== 127
+E_NORESULTS    :== 127
 E_INVALIDINPUT :== 128
-E_INVALIDNAME :== 129
-E_INVALIDTYPE :== 130
+E_INVALIDNAME  :== 129
+E_INVALIDTYPE  :== 130
 
-MAX_RESULTS :== 15
+MAX_RESULTS    :== 15
 
 Start w
 # (io, w) = stdio w
@@ -203,45 +203,42 @@ where
 		// Search normal functions
 		# filts = catMaybes [ (\t _ -> isUnifiable t) <$> mbType
 		                    , (\n loc _ -> isNameMatch (size n-2) n loc) <$> name
-		                    , isModMatchF <$> modules
+		                    , (\mods loc _ -> isModMatch mods loc) <$> modules
 		                    ]
 		# funs = map (\f -> makeFunctionResult name mbType Nothing f db) $ findFunction`` filts db
 		// Search macros
 		# macros = case name of
 			Nothing  = []
-			(Just n) = findMacro` (\(ML lib mod m _) _ -> isNameMatch (size n-2) n (FL lib mod m Nothing)) db
+			(Just n) = findMacro` (\loc _ -> isNameMatch (size n-2) n loc) 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 Nothing)) <$> name
-		                    , isModMatchC <$> modules
+		                    , (\n (Location lib mod _ _) _ _ f _ -> isNameMatch
+		                      (size n-2) n (Location lib mod Nothing f)) <$> name
+		                    , (\mods loc _ _ _ _ -> isModMatch mods loc) <$> modules
 		                    ]
 		# members = findClassMembers`` filts db
-		# 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
+		# 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
 		// Search types
-		# lcTypeName = if (isJust mbType && isType (fromJust mbType))
+		# lcName = if (isJust mbType && isType (fromJust mbType))
 			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
 			(toLowerCase <$> name)
-		# types = case lcTypeName of
+		# types = case lcName of
 			(Just n) = findType` (\tl _ -> toLowerCase (getName tl) == n) db
 			Nothing  = []
 		# types = map (\(tl,td) -> makeTypeResult name tl td) types
 		// Search classes
 		# classes = case (isNothing mbType, toLowerCase <$> name) of
 			(True, Just c) = map (flip makeClassResult db) $
-				findClass` (\(CL _ _ c` _) _ _ _ -> toLowerCase c` == c) db
+				findClass` (\(Location _ _ _ c`) _ _ _ -> toLowerCase c` == c) db
 			_ = []
 		// Merge results
 		= sort $ funs ++ members ++ types ++ classes ++ macros
-	where
-		getName (TL _ _ t _)   = t
-		getName (TL_Builtin t) = t
 
-	makeClassResult :: (ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])
+	makeClassResult :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
 		TypeDB -> Result
-	makeClassResult (CL lib mod cls line, vars, cc, funs) db
+	makeClassResult (Location lib mod line cls, vars, cc, funs) db
 		= ClassResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
@@ -259,8 +256,8 @@ where
 		    }
 		  )
 
-	makeTypeResult :: (Maybe String) TypeLocation TypeDef -> Result
-	makeTypeResult mbName (TL lib mod t line) td
+	makeTypeResult :: (Maybe String) Location TypeDef -> Result
+	makeTypeResult mbName (Location lib mod line t) td
 		= TypeResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
@@ -272,7 +269,7 @@ where
 		    }
 		  , { type = concat $ print False td }
 		  )
-	makeTypeResult mbName (TL_Builtin t) td
+	makeTypeResult mbName (Builtin t) td
 		= TypeResult
 		  ( { library  = ""
 		    , filename = ""
@@ -285,8 +282,8 @@ where
 		  , { type = concat $ print False td }
 		  )
 
-	makeMacroResult :: (Maybe String) MacroLocation Macro -> Result
-	makeMacroResult mbName (ML lib mod m line) mac
+	makeMacroResult :: (Maybe String) Location Macro -> Result
+	makeMacroResult mbName (Location lib mod line m) mac
 		= MacroResult
 		  ( { library  = lib
 		    , filename = modToFilename mod
@@ -302,7 +299,7 @@ where
 		  )
 
 	makeFunctionResult :: (Maybe String) (Maybe Type) (Maybe ShortClassResult)
-	              (FunctionLocation, ExtendedType) TypeDB -> Result
+		(Location, ExtendedType) TypeDB -> Result
 	makeFunctionResult
 		orgsearch orgsearchtype mbCls (fl, et=:(ET type tes)) db
 		= FunctionResult
@@ -331,8 +328,8 @@ where
 		  )
 	where
 		(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)
+			(Location l m ln f) = (l,  m,  f, ln,      Nothing)
+			(Builtin f)         = ("", "", f, Nothing, Just True)
 
 		toStrUnifier :: Unifier -> StrUnifier
 		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
@@ -368,21 +365,16 @@ where
 	isUnifiable :: Type ExtendedType -> Bool
 	isUnifiable t1 (ET t2 _) = isJust (unify [] t1 (prepare_unification False t2))
 
-	isNameMatch :: !Int !String FunctionLocation -> Bool
-	isNameMatch maxdist n1 fl
-		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName fl})
+	isNameMatch :: !Int !String Location -> Bool
+	isNameMatch maxdist n1 loc
+		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName loc})
 		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein n1 n2 <= maxdist
-	where
-		getName (FL _ _ n _) = n; getName (FL_Builtin n) = n
-
-	isModMatchF :: ![String] FunctionLocation ExtendedType -> Bool
-	isModMatchF mods (FL _ mod _ _) _ = isMember mod mods
 
-	isModMatchC :: ![String] ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool
-	isModMatchC mods (CL _ mod _ _) _ _ _ _ = isMember mod mods
+	isModMatch :: ![String] Location -> Bool
+	isModMatch mods (Location _ mod _ _) = isMember mod mods
 
 	log :: (LogMessage (Maybe Request) Response) IPAddress *World
-	       -> *(IPAddress, *World)
+		-> *(IPAddress, *World)
 	log msg s w
 	| not needslog = (newS msg s, w)
 	# (tm,w) = localTime w

backend/TypeDB.dcl

@@ -29,20 +29,13 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
            , macro_extras :: TypeExtras
            }
 
-:: 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
+:: Location = Location Library Module LineNr Name
+            | Builtin                        Name
 
+:: Name         :== String
 :: Library      :== String
 :: Module       :== String
-:: FunctionName :== String
-:: MacroName    :== String
 :: Class        :== String
-:: GenericName  :== String
-:: TypeName     :== String
 :: LineNr       :== Maybe Int
 
 derive gEq TypeDB
@@ -51,52 +44,53 @@ instance zero TypeDB
 instance zero TypeExtras
 
 instance print TE_Priority
-instance print (FunctionName, ExtendedType)
-
-getFunction :: FunctionLocation TypeDB -> Maybe ExtendedType
-putFunction :: FunctionLocation ExtendedType TypeDB -> TypeDB
-putFunctions :: [(FunctionLocation, ExtendedType)] TypeDB -> TypeDB
-findFunction :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
-findFunction` :: (FunctionLocation ExtendedType -> Bool) TypeDB
-		-> [(FunctionLocation, ExtendedType)]
-findFunction`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
-		-> [(FunctionLocation, ExtendedType)]
-
-getMacro :: MacroLocation TypeDB -> Maybe Macro
-putMacro :: MacroLocation Macro TypeDB -> TypeDB
-putMacros :: [(MacroLocation, Macro)] TypeDB -> TypeDB
-findMacro` :: (MacroLocation Macro -> Bool) TypeDB -> [(MacroLocation, Macro)]
+instance print (Name, ExtendedType)
+
+getName :: Location -> Name
+
+getFunction :: Location TypeDB -> Maybe ExtendedType
+putFunction :: Location ExtendedType TypeDB -> TypeDB
+putFunctions :: [(Location, ExtendedType)] TypeDB -> TypeDB
+findFunction :: Name TypeDB -> [(Location, ExtendedType)]
+findFunction` :: (Location ExtendedType -> Bool) TypeDB
+		-> [(Location, ExtendedType)]
+findFunction`` :: [(Location ExtendedType -> Bool)] TypeDB
+		-> [(Location, ExtendedType)]
+
+getMacro :: Location TypeDB -> Maybe Macro
+putMacro :: Location Macro TypeDB -> TypeDB
+putMacros :: [(Location, Macro)] TypeDB -> TypeDB
+findMacro` :: (Location Macro -> Bool) TypeDB -> [(Location, Macro)]
 
 getInstances :: Class TypeDB -> [Type]
 putInstance :: Class Type TypeDB -> TypeDB
 putInstances :: Class [Type] TypeDB -> TypeDB
 putInstancess :: [(Class, [Type])] TypeDB -> TypeDB
 
-getClass :: ClassLocation TypeDB -> Maybe ([TypeVar],ClassContext,[(FunctionName,ExtendedType)])
-putClass :: ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] TypeDB -> TypeDB
-putClasses :: [(ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])] TypeDB -> TypeDB
-findClass :: Class TypeDB -> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])]
-findClass` :: (ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] -> Bool) TypeDB
-		-> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])]
-
-findClassMembers` :: (ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool) TypeDB
-		-> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
-findClassMembers`` :: [ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool]
-		TypeDB -> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
-
-getType :: TypeLocation TypeDB -> Maybe TypeDef
-putType :: TypeLocation TypeDef TypeDB -> TypeDB
-putTypes :: [(TypeLocation, TypeDef)] TypeDB -> TypeDB
-findType :: TypeName TypeDB -> [(TypeLocation, TypeDef)]
-findType` :: (TypeLocation TypeDef -> Bool) TypeDB
-		-> [(TypeLocation, TypeDef)]
-
-getDerivations :: GenericName TypeDB -> [Type]
-putDerivation :: GenericName Type TypeDB -> TypeDB
-putDerivations :: GenericName [Type] TypeDB -> TypeDB
-putDerivationss :: [(GenericName, [Type])] TypeDB -> TypeDB
-
-searchExact :: Type TypeDB -> [(FunctionLocation, ExtendedType)]
+getClass :: Location TypeDB -> Maybe ([TypeVar],ClassContext,[(Name,ExtendedType)])
+putClass :: Location [TypeVar] ClassContext [(Name,ExtendedType)] TypeDB -> TypeDB
+putClasses :: [(Location, [TypeVar], ClassContext, [(Name,ExtendedType)])] TypeDB -> TypeDB
+findClass :: Class TypeDB -> [(Location, [TypeVar], ClassContext, [(Name, ExtendedType)])]
+findClass` :: (Location [TypeVar] ClassContext [(Name,ExtendedType)] -> Bool) TypeDB
+		-> [(Location, [TypeVar], ClassContext, [(Name, ExtendedType)])]
+
+findClassMembers` :: (Location [TypeVar] ClassContext Name ExtendedType -> Bool) TypeDB
+		-> [(Location, [TypeVar], ClassContext, Name, ExtendedType)]
+findClassMembers`` :: [Location [TypeVar] ClassContext Name ExtendedType -> Bool]
+		TypeDB -> [(Location, [TypeVar], ClassContext, Name, ExtendedType)]
+
+getType :: Location TypeDB -> Maybe TypeDef
+putType :: Location TypeDef TypeDB -> TypeDB
+putTypes :: [(Location, TypeDef)] TypeDB -> TypeDB
+findType :: Name TypeDB -> [(Location, TypeDef)]
+findType` :: (Location TypeDef -> Bool) TypeDB -> [(Location, TypeDef)]
+
+getDerivations :: Name TypeDB -> [Type]
+putDerivation :: Name Type TypeDB -> TypeDB
+putDerivations :: Name [Type] TypeDB -> TypeDB
+putDerivationss :: [(Name, [Type])] TypeDB -> TypeDB
+
+searchExact :: Type TypeDB -> [(Location, ExtendedType)]
 
 newDb :: TypeDB
 openDb :: *File -> *(Maybe TypeDB, *File)

backend/TypeDB.icl

@@ -13,12 +13,12 @@ import Text.JSON
 import Type
 
 :: TypeDB
-	= { functionmap :: Map FunctionLocation ExtendedType
-	  , macromap    :: Map MacroLocation Macro
-	  , classmap    :: Map ClassLocation ([TypeVar],ClassContext,[(FunctionName, ExtendedType)])
+	= { functionmap :: Map Location ExtendedType
+	  , macromap    :: Map Location Macro
+	  , classmap    :: Map Location ([TypeVar],ClassContext,[(Name, ExtendedType)])
 	  , instancemap :: Map Class [Type]
-	  , typemap     :: Map TypeLocation TypeDef
-	  , derivemap   :: Map GenericName [Type]
+	  , typemap     :: Map Location TypeDef
+	  , derivemap   :: Map Name [Type]
 	  }
 
 printersperse :: Bool a [b] -> [String] | print a & print b
@@ -27,15 +27,14 @@ printersperse ia a bs = intercalate (print False a) (map (print ia) bs)
 (--) infixr 5 :: a b -> [String] | print a & print b
 (--) a b = print False a ++ print False b
 
-derive gEq ClassOrGeneric, FunctionLocation, ClassLocation, Type, TypeDB,
-	TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation, TypeDefRhs,
-	RecordField, Constructor, Kind, MacroLocation, Macro
-derive JSONEncode ClassOrGeneric, FunctionLocation, ClassLocation, Type,
-	TypeDB, TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation,
-	TypeDefRhs, RecordField, Constructor, Kind, MacroLocation, Macro
-derive JSONDecode ClassOrGeneric, FunctionLocation, ClassLocation, Type,
-	TypeDB, TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation,
-	TypeDefRhs, RecordField, Constructor, Kind, MacroLocation, Macro
+derive gEq ClassOrGeneric, Location, Type, TypeDB, TypeExtras, TE_Priority,
+	ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor, Kind, Macro
+derive JSONEncode ClassOrGeneric, Location, Type, TypeDB, TypeExtras,
+	TE_Priority, ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor,
+	Kind, Macro
+derive JSONDecode ClassOrGeneric, Location, Type, TypeDB, TypeExtras,
+	TE_Priority, ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor,
+	Kind, Macro
 
 instance zero TypeDB
 where
@@ -47,35 +46,18 @@ 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
+instance < Location
 where
-	(<) (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 d) (ML e f g h) = (a,b,c,d) < (e,f,g,h)
-
-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 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
+	(<) (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
 
 instance zero TypeExtras
 where
@@ -97,7 +79,7 @@ where
 	print _ (RightAssoc i) = "infixr " -- i
 	print _ (NoAssoc i)    = "infix " -- i
 
-instance print (FunctionName, ExtendedType)
+instance print (Name, ExtendedType)
 where
 	print _ (f, (ET t e))
 		= gen -- fname -- " " -- e -- " :: " -- t
@@ -108,40 +90,41 @@ where
 		| e.te_isrecordfield   = "." +++ f
 		| otherwise            = f
 
-getFunction :: FunctionLocation TypeDB -> Maybe ExtendedType
+getName :: Location -> Name
+getName (Location _ _ _ name) = name
+getName (Builtin name)        = name
+
+getFunction :: Location TypeDB -> Maybe ExtendedType
 getFunction loc {functionmap} = get loc functionmap
 
-putFunction :: FunctionLocation ExtendedType TypeDB -> TypeDB
+putFunction :: Location ExtendedType TypeDB -> TypeDB
 putFunction fl t tdb=:{functionmap} = { tdb & functionmap = put fl t functionmap }
 
-putFunctions :: [(FunctionLocation, ExtendedType)] TypeDB -> TypeDB
+putFunctions :: [(Location, ExtendedType)] TypeDB -> TypeDB
 putFunctions ts tdb = foldr (\(loc,t) db -> putFunction loc t db) tdb ts
 
-findFunction :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
+findFunction :: Name TypeDB -> [(Location, ExtendedType)]
 findFunction f db=:{functionmap}
 	= toList $ filterWithKey (\fl _-> f == getName fl) functionmap
-where
-	getName (FL _ _ f _)   = f
-	getName (FL_Builtin f) = f
 
-findFunction` :: (FunctionLocation ExtendedType -> Bool) TypeDB
-	-> [(FunctionLocation, ExtendedType)]
+findFunction` :: (Location ExtendedType -> Bool) TypeDB
+	-> [(Location, ExtendedType)]
 findFunction` f {functionmap} = toList $ filterWithKey f functionmap
 
-findFunction`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
-	-> [(FunctionLocation, ExtendedType)]
+findFunction`` :: [(Location ExtendedType -> Bool)] TypeDB
+	-> [(Location, ExtendedType)]
 findFunction`` fs {functionmap} = toList $ foldr filterWithKey functionmap fs
 
-getMacro :: MacroLocation TypeDB -> Maybe Macro
+getMacro :: Location TypeDB -> Maybe Macro
 getMacro loc {macromap} = get loc macromap
 
-putMacro :: MacroLocation Macro TypeDB -> TypeDB
+putMacro :: Location Macro TypeDB -> TypeDB
 putMacro ml m db=:{macromap} = { db & macromap = put ml m macromap }
 
-putMacros :: [(MacroLocation, Macro)] TypeDB -> TypeDB
+putMacros :: [(Location, Macro)] TypeDB -> TypeDB
 putMacros ms db = foldr (\(loc,m) db -> putMacro loc m db) db ms
 
-findMacro` :: (MacroLocation Macro -> Bool) TypeDB -> [(MacroLocation, Macro)]
+findMacro` :: (Location Macro -> Bool) TypeDB -> [(Location, Macro)]
 findMacro` f {macromap} = toList $ filterWithKey f macromap
 
 getInstances :: Class TypeDB -> [Type]
@@ -158,71 +141,68 @@ putInstances c ts db = foldr (\t db -> putInstance c t db) db ts
 putInstancess :: [(Class, [Type])] TypeDB -> TypeDB
 putInstancess is db = foldr (\(c,ts) db -> putInstances c ts db) db is
 
-getClass :: ClassLocation TypeDB -> Maybe ([TypeVar],ClassContext,[(FunctionName,ExtendedType)])
+getClass :: Location TypeDB -> Maybe ([TypeVar],ClassContext,[(Name,ExtendedType)])
 getClass loc {classmap} = get loc classmap
 
-putClass :: ClassLocation [TypeVar] ClassContext [(FunctionName, ExtendedType)] TypeDB -> TypeDB
+putClass :: Location [TypeVar] ClassContext [(Name, ExtendedType)] TypeDB -> TypeDB
 putClass cl tvs cc fs db=:{classmap} = {db & classmap = put cl (tvs,cc,fs) classmap}
 
-putClasses :: [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])] TypeDB -> TypeDB
+putClasses :: [(Location, [TypeVar], ClassContext, [(Name, ExtendedType)])] TypeDB -> TypeDB
 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 :: Class TypeDB -> [(Location, [TypeVar], ClassContext, [(Name, 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 (\(Location _ _ _ c`) _->c==c`) classmap
 
-findClass` :: (ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] -> Bool) TypeDB
-		-> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])]
+findClass` :: (Location [TypeVar] ClassContext [(Name,ExtendedType)] -> Bool) TypeDB
+		-> [(Location, [TypeVar], ClassContext, [(Name,ExtendedType)])]
 findClass` f {classmap} = map (\(k,(x,y,z))->(k,x,y,z)) results
 where results = toList $ filterWithKey (\cl (vs,cc,fs)->f cl vs cc fs) classmap
 
-findClassMembers` :: (ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool) TypeDB
-		-> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
+findClassMembers` :: (Location [TypeVar] ClassContext Name ExtendedType -> Bool) TypeDB
+		-> [(Location, [TypeVar], ClassContext, Name, ExtendedType)]
 findClassMembers` f {classmap} = filter (app5 f) $ flatten members
 where
 	members = map (\(cl,(vs,cc,fs))->[(cl,vs,cc,f,t) \\ (f,t)<-fs]) $ toList classmap
 
-findClassMembers`` :: [(ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool)]
-		TypeDB -> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
+findClassMembers`` :: [(Location [TypeVar] ClassContext Name ExtendedType -> Bool)]
+		TypeDB -> [(Location, [TypeVar], ClassContext, Name, ExtendedType)]
 findClassMembers`` fs {classmap} = foldr (filter o app5) all_members fs
 where
 	all_members = [(cl,vs,cc,f,t) \\ (cl,(vs,cc,fs)) <- toList classmap, (f,t) <- fs]
 
-getType :: TypeLocation TypeDB -> Maybe TypeDef
+getType :: Location TypeDB -> Maybe TypeDef
 getType loc {typemap} = get loc typemap
 
-putType :: TypeLocation TypeDef TypeDB -> TypeDB
+putType :: Location TypeDef TypeDB -> TypeDB
 putType tl td db=:{typemap} = {db & typemap = put tl td typemap}
 
-putTypes :: [(TypeLocation, TypeDef)] TypeDB -> TypeDB
+putTypes :: [(Location, TypeDef)] TypeDB -> TypeDB
 putTypes ts db = foldr (\(loc,td) -> putType loc td) db ts
 
-findType :: TypeName TypeDB -> [(TypeLocation, TypeDef)]
+findType :: Name TypeDB -> [(Location, TypeDef)]
 findType t db=:{typemap}
 	= toList $ filterWithKey (\tl _ -> getName tl == t) typemap
-where
-	getName (TL _ _ t _)   = t
-	getName (TL_Builtin t) = t
 
-findType` :: (TypeLocation TypeDef -> Bool) TypeDB
-		-> [(TypeLocation, TypeDef)]
+findType` :: (Location TypeDef -> Bool) TypeDB
+		-> [(Location, TypeDef)]
 findType` f {typemap} = toList $ filterWithKey f typemap
 
-getDerivations :: GenericName TypeDB -> [Type]
+getDerivations :: Name TypeDB -> [Type]
 getDerivations gen {derivemap} = if (isNothing ts) [] (fromJust ts)
 where ts = get gen derivemap
 
-putDerivation :: GenericName Type TypeDB -> TypeDB
+putDerivation :: Name Type TypeDB -> TypeDB
 putDerivation gen t db=:{derivemap} = {db & derivemap=put gen ts derivemap}
 where ts = removeDup [t : getDerivations gen db]
 
-putDerivations :: GenericName [Type] TypeDB -> TypeDB
+putDerivations :: Name [Type] TypeDB -> TypeDB
 putDerivations gen ts db = foldr (\t db -> putDerivation gen t db) db ts
 
-putDerivationss :: [(GenericName, [Type])] TypeDB -> TypeDB
+putDerivationss :: [(Name, [Type])] TypeDB -> TypeDB
 putDerivationss ds db = foldr (\(g,ts) db -> putDerivations g ts db) db ds
 
-searchExact :: Type TypeDB -> [(FunctionLocation, ExtendedType)]
+searchExact :: Type TypeDB -> [(Location, ExtendedType)]
 searchExact t db = filter ((\(ET t` _)->t==t`) o snd) $ toList db.functionmap
 
 newDb :: TypeDB

backend/builddb.icl

@@ -23,7 +23,6 @@ import CoclUtils
 import CleanPrettyPrint
 
 // frontend