Commit fc1f85cb authored by Camil Staps's avatar Camil Staps 🚀

Resolve #46

parent 60b78a34
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment