Verified Commit 8016aa84 authored by Camil Staps's avatar Camil Staps 🙂

Add type definitions to TypeDB & builddb

parent 8055c769
Subproject commit f29840bc7e56b53e4c0fde5ec665fdd832ba711f
Subproject commit 0c7eb5ca73c8f9798ed6f17b86d448fa021d2e6c
......@@ -100,7 +100,7 @@ where
isNameMatch (size name-2) name loc)
, isModMatchF <$> modules
]
# funcs = map (makeResult name mbType Nothing) $ findType`` filts db
# funs = map (makeResult name mbType Nothing) $ findFunction`` filts db
// Search class members
# filts = catMaybes $ [ (\t->(\_ _ _ u->isUnifiable t u)) <$> mbType
, pure (\(CL lib mod _) _ f _ ->
......@@ -111,7 +111,7 @@ where
# members = map (\(CL lib mod cls,vs,f,et) -> makeResult name mbType
(Just {cls_name=cls,cls_vars=vs}) (FL lib mod f,et)) members
# drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
# results = drop drop_n $ sort $ funcs ++ members
# results = drop drop_n $ sort $ funs ++ members
# more = max 0 (length results - MAX_RESULTS)
# results = take MAX_RESULTS results
| isEmpty results = (err E_NORESULTS "No results", w)
......
......@@ -27,7 +27,7 @@ man: $(MAN)
$(SED) -i 's/\([ \t]\+Path:[ \t]\+\){Project}$$/&\n\1{Application}\/lib\/ArgEnv\/\n\1{Application}\/lib\/TCPIP\//' $@
$(SED) -i 's/\($(basename $@)\).exe/\1/' $@
$(SED) -i 's/\(Output:[ \t]\+\)ShowConstructors/\1NoConsole/' $@
$(SED) -i 's/\(HeapSize:[ \t]\+\)2097152/\120971520/' $@
$(SED) -i 's/\(HeapSize:[ \t]\+\)2097152/\141943040/' $@
$(DB): builddb
./builddb > $(DB)
......
......@@ -10,7 +10,7 @@ from Data.Maybe import ::Maybe
from GenEq import generic gEq
// CleanTypeUnifier
from Type import ::Type, ::TypeVar, ::TVAssignment, class print(..)
from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..)
:: TypeDB
instance zero TypeDB
......@@ -33,13 +33,17 @@ instance print TE_Priority
:: FunctionName :== String
:: Class :== String
getType :: FunctionLocation TypeDB -> Maybe ExtendedType
putType :: FunctionLocation ExtendedType TypeDB -> TypeDB
putTypes :: [(FunctionLocation, ExtendedType)] TypeDB -> TypeDB
findType :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
findType` :: (FunctionLocation ExtendedType -> Bool) TypeDB
:: TypeLocation = TL Library Module TypeName
:: TypeName :== String
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)]
findType`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
findFunction`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
-> [(FunctionLocation, ExtendedType)]
getInstances :: Class TypeDB -> [Type]
......@@ -59,6 +63,12 @@ findClassMembers` :: (ClassLocation [TypeVar] FunctionName ExtendedType -> Bool)
findClassMembers`` :: [ClassLocation [TypeVar] FunctionName ExtendedType -> Bool]
TypeDB -> [(ClassLocation, [TypeVar], 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)]
searchExact :: Type TypeDB -> [(FunctionLocation, ExtendedType)]
searchUnifiable :: Type TypeDB
......@@ -67,4 +77,3 @@ searchUnifiable :: Type TypeDB
newDb :: TypeDB
openDb :: *File -> *(Maybe TypeDB, *File)
saveDb :: TypeDB *File -> *File
......@@ -11,23 +11,28 @@ import Text.JSON
import Type
:: TypeDB = { functionmap :: Map FunctionLocation ExtendedType
, classmap :: Map ClassLocation ([TypeVar],[(FunctionName, ExtendedType)])
, classmap :: Map ClassLocation ([TypeVar],[(FunctionName, ExtendedType)])
, instancemap :: Map Class [Type]
, typemap :: Map TypeLocation TypeDef
}
(<+) infixr 5 :: a b -> [String] | print a & print b
(<+) a b = print a ++ print b
derive gEq ClassOrGeneric, FunctionLocation, ClassLocation, Type, TypeDB,
TypeExtras, TE_Priority, ExtendedType
TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation, TypeDefRhs,
RecordField, Constructor
derive JSONEncode ClassOrGeneric, FunctionLocation, ClassLocation, Type,
TypeDB, TypeExtras, TE_Priority, ExtendedType
TypeDB, TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation,
TypeDefRhs, RecordField, Constructor
derive JSONDecode ClassOrGeneric, FunctionLocation, ClassLocation, Type,
TypeDB, TypeExtras, TE_Priority, ExtendedType
TypeDB, TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation,
TypeDefRhs, RecordField, Constructor
instance zero TypeDB where zero = { functionmap = newMap
instance zero TypeDB where zero = { functionmap = newMap
, classmap = newMap
, instancemap = newMap
, typemap = newMap
}
instance < FunctionLocation where (<) (FL a b c) (FL d e f) = (a,b,c) < (d,e,f)
......@@ -36,31 +41,34 @@ where print (FL lib mod fn) = fn <+ " in " <+ mod <+ " in " <+ lib
instance < ClassLocation where (<) (CL a b c) (CL d e f) = (a,b,c) < (d,e,f)
instance < TypeLocation where (<) (TL a b c) (TL d e f) = (a,b,c) < (d,e,f)
instance print TE_Priority
where
print (LeftAssoc i) = "infixl " <+ i
print (RightAssoc i) = "infixr " <+ i
print (NoAssoc i) = "infix " <+ i
getType :: FunctionLocation TypeDB -> Maybe ExtendedType
getType loc {functionmap} = get loc functionmap
getFunction :: FunctionLocation TypeDB -> Maybe ExtendedType
getFunction loc {functionmap} = get loc functionmap
putType :: FunctionLocation ExtendedType TypeDB -> TypeDB
putType fl t tdb=:{functionmap} = { tdb & functionmap = put fl t functionmap }
putFunction :: FunctionLocation ExtendedType TypeDB -> TypeDB
putFunction fl t tdb=:{functionmap} = { tdb & functionmap = put fl t functionmap }
putTypes :: [(FunctionLocation, ExtendedType)] TypeDB -> TypeDB
putTypes ts tdb = foldr (\(loc,t) db -> putType loc t db) tdb ts
putFunctions :: [(FunctionLocation, ExtendedType)] TypeDB -> TypeDB
putFunctions ts tdb = foldr (\(loc,t) db -> putFunction loc t db) tdb ts
findType :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
findType f db=:{functionmap} = toList $ filterWithKey (\(FL _ _ f`) _->f==f`) functionmap
findFunction :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
findFunction f db=:{functionmap}
= toList $ filterWithKey (\(FL _ _ f`) _->f==f`) functionmap
findType` :: (FunctionLocation ExtendedType -> Bool) TypeDB
-> [(FunctionLocation, ExtendedType)]
findType` f {functionmap} = toList $ filterWithKey f functionmap
findFunction` :: (FunctionLocation ExtendedType -> Bool) TypeDB
-> [(FunctionLocation, ExtendedType)]
findFunction` f {functionmap} = toList $ filterWithKey f functionmap
findType`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
-> [(FunctionLocation, ExtendedType)]
findType`` fs {functionmap} = toList $ foldr filterWithKey functionmap fs
findFunction`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
-> [(FunctionLocation, ExtendedType)]
findFunction`` fs {functionmap} = toList $ foldr filterWithKey functionmap fs
getInstances :: Class TypeDB -> [Type]
getInstances c {instancemap} = if (isNothing ts) [] (fromJust ts)
......@@ -107,6 +115,23 @@ findClassMembers`` fs {classmap} = foldr (filter o app4) all_members fs
where
all_members = [(cl,vs,f,t) \\ (cl,(vs,fs)) <- toList classmap, (f,t) <- fs]
getType :: TypeLocation TypeDB -> Maybe TypeDef
getType loc {typemap} = get loc typemap
putType :: TypeLocation TypeDef TypeDB -> TypeDB
putType tl td db=:{typemap} = {db & typemap = put tl td typemap}
putTypes :: [(TypeLocation, TypeDef)] TypeDB -> TypeDB
putTypes ts db = foldr (\(loc,td) -> putType loc td) db ts
findType :: TypeName TypeDB -> [(TypeLocation, TypeDef)]
findType t db=:{typemap}
= toList $ filterWithKey (\(TL _ _ t`) _->t==t`) typemap
findType` :: (TypeLocation TypeDef -> Bool) TypeDB
-> [(TypeLocation, TypeDef)]
findType` f {typemap} = toList $ filterWithKey f typemap
searchExact :: Type TypeDB -> [(FunctionLocation, ExtendedType)]
searchExact t db = filter ((\(ET t` _)->t==t`) o snd) $ toList db.functionmap
......@@ -114,7 +139,7 @@ searchUnifiable :: Type TypeDB
-> [(FunctionLocation, ExtendedType, [TVAssignment], [TVAssignment])]
searchUnifiable t db = search` $ toList db.functionmap
where
search` :: [(FunctionLocation,ExtendedType)]
search` :: [(FunctionLocation,ExtendedType)]
-> [(FunctionLocation,ExtendedType,[TVAssignment],[TVAssignment])]
search` [] = []
search` [(l,ET t` tes):list]
......@@ -135,4 +160,3 @@ saveDb :: TypeDB *File -> *File
saveDb db f = fwrites (toString $ toJSON db) f
app4 f (a,b,c,d) :== f a b c d
......@@ -24,7 +24,7 @@ from hashtable import ::HashTable, ::QualifiedIdents(NoQualifiedIdents), ::Ident
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}, ::ParsedDefinition(PD_TypeSpec,PD_Instance,PD_Class), ::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType, ::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_types}, ::Type, ::ClassDef{class_ident,class_args}, ::TypeVar
from syntax import ::SymbolTable, ::SymbolTableEntry, ::Ident{..}, ::SymbolPtr, ::Position(NoPos), ::Module{mod_ident,mod_defs}, ::ParsedDefinition(PD_TypeSpec,PD_Instance,PD_Class,PD_Type), ::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType, ::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_types}, ::Type, ::ClassDef{class_ident,class_args}, ::TypeVar, ::ParsedTypeDef, ::TypeDef
from scanner import ::Priority(..), ::Assoc(..)
from parse import wantModule
......@@ -142,9 +142,10 @@ getModuleTypes root mod lib cache db w
| not ok = abort ("Couldn't close file " +++ filename +++ ".\n")
# mod = pm.mod_ident.id_name
# lib = cleanlib mod lib
# db = 'DB'.putTypes (pd_typespecs lib mod pm.mod_defs) db
# db = 'DB'.putFunctions (pd_typespecs lib mod pm.mod_defs) db
# db = 'DB'.putInstancess (pd_instances pm.mod_defs) db
# db = 'DB'.putClasses (pd_classes lib mod pm.mod_defs) db
# db = 'DB'.putTypes (pd_types lib mod pm.mod_defs) db
= (db,cache,w)
where
mkdir :: String -> String
......@@ -186,6 +187,11 @@ where
in ('DB'.CL lib mod id_name, map 'T'.toTypeVar class_args,
[(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)
\\ PD_Type ptd <- pds, td <- ['T'.toTypeDef ptd]]
unigroups :: (Type Type -> Bool) [(a,Type)] -> [([a],Type)]
unigroups f ts = unigroups` ts []
where
......
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