Commit 57e7845f authored by Camil Staps's avatar Camil Staps 🚀

More implementation module locations

parent 9efa92eb
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
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