Verified Commit 48d6dc8b authored by Camil Staps's avatar Camil Staps 🙂

Update module hierarchy; remove DB,NGramIndex (-> Platform) and TypeTree (-> CleanTypes)

parent 00b4e563
[submodule "CleanTypeUnifier"]
path = CleanTypeUnifier
url = https://github.com/clean-cloogle/CleanTypeUnifier
[submodule "CleanTypes"]
path = CleanTypes
url = https://github.com/clean-cloogle/CleanTypes.git
[submodule "CleanPrettyPrint"]
path = CleanPrettyPrint
url = https://github.com/clean-cloogle/CleanPrettyPrint.git
[submodule "libcloogle"]
path = libcloogle
url = https://github.com/clean-cloogle/libcloogle
url = https://github.com/clean-cloogle/libcloogle.git
definition module Doc
definition module Clean.Doc
/**
* Parsing and storing Clean documentation
......@@ -10,7 +10,7 @@ from Data.Either import :: Either
from Data.GenDefault import generic gDefault
from Data.Maybe import :: Maybe
from TypeDef import :: Type
from Clean.Types import :: Type
/**
* A wrapper around the {{`String`}} type which makes sure that multi-line
......
implementation module Doc
implementation module Clean.Doc
import _SystemArray
import StdBool
......@@ -25,8 +25,8 @@ import qualified Text
import Text.Language
import Text.Parsers.Simple.ParserCombinators
from TypeDef import :: Type, :: TypeRestriction
import qualified TypeParse as T
from Clean.Types import :: Type, :: TypeRestriction
import qualified Clean.Types.Parse as T
gDefault{|Maybe|} _ = Nothing
......
definition module Idents
definition module Clean.Idents
from StdClass import class Eq
from StdList import isMember, removeDup
......
implementation module Idents
implementation module Clean.Idents
from Data.Func import $
from Data.List import concatMap
......
Subproject commit 37fe62dd59f1435a3fbfbfb97218ef40f6af3f8c
Subproject commit 2de872a93430eef1ae767596a2765bcc5120596e
Subproject commit e696b7feca939c4ee74acbe8c8edbedcd061e975
Subproject commit e4eda2f035b11f6786ff1f643bb1803d8421d643
definition module CloogleDB
definition module Cloogle.DB
from StdOverloaded import class ==, class <, class zero
from StdClass import class Ord
......@@ -6,25 +6,26 @@ from StdClass import class Ord
from Data.GenEq import generic gEq
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Data.NGramIndex import :: NGramIndex
from Database.Native import :: NativeDB, :: Entry, :: Index
from System.FilePath import :: FilePath
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Type import :: Type, :: TypeVar, :: TVAssignment, :: TypeDef,
:: TypeContext, :: TypeRestriction, :: Priority, class print(..)
from Clean.Types import :: Type, :: TypeVar, :: TVAssignment, :: TypeDef,
:: TypeContext, :: TypeRestriction, :: Priority
from Clean.Types.Tree import :: TypeTree
from Clean.Types.Util import class print(..)
from Cloogle import :: FunctionKind, :: SyntaxExample,
:: CleanLangReportLocation, :: ABCArgument
from Clean.Doc import :: FunctionDoc, :: TypeDoc, :: ClassDoc, :: ModuleDoc
from Doc import :: FunctionDoc, :: TypeDoc, :: ClassDoc, :: ModuleDoc
from DB import :: DB, :: Entry, :: Index
from NGramIndex import :: NGramIndex
from TypeTree import :: TypeTree
from Cloogle.API import :: FunctionKind, :: SyntaxExample,
:: CleanLangReportLocation, :: ABCArgument
/**
* A storage for function types, class definitions, type definitions, etc.
*/
:: *CloogleDB =
{ db :: !*DB CloogleEntry AnnotationKey Int //* Core data
{ db :: !*NativeDB CloogleEntry AnnotationKey Int //* Core data
, name_ngrams :: !NGramIndex Index //* Name ngrams
, name_map :: !Map Name [Index] //* For exact name search
, types :: !TypeTree Index //* Types, map to FunctionEntries
......
implementation module CloogleDB
implementation module Cloogle.DB
// Standard libraries
import StdArray
......@@ -26,24 +26,25 @@ from Data.Map import :: Map(..), elems, filterWithKey, foldrNoKey,
foldrWithKey, fromList, get, mapSize, alter, mapWithKey, newMap, put,
toAscList, toList, instance Functor (Map k)
import Data.Maybe
import Data.NGramIndex
import qualified Data.NGramIndex as NGrams
import Data.Tuple
from Database.Native import :: NativeDB, :: Index, :: Entry{..},
:: SearchMode(..), instance == Index, instance < Index
import qualified Database.Native as DB
import Database.Native.JSON
import System.File
import System.FilePath
from Text import class Text(concat), instance Text String
import Text.GenJSON
// CleanTypeUnifier
import Type
import Clean.Types
import Clean.Types.Tree
import Clean.Types.Util
import Cloogle
import Clean.Doc
from DB import :: DB, :: Index, :: Entry{..}, :: SearchMode(..),
instance == Index, instance < Index
import qualified DB
import Doc
import NGramIndex
import qualified NGramIndex as NGrams
import TypeTree
import Cloogle.API
JSONEncode{|()|} _ () = [JSONNull]
JSONDecode{|()|} _ [JSONNull:xs] = (Just (), xs)
......@@ -63,13 +64,13 @@ derive JSONEncode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
SyntaxEntry, Type, TypeDef, TypeDefEntry, TypeDefRhs, TypeDoc,
TypeRestriction, ABCInstructionEntry, Property, PropertyVarInstantiation,
MultiLineString
MultiLineString, NGramIndex
derive JSONDecode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry,
InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
SyntaxEntry, Type, TypeDef, TypeDefEntry, TypeDefRhs, TypeDoc,
TypeRestriction, ABCInstructionEntry, Property, PropertyVarInstantiation,
MultiLineString
MultiLineString, NGramIndex
printersperse :: Bool a [b] -> [String] | print a & print b
printersperse ia a bs = intercalate (print False a) (map (print ia) bs)
......
definition module CloogleDBFactory
definition module Cloogle.DB.Factory
/**
* Functions to populate a database using the Clean compiler frontend
......@@ -6,7 +6,7 @@ definition module CloogleDBFactory
from Data.Set import :: Set
import CloogleDB
import Cloogle.DB
:: TemporaryDB
......
implementation module CloogleDBFactory
implementation module Cloogle.DB.Factory
import StdArray
import StdBool
......@@ -22,15 +22,17 @@ import Data.List
from Data.Map import :: Map
import qualified Data.Map as M
import Data.Maybe
from Data.NGramIndex import :: NGramIndex, newNGramIndex, index
import qualified Data.Set as S
import Data.Tuple
from Database.Native import :: NativeDB, :: Index(..), newDB,
instance == Index, instance < Index
import qualified Database.Native as DB
import System.Directory
import System.FilePath
from Text import class Text(concat,indexOf,replaceSubString,startsWith),
instance Text String, <+
import CleanPrettyPrint
from compile import :: DclCache{hash_table}, empty_cache
from hashtable import :: BoxedIdent{boxed_ident}, :: HashTable{hte_symbol_heap},
:: IdentClass(IC_Module), :: QualifiedIdents(NoQualifiedIdents),
......@@ -59,18 +61,31 @@ from syntax import :: ClassDef{class_args,class_context,class_ident,class_pos},
:: ParsedImport, :: Import{import_module},
:: DocType, :: OptionalDoc
import CoclUtils
import qualified Type as T
from Type import instance == Type,
class print(print), instance print Type, instance print Priority
from TypeUnify import isomorphic_to
from Cloogle import :: FunctionKind(..)
from DB import :: DB, :: Index(..), newDB, instance == Index, instance < Index
import qualified DB
import qualified CloogleDB as CDB
from NGramIndex import :: NGramIndex, newNGramIndex, index
from TypeTree import :: TypeTree, instance zero (TypeTree v), addType
from CloogleDB import
import Clean.PrettyPrint
from Clean.Types import instance == Type
import qualified Clean.Types as T
from Clean.Types.Tree import :: TypeTree, instance zero (TypeTree v), addType
from Clean.Types.Unify import isomorphic_to
import qualified Clean.Types.Unify as TU
from Clean.Types.Util import class print(print), instance print Type,
instance print Priority
import Clean.Types.CoclTransform
from Clean.Doc import :: ModuleDoc, :: FunctionDoc{vars,description}, :: ClassDoc,
:: TypeDoc{..}, :: ConstructorDoc, :: ClassMemberDoc, :: Description,
:: ParseWarning(UsedReturn,IllegalField), :: ParseError,
generic docBlockToDoc, parseDoc, parseSingleLineDoc, :: DocBlock,
class docType(..), instance docType FunctionDoc,
class docConstructors(..), instance docConstructors TypeDoc,
class docFields(..), instance docFields TypeDoc,
traceParseError, traceParseWarnings,
constructorToFunctionDoc, functionToClassMemberDoc, addClassMemberDoc
import Clean.Idents
from Cloogle.API import :: FunctionKind(..), instance == FunctionKind
import qualified Cloogle.DB as CDB
from Cloogle.DB import
:: CloogleDB{..}, :: AnnotationKey,
:: Library,
:: Location(Builtin,NoLocation),
......@@ -89,17 +104,6 @@ from CloogleDB import
class getLocation, instance getLocation CloogleEntry,
instance == Location,
location
from Cloogle import instance == FunctionKind
from Doc import :: ModuleDoc, :: FunctionDoc{vars,description}, :: ClassDoc,
:: TypeDoc{..}, :: ConstructorDoc, :: ClassMemberDoc, :: Description,
:: ParseWarning(UsedReturn,IllegalField), :: ParseError,
generic docBlockToDoc, parseDoc, parseSingleLineDoc, :: DocBlock,
class docType(..), instance docType FunctionDoc,
class docConstructors(..), instance docConstructors TypeDoc,
class docFields(..), instance docFields TypeDoc,
traceParseError, traceParseWarnings,
constructorToFunctionDoc, functionToClassMemberDoc, addClassMemberDoc
import Idents
:: TemporaryDB
= { temp_functions :: ![[('CDB'.FunctionEntry, 'S'.Set String)]]
......@@ -169,7 +173,7 @@ finaliseDB extra tdb =
Just is -> Just [i:is]) 'M'.newMap
[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
, types = foldr (uncurry addType) zero
[(snd $ 'T'.prepare_unification False alwaysUnique synonymmap $ 'T'.removeTypeContexts t,i)
[(snd $ 'TU'.prepare_unification False alwaysUnique synonymmap $ 'T'.removeTypeContexts t,i)
\\ (i,FunctionEntry fe) <- entridxs, Just t <- [fe.fe_type <|> (docType =<< fe.fe_documentation)]]
, core = coreidxs
, apps = appidxs
......
definition module Search
definition module Cloogle.Search
/**
* Search functions for the Cloogle system
*/
from Cloogle import :: Request, :: Result
from CloogleDB import :: CloogleDB, :: AnnotationKey, :: CloogleEntry
from DB import :: DB
from Database.Native import :: NativeDB
from Cloogle.API import :: Request, :: Result
from Cloogle.DB import :: CloogleDB, :: AnnotationKey, :: CloogleEntry
/**
* Cloogle setting: whether to include language builtins if the Request has
......
implementation module Search
implementation module Cloogle.Search
import StdArray
import StdBool
......@@ -17,14 +17,19 @@ import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Tuple
from Database.Native import :: Entry{value}
from Text import class Text(concat,indexOf,toLowerCase,split),
instance Text String, instance + String
from DB import :: Entry{value}
import CloogleDB
import Type
import Cloogle
import Doc
import Clean.Types
import Clean.Types.Parse
import Clean.Types.Unify
import Clean.Types.Util
import Clean.Doc
import Cloogle.API
import Cloogle.DB
:: SearchStrategy
= SSIdentity
......
definition module DB
from StdOverloaded import class ==, class <
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
/**
* A database. Entries can be soft deleted. Entries are indexed with integers
* which can be difficult to work with but at least provide constant time
* access.
* Annotations are not designed to be persistent. If you need to add persistent
* data to the database use a map over values.
*
* @var The type of values stored.
* @var The key type of annotations.
* @var The type of annotations.
*/
:: *DB v ak a
:: Index =: Index Int
:: Entry v ak a =
{ value :: !v
, included :: !Bool
, annotations :: !Map ak a
}
derive JSONEncode Index
derive JSONDecode Index
instance == Index
instance < Index
/**
* Two search modes are available.
*/
:: SearchMode
= Intersect //* Only consider included entries (i.e., an AND with previous searches)
| AddExcluded //* Re-include matching entries but don't remove non-matching entries (i.e., an OR with previous searches)
/**
* Create a new database from a list of entries.
*/
newDB :: ![v] -> *DB v ak a
/**
* Save the database to a file.
*/
saveDB :: !*(DB v ak a) !*File -> *(!*DB v ak a, !*File) | JSONEncode{|*|} v
/**
* Open a database from a file.
*/
openDB :: !*File -> *(!Maybe (*DB v ak a), !*File) | JSONDecode{|*|} v
/**
* Reset all entries to included.
*/
resetDB :: !*(DB v ak a) -> *DB v ak a
/**
* Return all entries (whether they have been excluded or not).
*/
allEntries :: !*(DB v ak a) -> *(![v], !*DB v ak a)
/**
* Get all entries that are still included, and their annotations.
*/
getEntries :: !*(DB v ak a) -> *(![(v, Map ak a)], !*DB v ak a)
/**
* An in-place map over all entries (also the excluded ones).
*/
mapInPlace :: !(Int v -> v) !*(DB v ak a) -> *(DB v ak a)
/**
* Linear search for entries. The search function returns whether the entry
* should be included and which annotations should be added (if any). Excluded
* entries are ignored.
*/
search :: !SearchMode !(v -> (Bool, [(ak, a)])) !*(DB v ak a) -> *DB v ak a | ==, < ak
/**
* Like {{`search`}}, but search for specific indices.
*/
searchIndices :: !SearchMode ![(!Index, ![(!ak, !a)])] !*(DB v ak a) -> *DB v ak a | ==, < ak
/**
* Exclude a list of indices.
*/
unsearchIndices :: ![Index] !*(DB v ak a) -> *DB v ak a
/**
* Like {{`searchIndices`}}, but also check on some property.
* This search always uses the {{`AddExcluded`}} {{`SearchMode`}}.
*/
searchWithIndices :: !(v -> (Bool, ![(!ak, !a)])) ![Index] !*(DB v ak a) -> *DB v ak a | ==, < ak
/**
* Get an entry and its annotations.
* Also see {{`getIndices`}}.
*/
getIndex :: !Index !*(DB v ak a) -> *(!Entry v ak a, !*(DB v ak a))
/**
* Like {{`getIndex`}}, but for a list of indices.
*/
getIndices :: ![Index] !*(DB v ak a) -> *(![Entry v ak a], !*(DB v ak a))
implementation module DB
import StdArray
import StdBool
import StdFile
import StdInt
import StdString
import StdTuple
from Data.Func import $, hyperstrict
import Data.Functor
import Data.Map
import Data.Maybe
import Text.GenJSON
:: *DB v ak a = DB *{!Entry v ak a}
JSONEncode{|Index|} _ (Index i) = [JSONInt i]
JSONDecode{|Index|} _ [JSONInt i:l] = (Just (Index i), l)
JSONDecode{|Index|} _ l = (Nothing, l)
instance == Index where == (Index a) (Index b) = a == b
instance < Index where < (Index a) (Index b) = a < b
newDB :: ![v] -> *DB v ak a
newDB vs = DB {{value=hyperstrict v,included=True,annotations=newMap} \\ v <- vs}
saveDB :: !*(DB v ak a) !*File -> *(!*DB v ak a, !*File) | JSONEncode{|*|} v
saveDB (DB db) f
# (s,db) = usize db
# f = f <<< toString s <<< "\n"
# (db,f) = loop 0 (s-1) db f
= (DB db, f)
where
loop :: !Int !Int !*{!Entry v ak a} !*File -> *(*{!Entry v ak a}, !*File) | JSONEncode{|*|} v
loop i s es f
| i > s = (es,f)
# (e,es) = es![i]
# f = f <<< toJSON e.value <<< '\n'
= loop (i+1) s es f
openDB :: !*File -> *(!Maybe (*DB v ak a), !*File) | JSONDecode{|*|} v
openDB f
# (line,f) = freadline f
# n = toInt (line % (0, size line - 2))
# (es,f) = loop n f
= case es of
Nothing -> (Nothing, f)
Just es -> (Just $ newDB es, f)
where
loop :: !Int !*File -> *(Maybe [v], !*File) | JSONDecode{|*|} v
loop 0 f = (Just [], f)
loop n f
# (end,f) = fend f
| end = (Nothing, f)
# (line,f) = freadline f
= case fromJSON $ fromString line of
Nothing -> (Nothing, f)
Just e -> case loop (n-1) f of
(Nothing, f) -> (Nothing, f)
(Just es, f) -> (Just [e:es], f)
resetDB :: !*(DB v ak a) -> *DB v ak a
resetDB (DB db)
# (s,db) = usize db
# db = upd (s-1) db
= DB db
where
upd :: !Int !*{!Entry v ak a} -> *{!Entry v ak a}
upd -1 es = es
upd i es
# (e,es) = es![i]
= upd (i-1) {es & [i]={e & included=True}}
allEntries :: !*(DB v ak a) -> *(![v], !*DB v ak a)
allEntries (DB db)
# (s,db) = usize db
# (es,db) = collect (s-1) db
= (es, DB db)
where
collect :: !Int !*{!Entry v ak a} -> *(![v], !*{!Entry v ak a})
collect -1 es = ([], es)
collect i es
# (e,es) = es![i]
# (r,es) = collect (i-1) es
= ([e.value:r], es)
getEntries :: !*(DB v ak a) -> *(![(v, Map ak a)], !*DB v ak a)
getEntries (DB db)
# (s,db) = usize db
# (es,db) = collect (s-1) db
= (es,DB db)
where
collect :: !Int !*{!Entry v ak a} -> *(![(v, Map ak a)], !*{!Entry v ak a})
collect -1 es = ([], es)
collect i es
# (e,es) = es![i]
# (r,es) = collect (i-1) es
= (if e.included [(e.value,e.annotations):r] r, es)
mapInPlace :: !(Int v -> v) !*(DB v ak a) -> *(DB v ak a)
mapInPlace f (DB db)
# (s,db) = usize db
= DB (upd 0 s db)
where
//upd :: !Int !Int !*{!Entry v ak a} -> *{!Entry v ak a}
upd i s es
| i == s = es
#! (e,es) = es![i]
#! e & value = hyperstrict $ f i e.value
= upd (i+1) s {es & [i]=e}
search :: !SearchMode !(v -> (Bool, [(ak, a)])) !*(DB v ak a) -> *DB v ak a | ==, < ak
search mode f (DB db)
# (s,db) = usize db
= DB (upd (s - 1) db)
where
//upd :: (!Int !*{!Entry v ak a} -> *{!Entry v ak a}) | ==, < ak
upd = case mode of
Intersect -> intersect
AddExcluded -> addExcluded
intersect -1 es = es
intersect i es
# (e,es) = es![i]
| not e.included = intersect (i-1) es
# (include,annotations) = f e.value
= intersect (i-1) {es & [i]=
{ e
& included=include
, annotations=foldr (uncurry put) e.annotations annotations
}}
addExcluded -1 es = es
addExcluded i es
# (e,es) = es![i]
# (include,annotations) = f e.value
= addExcluded (i-1) {es & [i]=
{ e
& included=e.included || include
, annotations=foldr (uncurry put) e.annotations annotations
}}
searchIndices :: !SearchMode ![(!Index, ![(!ak, !a)])] !*(DB v ak a) -> *DB v ak a | ==, < ak
searchIndices mode idxs (DB db)
# (s,db) = usize db
# db = upd 0 (s-1) idxs db
= (DB db)
where
upd :: !Int !Int ![(!Index, ![(!ak, !a)])] !*{!Entry v ak a} -> *{!Entry v ak a} | ==, < ak
upd i s _ es
| i > s = es
upd i s [] es
| mode=:AddExcluded = es
# (e,es) = es![i]
= upd (i+1) s [] {es & [i]={e & included=False}}
upd i s allidxs=:[match=:(Index idx,annots):idxs] es
# (e,es) = es![i]
# e & included = case mode of
Intersect -> e.included && match
AddExcluded -> e.included || match
# e & annotations = if e.included (foldr (uncurry put) e.annotations annots) e.annotations
= upd (i+1) s (if match idxs allidxs) {es & [i]=e}
where
match = i == idx
unsearchIndices :: ![Index] !*(DB v ak a) -> *DB v ak a
unsearchIndices idxs (DB db)
# db = upd idxs db
= (DB db)
where
upd :: ![Index] !*{!Entry v ak a} -> *{!Entry v ak a}
upd [] es = es
upd [Index i:is] es
# (e,es) = es![i]
= upd is {es & [i].included=False}
searchWithIndices :: !(v -> (Bool, ![(!ak, !a)])) ![Index] !*(DB v ak a) -> *DB v ak a | ==, < ak
searchWithIndices prop idxs (DB db)
# db = upd idxs db
= (DB db)
where
upd [] es = es
upd [Index i:is] es
# (e,es) = es![i]
# e = case prop e.value of
(False, _) -> {e & included=False}
(True, annots) -> {e & included=True, annotations=foldr (uncurry put) e.annotations annots}
= upd is {es & [i]=e}
getIndex :: !Index !*(DB v ak a) -> *(!Entry v ak a, !*(DB v ak a))
getIndex (Index n) (DB db)
# (e,db) = db![n]
= (e, DB db)
getIndices :: ![Index] !*(DB v ak a) -> *(![Entry v ak a], !*(DB v ak a))
getIndices is (DB db)
# (es,db) = get is db
= (es, DB db)
where
get :: ![Index] !*{!Entry v ak a} -> *(![Entry v ak a], !*{!Entry v ak a})
get [] db = ([], db)
get [Index i:is] db
# (e,db) = db![i]