Skip to content
GitLab
Commit b0ffc354 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 27b466f4
Expand all Hide whitespace changes
Inline Side-by-side
libraries/Gerda/GenericDatabase.icl
View file @ b0ffc354
module GenericDatabase
import Gerda, StdEnv
import Gerda, StdEnv, GenEq//, MyDebug
:: R = {naam :: [Char], leeftijd :: Real, rec :: Maybe R}
:: A = C R
......@@ -11,59 +11,40 @@ import Gerda, StdEnv
:: GRose m a = GRose a (m (GRose m a))
:: Test` = Constr` Int
Start world
# (g, world) = openGerda "Clean Data Structures" world
// x = 42
// x = [[1]]
// x = (1, 3.1415927, 'a', [C2, C1, C3])
// x = [3, 5, 7]
// x = [C3, C1, C2, C1, C3, C2]
// x = [[[[[[[1]]]]]]]
// x = ["test"]
// x = ['aapnoot']
// x = [['aap'], ['noot']]
// x = Bin (Tip 'a') 42 (Tip 'b')
// x = Rose 1 [Rose 2 [], Rose 3 []]
// x = [[C1, C2], [C3, C2, C1]]
// r1 = {naam = ['aap'], leeftijd = 13.5, rec = Nothing}
// r2 = {naam = ['aap'], leeftijd = 13.5, rec = Just r1}
// x = array {r1, r2, r2, r1}
// x = ["Hello", "world"]
// x = Rose 1 [Rose 2 [], Rose 3 []]
// x = "a" +++ {'b' \\ _ <- [1..1000]}
// x = GRose (1, 'a', 0.5, "bud") [GRose (2, 'b', 0.75, "another bud") [], GRose (3, 'c', 0.875, "yet another bud") []]
// x = [1..10000]
// x = array {strictArray {1, 2, 3}, strictArray {1 .. 100}}
// x = Constr` 42
x = PAIR Nothing Nothing
g = writeGerda "test`.1" x g
// g = writeGerda "test2" x2 g
(y, g) = readGerda "test`.1" g
// (y2, g) = readGerda "test2" g
/* = case y `typeOf` x of
Just x`
# g = writeGerda "test2" x` g
(z, g) = readGerda "test" g
-> (z `typeOf` x, closeGerda g world)*/
= (y `typeOf` x, closeGerda g world)
// x = gerdaObject 42
// g = writeGerda "test" x g
// (y, g) = readGerda "test" g
// f = case y of Just {gerdaWrite} -> gerdaWrite; _ -> const id
// h = case y of Just {gerdaRead} -> gerdaRead; _ -> (\g -> (undef, g))
// g = f 123 g
// (w, g) = h g
// (z, g) = readGerda "test" g
// = (y `typeOf` x, Just w `typeOf` x.gerdaValue, z `typeOf` x, closeGerda g world)
:: Test = E. a: {value :: a, write :: a *Gerda -> *Gerda, read :: *Gerda -> *(a, *Gerda), equal :: a a -> Bool}
test :: a -> Test | gerda{|*|}, gEq{|*|} a
test x = {value = x, write = \x g -> writeGerda "test" x g, read = \g -> case readGerda "test" g of (Just x, g) -> (x, g), equal = (===)}
tests = flatten (repeatn 10 [
// test {gerdaKey = 1, gerdaValue = 2},
test 42,
test C1,
test (Constr` 42),
test [1, 3, 5, 7],
test (1, 3.1415927, 'a', [C3, C1, C2, C1, C3, C2]),
test [[[[[[[1]]]]]]],
test "test",
test ("a" +++ {'b' \\ _ <- [1..1000]}),
test [['aap'], ['noot']],
test (Bin (Tip 'a') 42 (Tip 'b')),
test (Rose 1 [Rose 2 [], Rose 3 []]),
test p1,
test p2,
test r2,
test (strictArray {2, 3, 5, 7, 11, 13, 17, 19}),
test (array {r1, r2, r2, r1}),
test (GRose (1, 'a', 0.5, "bud") [GRose (2, 'b', 0.75, "another bud") [], GRose (3, 'c', 0.875, "yet another bud") []]),
test {gerdaUnique = 21}])
where
(`typeOf`) :: !(Maybe (EITHER Int Int)) (PAIR (Maybe Int) (Maybe Int)) -> Maybe (EITHER Int Int)
(`typeOf`) x _ = x
r1 = {naam = ['noot'], leeftijd = 41.2, rec = Nothing}
r2 = {naam = ['aap'], leeftijd = 13.5, rec = Just r1}
x :: Phantom [Int]
x = Opera
p1 :: Phantom Char
p1 = Opera
x2 :: Phantom Char
x2 = Opera
p2 :: Phantom [Int]
p2 = Opera
array :: !{a} -> {a}
array x = x
......@@ -71,7 +52,36 @@ where
strictArray :: !{!a} -> {!a}
strictArray x = x
derive gerda Tree, Rose, R, N, (,), (,,), (,,,), GRose, Test`, Phantom
runTests [{value, write, read, equal}:ts] g
# g = write value g
(v, g) = read g
| not (equal v value) = abort "TEST FAILED" //<<- (value, v)
= runTests ts g
runTests _ g = g
Start world
# (g, world) = openGerda "Clean Data Structures" world
g = runTests tests g
x = gerdaObject (42, 'a', 3.14, [1..10])
g = writeGerda "test2" x g
(y, g) = readGerda "test2" g
w = case y of Just {gerdaWrite} -> gerdaWrite; _ -> const id
r = case y of Just {gerdaRead} -> gerdaRead; _ -> (\g -> (abort "NO readGerda", g))
g = w (123, 'b', 2.41, []) g
(u, g) = r g
g = w (789, 'c', 1.61, []) g
(z, g) = r g
(v, g) = readGerda "test2" g
= (mapMaybe (\{gerdaObject} -> gerdaObject) y `typeOf` x.gerdaObject, u, z, mapMaybe (\{gerdaObject} -> gerdaObject) v `typeOf` x.gerdaObject, closeGerda g world)
// = closeGerda g world
where
(`typeOf`) :: !(Maybe a) a -> Maybe a
(`typeOf`) x _ = x
derive gerda (,), (,,), (,,,), Tree, Rose, R, N, GRose, Test`, Phantom
derive gEq GerdaPrimary, GerdaUnique, Binary252, Maybe, Tree, Rose, R, N, Test`, Phantom
gEq{|GRose|} eq_m eq_a (GRose x xs) (GRose y ys) = eq_a x y && eq_m (gEq{|(*->*)->*->*|} eq_m eq_a) xs ys
:: Phantom a = Opera
......
libraries/Gerda/GenericDatabase.prj
View file @ b0ffc354
......@@ -7,8 +7,8 @@ Global
CheckStacks: False
CheckIndexes: True
Application
HeapSize: 4194304
StackSize: 1048576
HeapSize: 8388608
StackSize: 2097152
ExtraMemory: 81920
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
......@@ -18,7 +18,7 @@ Global
MarkingCollector: False
StandardRuntimeEnv: True
Profile
Memory: True
Memory: False
MemoryMinimumHeapSize: 0
Time: True
Stack: False
......@@ -38,6 +38,7 @@ Global
Paths
Path: {Project}
Path: {Application}\Libraries\StdLib
Path: {Application}\Libraries\Generics
Path: {Application}\Libraries\WrapDebug
Precompile:
Postlink:
......@@ -61,13 +62,13 @@ MainModule
X: 10
Y: 10
SizeX: 622
SizeY: 490
IclOpen: True
SizeY: 511
IclOpen: False
LastModified: No 0 0 0 0 0 0
OtherModules
Module
Name: Gerda
Dir: {Project}
Name: GenEq
Dir: {Application}\Libraries\Generics
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
......@@ -76,27 +77,15 @@ OtherModules
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: True
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 88
Y: 44
SizeX: 751
SizeY: 477
DclOpen: True
Icl
WindowPosition
X: 26
Y: 41
SizeX: 800
SizeY: 494
IclOpen: True
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdGeneric
Dir: {Application}\Libraries\StdEnv
Name: odbccp
Dir: {Project}
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
......@@ -108,6 +97,12 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 224
Y: 74
SizeX: 800
SizeY: 632
DclOpen: False
Icl
WindowPosition
......@@ -117,9 +112,11 @@ OtherModules
SizeY: 640
IclOpen: False
LastModified: No 0 0 0 0 0 0
NeededLibraries
Library: odbccp_library
Module
Name: StdInt
Dir: {Application}\Libraries\StdEnv
Name: odbc
Dir: {Project}
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
......@@ -131,11 +128,25 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 211
Y: 44
SizeX: 800
SizeY: 646
DclOpen: False
Icl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 640
IclOpen: False
LastModified: No 0 0 0 0 0 0
NeededLibraries
Library: odbc_library
Module
Name: StdOverloaded
Name: StdDebug
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -158,7 +169,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdMisc
Name: StdCharList
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -175,7 +186,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdClass
Name: StdTuple
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -198,25 +209,8 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdBool
Name: StdOrdList
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdMaybe
Dir: {Application}\Libraries\StdLib
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
......@@ -238,7 +232,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdFunc
Name: _SystemEnum
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -251,17 +245,11 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 640
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdEnv
Name: StdEnum
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -278,7 +266,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdReal
Name: StdList
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -291,11 +279,17 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 640
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdChar
Name: StdFile
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -312,7 +306,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdArray
Name: StdString
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -364,7 +358,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdString
Name: StdArray
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -387,7 +381,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdFile
Name: StdChar
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -404,7 +398,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdList
Name: StdReal
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -421,7 +415,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdEnum
Name: StdEnv
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -438,7 +432,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: _SystemEnum
Name: StdFunc
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -451,12 +445,18 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 640
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdOrdList
Dir: {Application}\Libraries\StdEnv
Name: StdMaybe
Dir: {Application}\Libraries\StdLib
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
......@@ -478,7 +478,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdTuple
Name: StdBool
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -495,7 +495,7 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdCharList
Name: StdClass
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -508,11 +508,17 @@ OtherModules
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 640
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdDebug
Name: StdMisc
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
......@@ -529,8 +535,8 @@ OtherModules
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: odbc
Dir: {Project}
Name: StdOverloaded
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
......@@ -544,10 +550,44 @@ OtherModules
Fusion: False
Dcl
WindowPosition
X: 211
Y: 44
X: 10
Y: 10
SizeX: 800
SizeY: 646
SizeY: 640
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdInt
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
DclOpen: False
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
Name: StdGeneric
Dir: {Application}\Libraries\StdEnv
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
DclOpen: False
Icl
WindowPosition
......@@ -557,10 +597,8 @@ OtherModules
SizeY: 640
IclOpen: False
LastModified: No 0 0 0 0 0 0
NeededLibraries
Library: odbc_library
Module
Name: odbccp
Name: Gerda
Dir: {Project}
Compiler
NeverMemoryProfile: False
......@@ -570,85 +608,85 @@ OtherModules
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: False
ReadableABC: True
ReuseUniqueNodes: True
Fusion: False
Dcl
WindowPosition
X: 224
Y: 74
SizeX: 800
SizeY: 632
X: 88
Y: 44
SizeX: 751
SizeY: 477
DclOpen: False
Icl
WindowPosition
X: 10
Y: 10
SizeX: 800
SizeY: 640
X: 9
Y: 22
SizeX: 812
SizeY: 500
IclOpen: False
LastModified: No 0 0 0 0 0 0
NeededLibraries
Library: odbccp_library
Static
Mods
Path: {Project}\GenericDatabase.icl
Path: {Project}\Gerda.icl
Path: {Application}\Libraries\StdEnv\StdGeneric.icl
Path: {Application}\Libraries\StdEnv\StdInt.icl
Path: {Application}\Libraries\StdEnv\StdOverloaded.icl
Path: {Application}\Libraries\StdEnv\StdMisc.icl
Path: {Application}\Libraries\StdEnv\StdClass.icl
Path: {Application}\Libraries\StdEnv\StdBool.icl
Path: {Application}\Libraries\StdLib\StdMaybe.icl
Path: {Application}\Libraries\StdEnv\StdFunc.icl
Path: {Application}\Libraries\StdEnv\StdEnv.icl
Path: {Application}\Libraries\StdEnv\StdReal.icl
Path: {Application}\Libraries\StdEnv\StdChar.icl
Path: {Application}\Libraries\StdEnv\StdArray.icl
Path: {Application}\Libraries\StdEnv\_SystemArray.icl
Path: {Application}\Libraries\StdEnv\StdString.icl
Path: {Application}\Libraries\StdEnv\StdFile.icl
Path: {Application}\Libraries\StdEnv\StdList.icl
Path: {Application}\Libraries\StdEnv\StdEnum.icl
Path: {Application}\Libraries\StdEnv\_SystemEnum.icl
Path: {Application}\Libraries\StdEnv\StdOrdList.icl
Path: {Application}\Libraries\StdEnv\StdTuple.icl
Path: {Application}\Libraries\StdEnv\StdCharList.icl
Path: {Application}\Libraries\StdEnv\StdDebug.icl
Path: {Project}\odbc.icl
Path: {Application}\Libraries\Generics\GenEq.icl
Path: {Project}\odbccp.icl
Path: {Project}\odbc.icl
Path: {Application}\Libraries\StdEnv\StdDebug.icl
Path: {Application}\Libraries\StdEnv\StdCharList.icl
Path: {Application}\Libraries\StdEnv\StdTuple.icl
Path: {Application}\Libraries\StdEnv\StdOrdList.icl
Path: {Application}\Libraries\StdEnv\_SystemEnum.icl
Path: {Application}\Libraries\StdEnv\StdEnum.icl
Path: {Application}\Libraries\StdEnv\StdList.icl
Path: {Application}\Libraries\StdEnv\StdFile.icl
Path: {Application}\Libraries\StdEnv\StdString.icl
Path: {Application}\Libraries\StdEnv\_SystemArray.icl
Path: {Application}\Libraries\StdEnv\StdArray.icl
Path: {Application}\Libraries\StdEnv\StdChar.icl
Path: {Application}\Libraries\StdEnv\StdReal.icl
Path: {Application}\Libraries\StdEnv\StdEnv.icl
Path: {Application}\Libraries\StdEnv\StdFunc.icl
Path: {Application}\Libraries\StdLib\StdMaybe.icl
Path: {Application}\Libraries\StdEnv\StdBool.icl
Path: {Application}\Libraries\StdEnv\StdClass.icl
Path: {Application}\Libraries\StdEnv\StdMisc.icl
Path: {Application}\Libraries\StdEnv\StdOverloaded.icl
Path: {Application}\Libraries\StdEnv\StdInt.icl
Path: {Application}\Libraries\StdEnv\StdGeneric.icl
Path: {Project}\Gerda.icl
Objs
Path: {Application}\Libraries\StdEnv\Clean System Files\_startup0.o
Path: {Application}\Libraries\StdEnv\Clean System Files\_startup1Profile.o
Path: {Application}\Libraries\StdEnv\Clean System Files\_startup2.o
Path: {Application}\Libraries\StdEnv\Clean System Files\_system.o
Path: {Project}\Clean System Files\GenericDatabase.o
Path: {Project}\Clean System Files\Gerda.o