Commit 94be5208 authored by Camil Staps's avatar Camil Staps 🚀

Added backend/ and frontend/; reorganisation; some cleanup

parents
CleanLevenshtein @ 34b88397
Subproject commit 34b88397b2d392a391e63c7fd3b924b045a61184
CleanTypeUnifier @ 445b766c
Subproject commit 445b766c1642d196670f9b419ed5e9e350f1353a
This diff is collapsed.
# Installation:
# docker build -t cloogle .
#
# Usage:
# docker run \
# -d \
# --net=host \
# --name=cloogle \
# -v /path/to/cloogle/cloogle.log:/usr/src/cloogle/cloogle.log \
# cloogle
FROM camilstaps/clean:2.4-itasks
COPY . /usr/src/cloogle
WORKDIR /usr/src/cloogle
RUN make
EXPOSE 31215
ENTRYPOINT "./serve"
CMD []
BIN:=CloogleServer builddb
PRJ:=$(addsuffix .prj,$(BIN))
DB=types.json
MAN:=builddb.1 # Others don't have --help/--version # $(addsuffix .1,$(BIN))
CPM:=cpm
SED:=sed
.SECONDARY: $(PRJ)
.PHONY: all
all: $(BIN) $(DB)
man: $(MAN)
%.1: %
help2man -N ./$< > $@
%: %.prj
$(CPM) $< \
| grep -v "^Analyzing" \
| grep -v "^Warning: Unable to setup directory cache"
%.prj:
$(CPM) project $(basename $@) create
$(SED) -i 's/\(Target:[ \t]\+\)StdEnv/\1CleanPlatform/' $@
$(SED) -i 's/[ \t]\+Path:[ \t]\+{Project}/&\n&\/CleanLevenshtein\n&\/CleanTypeUnifier\n&\/CleanTypeUnifier\/clean-compiler\/main\/\n&\/CleanTypeUnifier\/clean-compiler\/frontend\/\n&\/CleanTypeUnifier\/clean-compiler\/backend\/\n&\/CleanTypeUnifier\/clean-compiler\/main\/Unix\//' $@
$(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/\141943040/' $@
$(DB): builddb
./builddb > $(DB)
clean:
$(RM) -r 'Clean System Files' $(BIN) $(PRJ) $(MAN) $(DB)
definition module SimpleTCPServer
from StdOverloaded import class zero, class fromString, class toString
from StdMaybe import :: Maybe
from TCPIP import ::IPAddress, ::Port
:: LogMessage a b = Connected IPAddress
| Received a
| Sent b
| Disconnected
:: Logger a b s :== (LogMessage a b) s *World -> *(s, *World)
serve :: (a *World -> *(b,*World)) (Maybe (Logger a b s)) Port *World
-> *World | fromString a & toString b
implementation module SimpleTCPServer
import TCPIP
import StdEnv
import StdMaybe
import System._Posix
TIMEOUT :== Just 5000
instance zero (Logger a b s) where zero = \_ _ w -> (undef, w)
serve :: (a *World -> *(b,*World)) (Maybe (Logger a b s)) Port *World -> *World | fromString a & toString b
serve f log port w
# (ok, mbListener, w) = openTCP_Listener port w
| not ok = abort ("Couldn't open port " +++ toString port +++ "\n")
# listener = fromJust mbListener
# log = if (isNothing log) zero (fromJust log)
# (_,w) = signal 17 1 w // SIGCHLD, SIG_IGN: no notification if child ps dies
# (listener, w) = loop f log listener w
= closeRChannel listener w
where
loop :: (a *World -> *(b,*World)) (Logger a b s) TCP_Listener *World
-> (TCP_Listener, *World) | fromString a & toString b
loop f log li w
#! ((ip,dupChan),li,w) = receive li w
#! (st,w) = log (Connected ip) undef w
# (pid,w) = fork w
| pid < 0
= abort "fork failed\n"
| pid > 0
// Parent: handle new requests
= loop f log li w
// Child: handle current request
= handle f log st dupChan w
handle :: (a *World-> (b,*World)) (Logger a b s) !s !TCP_DuplexChannel !*World
-> (TCP_Listener, *World) | fromString a & toString b
handle f log st dupChannel=:{rChannel,sChannel} w
# (tRep,msg,rChannel,w) = receive_MT TIMEOUT rChannel w
| tRep <> TR_Success
# (st,w) = log Disconnected st w
# w = closeChannel sChannel (closeRChannel rChannel w)
= exit 0 w
# msg = fromString (toString (fromJust msg))
# (st, w) = log (Received msg) st w
# (resp, w) = f msg w
# (sChannel, w) = send (toByteSeq (toString resp)) sChannel w
# (st, w) = log (Sent resp) st w
= handle f log st {dupChannel & rChannel=rChannel, sChannel=sChannel} w
signal :: !Int !Int !*World -> *(!Int, !*World)
signal signum handler w = code {
ccall signal "II:I:A"
}
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
:: TypeDB
instance zero TypeDB
derive gEq TypeDB
:: FunctionLocation = FL Library Module FunctionName
instance print FunctionLocation
:: TypeExtras = { te_priority :: Maybe TE_Priority
, te_isconstructor :: Bool
, te_generic_vars :: Maybe [TypeVar]
}
instance zero TypeExtras
:: TE_Priority = LeftAssoc Int | RightAssoc Int | NoAssoc Int
instance print TE_Priority
:: ExtendedType = ET Type TypeExtras
instance print (FunctionName, ExtendedType)
:: ClassLocation = CL Library Module Class
:: Library :== String
:: Module :== String
:: FunctionName :== String
:: Class :== String
:: GenericName :== String
:: 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)]
findFunction`` :: [(FunctionLocation ExtendedType -> Bool)] TypeDB
-> [(FunctionLocation, ExtendedType)]
getInstances :: Class TypeDB -> [Type]
putInstance :: Class Type TypeDB -> TypeDB
putInstances :: Class [Type] TypeDB -> TypeDB
putInstancess :: [(Class, [Type])] TypeDB -> TypeDB
getClass :: ClassLocation TypeDB -> Maybe ([TypeVar],ClassContext,[(FunctionName,ExtendedType)])
putClass :: ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] TypeDB -> TypeDB
putClasses :: [(ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])] TypeDB -> TypeDB
findClass :: Class TypeDB -> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])]
findClass` :: (ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] -> Bool) TypeDB
-> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])]
findClassMembers` :: (ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool) TypeDB
-> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
findClassMembers`` :: [ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool]
TypeDB -> [(ClassLocation, [TypeVar], ClassContext, 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)]
getDerivations :: GenericName TypeDB -> [Type]
putDerivation :: GenericName Type TypeDB -> TypeDB
putDerivations :: GenericName [Type] TypeDB -> TypeDB
putDerivationss :: [(GenericName, [Type])] TypeDB -> TypeDB
searchExact :: Type TypeDB -> [(FunctionLocation, ExtendedType)]
newDb :: TypeDB
openDb :: *File -> *(Maybe TypeDB, *File)
saveDb :: TypeDB *File -> *File
implementation module TypeDB
// Standard libraries
import StdEnv
from Data.Func import $
from Data.List import intercalate
import Data.Map
import Data.Maybe
import Text.JSON
// CleanTypeUnifier
import Type
:: TypeDB
= { functionmap :: Map FunctionLocation ExtendedType
, classmap :: Map ClassLocation ([TypeVar],ClassContext,[(FunctionName, ExtendedType)])
, instancemap :: Map Class [Type]
, typemap :: Map TypeLocation TypeDef
, derivemap :: Map GenericName [Type]
}
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, FunctionLocation, ClassLocation, Type, TypeDB,
TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation, TypeDefRhs,
RecordField, Constructor, Kind
derive JSONEncode ClassOrGeneric, FunctionLocation, ClassLocation, Type,
TypeDB, TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation,
TypeDefRhs, RecordField, Constructor, Kind
derive JSONDecode ClassOrGeneric, FunctionLocation, ClassLocation, Type,
TypeDB, TypeExtras, TE_Priority, ExtendedType, TypeDef, TypeLocation,
TypeDefRhs, RecordField, Constructor, Kind
instance zero TypeDB
where
zero = { functionmap = newMap
, classmap = newMap
, instancemap = newMap
, typemap = newMap
, derivemap = newMap
}
instance < FunctionLocation where (<) (FL a b c) (FL d e f) = (a,b,c) < (d,e,f)
instance print FunctionLocation
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 zero TypeExtras
where
zero = { te_priority = Nothing
, te_isconstructor = False
, te_generic_vars = Nothing
}
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 TE_Priority
where
print _ (LeftAssoc i) = "infixl " -- i
print _ (RightAssoc i) = "infixr " -- i
print _ (NoAssoc i) = "infix " -- i
instance print (FunctionName, ExtendedType)
where
print _ (f, (ET t e=:{te_generic_vars=Just _}))
= "generic " -- f -- " " -- e -- " :: " -- t
print _ (f, (ET t e))
= f -- " " -- e -- " :: " -- t
getFunction :: FunctionLocation TypeDB -> Maybe ExtendedType
getFunction loc {functionmap} = get loc functionmap
putFunction :: FunctionLocation ExtendedType TypeDB -> TypeDB
putFunction fl t tdb=:{functionmap} = { tdb & functionmap = put fl t functionmap }
putFunctions :: [(FunctionLocation, ExtendedType)] TypeDB -> TypeDB
putFunctions ts tdb = foldr (\(loc,t) db -> putFunction loc t db) tdb ts
findFunction :: FunctionName TypeDB -> [(FunctionLocation, ExtendedType)]
findFunction f db=:{functionmap}
= toList $ filterWithKey (\(FL _ _ f`) _->f==f`) functionmap
findFunction` :: (FunctionLocation ExtendedType -> Bool) TypeDB
-> [(FunctionLocation, ExtendedType)]
findFunction` f {functionmap} = toList $ filterWithKey f functionmap
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)
where ts = get c instancemap
putInstance :: Class Type TypeDB -> TypeDB
putInstance c t db=:{instancemap} = {db & instancemap=put c ts instancemap}
where ts = removeDup [t : getInstances c db]
putInstances :: Class [Type] TypeDB -> TypeDB
putInstances c ts db = foldr (\t db -> putInstance c t db) db ts
putInstancess :: [(Class, [Type])] TypeDB -> TypeDB
putInstancess is db = foldr (\(c,ts) db -> putInstances c ts db) db is
getClass :: ClassLocation TypeDB -> Maybe ([TypeVar],ClassContext,[(FunctionName,ExtendedType)])
getClass loc {classmap} = get loc classmap
putClass :: ClassLocation [TypeVar] ClassContext [(FunctionName, ExtendedType)] TypeDB -> TypeDB
putClass cl tvs cc fs db=:{classmap} = {db & classmap = put cl (tvs,cc,fs) classmap}
putClasses :: [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])] TypeDB -> TypeDB
putClasses cs db = foldr (\(cl,tvs,cc,fs) db -> putClass cl tvs cc fs db) db cs
findClass :: Class TypeDB -> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName, ExtendedType)])]
findClass c {classmap} = map (\(k,(x,y,z))->(k,x,y,z)) results
where results = toList $ filterWithKey (\(CL _ _ c`) _->c==c`) classmap
findClass` :: (ClassLocation [TypeVar] ClassContext [(FunctionName,ExtendedType)] -> Bool) TypeDB
-> [(ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])]
findClass` f {classmap} = map (\(k,(x,y,z))->(k,x,y,z)) results
where results = toList $ filterWithKey (\cl (vs,cc,fs)->f cl vs cc fs) classmap
findClassMembers` :: (ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool) TypeDB
-> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
findClassMembers` f {classmap} = filter (app5 f) $ flatten members
where
members = map (\(cl,(vs,cc,fs))->[(cl,vs,cc,f,t) \\ (f,t)<-fs]) $ toList classmap
findClassMembers`` :: [(ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool)]
TypeDB -> [(ClassLocation, [TypeVar], ClassContext, FunctionName, ExtendedType)]
findClassMembers`` fs {classmap} = foldr (filter o app5) all_members fs
where
all_members = [(cl,vs,cc,f,t) \\ (cl,(vs,cc,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
getDerivations :: GenericName TypeDB -> [Type]
getDerivations gen {derivemap} = if (isNothing ts) [] (fromJust ts)
where ts = get gen derivemap
putDerivation :: GenericName Type TypeDB -> TypeDB
putDerivation gen t db=:{derivemap} = {db & derivemap=put gen ts derivemap}
where ts = removeDup [t : getDerivations gen db]
putDerivations :: GenericName [Type] TypeDB -> TypeDB
putDerivations gen ts db = foldr (\t db -> putDerivation gen t db) db ts
putDerivationss :: [(GenericName, [Type])] TypeDB -> TypeDB
putDerivationss ds db = foldr (\(g,ts) db -> putDerivations g ts db) db ds
searchExact :: Type TypeDB -> [(FunctionLocation, ExtendedType)]
searchExact t db = filter ((\(ET t` _)->t==t`) o snd) $ toList db.functionmap
newDb :: TypeDB
newDb = zero
openDb :: *File -> *(Maybe TypeDB, *File)
openDb f
# (data, f) = freadline f
= (fromJSON $ fromString data, f)
saveDb :: TypeDB *File -> *File
saveDb db f = fwrites (toString $ toJSON db) f
app5 f (a,b,c,d,e) :== f a b c d e
module builddb
// Project libraries
import qualified TypeDB as DB
from TypeDB import ::TypeExtras{..}, instance zero TypeExtras
// StdEnv
import StdFile, StdList, StdMisc, StdArray, StdBool, StdString, StdTuple
// CleanPlatform
import Data.Maybe, Data.Either, Data.Error, Data.Func, Data.Tuple, Data.Functor
from Text import class Text(concat), instance Text String
import System.Directory, System.CommandLine
// CleanTypeUnifier
import qualified Type as T
from Type import class print(print), instance print [a], instance print String
import CoclUtils
// frontend
//import Heap, compile, parse, predef
import Heap
from hashtable import ::HashTable, ::QualifiedIdents(NoQualifiedIdents),
::IdentClass(IC_Module), ::BoxedIdent{..}, putIdentInHashTable
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,PD_Type,PD_Generic,PD_Derive),
::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType,
::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_types},
::Type, ::ClassDef{class_ident,class_args,class_context},
::TypeVar, ::ParsedTypeDef, ::TypeDef,
::GenericDef{gen_ident,gen_type,gen_vars},
::GenericCaseDef{gc_type,gc_gcf}, ::GenericCaseFunctions(GCF), ::GCF
from scanner import ::Priority(..), ::Assoc(..)
from parse import wantModule
:: CLI = { help :: Bool
, version :: Bool
, root :: String
, libs :: [String]
}
instance zero CLI where
zero = { version = False
, help = False
, root = "/opt/clean/lib/"
, libs = [ "StdEnv"
, "StdLib"
, "ArgEnv"
, "Directory"
, "Dynamics"
, "Gast"
, "Generics"
, "MersenneTwister"
, "TCPIP"
, "clean-platform/OS-Independent"
, "clean-platform/OS-Linux"
, "clean-platform/OS-Linux-32"
, "clean-platform/OS-Linux-64"
, "clean-platform/OS-Mac"
, "clean-platform/OS-Posix"
, "clean-platform/OS-Windows"
, "clean-platform/OS-Windows-32"
, "clean-platform/OS-Windows-64"
, "iTasks-SDK/Dependencies/graph_copy"
, "iTasks-SDK/Dependencies/clean-sapl/src"
, "iTasks-SDK/Server"
, "iTasks-SDK/Tests"
]
}
VERSION :== "Cloogle's builddb version 0.1\n"
USAGE :== concat [
VERSION, "\n",
"Usage: ./builddb [opts] > types.json\n\n",
"\t-h, --help Show this help\n",
"\t-r PATH Change the library root to PATH\n",
"\t-l PATH Add PATH to the librarypaths relative to the root\n"]
Start w
# (args, w) = getCommandLine w
# (f, w) = stdio w
# (ok, w) = case parseCLI (tl args) of
(Left e) = fclose (f <<< e) w
(Right cli)
| cli.help = fclose (f <<< USAGE) w
| cli.version = fclose (f <<< VERSION) w
# (mods, w) = findModules` cli.libs cli.root w
# (st, w) = init_identifiers newHeap w
# cache = empty_cache st
# (db, w) = loop cli.root mods 'DB'.newDb cache w
# f = 'DB'.saveDb db f
= fclose f w
| not ok = abort "Couldn't close stdio"
= w
where
loop :: String [(String,String)] 'DB'.TypeDB *DclCache *World -> *('DB'.TypeDB, *World)
loop _ [] db _ w = (db,w)
loop root [(lib,mod):list] db cache w
# (db, cache, w) = getModuleTypes root mod lib cache db w
= loop root list db cache w
parseCLI :: [String] -> Either String CLI
parseCLI [] = Right zero
parseCLI [x:a] = case (x,a) of
("--help", xs) = (\c->{c & help=True}) <$> parseCLI xs
("--version", xs) = (\c->{c & version=True}) <$> parseCLI xs
("-l", []) = Left "'-l' requires an argument"
("-r", []) = Left "'-r' requires an argument"
("-r", [x:xs]) = (\c->{c & root=x}) <$> parseCLI xs
("-l", [x:xs]) = (\c->{c & libs=[x:c.libs]}) <$> parseCLI xs
(x, _) = Left $ "Unknown option '" +++ x +++ "'"
// Libraries Library Module
findModules` :: ![String] !String !*World -> *(![(String,String)], !*World)
findModules` [] _ w = ([], w)
findModules` [lib:libs] root w
#! (mods, w) = findModules lib root w
#! (moremods, w) = findModules` libs root w
= (removeDup (mods ++ moremods), w)
findModules :: !String !String !*World -> *(![(String,String)], !*World)
findModules lib root w
#! (fps, w) = readDirectory (root +++ "/" +++ lib) w
| isError fps = ([], w)
#! fps = fromOk fps
#! mods = map (\s->(lib, s%(0,size s-5))) $ filter isDclModule fps
#! (moremods, w) = findModules` (map ((+++) (lib+++"/")) (filter isDirectory fps)) root w
= (removeDup (mods ++ moremods), w)
where
isDclModule :: String -> Bool
isDclModule s = s % (size s - 4, size s - 1) == ".dcl"
isDirectory :: String -> Bool
isDirectory s = not $ isMember '.' $ fromString s
getModuleTypes :: String String String *DclCache 'DB'.TypeDB *World -> *('DB'.TypeDB, *DclCache, *World)
getModuleTypes root mod lib cache db w
# filename = root +++ "/" +++ lib +++ "/" +++ mkdir mod +++ ".dcl"
# (ok,f,w) = fopen filename FReadText w
| not ok = abort ("Couldn't open file " +++ filename +++ ".\n")
# (mod_id, ht) = putIdentInHashTable mod (IC_Module NoQualifiedIdents) cache.hash_table
cache = {cache & hash_table=ht}
# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" False mod_id.boxed_ident NoPos True cache.hash_table stderr) w
cache = {cache & hash_table=ht}
# (ok,w) = fclose f w
| not ok = abort ("Couldn't close file " +++ filename +++ ".\n")
# mod = pm.mod_ident.id_name
# lib = cleanlib mod lib
# 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
# typedefs = pd_types lib mod pm.mod_defs
# db = 'DB'.putTypes typedefs db
# db = 'DB'.putFunctions (flatten $ map constructor_functions typedefs) db
# db = 'DB'.putFunctions (pd_generics lib mod pm.mod_defs) db
# db = 'DB'.putDerivationss (pd_derivations pm.mod_defs) db
= (db,cache,w)
where
mkdir :: String -> String
mkdir s = { if (c == '.') '/' c \\ c <-: s }
cleanlib :: !String !String -> String // Remove module dirs from lib
cleanlib mod lib = toString $ cl` (fromString $ mkdir mod) (fromString lib)
where
cl` :: ![Char] ![Char] -> [Char]
cl` mod lib
| not (isMember '/' mod) = lib
# mod = reverse $ tl $ dropWhile ((<>)'/') $ reverse mod
| drop (length lib - length mod) lib == mod
= take (length lib - length mod - 1) lib
= lib
pd_derivations :: [ParsedDefinition] -> [('DB'.GenericName, ['DB'.Type])]