Merge pull request #21 from Dr-Nekoma/ffi-and-pagination

FFI and Pagination

.gitignore

@@ -7,3 +7,5 @@ racketowerDB/main
 .DS_Store
 compiled/
 /doc/
+/utilities/*.o
+libbplustree.so

ast.rkt

@@ -4,6 +4,9 @@
   check-local-constraints
   (struct+updaters-out table)
   fields-size
+  table-row-size
+  extract-value
+  lookup-table-in-schema
   (struct+updaters-out procedure)
   (struct+updaters-out field)
   (struct+updaters-out integer32)
@@ -85,6 +88,10 @@
    (define (deserialize _self byte-stream)
      (integer32 (integer-bytes->integer (subbytes byte-stream 0 4) #t)))])
 
+(define (field-size field)
+  (let [(type (field-type field))]
+    (type-byte-size type)))
+
 (define-serializable field [position type] #:transparent
   #:guard
   (checked-guard
@@ -120,6 +127,33 @@
               ((eval-syntax constraint) rows))
       constraints)))
 
+(define (table-row-size table)
+  (let [(fields (hash-values (table-fields table)))]
+    (foldl (lambda (field acc) (+ acc (field-size field))) 0 fields)))
+
+(define (lookup-table-in-schema schema table-name)
+  (let [(entity (hash-ref schema table-name))]
+    (cond
+      [(table? entity) entity]
+      [(procedure? entity)
+       (error "Don't write procedures yet")])))
+
+(define (table-column-value table table-name column-name)
+  (define (column-name-message column-name)
+      (error (format "Could not find column ~s in table fields of table ~s" column-name table-name)))
+
+  (let* [(column-field (hash-ref (table-fields table) column-name (lambda () (column-name-message column-name))))
+         (field-type (field-type column-field))
+         (name (type-name field-type))]
+    (case name
+      [[INTEGER] integer32-value]
+      [[VARCHAR] (error "TODO: We only support integers for now and you asked for a string bud xD")]
+      [else (error (format "Could not find type ~a in table's fields: ~a" name (table-fields table)))])))
+
+(define (extract-value schema table-name column-name)
+  (~> (lookup-table-in-schema schema table-name)
+      (table-column-value _ table-name column-name)))
+
 (define-serializable table
   [identifier row-id fields local-constraints] #:transparent
   #:guard

bplustree.rkt

@@ -0,0 +1,31 @@
+#lang racket
+
+(require ffi/unsafe
+         ffi/unsafe/define)
+
+(provide insert
+	 find_and_get_value
+	 find_and_get_node
+	 print_leaves
+	 print_tree
+	 convert-leaves
+	 deref-row-id
+	 _RECORD
+	 _RECORD-pointer
+	 RECORD->list)
+
+(define-cstruct _RECORD ([chunkNumber _int]
+                         [pageNumber _int]
+                         [slotNumber _int]))
+
+(define-ffi-definer define-bplustree (ffi-lib "libbplustree"))
+
+(define-bplustree insert (_fun _pointer _int _int _int _int -> _pointer))
+(define-bplustree find_and_get_value (_fun _pointer _int _bool -> _pointer))
+(define-bplustree find_and_get_node (_fun _pointer _int _pointer -> _pointer))
+(define-bplustree print_leaves (_fun _pointer -> _void))
+(define-bplustree print_tree (_fun _pointer -> _void))
+
+(define (convert-leaves ptr size) (ptr-ref ptr (_array/vector _RECORD-pointer size)))
+
+(define (deref-row-id row-id-ptr) (RECORD->list (ptr-ref row-id-ptr _RECORD)))

flake.nix

@@ -20,6 +20,7 @@
       devShells.default = pkgs.mkShell {
         packages = with pkgs; [ 
           just
+          gcc
 
           # Backend and Query Language
           racket 

io.rkt

@@ -33,22 +33,17 @@
      (bytes-join _ #"")))
 
   (define (write-row-to-disk schema table-name row)
-    (let [(entity (hash-ref schema table-name))]
-      (cond
-        [(table? entity)
-         (let* [(converted-row (convert-row entity row))
-                (row-id (table-row-id entity))
-                (total-size (fields-size (table-fields entity)))
-                (off-set (* row-id total-size))
-                (file-name (build-ndf-filename table-name #:data? 'data))]
-           (call-with-output-file file-name #:exists 'can-update
-             (lambda [out]
-               (file-position out off-set)
-               (write-bytes converted-row out)))
-           (set! schema (update-row-id-table schema table-name (+ row-id 1))))]
-        [(procedura? entity)
-         (println "Don't write procedures yet")])
-      schema))
+    (let* [(table (lookup-table-in-schema schema table-name))
+           (converted-row (convert-row table row))
+           (row-id (table-row-id table))
+           (total-size (fields-size (table-fields table)))
+           (off-set (* row-id total-size))
+           (file-name (build-ndf-filename table-name #:data? 'data))]
+      (call-with-output-file file-name #:exists 'can-update
+        (lambda [out]
+          (file-position out off-set)
+          (write-bytes converted-row out)))
+      (update-row-id-table schema table-name (+ row-id 1))))
 
   (define (write-rows-to-disk schema table-name rows)
     (if (empty? rows)
@@ -58,13 +53,13 @@
         (write-rows-to-disk new-schema table-name (rest rows)))))
 
   (define (update-row-id-table schema table-name id)
-    (let [(entity (hash-ref schema table-name))]
-      (cond
-        [(table? entity)
-         (hash-set! schema table-name (table-row-id-set entity id))
-         schema]
-        [(procedura? entity)
-         (raise 'tried-update-row-id-with-procedure)])))
+    (hash-set!
+     schema
+     table-name
+     (table-row-id-set
+      (lookup-table-in-schema schema table-name)
+      id))
+    schema)
 
   (define (write-table-to-disk table table-name)
     (define-values (_table-size serialized-table) (serialize table))
@@ -131,41 +126,43 @@
            (in (open-input-file file-name #:mode 'binary))]
       (deserialize struct:table (port->bytes in #:close? #t))))
 
-  (define (read-table-values-from-disk schema table-name)
-    (let* [(file-name (build-ndf-filename #:data? 'data table-name))
-           (in (open-input-file file-name #:mode 'binary))
-           (byte-stream (port->bytes in #:close? #t))
-           (entity (hash-ref schema table-name))]
-      (cond
-        [(table? entity)
-         (define (create-pair key-field) (cons (car key-field) (field-type (cdr key-field))))
-         (define (sort-by-position key-field1 key-field2)
-           (let [(p1 (field-position (cdr key-field1)))
-                 (p2 (field-position (cdr key-field2)))]
-             (< p1 p2)))
-         (define (reconstruct-literal-data accumulator fields sub-byte-stream)
-           (let* [(first-elem (first fields))
-                  (name (car first-elem))
-                  (type (cdr first-elem))
-                  (size (type-byte-size type))
-                  (new-literal (from-bytes type (subbytes sub-byte-stream 0 size)))
-                  (return (append (list (cons name new-literal)) accumulator))
-                  (rest-fields (rest fields))
-                  (remaining-bytes (subbytes sub-byte-stream size (bytes-length sub-byte-stream)))]
-             (if (empty? rest-fields)
-               (cons return remaining-bytes)
-               (reconstruct-literal-data return rest-fields remaining-bytes))))
-         (define (reconstruct-all-literals accumulator fields inner-byte-stream)
-           (let* [(one-line (reconstruct-literal-data (list) fields inner-byte-stream))
-                  (computed-line (list (car one-line)))
-                  (remaining-bytes (cdr one-line))
-                  (return (append accumulator computed-line))]
-             (if (bytes=? #"" remaining-bytes)
-               return
-               (reconstruct-all-literals return fields remaining-bytes))))
-         (~>
-           (hash->list (table-fields entity))
-           (sort _ sort-by-position)
-           (map create-pair _)
-           (reconstruct-all-literals (list) _ byte-stream))]
-        [(procedura? entity) (raise 'tried-deserialize-procedure-in-table-function)]))))
+  ;; TODO: This function should account for eventual errors LOL
+  (define (read-table-values-from-disk schema table-name #:source [source #""])
+    (define file-name (build-ndf-filename #:data? 'data table-name))
+    (define byte-stream
+      (if (bytes-empty? source)
+          (port->bytes (open-input-file file-name #:mode 'binary) #:close? #t)
+          source))
+    ;; TODO: This validation should be done in the caller
+    (define entity (lookup-table-in-schema schema table-name))
+    (define (create-pair key-field) (cons (car key-field) (field-type (cdr key-field))))
+    (define (sort-by-position key-field1 key-field2)
+      (let [(p1 (field-position (cdr key-field1)))
+            (p2 (field-position (cdr key-field2)))]
+        (< p1 p2)))
+    (define (reconstruct-literal-data accumulator fields sub-byte-stream)
+      (let* [(first-elem (first fields))
+             (name (car first-elem))
+             (type (cdr first-elem))
+             (size (type-byte-size type))
+             (new-literal (from-bytes type (subbytes sub-byte-stream 0 size)))
+             (return (append (list (cons name new-literal)) accumulator))
+             (rest-fields (rest fields))
+             (remaining-bytes (subbytes sub-byte-stream size (bytes-length sub-byte-stream)))]
+        (if (empty? rest-fields)
+            (cons return remaining-bytes)
+            (reconstruct-literal-data return rest-fields remaining-bytes))))
+    (define (reconstruct-all-literals accumulator fields inner-byte-stream)
+      (let* [(one-line (reconstruct-literal-data (list) fields inner-byte-stream))
+             (computed-line (list (car one-line)))
+             (remaining-bytes (cdr one-line))
+             (return (append accumulator computed-line))]
+        (if (bytes=? #"" remaining-bytes)
+            return
+            (reconstruct-all-literals return fields remaining-bytes))))
+    (~>
+     (hash->list (table-fields entity))
+     (sort _ sort-by-position)
+     (map create-pair _)
+     (reconstruct-all-literals (list) _ byte-stream)
+     (map make-hash _))))

justfile

@@ -1,8 +1,15 @@
 # TODO: Check if you are already inside nix shell before running any just commands
 
+bplustree:
+	gcc -c -fPIC utilities/bplustree.c -o utilities/bplustree.o
+	gcc utilities/bplustree.o -shared -o libbplustree.so
+
 build:
 	raco exe --gui main.rkt
 
+run: build bplustree
+	./main
+
 install:
 	raco pkg install
 

main.rkt

@@ -6,7 +6,9 @@
   (submod RacketowerDB/io reader)
   ;(submod RacketowerDB/language parser)
   (submod RacketowerDB/backend server)
-  RacketowerDB/util)
+  RacketowerDB/bplustree
+  RacketowerDB/util
+  RacketowerDB/pagination)
 
 ;; review if this is needed for eval-syntax
 (dynamic-require 'RacketowerDB/ast 0)
@@ -75,7 +77,7 @@
   (define row1
     `(("NAME" . ,(stringl "Nathan"))
       ("EDITOR" . ,(stringl "Visual Studio Code"))
-      ("AGE" . ,(integer32 123))))
+      ("AGE" . ,(integer32 100))))
 
   (define row2
     `(("NAME" . ,(stringl "Lemos"))
@@ -84,27 +86,60 @@
 
   (define row3
     `(("MODEL" . ,(stringl "Ford"))
-      ("YEAR" . ,(integer32 1999))))
+      ("YEAR" . ,(integer32 1996))))
 
   (define row4
-    `(("MODEL" . ,(stringl "Abc"))
-      ("YEAR" . ,(integer32 2013))))
+    `(("MODEL" . ,(stringl "Abcd"))
+      ("YEAR" . ,(integer32 1999))))
 
-  (check-local-constraints programmer-table (list row1 row2))
-  (hash-set! schema "CAR" car-table)
-  (hash-set! schema "TEST" procedure-test)
+  (define row5
+    `(("MODEL" . ,(stringl "asdf"))
+      ("YEAR" . ,(integer32 1996))))
+
+  (define row6
+    `(("MODEL" . ,(stringl "jkl;"))
+      ("YEAR" . ,(integer32 1997))))
+
+  (define row7
+    `(("MODEL" . ,(stringl "Mach 6"))
+      ("YEAR" . ,(integer32 1997))))
+
+  (define row8
+    `(("MODEL" . ,(stringl "qwer"))
+      ("YEAR" . ,(integer32 1997))))
+
+  (define row9
+    `(("MODEL" . ,(stringl "Mach 5"))
+      ("YEAR" . ,(integer32 1997))))
+
+  (define row10
+    `(("MODEL" . ,(stringl "Tesla"))
+      ("YEAR" . ,(integer32 2020))))
+
+  (define row11
+    `(("MODEL" . ,(stringl "Honda"))
+      ("YEAR" . ,(integer32 1996))))
+
   (hash-set! schema "PROGRAMMER" programmer-table)
-  (write-schema-to-disk schema)
-  (set! schema (read-schema-from-disk "schema"))
-  (check-local-constraints (hash-ref schema "PROGRAMMER") (list row1 row2))
-  (println schema)
+  (hash-set! schema "CAR" car-table)
+  (set! schema (write-rows-to-disk schema "CAR" (list row3 row4 row5 row6 row7 row8 row9 row10 row11)))
   (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2)))
-  (println (read-table-values-from-disk schema "PROGRAMMER"))
-  (write-table-to-disk programmer-table "PROGRAMMER")
-  (let ((read-table (read-table-from-disk "PROGRAMMER")))
-    (hash-set! schema "PROGRAMMER" read-table)
-    (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2)))
-    (println schema)))
+  ;; (println (read-table-values-from-disk schema "PROGRAMMER"))
+  ;; (define-values (pages amount-already-read) (build-pages 0 1 1 (+ 7 10 4) 0 "AGE" schema "PROGRAMMER"))  
+  (println (search schema (query "PROGRAMMER" "AGE" 100)))
+  ;; (check-local-constraints programmer-table (list row1 row2))
+  ;; (hash-set! schema "TEST" procedure-test)
+  ;; (write-schema-to-disk schema)
+  ;; (set! schema (read-schema-from-disk "schema"))
+  ;; (check-local-constraints (hash-ref schema "PROGRAMMER") (list row1 row2))
+  ;; (println schema)
+  ;; (write-table-to-disk programmer-table "PROGRAMMER")
+  ;; (let ((read-table (read-table-from-disk "PROGRAMMER")))
+  ;;   (hash-set! schema "PROGRAMMER" read-table)
+  ;;   (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2)))
+  ;;   (println schema))
+  ;; (tree-test)
+  )
 
   ;;(exit-handler)
   ;;(server-entrypoint)