Verified Commit f775c7f5 authored by Camil Staps's avatar Camil Staps
Browse files

Remove stuff that is now in the Cloogle repository

parent ae384de3
[submodule "CleanTypeUnifier"]
path = backend/CleanTypeUnifier
url = https://github.com/clean-cloogle/CleanTypeUnifier
[submodule "backend/CleanPrettyPrint"]
path = backend/CleanPrettyPrint
url = https://github.com/clean-cloogle/CleanPrettyPrint.git
[submodule "backend/clean-platform"]
path = backend/clean-platform
url = https://gitlab.science.ru.nl/clean-and-itasks/clean-platform.git
[submodule "backend/Cloogle"]
path = backend/Cloogle
url = https://github.com/clean-cloogle/Cloogle
definition module Cache
from StdOverloaded import class toString
from Data.Maybe import :: Maybe
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
:: CacheType = Brief | LongTerm
:: CacheKey :== String
cacheKey :: (a -> CacheKey) | toString a
// Check if for the hash of the argument a JSON file exists of type b
readCache :: !a *World -> (Maybe b, !*World) | toString a & JSONDecode{|*|} b
// Write for the hash of a a JSON file of type b
writeCache :: CacheType !a !b -> *World -> *World | toString a & JSONEncode{|*|} b
implementation module Cache
import StdFunc
import StdTuple
from Data.Func import $
import Control.Monad
import Control.Applicative
import Data.Functor
import Crypto.Hash.MD5
import Text.JSON
import Data.Error
import StdFile
import System.FilePath
import System.File
import Data.Tuple
cache_types :== [Brief, LongTerm]
cache_dir :: CacheType -> FilePath
cache_dir LongTerm = "./cache/lt"
cache_dir Brief = "./cache/brief"
cacheKey :: (a -> CacheKey) | toString a
cacheKey = md5 o toString
toCacheFile :: CacheType -> a -> FilePath | toString a
toCacheFile t = (</>) (cache_dir t) o cacheKey
readCache :: !a *World -> (Maybe b, !*World) | toString a & JSONDecode{|*|} b
readCache k w
# (files,w) = seqList [appFst error2mb o readFile (toCacheFile t k) \\ t <- cache_types] w
= (join $ fromJSON <$> fromString <$> foldl (<|>) empty files, w)
writeCache :: CacheType !a !b -> *World -> *World | toString a & JSONEncode{|*|} b
writeCache t k v = snd o writeFile (toCacheFile t k) (toString $ toJSON v)
Subproject commit 833846d37ef22b9c24f9bf4d6adb80ccf6979581
Subproject commit 1afa69c23f7dbe2c9646ddf7daa667d1a2f8c38c
Subproject commit 84f36d1d1f43ab94233cb631a07c1407e4c13922
definition module Cloogle
from StdOverloaded import class zero, class fromString, class toString, class <
from Data.Maybe import :: Maybe
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
:: Request
= { unify :: Maybe String
, name :: Maybe String
, className :: Maybe String
, typeName :: Maybe String
, modules :: Maybe [String]
, libraries :: Maybe [String]
, include_builtins :: Maybe Bool
, include_core :: Maybe Bool
, page :: Maybe Int
}
:: Response
= { return :: Int
, data :: [Result]
, msg :: String
, more_available :: Maybe Int
, suggestions :: Maybe [(Request, Int)]
}
:: Result
= FunctionResult FunctionResult
| TypeResult TypeResult
| ClassResult ClassResult
| MacroResult MacroResult
| ModuleResult ModuleResult
:: BasicResult
= { library :: String
, filename :: String
, modul :: String
, dcl_line :: Maybe Int
, icl_line :: Maybe Int
, distance :: Int
, builtin :: Maybe Bool
}
:: FunctionResult :== (BasicResult, FunctionResultExtras)
:: FunctionResultExtras
= { func :: String
, unifier :: Maybe StrUnifier
, cls :: Maybe ShortClassResult
, constructor_of :: Maybe String
, recordfield_of :: Maybe String
, generic_derivations :: Maybe [(String, [LocationResult])]
}
:: TypeResult :== (BasicResult, TypeResultExtras)
:: TypeResultExtras
= { type :: String
, type_instances :: [(String, [String], [LocationResult])]
, type_derivations :: [(String, [LocationResult])]
}
:: ClassResult :== (BasicResult, ClassResultExtras)
:: ClassResultExtras
= { class_name :: String
, class_heading :: String
, class_funs :: [String]
, class_instances :: [([String], [LocationResult])]
}
:: MacroResult :== (BasicResult, MacroResultExtras)
:: MacroResultExtras
= { macro_name :: String
, macro_representation :: String
}
:: ModuleResult :== (BasicResult, ModuleResultExtras)
:: ModuleResultExtras
= { module_is_core :: Bool
}
:: LocationResult :== (String, String, Maybe Int, Maybe Int)
:: StrUnifier
= { left_to_right :: [(String,String)]
, right_to_left :: [(String,String)]
, used_synonyms :: [(String,String)]
}
:: ShortClassResult = { cls_name :: String, cls_vars :: [String] }
derive JSONEncode Request, Response, Result, ShortClassResult, BasicResult,
FunctionResultExtras, TypeResultExtras, ClassResultExtras,
MacroResultExtras, ModuleResultExtras, StrUnifier
derive JSONDecode Request, Response, Result, ShortClassResult, BasicResult,
FunctionResultExtras, TypeResultExtras, ClassResultExtras,
MacroResultExtras, ModuleResultExtras, StrUnifier
instance zero Request
instance zero Response
instance toString Request
instance toString Response
instance fromString (Maybe Request)
instance < BasicResult
instance < Result
CLOOGLE_E_NORESULTS :== 127
CLOOGLE_E_INVALIDINPUT :== 128
CLOOGLE_E_INVALIDNAME :== 129
CLOOGLE_E_INVALIDTYPE :== 130
err :: Int String -> Response
implementation module Cloogle
from Data.Func import $
import Text
import Text.JSON
derive JSONEncode Request, Response, Result, ShortClassResult, BasicResult,
FunctionResultExtras, TypeResultExtras, ClassResultExtras,
MacroResultExtras, ModuleResultExtras, StrUnifier
derive JSONDecode Request, Response, Result, ShortClassResult, BasicResult,
FunctionResultExtras, TypeResultExtras, ClassResultExtras,
MacroResultExtras, ModuleResultExtras, StrUnifier
instance zero Request
where
zero = { unify = Nothing
, name = Nothing
, className = Nothing
, typeName = Nothing
, modules = Nothing
, libraries = Nothing
, include_builtins = Nothing
, include_core = Nothing
, page = Nothing
}
instance zero Response
where
zero = { return = 0
, msg = "Success"
, data = []
, more_available = Nothing
, suggestions = Nothing
}
instance toString Request where toString r = toString $ toJSON r
instance toString Response where toString r = toString (toJSON r) + "\n"
instance fromString (Maybe Request) where fromString s = fromJSON $ fromString s
instance < BasicResult where (<) r1 r2 = r1.distance < r2.distance
instance < Result
where
(<) r1 r2 = basic r1 < basic r2
where
basic :: Result -> BasicResult
basic (FunctionResult (br,_)) = br
basic (TypeResult (br,_)) = br
basic (ClassResult (br,_)) = br
basic (MacroResult (br,_)) = br
basic (ModuleResult (br,_)) = br
err :: Int String -> Response
err c m = { return = c
, data = []
, msg = m
, more_available = Nothing
, suggestions = Nothing
}
......@@ -7,13 +7,14 @@ CLMFLAGS:=-dynamics -h 200M -nr -nt\
-I $$CLEAN_HOME/lib/Dynamics\
-I $$CLEAN_HOME/lib/Generics\
-I $$CLEAN_HOME/lib/TCPIP\
-I clean-platform/src/libraries/OS-Independent\
-I clean-platform/src/libraries/OS-Independent/Deprecated/StdLib\
-I clean-platform/src/libraries/OS-Linux-64\
-I clean-platform/src/libraries/OS-Linux\
-I clean-platform/src/libraries/OS-Posix\
-I CleanTypeUnifier\
-I CleanPrettyPrint\
-I Cloogle\
-I Cloogle/clean-platform/src/libraries/OS-Independent\
-I Cloogle/clean-platform/src/libraries/OS-Independent/Deprecated/StdLib\
-I Cloogle/clean-platform/src/libraries/OS-Linux-64\
-I Cloogle/clean-platform/src/libraries/OS-Linux\
-I Cloogle/clean-platform/src/libraries/OS-Posix\
-I Cloogle/CleanTypeUnifier\
-I Cloogle/CleanPrettyPrint\
-I clean-compiler/frontend\
-I clean-compiler/backend\
-I clean-compiler/main\
......
definition module TypeDB
// Standard libraries
from StdOverloaded import class <, class zero
from StdClass import class Ord
from Data.Map import ::Map
from Data.Maybe import ::Maybe
from GenEq import generic gEq
// CleanTypeUnifier
from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
::ClassContext, ::ClassRestriction, ::ClassOrGeneric, ::Priority
:: TypeDB
:: TypeExtras = { te_priority :: Maybe Priority
, te_isconstructor :: Bool
, te_isrecordfield :: Bool
, te_generic_vars :: Maybe [TypeVar]
, te_representation :: Maybe String
}
:: ExtendedType = ET Type TypeExtras
:: Macro = { macro_as_string :: String
, macro_extras :: TypeExtras
}
:: Location = Location Library Module LineNr LineNr Name
| Builtin Name
:: ModuleInfo = { is_core :: Bool }
:: Name :== String
:: Library :== String
:: Module :== String
:: Class :== String
:: LineNr :== Maybe Int
instance zero TypeDB
instance zero TypeExtras
instance zero ModuleInfo
instance print (Name, ExtendedType)
getName :: Location -> Name
isBuiltin :: Location -> Bool
functionCount :: TypeDB -> Int
macroCount :: TypeDB -> Int
classCount :: TypeDB -> Int
instanceCount :: TypeDB -> Int
typeCount :: TypeDB -> Int
deriveCount :: TypeDB -> Int
moduleCount :: TypeDB -> Int
filterLocations :: (Location -> Bool) TypeDB -> TypeDB
getFunction :: Location TypeDB -> Maybe ExtendedType
putFunction :: Location ExtendedType TypeDB -> TypeDB
putFunctions :: [(Location, ExtendedType)] TypeDB -> TypeDB
findFunction :: Name TypeDB -> [(Location, ExtendedType)]
findFunction` :: (Location ExtendedType -> Bool) TypeDB
-> [(Location, ExtendedType)]
findFunction`` :: [(Location ExtendedType -> Bool)] TypeDB
-> [(Location, ExtendedType)]
getMacro :: Location TypeDB -> Maybe Macro
putMacro :: Location Macro TypeDB -> TypeDB
putMacros :: [(Location, Macro)] TypeDB -> TypeDB
findMacro` :: (Location Macro -> Bool) TypeDB -> [(Location, Macro)]
findMacro`` :: [(Location Macro -> Bool)] TypeDB -> [(Location, Macro)]
getInstances :: Class TypeDB -> [([(Type,String)], [Location])]
putInstance :: Class [(Type,String)] Location TypeDB -> TypeDB
putInstances :: [(Class, [(Type,String)], Location)] TypeDB -> TypeDB
getClass :: Location TypeDB -> Maybe ([TypeVar],ClassContext,[(Name,ExtendedType)])
putClass :: Location [TypeVar] ClassContext [(Name,ExtendedType)] TypeDB -> TypeDB
putClasses :: [(Location, [TypeVar], ClassContext, [(Name,ExtendedType)])] TypeDB -> TypeDB
findClass :: Class TypeDB -> [(Location, [TypeVar], ClassContext, [(Name, ExtendedType)])]
findClass` :: (Location [TypeVar] ClassContext [(Name,ExtendedType)] -> Bool) TypeDB
-> [(Location, [TypeVar], ClassContext, [(Name, ExtendedType)])]
findClass`` :: [(Location [TypeVar] ClassContext [(Name,ExtendedType)] -> Bool)] TypeDB
-> [(Location, [TypeVar], ClassContext, [(Name, ExtendedType)])]
findClassMembers` :: (Location [TypeVar] ClassContext Name ExtendedType -> Bool) TypeDB
-> [(Location, [TypeVar], ClassContext, Name, ExtendedType)]
findClassMembers`` :: [Location [TypeVar] ClassContext Name ExtendedType -> Bool]
TypeDB -> [(Location, [TypeVar], ClassContext, Name, ExtendedType)]
getType :: Location TypeDB -> Maybe TypeDef
putType :: Location TypeDef TypeDB -> TypeDB
putTypes :: [(Location, TypeDef)] TypeDB -> TypeDB
findType :: Name TypeDB -> [(Location, TypeDef)]
findType` :: (Location TypeDef -> Bool) TypeDB -> [(Location, TypeDef)]
findType`` :: [(Location TypeDef -> Bool)] TypeDB -> [(Location, TypeDef)]
allTypes :: (TypeDB -> [TypeDef])
getDerivations :: Name TypeDB -> [(Type, String, [Location])]
putDerivation :: Name Type String Location TypeDB -> TypeDB
putDerivations :: Name [(Type, String, Location)] TypeDB -> TypeDB
putDerivationss :: [(Name, [(Type, String, Location)])] TypeDB -> TypeDB
getModule :: Library Module TypeDB -> Maybe ModuleInfo
putModule :: Library Module ModuleInfo TypeDB -> TypeDB
findModule` :: (Library Module ModuleInfo -> Bool) TypeDB -> [(Library, Module, ModuleInfo)]
searchExact :: Type TypeDB -> [(Location, ExtendedType)]
getTypeInstances :: Name TypeDB -> [(Class, [(Type,String)], [Location])]
getTypeDerivations :: Name TypeDB -> [(Name, [Location])]
newDb :: TypeDB
openDb :: *File -> *(Maybe TypeDB, *File)
saveDb :: !TypeDB !*File -> *File
implementation module TypeDB
// Standard libraries
from StdFunc import o, const
import StdBool, StdFile, StdList, StdMisc, StdOrdList, StdOverloaded, StdTuple
import Control.Applicative
import Control.Monad
from Data.Func import $
import Data.Functor
from Data.List import intercalate, groupBy
import Data.Map
import Data.Maybe
from Text import class Text(concat), instance Text String
import Text.JSON
import GenLexOrd
// CleanTypeUnifier
import Type
:: TypeDB
= { // Base maps
functionmap :: Map Location ExtendedType
, macromap :: Map Location Macro
, classmap :: Map Location ([TypeVar],ClassContext,[(Name, ExtendedType)])
, instancemap :: Map Class [([(Type,String)], [Location])]
, typemap :: Map Location TypeDef
, derivemap :: Map Name [(Type, String, [Location])]
, modulemap :: Map (Library, Module) ModuleInfo
// Derived maps
, instancemap` :: Map Name [(Class, [(Type,String)], [Location])]
, derivemap` :: Map Name [(Name, [Location])]
}
printersperse :: Bool a [b] -> [String] | print a & print b
printersperse ia a bs = intercalate (print False a) (map (print ia) bs)
(--) infixr 5 :: a b -> [String] | print a & print b
(--) a b = print False a ++ print False b
derive gEq ClassOrGeneric, Location, Type, TypeExtras, Priority,
ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor, Kind, Macro
derive JSONEncode ClassOrGeneric, Location, Type, TypeDB, TypeExtras,
Priority, ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor,
Kind, Macro, ModuleInfo
derive JSONDecode ClassOrGeneric, Location, Type, TypeDB, TypeExtras,
Priority, ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor,
Kind, Macro, ModuleInfo
instance zero TypeDB
where
zero = { functionmap = newMap
, macromap = newMap
, classmap = newMap
, instancemap = newMap
, typemap = newMap
, derivemap = newMap
, modulemap = newMap
, instancemap` = newMap
, derivemap` = newMap
}
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) | gLexOrd{|*|} a & gLexOrd{|*|} b & gLexOrd{|*|} c & gLexOrd{|*|} d
where (<) a b = (a =?= b) === LT
instance == Location
where
(==) a b = gEq{|*|} a b
instance zero TypeExtras
where
zero = { te_priority = Nothing
, te_isconstructor = False
, te_isrecordfield = False
, te_generic_vars = Nothing
, te_representation = Nothing
}
instance zero ModuleInfo where zero = {is_core = False}
instance print TypeExtras
where
print b {te_priority=Just p} = print b p -- " "
print b {te_generic_vars=Just vars} = printersperse b " " vars -- " "
print _ _ = []
instance print (Name, ExtendedType)
where
print _ (f, (ET t e))
= gen -- fname -- " " -- e -- " :: " -- t
where
gen = if (isJust e.te_generic_vars) "generic " ""
fname
| isJust e.te_priority = concat ("(" -- f -- ")")
| e.te_isrecordfield = "." +++ f
| otherwise = f
getName :: Location -> Name
getName (Location _ _ _ _ name) = name
getName (Builtin name) = name
isBuiltin :: Location -> Bool
isBuiltin (Builtin _) = True
isBuiltin _ = False
functionCount :: TypeDB -> Int
functionCount {functionmap} = mapSize functionmap
macroCount :: TypeDB -> Int
macroCount {macromap} = mapSize macromap
classCount :: TypeDB -> Int
classCount {classmap} = mapSize classmap
instanceCount :: TypeDB -> Int
instanceCount {instancemap} = sum $ map length $ elems instancemap
typeCount :: TypeDB -> Int
typeCount {typemap} = mapSize typemap
deriveCount :: TypeDB -> Int
deriveCount {derivemap} = sum $ map length $ elems derivemap
moduleCount :: TypeDB -> Int
moduleCount {modulemap} = mapSize modulemap
filterLocations :: (Location -> Bool) TypeDB -> TypeDB
filterLocations f db
= { db
& functionmap = filterLoc db.functionmap
, macromap = filterLoc db.macromap
, classmap = filterLoc db.classmap
, typemap = filterLoc db.typemap
, instancemap = filtInstLocs <$> db.instancemap
, derivemap = filtDervLocs <$> db.derivemap
, modulemap = filtModules db.modulemap
}
where
filterLoc :: ((Map Location a) -> Map Location a)
filterLoc = filterWithKey (const o f)
filtInstLocs :: [(a, [Location])] -> [(a, [Location])]
filtInstLocs [] = []
filtInstLocs [(t,ls):rest] = case ls` of
[] = filtInstLocs rest
_ = [(t,ls`):filtInstLocs rest]
where ls` = filter f ls
filtDervLocs :: [(a, b, [Location])] -> [(a, b, [Location])]
filtDervLocs [] = []
filtDervLocs [(t,s,ls):rest] = case ls` of
[] = filtDervLocs rest
_ = [(t,s,ls`):filtDervLocs rest]
where ls` = filter f ls
filtModules :: ((Map (Library, Module) a) -> Map (Library, Module) a)
filtModules = filterWithKey (\(l,m) _ -> f (Location l m Nothing Nothing undef))
getFunction :: Location TypeDB -> Maybe ExtendedType
getFunction loc {functionmap} = get loc functionmap
putFunction :: Location ExtendedType TypeDB -> TypeDB
putFunction fl t tdb=:{functionmap} = { tdb & functionmap = put fl t functionmap }
putFunctions :: [(Location, ExtendedType)] TypeDB -> TypeDB
putFunctions ts tdb = foldr (\(loc,t) db -> putFunction loc t db) tdb ts
findFunction :: Name TypeDB -> [(Location, ExtendedType)]
findFunction f db=:{functionmap}
= toList $ filterWithKey (\fl _-> f == getName fl) functionmap
findFunction` :: (Location ExtendedType -> Bool) TypeDB
-> [(Location, ExtendedType)]
findFunction` f {functionmap} = toList $ filterWithKey f functionmap
findFunction`` :: [(Location ExtendedType -> Bool)] TypeDB
-> [(Location, ExtendedType)]
findFunction`` fs {functionmap} = toList $ foldr filterWithKey functionmap fs
getMacro :: Location TypeDB -> Maybe Macro
getMacro loc {macro