Verified Commit 4cf0b6c4 authored by Camil Staps's avatar Camil Staps 🐟

Combine all FunctionLocation, ClassLocation etc. into one Location

parent 43a0e806
......@@ -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,18 +365,13 @@ 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)
......
......@@ -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)
......
......@@ -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
......
......@@ -23,7 +23,6 @@ import CoclUtils
import CleanPrettyPrint
// frontend
//import Heap, compile, parse, predef
import Heap
from hashtable import ::HashTable, ::QualifiedIdents(NoQualifiedIdents),
::IdentClass(IC_Module), ::BoxedIdent{..}, putIdentInHashTable
......@@ -119,6 +118,7 @@ where
loop _ [] db _ w = (db,w)
loop root [(lib,mod):list] db cache w
# (db, cache, w) = getModuleTypes root mod lib cache db w
# w = snd (fclose (stderr <<< lib <<< ": " <<< mod <<< "\n") w)
= loop root list db cache w
parseCLI :: [String] -> Either String CLI
......@@ -132,16 +132,16 @@ where
("-l", [x:xs]) = (\c->{c & libs=[x:c.libs]}) <$> parseCLI xs
(x, _) = Left $ "Unknown option '" +++ x +++ "'"
predefFunctions :: [('DB'.FunctionLocation, 'DB'.ExtendedType)]
predefFunctions :: [('DB'.Location, 'DB'.ExtendedType)]
predefFunctions
= [ ( 'DB'.FL_Builtin "if"
= [ ( 'DB'.Builtin "if"
, 'DB'.ET ('T'.Func ['T'.Type "Bool" [], 'T'.Var "a", 'T'.Var "a"] ('T'.Var "a") []) zero
)
]
predefTypes :: [('DB'.TypeLocation, 'T'.TypeDef)]
predefTypes :: [('DB'.Location, 'T'.TypeDef)]
predefTypes
= [ ( 'DB'.TL_Builtin "Bool"
= [ ( 'DB'.Builtin "Bool"
, { deft
& 'Type'.td_name = "Bool"
, 'Type'.td_rhs = 'T'.TDRCons False
......@@ -150,14 +150,14 @@ predefTypes
]
}
)
, ( 'DB'.TL_Builtin "Int", { deft & 'Type'.td_name = "Int" } )
, ( 'DB'.TL_Builtin "Real", { deft & 'Type'.td_name = "Real" } )
, ( 'DB'.TL_Builtin "Char", { deft & 'Type'.td_name = "Char" } )
, ( 'DB'.TL_Builtin "String", { deft & 'Type'.td_name = "String",
, ( 'DB'.Builtin "Int", { deft & 'Type'.td_name = "Int" } )
, ( 'DB'.Builtin "Real", { deft & 'Type'.td_name = "Real" } )
, ( 'DB'.Builtin "Char", { deft & 'Type'.td_name = "Char" } )
, ( 'DB'.Builtin "String", { deft & 'Type'.td_name = "String",
'Type'.td_rhs = 'T'.TDRSynonym ('T'.Type "{#Char}" []) } )
, ( 'DB'.TL_Builtin "Dynamic", { deft & 'Type'.td_name = "Dynamic" } )
, ( 'DB'.TL_Builtin "File", { deft & 'Type'.td_name = "File" }