Commit 325e5502 authored by Camil Staps's avatar Camil Staps 🚀

Use stdio instead of types.db; classmap etc.

parent 488a1c07
......@@ -12,4 +12,3 @@ clean-platform
Clean System Files/
search
builddb
types.db
Subproject commit 8de758c44d0cafccfe150ea4e8028161577c4e82
Subproject commit 246fc5e67ede9b51589068f35753cfe7344c811d
......@@ -20,10 +20,11 @@ derive gEq TypeDB
instance < FunctionLocation
instance print FunctionLocation
:: ClassLocation = CL Library Module Class
:: Library :== String
:: Module :== String
:: FunctionName :== String
:: Class :== String
getType :: FunctionLocation TypeDB -> Maybe Type
......
......@@ -11,19 +11,25 @@ import Text.JSON
import Type
:: TypeDB = { typemap :: Map FunctionLocation Type
, instancemap :: Map Class Type
, classmap :: Map ClassLocation ([TypeVar],[(FunctionName, Type)])
, instancemap :: Map Class [Type]
, instancemap_r :: Map Type [Class]
}
(<+) infixr 5 :: a b -> [String] | print a & print b
(<+) a b = print a ++ print b
instance zero TypeDB where zero = {typemap=newMap, instancemap=newMap}
derive gEq ClassOrGeneric, ArrayKind, Strict, SpineStrictness, ListKind,
FunctionLocation, Type, TypeDB
FunctionLocation, ClassLocation, Type, TypeDB
derive JSONEncode ClassOrGeneric, ArrayKind, Strict, SpineStrictness, ListKind,
FunctionLocation, Type, TypeDB
FunctionLocation, ClassLocation, Type, TypeDB
derive JSONDecode ClassOrGeneric, ArrayKind, Strict, SpineStrictness, ListKind,
FunctionLocation, Type, TypeDB
FunctionLocation, ClassLocation, Type, TypeDB
instance zero TypeDB where zero = { typemap = newMap
, classmap = newMap
, instancemap = newMap
, instancemap_r = newMap }
instance < FunctionLocation where (<) (FL a b c) (FL d e f) = (a,b,c) < (d,e,f)
instance print FunctionLocation
......
......@@ -47,45 +47,23 @@ libraries :== [
]
Start w
# (mods, w) = findModules` libraries w //libraries w
# (mods, w) = findModules` libraries w
# (st, w) = init_identifiers newHeap w
# cache = empty_cache st
# (db, w) = loop mods 'DB'.newDb cache w
# (ok, f, w) = fopen "types.db" FReadText w
| not ok = abort "Couldn't open types.db for reading\n"
# (db`, f) = 'DB'.openDb f
| isNothing db` = abort "types.db does not contain a TypeDB\n"
# db` = fromJust db`
# msg = if (db===db`) "databases are equal" "databases are not equal"
# (ok, f) = freopen f FWriteText
| not ok = abort "Couldn't open types.db for writing\n"
# (f, w) = stdio w
# f = 'DB'.saveDb db f
# (ok, w) = fclose f w
| not ok = abort "Couldn't close types.db after writing\n"
= (msg, ok)
| not ok = abort "Couldn't close stdio after writing\n"
= w
where
loop :: [(String,String)] 'DB'.TypeDB *DclCache *World -> *('DB'.TypeDB, *World)
loop [] db _ w = (db,w)
loop [(lib,mod):list] db cache w
# (sts, cache, w) = getModuleTypes mod lib cache w
# (io, w) = stdio w
| isEmpty sts
# io = fwrites (line +++ "\nSkipping " +++ mod +++ " in " +++ lib +++ " (no function types found)\n") io
= loop list db cache (snd (fclose io w))
# io = fwrites (line +++ "\nParsing " +++ mod +++ " in " +++ lib +++ "\n" +++ line +++ "\n") io
# io = fwrites (concat (join "\n" [alignl 42 (concat (print t)) <+ "\t" <+ n \\ ('DB'.FL _ _ n, t) <- sts]) +++ "\n") io
# (ok, w) = fclose io w
| not ok = abort "Couldn't close stdio\n"
# db = 'DB'.putTypes sts db
= loop list db cache w
line = {c \\ c <- repeatn 80 '-'}
// Libraries Library Module
findModules` :: ![String] !*World -> *(![(String,String)], !*World)
findModules` [] w = ([], w)
......
......@@ -24,7 +24,7 @@ Global
Time: False
Stack: False
Output
Output: ShowConstructors
Output: NoReturnType
Font: Monaco
FontSize: 9
WriteStdErr: False
......
......@@ -8,14 +8,12 @@ import Data.Maybe
import Text
Start w
# (ok, f, w) = fopen "types.db" FReadText w
| not ok = abort "Couldn't open types.db for reading\n"
# (db, f) = openDb f
| isNothing db = abort "types.db does not contain a TypeDB\n"
# (io, w) = stdio w
# (db, io) = openDb io
| isNothing db = abort "stdin does not have a TypeDB\n"
# db = fromJust db
# types = searchUnifiable (Func [Var "a"] (Type "Int" []) []) db
# types = sortBy (\(_,_,a,b)(_,_,x,y)->length (a++b) < length (x++y)) types
# (io, w) = stdio w
# io = fwrites (concat (join "\n" [alignl 42 (concat (print t)) <+ "\t" <+ n \\ (FL _ _ n, t, _, _) <- types]) +++ "\n") io
# (ok, w) = fclose io w
= w
......
......@@ -24,7 +24,7 @@ Global
Time: False
Stack: False
Output
Output: ShowConstructors
Output: NoReturnType
Font: Monaco
FontSize: 9
WriteStdErr: False
......
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