It's alive\!

Author: TurtleKitty

main.rkt

@@ -2,42 +2,40 @@
 
 (require (planet dvanhorn/fector:1:1))
 
-;(provide create-datastore)
-
-; create datastore
-; create relation name (fields)
-; delete relation
-; create tuples ((x y z)(p d q))
-; read (x y) from relation where (u v)
-; update (x y) in relation where (u v)
-; delete from relation where (u v)
+(provide create-datastore)
 
 
 (define (create-datastore (rs #f) (is #f))
     (define relations (or rs (hash)))
     (define indexes (or is (hash)))
+    (define (unroll-relations)
+	(make-immutable-hash
+	    (map (λ (k) (cons k ((hash-ref relations k))))
+		 (hash-keys relations))))
     (define (serialize)
-	(hash 'relations relations 'indexes indexes))
+	(hash
+	    'relations (unroll-relations)
+	    'indexes indexes))
     (define (relvar name)
 	(hash-ref relations name))
-    (define (rebuild name fn)
+    (define (rebuild name noob)
 	(create-datastore
-	    (hash-set relations name (fn) indexes)))
-    (define (add-relation name fields (tuples #f))
-	(rebuild name (λ () (relation name fields tuples))))
+	    (hash-set relations name noob) indexes))
+    (define (add-relation name fields (tuples empty))
+	(rebuild name (relation name fields tuples)))
     (define (add-tuples relname tupz)
-	(rebuild relname (λ () ((relvar relname) 'create tupz))))
+	(rebuild relname ((relvar relname) 'create tupz)))
     (define (rm-tuples relname where)
-	(rebuild relname (λ () ((relvar relname) 'delete where))))
+	(rebuild relname ((relvar relname) 'delete where)))
     (define (update-tuples relname where put)
-	(rebuild relname (λ () ((relvar relname) 'update where put))))
+	(rebuild relname ((relvar relname) 'update where put)))
     (define (query result-type relname where want)
-	(rebuild relname (λ () ((relvar relname) result-type where want))))
+	((relvar relname) result-type where want))
     (case-lambda
 	(() (serialize))
 	((cmd)
 	    (case cmd
-		('relations relations)
+		('relations (unroll-relations))
 		('indexes indexes)))
 	((cmd x)
 	    (case cmd
@@ -50,7 +48,7 @@
 	((cmd x y z)
 	    (case cmd
 		('add_relation (add-relation x y z))
-		('(read read-row read-col read-val) (query cmd x y z))
+		((read read-row read-col read-val) (query cmd x y z))
 		('update (update-tuples x y z))))))
 
 (define (list->fector lst)

tests.rkt

@@ -2,125 +2,68 @@
 
 (require "main.rkt")
 
-; create datastore
-; delete datastore
-; create relation name (fields)
-; delete relation
-; create tuple (x y z)
-; read (x y) from relation where (u v)
-; update (x y) in relation where (u v)
-; delete from relation where (u v)
 
 (define world (create-datastore))
 
-(world 'display)
+(world)
+
+(define bfields '(id name brawn brains moves cool karma))
 
 (define world2
     (world 'add_relation
 	'brawlers
-	'(id name brawn brains moves cool karma)))
+	bfields))
 
-(world2 'display)
+(world2)
 
 (define world3
-    (world 'add_tuples
-	'brawlers
-	'(1 "Jack Damage" 20 0 2 10 100)
-	'(2 "Dark Okie" 18 3 14 7 100)
-	'(3 "Grey Hound" 10 0 17 0 100)
-	'(4 "Billy Gunn" 0 3 4 0 100)
-	'(5 "Doctor Braino" 0 10 0 10 100)))
+    (world2 'create 'brawlers
+	'((1 "Jack Damage" 20 0 2 10 100)
+	  (2 "Dark Okie" 18 3 14 7 100)
+	  (3 "Grey Hound" 10 0 17 0 100)
+	  (4 "Billy Gunn" 0 3 4 0 100)
+	  (5 "Doctor Braino" 0 10 0 10 100))))
 
-(world3 'display)
+(world3)
 
 (define world4
-    (world 'update
-	'brawlers
-	'((brawn 21) (brains 1))
-	'((id 1))))
+    (world3 'update 'brawlers
+	'((id 1))
+	'((brawn 21) (brains 1))))
 
-(world4 'display)
+(world4)
 
 (define brawlers
-    (world 'get_relation 'brawlers))
-
-(brawlers 'display)
-
-(define jack
-    (brawlers 'get_tuple '(('id 1)))
-
-(jack 'display)
+    (world4 'get_relation 'brawlers))
 
-(define new-world (create-datastore (ds init)))
+(brawlers)
 
+(define jack (car (brawlers 'read '((id 1)) '(name brawn brains moves cool karma))))
 
-(define fields '(x y z p q))
-(define tf (tuple-factory fields))
-(define xyzpq (tf '(1 1 2 3 5)))
-
-(newline)
-
-(xyzpq)
-(xyzpq 'z)
-((xyzpq 'q 8))
-
-(newline)
-
-(define ts
-    '((1 1 2 3 5)
-      (8 13 21 34 55)
-      (0 0 2 1 0)  
-      (1 1 1 1 1)
-      (0 0 0 0 0)))
-
-(define table (relation 'numbers fields ts))
+(displayln (jack 'cool))
 
 (define (unroll xs)
     (map (λ (tup) (tup)) xs))
 
-(table 'name)
-(table 'fields)
-
-(unroll (table 'read '((x 0) (q 0)) '(y z p)))
-((table 'read-row '((p 3)) '(x y z)))
-(table 'read-val '((z 21)) '(q))
-
 (unroll
-    (table 'read
-	(λ (tup)
-	    (let ((total (apply + (map tup (table 'fields)))))
-		(or (= (tup 'z) 21) (and (> total 4) (< total 16)))))
-	'(x y z p q)))
-
-(newline)
-
-(table)
-
-(define table2 (table 'create '((8 6 7 5 3) (0 9 8 6 7) (5 3 0 9 9))))
-
-(table2)
-
-(define table3 (table2 'update '((x 0)) '((y 3))))
-
-(table3)
-
-(define table4 (table3 'update
-    (λ (t) (> (apply + (map t (table3 'fields))) 10))
-    (λ (t) (let ((xyz (map t '(x y z))))
-	 (append xyz (list (apply + xyz) (apply * xyz)))))))
-
-(table4)
-
-(define table5 (table4 'delete (λ (t) (> (apply + (map t (table4 'fields))) 100))))
-
-(table5)
-
-(define table6 (table5 'delete '((x 1))))
+    (world4 'read 'brawlers
+	(λ (tup) (> (tup 'brawn) 10))
+	'(id name)))
 
-(table6)
+(define world5
+    (world4 'update 'brawlers
+	(λ (t) (> (apply + (map t '(brawn brains moves cool))) 12))
+	(λ (t) (map (t 'cool 37) bfields))))
 
+(world5)
 
+(define world6
+    (world5 'delete 'brawlers
+	(λ (t) (< (apply + (map t '(brawn moves))) 8))))
 
+(world6)
 
+(world6 'relations)
 
+(world6 'indexes)