Verified Commit 610f4425 authored by Camil Staps's avatar Camil Staps 🚀

More flexible indexing

parent 3833d6b9
......@@ -42,12 +42,50 @@ findModules :: ![String] !String !Library !a !String !*World
indexModule :: !String !Module !Library !(String ModuleEntry -> ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
:: LocationInFile =
{ dcl_line :: Maybe Int
, icl_line :: Maybe Int
, name :: Maybe String
}
/**
* Parse a module and get its contents
*
* @param The path to the module, without .icl or .dcl
* @result A tuple of:
* - Function definitions
* - Macro definitions
* - Generic function definitions
* - Constructor function definitions
* - Record field function definitions
* - Type definitions
* - Class definitions
* - Instances
* - Derivations
* - Class derivations
* - The module
*/
findModuleContents :: !String !*World
-> *( ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, FunctionEntry)]
, ![(LocationInFile, TypeDefEntry)]
, ![(LocationInFile, ClassEntry)]
, ![(Name, [(Type, String)], LocationInFile)]
, ![(Name, [(Type, String, LocationInFile)])]
, ![(Name, Type, String, LocationInFile)]
, !(Name, ModuleEntry)
, !*World
)
/**
* Transform the constructors of an algebraic data type into plain functions.
*/
constructor_functions :: (Location, TypeDefEntry) -> [(Location, FunctionEntry)]
constructor_functions :: TypeDefEntry -> [(Name, FunctionEntry)]
/**
* Transform the record fields of a record type into plain functions.
*/
record_functions :: (Location, TypeDefEntry) -> [(Location, FunctionEntry)]
record_functions :: TypeDefEntry -> [(Name, FunctionEntry)]
......@@ -19,6 +19,7 @@ import Data.Functor
import Data.Maybe
import Data.Tuple
import System.Directory
import System.FilePath
from Text import class Text(concat,indexOf,replaceSubString), instance Text String
import CleanPrettyPrint
......@@ -104,7 +105,7 @@ where
filterFun mods ('DB'.Location l m _ _ _) = isEmpty [() \\ (l`,m`,_) <- mods | l == l` && m == m`]
filterFun _ ('DB'.Builtin _ _) = True
// Exclude Root Library Check for core Check for app Base module
// Exclude Root Library Aux Base module
findModules :: ![String] !String !'DB'.Library !a !String !*World
-> *(![('DB'.Library, 'DB'.Module, a)], !*World)
findModules ex root lib aux base w
......@@ -117,11 +118,16 @@ findModules ex root lib aux base w
#! (moremodss,w) = mapSt (findModules ex root lib aux o ((+++) basedot)) (filter isDirectory fps) w
= (removeDupBy (\(l,m,_)->(l,m)) (mods ++ flatten moremodss), w)
where
path = root +++ "/" +++ lib +++ if (base == "") "" "/" +++ replaceSubString "." "/" base
basedot = if (base == "") "" (base +++ ".")
path = root </?> lib </?> replaceSubString "." {pathSeparator} base
where
(</?>) infixr 5 :: !FilePath !FilePath -> FilePath
(</?>) "" p = p
(</?>) p "" = p
(</?>) p1 p2 = p1 </> p2
included :: String -> Bool
included s = not (any ((<>) -1 o flip indexOf (path +++ "/" +++ s)) ex)
included s = not (any ((<>) -1 o flip indexOf (path </> s)) ex)
isDclModule :: String -> Bool
isDclModule s = s % (size s - 4, size s - 1) == ".dcl"
......@@ -136,49 +142,86 @@ where
indexModule :: !String !'DB'.Module !'DB'.Library !(String 'DB'.ModuleEntry -> 'DB'.ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
indexModule root mod lib modf db w
#! (Right dcl,symbols,w) = readModule False w
#! (icl,_,w) = readModule True w
#! icl = case icl of (Left _) = Nothing; (Right x) = Just x
#! modname = dcl.mod_ident.id_name
#! (functions, macros, generics, confuns, recfuns, typedefs, clss, insts, derivs, clsderivs, (modname, modentry), w)
= findModuleContents root w
#! lib = lib % (0, size lib - size modname + size mod - 1)
#! typedefs = pd_types lib modname dcl.mod_defs icl symbols
#! db =
{ db
& temp_functions =
[ pd_typespecs lib modname dcl.mod_defs icl symbols
, pd_macros lib modname dcl.mod_defs symbols
, pd_generics lib modname dcl.mod_defs icl symbols
, [f \\ td <- typedefs, f <- constructor_functions td]
, [f \\ td <- typedefs, f <- record_functions td]
[ castLocFst functions
, castLocFst macros
, castLocFst generics
, castLocFst confuns
, castLocFst recfuns
: db.temp_functions
]
, temp_classes = [pd_classes lib modname dcl.mod_defs icl symbols:db.temp_classes]
, temp_instances = [pd_instances lib modname dcl.mod_defs icl:db.temp_instances]
, temp_types = [typedefs:db.temp_types]
, temp_derivations = [pd_derivations lib modname dcl.mod_defs:db.temp_derivations]
, temp_class_derivations = [pd_class_derivations lib modname dcl.mod_defs icl:db.temp_class_derivations]
, temp_modules = [(lib,modname,pd_module (modf mod) dcl.mod_defs):db.temp_modules]
, temp_classes = [castLocFst clss:db.temp_classes]
, temp_types = [castLocFst typedefs:db.temp_types]
, temp_instances = [castLocThd3 insts:db.temp_instances]
, temp_derivations = [map (appSnd castLocThd3) derivs:db.temp_derivations]
, temp_class_derivations = [castLocFrth clsderivs:db.temp_class_derivations]
, temp_modules = [(lib,modname,modf mod modentry):db.temp_modules]
}
= (db,w)
where
mkdir :: String -> String
mkdir s = { if (c == '.') '/' c \\ c <-: s }
pd_module :: !('DB'.ModuleEntry -> 'DB'.ModuleEntry) ![ParsedDefinition] -> ModuleEntry
pd_module modf [PD_Documentation _ doc:_]
= { pd_module modf []
castLocFst :: ([(LocationInFile, a)] -> [('DB'.Location, a)])
castLocFst = map (appFst castLoc)
castLocThd3 :: ([(a, b, LocationInFile)] -> [(a, b, 'DB'.Location)])
castLocThd3 = map (appThd3 castLoc)
castLocFrth = map (\(a,b,c,l) -> (a,b,c,castLoc l))
castLoc :: LocationInFile -> 'DB'.Location
castLoc l = 'DB'.Location lib mod l.dcl_line l.icl_line (fromJust (l.name <|> Just "")) // TODO
findModuleContents :: !String !*World
-> *( ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.FunctionEntry)]
, ![(LocationInFile, 'DB'.TypeDefEntry)]
, ![(LocationInFile, 'DB'.ClassEntry)]
, ![('DB'.Name, [('DB'.Type, String)], LocationInFile)]
, ![('DB'.Name, [('DB'.Type, String, LocationInFile)])]
, ![('DB'.Name, 'DB'.Type, String, LocationInFile)]
, !('DB'.Name, 'DB'.ModuleEntry)
, !*World
)
findModuleContents path w
#! (Right dcl,symbols,w) = readModule False w
#! (icl,_,w) = readModule True w
#! icl = case icl of (Left _) = Nothing; (Right x) = Just x
#! modname = dcl.mod_ident.id_name
#! typedefs = pd_types dcl.mod_defs icl symbols
= ( pd_typespecs dcl.mod_defs icl symbols
, pd_macros dcl.mod_defs symbols
, pd_generics dcl.mod_defs icl symbols
, [({loc & name=Just n}, f) \\ (loc,td) <- typedefs, (n,f) <- constructor_functions td]
, [({loc & name=Just n}, f) \\ (loc,td) <- typedefs, (n,f) <- record_functions td]
, typedefs
, pd_classes dcl.mod_defs icl symbols
, pd_instances dcl.mod_defs icl
, pd_derivations dcl.mod_defs
, pd_class_derivations dcl.mod_defs icl
, (modname,pd_module dcl.mod_defs)
, w
)
where
pd_module :: ![ParsedDefinition] -> ModuleEntry
pd_module [PD_Documentation _ doc:_]
= { zero
& me_documentation = docParseResultToMaybe $ parseModuleDoc doc
}
pd_module modf _ = modf zero
pd_module _ = zero
pd_macros :: String String ![ParsedDefinition] SymbolTable
-> [('DB'.Location, 'DB'.FunctionEntry)]
pd_macros lib mod dcl st
= [( 'DB'.Location lib mod (toLine pos) Nothing id.id_name
pd_macros :: ![ParsedDefinition] SymbolTable
-> [(LocationInFile, 'DB'.FunctionEntry)]
pd_macros dcl st
= [( {dcl_line=toLine pos, icl_line=Nothing, name=Just id.id_name}
, let doc = findDoc parseFunctionDoc id st in
{ zero
& fe_kind=Macro
, fe_type=getTypeDoc =<< doc
, fe_type=getTypeDoc =<< doc
, fe_representation=Just $ priostring id +++ cpp pd
, fe_priority=findPrio id >>= 'T'.toMaybePriority
, fe_documentation=doc
......@@ -199,17 +242,17 @@ where
| id`.id_name == id.id_name = Just pd
findTypeSpec id [_:dcl] = findTypeSpec id dcl
pd_derivations :: String String ![ParsedDefinition]
-> [('DB'.Name, [('DB'.Type, String, 'DB'.Location)])]
pd_derivations lib mod dcl
pd_derivations :: ![ParsedDefinition]
-> [('DB'.Name, [('DB'.Type, String, LocationInFile)])]
pd_derivations dcl
= [( id.id_name
, [('T'.toType gc_type, cpp gc_type, 'DB'.Location lib mod (toLine gc_pos) Nothing "")]
, [('T'.toType gc_type, cpp gc_type, {dcl_line=toLine gc_pos, icl_line=Nothing, name=Nothing})]
) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]
pd_generics :: String String ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [('DB'.Location, 'DB'.FunctionEntry)]
pd_generics lib mod dcl icl st
= [( 'DB'.Location lib mod (toLine gen_pos) (findIclLine id_name =<< icl) id_name
pd_generics :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.FunctionEntry)]
pd_generics dcl icl st
= [( {dcl_line=toLine gen_pos, icl_line=findIclLine id_name =<< icl, name=Just id_name}
, { zero
& fe_type=Just $ 'T'.toType gen_type
, fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
......@@ -225,10 +268,10 @@ where
[LinePos _ l:_] = Just l
_ = Nothing
pd_typespecs :: String String ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [('DB'.Location, 'DB'.FunctionEntry)]
pd_typespecs lib mod dcl icl st
= [( 'DB'.Location lib mod (toLine pos) (findIclLine id_name =<< icl) id_name
pd_typespecs :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.FunctionEntry)]
pd_typespecs dcl icl st
= [( {dcl_line=toLine pos, icl_line=findIclLine id_name =<< icl, name=Just id_name}
, { zero
& fe_type=Just $ 'T'.toType t
, fe_priority = 'T'.toMaybePriority p
......@@ -244,13 +287,13 @@ where
[LinePos _ l:_] = Just l
_ = Nothing
pd_class_derivations :: String String ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, 'DB'.Type, String, 'DB'.Location)]
pd_class_derivations lib mod dcl icl
pd_class_derivations :: ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, 'DB'.Type, String, LocationInFile)]
pd_class_derivations dcl icl
= [( id.id_name
, 'T'.toType gc_type
, cpp gc_type
, 'DB'.Location lib mod (toLine gc_pos) (findIclLine id.id_name ('T'.toType gc_type) =<< icl) ""
, {dcl_line=toLine gc_pos, icl_line=findIclLine id.id_name ('T'.toType gc_type) =<< icl, name=Nothing}
) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCFC id _} <- gcdefs]
where
findIclLine :: String 'T'.Type ParsedModule -> Maybe Int
......@@ -261,12 +304,12 @@ where
[LinePos _ l:_] = Just l
_ = Nothing
pd_instances :: String String ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, [('DB'.Type, String)], 'DB'.Location)]
pd_instances lib mod dcl icl
pd_instances :: ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, [('DB'.Type, String)], LocationInFile)]
pd_instances dcl icl
= [( id
, types
, 'DB'.Location lib mod (toLine pos) (findIclLine id (map fst types) =<< icl) ""
, {dcl_line=toLine pos, icl_line=findIclLine id (map fst types) =<< icl, name=Nothing}
) \\ (id,types,pos) <- instances]
where
instances = map (appSnd3 (map (\t -> ('T'.toType t, cppp t)))) $
......@@ -281,15 +324,15 @@ where
[LinePos _ l:_] = Just l
_ = Nothing
pd_classes :: String String ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [('DB'.Location, 'DB'.ClassEntry)]
pd_classes lib mod dcl icl st
pd_classes :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.ClassEntry)]
pd_classes dcl icl st
# dcl = filter (\pd->case pd of (PD_Class _ _)=True; _=False) dcl
= map (\(PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} dcl)
-> let
typespecs = pd_typespecs lib mod dcl icl st
macros = pd_macros lib mod dcl st
getMacro n = case filter ((==) n o 'DB'.getName o fst) macros of
typespecs = pd_typespecs dcl icl st
macros = pd_macros dcl st
getMacro n = case filter ((==) n o (\l->fromJust l.name) o fst) macros of
[] = Nothing
[(_,m):_] = m.fe_representation
updateRepresentation n fe
......@@ -297,14 +340,14 @@ where
& fe_kind=if (isNothing $ getMacro n) fe.fe_kind Macro
, fe_representation=getMacro n <|> fe.fe_representation
}
in ( 'DB'.Location lib mod (toLine class_pos) (findIclLine id_name =<< icl) id_name
in ( {dcl_line=toLine class_pos, icl_line=findIclLine id_name =<< icl, name=Just id_name}
, 'DB'.toClass
(map 'T'.toTypeVar class_args)
(flatten $ map 'T'.toTypeContext class_context)
(flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe) <- typespecs]
<$> (findDoc parseClassDoc id st))
[(f,updateRepresentation f et) \\ ('DB'.Location _ _ _ _ f, et) <- typespecs]
[(f,updateRepresentation f et) \\ ({name=Just f}, et) <- typespecs]
)) dcl
where
findIclLine :: String ParsedModule -> Maybe Int
......@@ -313,11 +356,11 @@ where
[LinePos _ l:_] = Just l
_ = Nothing
pd_types :: String String ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [('DB'.Location, 'DB'.TypeDefEntry)]
pd_types lib mod dcl icl st
pd_types :: ![ParsedDefinition] !(Maybe ParsedModule) SymbolTable
-> [(LocationInFile, 'DB'.TypeDefEntry)]
pd_types dcl icl st
= [let name = 'T'.td_name td in
( 'DB'.Location lib mod (toLine ptd.td_pos) (findIclLine name =<< icl) name
( {dcl_line=toLine ptd.td_pos, icl_line=findIclLine name =<< icl, name=Just name}
, 'DB'.toTypeDefEntry td $ findRhsDoc ptd =<<
(case findDoc (parsef ptd.td_rhs) ptd.td_ident st of
Just d -> Just d
......@@ -371,10 +414,10 @@ where
readModule icl w
# ht = newHashTable newHeap
# ht = set_hte_mark (if icl 1 0) ht
# filename = root +++ "/" +++ lib +++ "/" +++ mkdir mod +++ if icl ".icl" ".dcl"
# filename = path +++ if icl ".icl" ".dcl"
# (ok,f,w) = fopen filename FReadText w
| not ok = (Left $ "Couldn't open " +++ filename, abort "no symboltable\n", w)
# (mod_id, ht) = putIdentInHashTable mod (IC_Module NoQualifiedIdents) ht
# (mod_id, ht) = putIdentInHashTable path (IC_Module NoQualifiedIdents) ht
# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True ht stderr) w
# (ok,w) = fclose f w
| not ok = (Left $ "Couldn't open " +++ filename, abort "no symboltable\n", w)
......@@ -402,10 +445,9 @@ where
isUsedReturn :: ParseWarning -> Bool
isUsedReturn UsedReturn = True; isUsedReturn _ = False
constructor_functions :: ('DB'.Location, 'DB'.TypeDefEntry)
-> [('DB'.Location, 'DB'.FunctionEntry)]
constructor_functions (loc, etd)
= [(loc` c,
constructor_functions :: 'DB'.TypeDefEntry -> [('DB'.Name, 'DB'.FunctionEntry)]
constructor_functions etd
= [(c,
{ zero
& fe_kind=Constructor
, fe_type=Just f
......@@ -413,19 +455,14 @@ constructor_functions (loc, etd)
, fe_priority=p
})
\\ (c,f,p) <- 'T'.constructorsToFunctions ('DB'.getTypeDef etd)]
where
loc` c = case loc of
'DB'.Builtin _ d -> 'DB'.Builtin c d
'DB'.Location lib mod line iclline _ -> 'DB'.Location lib mod line iclline c
print_prio :: (Maybe 'T'.Priority) -> [String]
print_prio Nothing = []
print_prio (Just p) = [" "] ++ print False p
record_functions :: ('DB'.Location, 'DB'.TypeDefEntry)
-> [('DB'.Location, 'DB'.FunctionEntry)]
record_functions (loc, etd)
= [(loc` f,
record_functions :: 'DB'.TypeDefEntry -> [('DB'.Name, 'DB'.FunctionEntry)]
record_functions etd
= [(f,
{ zero
& fe_kind=RecordField
, fe_type=Just t
......@@ -435,9 +472,6 @@ record_functions (loc, etd)
\\ (f,t) <- 'T'.recordsToFunctions ('DB'.getTypeDef etd)
& doc <- field_doc]
where
loc` f = case loc of
'DB'.Builtin _ d -> 'DB'.Builtin f d
'DB'.Location lib mod line iclline _ -> 'DB'.Location lib mod line iclline f
field_doc = case getTypeRhsDoc =<< 'DB'.getTypeDefDoc etd of
Just (RecordDoc fields) = fields ++ repeat Nothing
_ = repeat Nothing
......
--- /frontend/parse.icl 2017-09-03 21:15:17.307092195 +0200
+++ /frontend/parse.icl 2017-07-13 23:20:56.000000000 +0200
@@ -294,7 +294,6 @@
, ps_flags = if support_generics PS_SupportGenericsMask 0
, ps_hash_table = hash_table
}
- pState = verify_name mod_name id_name file_name pState
(mod_ident, pState) = stringToIdent mod_name (IC_Module NoQualifiedIdents) pState
pState = check_layout_rule pState
(defs, pState) = want_definitions (SetGlobalContext iclmodule) pState
@@ -309,7 +309,7 @@
// otherwise // ~ succ
# ({fp_line}, scanState) = getPosition scanState
......
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