From e6d99d3b1654f90c79d450e15150879f189e3da1 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Fri, 10 Nov 2023 22:37:58 -0300 Subject: [PATCH 01/13] Migrate cursed modern OOP to new design --- ast.rkt | 214 ++++++++++++++++++-------------------- info.rkt | 3 +- io.rkt | 162 +++++++++++++++-------------- language.rkt | 230 ++++++++++++++++++++--------------------- main.rkt | 48 +++------ ndf/schemas/schema.ndf | Bin 192 -> 191 bytes util.rkt | 118 ++++++++++++--------- 7 files changed, 387 insertions(+), 388 deletions(-) diff --git a/ast.rkt b/ast.rkt index 753396a..61b8eaa 100644 --- a/ast.rkt +++ b/ast.rkt @@ -1,135 +1,121 @@ #lang racket (require racket/class) -(require racket/base) -(require racket/serialize) +(require struct-update) +(require racket/generic) +(require (except-in racket/serialize + serialize + deserialize + serializable?)) (require threading) -(provide table%) -(provide procedure%) -(provide field%) -(provide type%) -(provide string%) -(provide integer32%) -(require RacketowerDB/util) +(provide (struct+updaters-out table)) +(provide fields-size) +(provide (struct+updaters-out procedure)) +(provide (struct+updaters-out fyeld)) +(provide (struct+updaters-out type)) +(provide stringl) +(provide integer32) +(require (only-in RacketowerDB/util define-serializable entity-structs)) (require (submod RacketowerDB/util interfaces)) -(require (submod RacketowerDB/util classes)) +(require (submod RacketowerDB/util hashable)) -(define-serializable type% - [class* object% (bytable<%> serializable<%>) - (init-field [name null] - [byte-size null]) - (define/public (from-bytes byte-stream) +(define-serializable type + (name byte-size) #:transparent + #:methods gen:byteable + [(define (from-bytes self byte-stream) (let ((received-bytes-size (bytes-length byte-stream))) - (if (eq? received-bytes-size byte-size) - (case (list 'quote (string->symbol name)) - [('INTEGER) (new integer32% [value (integer-bytes->integer byte-stream #t)])] - [('VARCHAR) (new string% [value (bytes->string/utf-8 byte-stream)])] + (if (eq? received-bytes-size (type-byte-size self)) + (case (list 'quote (string->symbol (type-name self))) + [('INTEGER) (integer32 (integer-bytes->integer byte-stream #t))] + [('VARCHAR) (stringl (bytes->string/utf-8 byte-stream))] [else (raise 'error-with-unknown-type-from-bytes)]) (raise 'error-with-from-bytes-size-check)))) - (define/public (to-byte-size) - byte-size) - (define/public (serialize) - (let* ((name-bytes (string->bytes/utf-8 (symbol->string name))) + (define (to-byte-size self) + (type-byte-size self))] + #:methods gen:serializable + [(define (serialize self #:size [_size #f]) + (let* ((name-bytes (string->bytes/utf-8 (symbol->string (type-name self)))) (name-length (integer->integer-bytes (bytes-length name-bytes) 1 #t)) - (byte-size-bytes (integer->integer-bytes byte-size 4 #t))) + (byte-size-bytes (integer->integer-bytes (type-byte-size self) 4 #t))) (bytes-append name-length name-bytes byte-size-bytes))) - (define/public (deserialize byte-stream) - (let* ((name-length (integer-bytes->integer (make-bytes 1 (bytes-ref byte-stream 0)) #t)) + (define (deserialize _self byte-stream) + (let* ((name-length (integer-bytes->integer (make-bytes 1 (bytes-ref byte-stream 0)) #t)) (name-value (bytes->string/utf-8 (subbytes byte-stream 1 (+ 1 name-length)))) (byte-size-value (integer-bytes->integer (subbytes byte-stream (+ 1 name-length) (+ 3 name-length)) #t))) - (set-field! name this name-value) - (set-field! byte-size this byte-size-value) - (+ 5 name-length))) - (super-new)]) + (values (type name-value byte-size-value) (+ 5 name-length))))]) -(define literal% - (class* object% (printable<%>) - (init-field [value null]) - (define/public (custom-print port _) - (print value port)) - (define/public (custom-write port) - (write value port)) - (define/public (custom-display port) - (display value port)) - (super-new))) - -(define string% - (class* literal% (serializable<%>) - (define/public (serialize type) - (let* ((size-of-type (get-field byte-size type)) - (size-of-string (string-length value))) - (if (< size-of-type size-of-string) - (string->bytes/utf-8 (substring value 0 size-of-type)) ;; Truncate - (let ((dest-bytes (make-bytes size-of-type 0)) +(define-serializable stringl + (value) #:transparent + #:methods gen:serializable + [(define (serialize self #:size [size #f]) + (unless size (error "size is required")) + (let* ((value (stringl-value self)) + (size-of-string (string-length value))) + (if (< size size-of-string) + (string->bytes/utf-8 (substring value 0 size)) ;; Truncate + (let ((dest-bytes (make-bytes size 0)) (serialyzed-string (string->bytes/utf-8 value))) (bytes-copy! dest-bytes 0 serialyzed-string) - dest-bytes)))) ;; Padding - (define/public (deserialize byte-array) - (set-field! value this (string-trim (bytes->string/utf-8 byte-array))) - (bytes-length byte-array)) - (inherit-field value) - (super-new))) + dest-bytes)))) + (define (deserialize _self byte-stream) + (values (stringl (string-trim (bytes->string/utf-8 byte-stream)) (bytes-length byte-stream))))]) -(define integer32% - (class* literal% (serializable<%>) - (define/public (serialize _) - (integer->integer-bytes value 4 #t)) - (define/public (deserialize byte-array) - (set-field! value this (integer-bytes->integer (subbytes byte-array 0 4) #t)) - 4) - (inherit-field value) - (super-new))) +(define-serializable integer32 + (value) #:transparent + #:methods gen:serializable + [(define (serialize self #:size [_size #f]) + (integer->integer-bytes (integer32-value self) 4 #t)) + (define (deserialize _self byte-stream) + (values (integer32 (integer-bytes->integer (subbytes byte-stream 0 4) #t)) 4))]) -(define-serializable field% - (class hashable% - (init-field [position null] - [type null]) - (define/override (serialize) - (let ((position-bytes (integer->integer-bytes position 1 #t)) - (type-bytes (send type serialize))) +(define-serializable fyeld + (position type) #:transparent + #:methods gen:serializable + [(define/generic super-serialize serialize) + (define (serialize self #:size [_size #f]) + (let* ((position (fyeld-position self)) + (position-bytes (integer->integer-bytes position 1 #t)) + (type (fyeld-type self)) + (type-bytes (super-serialize type #:size (type-byte-size type)))) (bytes-append position-bytes type-bytes))) - (define/override (deserialize byte-stream) - (let* ((position-value (integer-bytes->integer (make-bytes 1 (bytes-ref byte-stream 0)) #t)) - (type-bytes (subbytes byte-stream 1)) - (new-type (new type%)) - (type-consumed (send new-type deserialize type-bytes))) - (set-field! type this new-type) - (set-field! position this position-value) - (+ 1 type-consumed))) - (super-new))) + (define (deserialize self byte-stream) + (let* ((position-value (integer-bytes->integer (make-bytes 1 (bytes-ref byte-stream 0)) #t)) + (type-bytes (subbytes byte-stream 1))) + (define-values (new-type type-consumed) (deserialize struct:type type-bytes)) + (values (fyeld position-value new-type) (+ 1 type-consumed))))]) + +(define (fields-size fields) + (let* ((fields-values (hash-values fields))) + (foldl (lambda (elem acc) + (let ((size (type-byte-size (fyeld-type elem)))) + (+ acc size))) + 0 fields-values))) + +(define-serializable table + (identifier row-id fields) #:transparent + #:methods gen:identifiable + [(define (give-identifier self) + (table-identifier self))] + #:methods gen:serializable + [(define (serialize self #:size [_size #f]) + (let* ((row-id (table-row-id self)) + (row-id-bytes (integer->integer-bytes row-id 4 #t)) + (fields-list (hash->list (table-fields self)))) + (bytes-append row-id-bytes (serialize-hash-list fields-list) #"\n"))) ;; Maybe the math is wrong because of this + (define (deserialize self byte-stream) + (let* ((row-id-value (integer-bytes->integer (subbytes byte-stream 0 4) #t)) + (fields-value (make-hash (deserialize-hash-list struct:fyeld (subbytes byte-stream 4) '())))) + (values (table "table" row-id-value fields-value) (bytes-length byte-stream))))]) -(define-serializable table% - (class hashable% - (define/public (fields-size) - (let* ((fields-values (hash-values fields))) - (foldl (lambda (elem acc) - (let ((size (get-field byte-size (get-field type elem)))) - (+ acc size))) - 0 fields-values))) - (init-field [row-id 0] - [identifier "table%"] - [fields (make-hash (list))]) - (define/override (serialize) - (let* ((row-id-bytes (integer->integer-bytes row-id 4 #t)) - (new-field (make-object field%)) - (fields-list (hash->list fields))) - (bytes-append row-id-bytes (send new-field serialize-hash-list fields-list)))) - (define/override (deserialize byte-array) - (let* ((row-id-value (integer-bytes->integer (subbytes byte-array 0 4) #t)) - (new-field (make-object field%)) - (fields-value (make-hash (send new-field deserialize-hash-list (subbytes byte-array 4) '())))) - (set-field! row-id this row-id-value) - (set-field! fields this fields-value) - (bytes-length byte-array))) - (super-new))) - - (define-serializable procedure% - (class hashable% - (init-field [identifier "procedure%"]) - (define/override (serialize) - (string->bytes/utf-8 "procedures' serialization is not yet implemented")) - (define/override (deserialize byte-array) - (println "procedures' deserialization is not yet implemented") - (bytes-length byte-array)) - (super-new))) +(define-serializable procedure + (identifier) #:transparent + #:methods gen:identifiable + [(define (give-identifier self) + (procedure-identifier self))] + #:methods gen:serializable + [(define (serialize _self #:size [_size #f]) + (bytes-append (string->bytes/utf-8 "procedures' serialization is not yet implemented") #"\n")) ;; Maybe the math is wrong because of this + {define (deserialize _self byte-stream) + (println "procedures' deserialization is not yet implemented") + (values (procedure "procedure") (bytes-length byte-stream))}]) diff --git a/info.rkt b/info.rkt index dee97f2..d72de96 100644 --- a/info.rkt +++ b/info.rkt @@ -2,7 +2,8 @@ (define collection "RacketowerDB") (define deps '("racket" "threading-lib" - "beautiful-racket")) + "beautiful-racket" + "struct-update-lib")) (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib")) diff --git a/io.rkt b/io.rkt index e32385e..894a488 100644 --- a/io.rkt +++ b/io.rkt @@ -3,20 +3,24 @@ (require racket/base) (require threading) (require racket/serialize) -(require RacketowerDB/ast) +(require (rename-in RacketowerDB/ast (procedure? procedura?))) (module+ writer (require RacketowerDB/util) + (require (submod RacketowerDB/util interfaces)) + (require (submod RacketowerDB/util hashable)) + (require struct-update) (provide write-rows-to-disk) (provide write-table-to-disk) (provide write-schema-to-disk) (define (convert-literal table attribute-name literal) - (let* ((attribute (hash-ref (get-field fields table) + (let* ((attribute (hash-ref (table-fields table) attribute-name)) - (type (get-field type attribute)) - (position (get-field position attribute))) - (cons position (send literal serialize type)))) + (type (fyeld-type attribute)) + (type-size (type-byte-size type)) + (position (fyeld-position attribute))) + (cons position (serialize literal type-size)))) (define (convert-row table row) (~> @@ -30,16 +34,15 @@ (define (update-row-id-table schema table-name id) (let ((entity (hash-ref schema table-name))) (cond - [(is-a? entity table%) + [(table? entity) (begin - (set-field! row-id entity id) - (hash-set! schema table-name entity) + (hash-set! schema table-name (table-row-id-set table id)) schema)] - [(is-a? entity procedure%) + [(procedura? entity) (raise 'tried-update-row-id-with-procedure)]))) (define (write-table-to-disk table table-name) - (let* ((serialized-table (send table serialize)) + (let* ((serialized-table (serialize table)) (file-name (build-ndf-filename table-name)) (out (open-output-file file-name #:exists 'can-update))) (write-bytes serialized-table out) @@ -54,28 +57,24 @@ (define (write-schema-to-disk schema) (define (write-entity-to-disk file-out entities-list) - (let* ((entity-name (get-field identifier (cdr (car entities-list)))) - (serialized-name (string->bytes/utf-8 entity-name)) - (new-entity (make-object (hash-ref entity-classes entity-name)))) + (let* ((entity-name (give-identifier (cdr (car entities-list))))) (write-string entity-name file-out) (newline file-out) - (write-bytes (send new-entity serialize-hash-list entities-list) file-out) - (newline file-out) - )) + (write-bytes (serialize-hash-list entities-list) file-out))) ;; Maybe the math is wrong because of this (let* ((schema-list (hash->list schema)) (file-name (build-ndf-filename "schema" #:data? 'schema)) (out (open-output-file file-name #:exists 'can-update))) - (~>> (group-by (lambda (x) (get-field identifier (cdr x))) schema-list) + (~>> (group-by (lambda (x) (give-identifier (cdr x))) schema-list) (map (curry write-entity-to-disk out))) (close-output-port out))) (define (write-row-to-disk schema table-name row) (let ((entity (hash-ref schema table-name))) (cond - [(is-a? entity table%) + [(table? entity) (let* ((converted-row (convert-row entity row)) - (row-id (get-field row-id entity)) - (total-size (send entity fields-size)) + (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)) (out (open-output-file file-name #:exists 'can-update))) @@ -83,78 +82,87 @@ (write-bytes converted-row out) (close-output-port out) (set! schema (update-row-id-table schema table-name (+ row-id 1))))] - [(is-a? entity procedure%) + [(procedura? entity) (println "Don't write procedures yet")]) schema))) (module+ reader (require RacketowerDB/util) + (require (submod RacketowerDB/util hashable)) (require RacketowerDB/ast) (require racket/hash) (provide read-schema-from-disk) (provide read-table-from-disk) - (provide read-table-values-from-disk) + ;; (provide read-table-values-from-disk) (define (read-schema-from-disk schema-name) + (define (build-hash-from-line struct-instance line-in-bytes) + (make-immutable-hash + (deserialize-hash-list + struct-instance + line-in-bytes + '()))) + (define (proceed-reading struct-name current-schema line-in-bytes) + (let ((line (bytes->string/utf-8 line-in-bytes))) + (if (hash-has-key? entity-structs line) + (cons line current-schema) + (cons struct-name (hash-union current-schema (build-hash-from-line (hash-ref entity-structs struct-name) line-in-bytes)))))) (let* ((file-name (build-ndf-filename schema-name #:data? 'schema)) (in (open-input-file file-name #:mode 'binary)) (schema (make-immutable-hash (list))) - (read-lines (fix-empty-read-bytes-lines (port->bytes-lines in))) - (builder-class null)) - (println read-lines) - (for/list ([i (length read-lines)]) - (if (even? i) - (set! builder-class (hash-ref entity-classes (bytes->string/utf-8 (list-ref read-lines i)))) - (set! schema (hash-union schema (make-immutable-hash - (send - (make-object builder-class) - deserialize-hash-list - (list-ref read-lines i) - '())))))) - (make-hash (hash->list schema)))) + (real-lines (port->bytes-lines in)) + (read-lines (fix-empty-read-bytes-lines real-lines))) + (~> (foldl + (lambda (line-in-bytes acc) + (let ((builder-struct (car acc)) + (current-schema (cdr acc))) + (proceed-reading builder-struct current-schema line-in-bytes))) + (cons null schema) read-lines) + cdr + hash->list + make-hash))) (define (read-table-from-disk table-name) (let* ((file-name (build-ndf-filename table-name)) - (in (open-input-file file-name #:mode 'binary)) - (table (new table%))) - (send table deserialize (port->bytes in)) - table)) + (in (open-input-file file-name #:mode 'binary))) + (define-values (table table-consumed) (deserialize struct:table (port->bytes in))) + table))) - (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)) - (entity (hash-ref schema table-name))) - (cond - [(is-a? entity table%) - (define (create-pair key-field) (cons (car key-field) (get-field type (cdr key-field)))) - (define (sort-by-position key-field1 key-field2) - (let ((p1 (get-field position (cdr key-field1))) - (p2 (get-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 (get-field byte-size type)) - (new-literal (send type from-bytes (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 (get-field fields entity)) - (sort _ sort-by-position) - (map create-pair _) - (reconstruct-all-literals (list) _ byte-stream))] - [(is-a? entity procedure%) (raise 'tried-deserialize-procedure-in-table-function)])))) + ;; (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)) + ;; (entity (hash-ref schema table-name))) + ;; (cond + ;; [(is-a? entity table%) + ;; (define (create-pair key-field) (cons (car key-field) (get-field type (cdr key-field)))) + ;; (define (sort-by-position key-field1 key-field2) + ;; (let ((p1 (get-field position (cdr key-field1))) + ;; (p2 (get-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 (get-field byte-size type)) + ;; (new-literal (send type from-bytes (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 (get-field fields entity)) + ;; (sort _ sort-by-position) + ;; (map create-pair _) + ;; (reconstruct-all-literals (list) _ byte-stream))] + ;; [(is-a? entity procedure%) (raise 'tried-deserialize-procedure-in-table-function)])))) diff --git a/language.rkt b/language.rkt index 572909a..3306d0d 100644 --- a/language.rkt +++ b/language.rkt @@ -1,129 +1,129 @@ #lang racket -(module lex racket - (require parser-tools/lex) - (require (prefix-in : parser-tools/lex-sre)) +;; (module lex racket +;; (require parser-tools/lex) +;; (require (prefix-in : parser-tools/lex-sre)) - (define (tokenizer ip) - (letrec ([one-line - (lambda () - (let ([result (mappings/tokens ip)]) - (unless (equal? (position-token-token result) 'EOF) - (printf "~a\n" result) - (one-line) - )))]) - (one-line))) +;; (define (tokenizer ip) +;; (letrec ([one-line +;; (lambda () +;; (let ([result (mappings/tokens ip)]) +;; (unless (equal? (position-token-token result) 'EOF) +;; (printf "~a\n" result) +;; (one-line) +;; )))]) +;; (one-line))) - (define-lex-abbrev keywords (:or "BEGIN" "END" "INSERT" "CREATE" "RELATION" "PROJECT" "SELECT")) - (define-lex-abbrev types (:or "STRING" "INTEGER")) - (define-empty-tokens keyword-tokens - (STRING INTEGER)) - (define-empty-tokens operation-tokens (LESS GREATER EQUAL)) - (define-empty-tokens empty-keyword-tokens - (PROJECT CREATE BEGIN ON SELECT END RELATION)) - (define-empty-tokens punctuation-tokens (LPAREN RPAREN COMMA EOF)) - (define-tokens basic-tokens - (IDENTIFIER NUMBER)) +;; (define-lex-abbrev keywords (:or "BEGIN" "END" "INSERT" "CREATE" "RELATION" "PROJECT" "SELECT")) +;; (define-lex-abbrev types (:or "STRING" "INTEGER")) +;; (define-empty-tokens keyword-tokens +;; (STRING INTEGER)) +;; (define-empty-tokens operation-tokens (LESS GREATER EQUAL)) +;; (define-empty-tokens empty-keyword-tokens +;; (PROJECT CREATE BEGIN ON SELECT END RELATION)) +;; (define-empty-tokens punctuation-tokens (LPAREN RPAREN COMMA EOF)) +;; (define-tokens basic-tokens +;; (IDENTIFIER NUMBER)) - (define mappings/tokens - (lexer-src-pos - [(eof) (token-EOF)] - ["(" (token-LPAREN)] - [")" (token-RPAREN)] - ["," (token-COMMA) ] - [">" (token-GREATER) ] - ["<" (token-LESS) ] - ["=" (token-EQUAL) ] - ["PROJECT" (token-PROJECT) ] - ["CREATE" (token-CREATE) ] - ["BEGIN" (token-BEGIN) ] - ["ON" (token-ON) ] - ["SELECT" (token-SELECT) ] - ["END" (token-END) ] - ["RELATION" (token-RELATION) ] - ["STRING" (token-STRING) ] - ["INTEGER" (token-INTEGER) ] - [keywords (string->symbol lexeme)] - [types (string->symbol lexeme)] - [(:+ numeric) (token-NUMBER (string->number lexeme))] - [(:: (:or alphabetic #\_) (:* (:or alphabetic numeric #\_))) (token-IDENTIFIER lexeme)] - ;; [(repetition 1 +inf.0 numeric) (string->number lexeme)] - [whitespace (return-without-pos (mappings/tokens input-port))])) +;; (define mappings/tokens +;; (lexer-src-pos +;; [(eof) (token-EOF)] +;; ["(" (token-LPAREN)] +;; [")" (token-RPAREN)] +;; ["," (token-COMMA) ] +;; [">" (token-GREATER) ] +;; ["<" (token-LESS) ] +;; ["=" (token-EQUAL) ] +;; ["PROJECT" (token-PROJECT) ] +;; ["CREATE" (token-CREATE) ] +;; ["BEGIN" (token-BEGIN) ] +;; ["ON" (token-ON) ] +;; ["SELECT" (token-SELECT) ] +;; ["END" (token-END) ] +;; ["RELATION" (token-RELATION) ] +;; ["STRING" (token-STRING) ] +;; ["INTEGER" (token-INTEGER) ] +;; [keywords (string->symbol lexeme)] +;; [types (string->symbol lexeme)] +;; [(:+ numeric) (token-NUMBER (string->number lexeme))] +;; [(:: (:or alphabetic #\_) (:* (:or alphabetic numeric #\_))) (token-IDENTIFIER lexeme)] +;; ;; [(repetition 1 +inf.0 numeric) (string->number lexeme)] +;; [whitespace (return-without-pos (mappings/tokens input-port))])) - (provide keyword-tokens) - (provide empty-keyword-tokens) - (provide punctuation-tokens) - (provide basic-tokens) - (provide operation-tokens) - (provide tokenizer) - (provide mappings/tokens)) +;; (provide keyword-tokens) +;; (provide empty-keyword-tokens) +;; (provide punctuation-tokens) +;; (provide basic-tokens) +;; (provide operation-tokens) +;; (provide tokenizer) +;; (provide mappings/tokens)) -(module+ parser - (require (submod ".." lex)) - (require parser-tools/yacc) - (require RacketowerDB/ast) - (require threading) +;; (module+ parser +;; (require (submod ".." lex)) +;; (require parser-tools/yacc) +;; (require RacketowerDB/ast) +;; (require threading) - (define (create-relation-fields fields-to-convert) - (define (create-relation-field field-to-convert index) - (let* ((name (car field-to-convert)) - (anamed-data (cdr field-to-convert)) - (type-name (car anamed-data)) - (size (cdr anamed-data))) - (cons name (new field% - [position index] - [type (new type% - [name type-name] - [byte-size size])])))) - (let ((indexes (range (length fields-to-convert)))) - (map create-relation-field fields-to-convert indexes))) +;; (define (create-relation-fields fields-to-convert) +;; (define (create-relation-field field-to-convert index) +;; (let* ((name (car field-to-convert)) +;; (anamed-data (cdr field-to-convert)) +;; (type-name (car anamed-data)) +;; (size (cdr anamed-data))) +;; (cons name (new field% +;; [position index] +;; [type (new type% +;; [name type-name] +;; [byte-size size])])))) +;; (let ((indexes (range (length fields-to-convert)))) +;; (map create-relation-field fields-to-convert indexes))) - (define parse - (parser - [start expr] - [end EOF] - [error (lambda (a b c d e) (begin (printf "tok-ok = ~a\ntok-name = ~a\ntok-value = ~a\nstart-pos = ~a\nend-pos = ~a\n" a b c d e) (void)))] - [tokens keyword-tokens punctuation-tokens operation-tokens basic-tokens empty-keyword-tokens] - [src-pos] +;; (define parse +;; (parser +;; [start expr] +;; [end EOF] +;; [error (lambda (a b c d e) (begin (printf "tok-ok = ~a\ntok-name = ~a\ntok-value = ~a\nstart-pos = ~a\nend-pos = ~a\n" a b c d e) (void)))] +;; [tokens keyword-tokens punctuation-tokens operation-tokens basic-tokens empty-keyword-tokens] +;; [src-pos] - ;; CREATE RELATION Car (A STRING(5) B INTEGER C INTEGER) +;; ;; CREATE RELATION Car (A STRING(5) B INTEGER C INTEGER) - ;; PROJECT a, b ON table_name SELECT a > 123 - ;; [grammar - ;; [expr [(LPAREN exprs RPAREN) $2] - ;; [(NUMBER) $1] - ;; [(IDENTIFIER) $1]] - ;; [exprs [() '()] - ;; [(expr exprs) (cons $1 $2)]]] +;; ;; PROJECT a, b ON table_name SELECT a > 123 +;; ;; [grammar +;; ;; [expr [(LPAREN exprs RPAREN) $2] +;; ;; [(NUMBER) $1] +;; ;; [(IDENTIFIER) $1]] +;; ;; [exprs [() '()] +;; ;; [(expr exprs) (cons $1 $2)]]] - [grammar - [expr [() null] - [(LPAREN exprs RPAREN) $2] - [(IDENTIFIER) $1] - [(NUMBER) $1] - [(PROJECT IDENTIFIER) $2] - [(SELECT exprs) $2] - [(expr operator expr) (list $1 $2 $3)] - [(CREATE RELATION IDENTIFIER LPAREN attrs RPAREN) - (cons $3 (new table% [fields (make-hash (create-relation-fields $5))]))] - [(PROJECT identifiers ON IDENTIFIER) (list $2 $4)] - [(PROJECT identifiers ON IDENTIFIER exprs) (list $2 $4 $5)] - ] - ;; [entities [(RELATION)]] - [identifiers - [() '()] - [(IDENTIFIER identifiers) (cons $1 $2)]] - [type [(STRING LPAREN NUMBER RPAREN) (cons 'VARCHAR $3)] - [(INTEGER) (cons 'INTEGER 4)]] - [operator [(LESS) "<"] - [(GREATER) ">"] - [(EQUAL) "="]] - [attr [(IDENTIFIER type) (cons $1 $2)]] - [attrs [() '()] - [(attr attrs) (cons $1 $2)]] - [exprs [() '()] - [(expr exprs) (cons $1 $2)]]] - )) +;; [grammar +;; [expr [() null] +;; [(LPAREN exprs RPAREN) $2] +;; [(IDENTIFIER) $1] +;; [(NUMBER) $1] +;; [(PROJECT IDENTIFIER) $2] +;; [(SELECT exprs) $2] +;; [(expr operator expr) (list $1 $2 $3)] +;; [(CREATE RELATION IDENTIFIER LPAREN attrs RPAREN) +;; (cons $3 (new table% [fields (make-hash (create-relation-fields $5))]))] +;; [(PROJECT identifiers ON IDENTIFIER) (list $2 $4)] +;; [(PROJECT identifiers ON IDENTIFIER exprs) (list $2 $4 $5)] +;; ] +;; ;; [entities [(RELATION)]] +;; [identifiers +;; [() '()] +;; [(IDENTIFIER identifiers) (cons $1 $2)]] +;; [type [(STRING LPAREN NUMBER RPAREN) (cons 'VARCHAR $3)] +;; [(INTEGER) (cons 'INTEGER 4)]] +;; [operator [(LESS) "<"] +;; [(GREATER) ">"] +;; [(EQUAL) "="]] +;; [attr [(IDENTIFIER type) (cons $1 $2)]] +;; [attrs [() '()] +;; [(attr attrs) (cons $1 $2)]] +;; [exprs [() '()] +;; [(expr exprs) (cons $1 $2)]]] +;; )) - (provide parse)) +;; (provide parse)) diff --git a/main.rkt b/main.rkt index 59058ef..e1d79f2 100644 --- a/main.rkt +++ b/main.rkt @@ -9,50 +9,32 @@ (check-equal? (+ 2 2) 4)) ;; http://docs.racket-lang.org/guide/Module_Syntax.html#%28part._main-and-test%29 -(module+ main +{module+ main (require racket/base) (require racket/serialize) (require racket/class) (require (submod RacketowerDB/io writer)) (require (submod RacketowerDB/io reader)) - (require (submod RacketowerDB/language parser)) + ;; (require (submod RacketowerDB/language parser)) (require (submod RacketowerDB/backend server)) (require RacketowerDB/util) - (require RacketowerDB/ast) + (require (except-in RacketowerDB/ast procedure?)) - (let* ((field-name (new field% [position 0] - [type (new type% [name 'VARCHAR] - [byte-size 5])])) - (field-editor (new field% [position 1] - [type (new type% [name 'VARCHAR] - [byte-size 5])])) - (field-year (new field% [position 0] - [type (new type% [name 'INTEGER] - [byte-size 4])])) - (table (new table% [fields (make-hash `(("NAME" . ,field-name) - ("EDITOR" . ,field-editor)))])) - (car-table (new table% [fields (make-hash `(("MODEL" . ,field-name) - ("YEAR" . ,field-year)))])) - (procedure (new procedure%)) - (schema (make-hash (list))) - (row1 `(("NAME" . ,(new string% [value "Nathan"])) - ("EDITOR" . ,(new string% [value "Visual Studio Code"])))) - (row2 `(("NAME" . ,(new string% [value "Lemos"])) - ("EDITOR" . ,(new string% [value "Emacs"])))) - (row3 `(("MODEL" . ,(new string% [value "Ford"])) - ("YEAR" . ,(new integer32% [value 1999])))) - (row4 `(("MODEL" . ,(new string% [value "Abc"])) - ("YEAR" . ,(new integer32% [value 2013])))) - (literal1 (new string% [value "potatoes"])) - (literal2 (new integer32% [value 32])) - ) - (hash-set! schema "TEST" procedure) - (hash-set! schema "PROGRAMMER" table) + (let* ((field-name (fyeld 0 (type 'VARCHAR 7))) + (field-editor (fyeld 1 (type 'VARCHAR 5))) + (field-year (fyeld 1 (type 'INTEGER 4))) + (programmer-table (table "table" 0 (make-hash `(("NAME" . ,field-name) + ("EDITOR" . ,field-editor))))) + (car-table (table "table" 0 (make-hash `(("MODEL" . ,field-name) + ("YEAR" . ,field-year))))) + (procedure-test (procedure "procedure")) + (schema (make-hash (list)))) + (hash-set! schema "TEST" procedure-test) + (hash-set! schema "PROGRAMMER" programmer-table) (hash-set! schema "CAR" car-table) (write-schema-to-disk schema) (set! schema (read-schema-from-disk "schema")) - ;; (println (get-field byte-size (get-field type (hash-ref (get-field fields (hash-ref schema "CAR")) "MODEL")))) ;; (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2))) ;; (println (read-table-values-from-disk schema "PROGRAMMER")) ;; (define sample-input (open-input-string "CREATE RELATION CAR (MODEL STRING(5) YEAR INTEGER)")) @@ -68,7 +50,7 @@ ;; (hash-set! schema new-table-name new-table) ;; (set! schema (write-rows-to-disk schema new-table-name (list row3 row4))) ;; (println schema) - )) + )} ;; (exit-handler) ;; (server-entrypoint) diff --git a/ndf/schemas/schema.ndf b/ndf/schemas/schema.ndf index 4dc3cb2aa09b1d206d17b5e5b1f97b755e5fee57..0413f8e11a4fa5a1d68c2b9be36de84175cc3067 100644 GIT binary patch delta 56 zcmX@WxSx@;peR2%HKnvDbt0GjL@zlhb_NCp79fsvbqr!;_w);Kb$1N{32;qpv|?Iz1_lNeAdYl(3}RsS^b2uycMSpwOl+`X I1xa!N0JdKYI{*Lx diff --git a/util.rkt b/util.rkt index 624b48b..e9e29ba 100644 --- a/util.rkt +++ b/util.rkt @@ -1,27 +1,22 @@ #lang racket -(require racket/base) +(require struct-update) (require threading) (require br/cond) (provide build-ndf-filename) -(provide entity-classes) +(provide entity-structs) (provide define-serializable) (provide fix-empty-read-bytes-lines) - (require syntax/parse/define (for-syntax racket/syntax)) -;; (define-syntax-parse-rule (create name) -;; #:with name-string (datum->syntax #f #'name) -;; (define name-string 2)) - (define (fix-empty-read-bytes-lines lines) (define (fix-one-turn inner-lines) (let ((newline-flag #f)) (foldl (lambda (line new-lines) - (if newline-flag + [if newline-flag (begin (begin (set! newline-flag #f) @@ -31,13 +26,12 @@ (begin (set! newline-flag #t) new-lines) - (append new-lines (list line))))) (list) inner-lines))) + (append new-lines (list line)))]) (list) inner-lines))) (define (stop-condition lines-to-check) (empty? (filter (lambda (line) (bytes=? #"" line)) lines-to-check))) (while (not (stop-condition lines)) (set! lines (fix-one-turn lines))) lines) - (define build-ndf-filename (lambda (#:data? [data? 'entity] name) (let ((path (case (list 'quote data?) @@ -47,57 +41,85 @@ [else (raise 'error-not-specified-datatype)]))) (string-append path (string-append name ".ndf"))))) -(define entity-classes (make-hash (list))) +(define entity-structs (make-hash (list))) -(define-syntax-parse-rule (define-serializable name body ...) - (begin - (define name body ...) - (hash-set! entity-classes (symbol->string 'name) name))) +(define-syntax (define-serializable stx) + (syntax-case stx () + [(define-serializable name body ...) + #`(begin + (struct name body ...) + (define-struct-updaters name) + (hash-set! + entity-structs + (symbol->string 'name) + #,(datum->syntax #'name (let ((datum-name (syntax->datum #'name))) + (string->symbol (string-append "struct:" (symbol->string datum-name)))))))])) (module interfaces racket - (provide serializable<%>) - (provide bytable<%>) + (provide + (contract-out + [give-identifier (-> identifiable? string?)] + [serialize (->* (serializable?) (#:size integer?) bytes?)] + [deserialize (-> serializable? bytes? (values serializable? natural?))] + [from-bytes (-> byteable? bytes? byteable?)] + [to-byte-size (-> byteable? natural?)]) + serializable? + byteable? + identifiable? + gen:serializable + gen:byteable + gen:identifiable) - (define serializable<%> - (interface () serialize deserialize)) + (require racket/generic) + (require racket/contract) + + (define-generics identifiable #:requires [give-identifier] + (give-identifier identifiable)) - (define bytable<%> - (interface () from-bytes to-byte-size))) + (define-generics serializable #:requires [serialize deserialize] + (serialize serializable #:size (size)) + (deserialize serializable byte-stream)) + + (define-generics byteable #:requires [from-bytes to-byte-size] + (from-bytes byteable byte-stream) + (to-byte-size byteable))) -(module+ classes +(module+ hashable (require (submod ".." interfaces)) - - (provide hashable%) - - (define hashable% - (class* object% (serializable<%>) - (abstract serialize) - (abstract deserialize) - (define/public (deserialize-hash-list byte-stream accumulator) - (define (deserialize-name more-bytes) - (let* ((name-size (integer-bytes->integer (subbytes more-bytes 0 4) #t)) - (name (bytes->string/utf-8 (subbytes more-bytes 4 (+ 4 name-size))))) - (cons name (+ 4 name-size)))) - (if (equal? byte-stream #"") - accumulator - (let* ((name-consumption (deserialize-name byte-stream)) - (name-consumed (cdr name-consumption)) - (name (car name-consumption)) - (field-consumed (send this deserialize (subbytes byte-stream name-consumed)))) - (deserialize-hash-list - (subbytes byte-stream (+ name-consumed field-consumed) (bytes-length byte-stream)) - (append accumulator (list (cons name this))))))) - (define/public (serialize-hash-list named-values-list) + + (provide + (contract-out + [deserialize-hash-list (-> serializable? bytes? list? list?)] + [serialize-hash-list (-> (listof (cons/c string? serializable?)) bytes?)])) + + (define (deserialize-hash-list entity byte-stream accumulator) + (define (deserialize-name more-bytes) + (let* ((name-size (integer-bytes->integer (subbytes more-bytes 0 4) #t)) + (name (bytes->string/utf-8 (subbytes more-bytes 4 (+ 4 name-size))))) + (cons name (+ 4 name-size)))) + (if (equal? byte-stream #"") + accumulator + (let* ((name-consumption (deserialize-name byte-stream)) + (name-consumed (cdr name-consumption)) + (name (car name-consumption))) + (define-values (thing thing-consumed) (deserialize entity (subbytes byte-stream name-consumed))) + (deserialize-hash-list + entity + (subbytes byte-stream (+ name-consumed thing-consumed) (bytes-length byte-stream)) + (append accumulator (list (cons name thing))))))) + + (define (serialize-hash-list named-values-list) (define (serialize-name name) (let* ((name-bytes (string->bytes/utf-8 name)) (name-size (integer->integer-bytes (bytes-length name-bytes) 4 #t))) (bytes-append name-size name-bytes))) (~> (map (lambda (named-value) + (let ((name (car named-value)) + (value (cdr named-value))) (bytes-append - (serialize-name (car named-value)) - (send (cdr named-value) serialize))) + (serialize-name name) + (serialize value)))) named-values-list) - (bytes-join _ #""))) - (super-new)))) + (bytes-join _ #"")))) From 39f61714317ff6ada432754195584c1436553dfc Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Fri, 10 Nov 2023 22:38:35 -0300 Subject: [PATCH 02/13] Upgrade flake to use newer racket version --- flake.lock | 14 +++++++------- flake.nix | 2 +- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/flake.lock b/flake.lock index ee0ae1d..dcf5a3b 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1689068808, - "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=", + "lastModified": 1694529238, + "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", "owner": "numtide", "repo": "flake-utils", - "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4", + "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", "type": "github" }, "original": { @@ -20,16 +20,16 @@ }, "nixpkgs": { "locked": { - "lastModified": 1688392541, - "narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=", + "lastModified": 1699403077, + "narHash": "sha256-48OxQRx3tVaQhGmrFDxtzr8uzmhJjll8mImWhLiDBxM=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b", + "rev": "14d17e6b1f9fbee8ffa624277e241fb7b04440db", "type": "github" }, "original": { "owner": "NixOS", - "ref": "release-22.11", + "ref": "release-23.05", "repo": "nixpkgs", "type": "github" } diff --git a/flake.nix b/flake.nix index 45cb998..5169d0f 100644 --- a/flake.nix +++ b/flake.nix @@ -2,7 +2,7 @@ description = "RacketowerDB"; inputs = { - nixpkgs.url = "github:NixOS/nixpkgs/release-22.11"; + nixpkgs.url = "github:NixOS/nixpkgs/release-23.05"; flake-utils.url = "github:numtide/flake-utils"; }; From 506dcde73e47c1b75fff062faf260b68db2bfeb2 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Fri, 10 Nov 2023 23:28:37 -0300 Subject: [PATCH 03/13] Fix reading schema from the disk --- ast.rkt | 11 ++++++----- main.rkt | 3 ++- ndf/schemas/schema.ndf | Bin 191 -> 191 bytes 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/ast.rkt b/ast.rkt index 61b8eaa..7053fcc 100644 --- a/ast.rkt +++ b/ast.rkt @@ -78,12 +78,13 @@ (position-bytes (integer->integer-bytes position 1 #t)) (type (fyeld-type self)) (type-bytes (super-serialize type #:size (type-byte-size type)))) - (bytes-append position-bytes type-bytes))) + (bytes-append position-bytes type-bytes))) + (define/generic super-deserialize deserialize) (define (deserialize self byte-stream) (let* ((position-value (integer-bytes->integer (make-bytes 1 (bytes-ref byte-stream 0)) #t)) (type-bytes (subbytes byte-stream 1))) - (define-values (new-type type-consumed) (deserialize struct:type type-bytes)) - (values (fyeld position-value new-type) (+ 1 type-consumed))))]) + (define-values (new-type type-consumed) (super-deserialize struct:type type-bytes)) + (values (fyeld position-value new-type) (+ 1 type-consumed))))]) (define (fields-size fields) (let* ((fields-values (hash-values fields))) @@ -102,7 +103,7 @@ (let* ((row-id (table-row-id self)) (row-id-bytes (integer->integer-bytes row-id 4 #t)) (fields-list (hash->list (table-fields self)))) - (bytes-append row-id-bytes (serialize-hash-list fields-list) #"\n"))) ;; Maybe the math is wrong because of this + (bytes-append row-id-bytes (serialize-hash-list fields-list) #"\n"))) (define (deserialize self byte-stream) (let* ((row-id-value (integer-bytes->integer (subbytes byte-stream 0 4) #t)) (fields-value (make-hash (deserialize-hash-list struct:fyeld (subbytes byte-stream 4) '())))) @@ -115,7 +116,7 @@ (procedure-identifier self))] #:methods gen:serializable [(define (serialize _self #:size [_size #f]) - (bytes-append (string->bytes/utf-8 "procedures' serialization is not yet implemented") #"\n")) ;; Maybe the math is wrong because of this + (bytes-append (string->bytes/utf-8 "procedures' serialization is not yet implemented") #"\n")) {define (deserialize _self byte-stream) (println "procedures' deserialization is not yet implemented") (values (procedure "procedure") (bytes-length byte-stream))}]) diff --git a/main.rkt b/main.rkt index e1d79f2..ecb6918 100644 --- a/main.rkt +++ b/main.rkt @@ -30,11 +30,12 @@ ("YEAR" . ,field-year))))) (procedure-test (procedure "procedure")) (schema (make-hash (list)))) + (hash-set! schema "CAR" car-table) (hash-set! schema "TEST" procedure-test) (hash-set! schema "PROGRAMMER" programmer-table) - (hash-set! schema "CAR" car-table) (write-schema-to-disk schema) (set! schema (read-schema-from-disk "schema")) + (println schema) ;; (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2))) ;; (println (read-table-values-from-disk schema "PROGRAMMER")) ;; (define sample-input (open-input-string "CREATE RELATION CAR (MODEL STRING(5) YEAR INTEGER)")) diff --git a/ndf/schemas/schema.ndf b/ndf/schemas/schema.ndf index 0413f8e11a4fa5a1d68c2b9be36de84175cc3067..a1dda58eee4f826151bce7e761287f3270ee0f63 100644 GIT binary patch delta 12 TcmdnbxSw%?=fnp4iJs;FAZG-- delta 12 TcmdnbxSw%?=fn>4iJtZVAa?}A From 4c4635be810320dd1e08b2cd6f630c4e2e3fe80e Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sat, 11 Nov 2023 00:42:28 -0300 Subject: [PATCH 04/13] Fix serialization of values using the new design --- ast.rkt | 4 +- io.rkt | 148 ++++++++++++++++++------------------ main.rkt | 35 +++++---- ndf/data/CAR.ndf | Bin 18 -> 0 bytes ndf/data/PROGRAMMER.ndf | Bin 20 -> 24 bytes ndf/entities/PROGRAMMER.ndf | Bin 48 -> 47 bytes util.rkt | 8 +- 7 files changed, 98 insertions(+), 97 deletions(-) delete mode 100644 ndf/data/CAR.ndf diff --git a/ast.rkt b/ast.rkt index 7053fcc..1ef52a2 100644 --- a/ast.rkt +++ b/ast.rkt @@ -103,7 +103,7 @@ (let* ((row-id (table-row-id self)) (row-id-bytes (integer->integer-bytes row-id 4 #t)) (fields-list (hash->list (table-fields self)))) - (bytes-append row-id-bytes (serialize-hash-list fields-list) #"\n"))) + (bytes-append row-id-bytes (serialize-hash-list fields-list #f)))) (define (deserialize self byte-stream) (let* ((row-id-value (integer-bytes->integer (subbytes byte-stream 0 4) #t)) (fields-value (make-hash (deserialize-hash-list struct:fyeld (subbytes byte-stream 4) '())))) @@ -116,7 +116,7 @@ (procedure-identifier self))] #:methods gen:serializable [(define (serialize _self #:size [_size #f]) - (bytes-append (string->bytes/utf-8 "procedures' serialization is not yet implemented") #"\n")) + (bytes-append (string->bytes/utf-8 "procedures' serialization is not yet implemented"))) {define (deserialize _self byte-stream) (println "procedures' deserialization is not yet implemented") (values (procedure "procedure") (bytes-length byte-stream))}]) diff --git a/io.rkt b/io.rkt index 894a488..6b4ca28 100644 --- a/io.rkt +++ b/io.rkt @@ -20,7 +20,7 @@ (type (fyeld-type attribute)) (type-size (type-byte-size type)) (position (fyeld-position attribute))) - (cons position (serialize literal type-size)))) + (cons position (serialize literal #:size type-size)))) (define (convert-row table row) (~> @@ -31,12 +31,37 @@ (map cdr _) (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)) + (out (open-output-file file-name #:exists 'can-update))) + (file-position out off-set) + (write-bytes converted-row out) + (close-output-port out) + (set! schema (update-row-id-table schema table-name (+ row-id 1))))] + [(procedura? entity) + (println "Don't write procedures yet")]) + schema)) + + (define (write-rows-to-disk schema table-name rows) + (if (empty? rows) + schema + (let* ((first-row (first rows)) + (new-schema (write-row-to-disk schema table-name first-row))) + (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) (begin - (hash-set! schema table-name (table-row-id-set table id)) + (hash-set! schema table-name (table-row-id-set entity id)) schema)] [(procedura? entity) (raise 'tried-update-row-id-with-procedure)]))) @@ -44,56 +69,33 @@ (define (write-table-to-disk table table-name) (let* ((serialized-table (serialize table)) (file-name (build-ndf-filename table-name)) - (out (open-output-file file-name #:exists 'can-update))) + (out (open-output-file file-name #:exists 'truncate))) (write-bytes serialized-table out) (close-output-port out))) - (define (write-rows-to-disk schema table-name rows) - (if (empty? rows) - schema - (let* ((first-row (first rows)) - (new-schema (write-row-to-disk schema table-name first-row))) - (write-rows-to-disk new-schema table-name (rest rows))))) - (define (write-schema-to-disk schema) (define (write-entity-to-disk file-out entities-list) (let* ((entity-name (give-identifier (cdr (car entities-list))))) (write-string entity-name file-out) (newline file-out) - (write-bytes (serialize-hash-list entities-list) file-out))) ;; Maybe the math is wrong because of this + (write-bytes (serialize-hash-list entities-list #t) file-out) + (newline file-out))) (let* ((schema-list (hash->list schema)) - (file-name (build-ndf-filename "schema" #:data? 'schema)) - (out (open-output-file file-name #:exists 'can-update))) + (file-name (build-ndf-filename "schema" #:data? 'schema)) + (out (open-output-file file-name #:exists 'truncate))) (~>> (group-by (lambda (x) (give-identifier (cdr x))) schema-list) (map (curry write-entity-to-disk out))) - (close-output-port out))) - - (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)) - (out (open-output-file file-name #:exists 'can-update))) - (file-position out off-set) - (write-bytes converted-row out) - (close-output-port out) - (set! schema (update-row-id-table schema table-name (+ row-id 1))))] - [(procedura? entity) - (println "Don't write procedures yet")]) - schema))) + (close-output-port out)))) (module+ reader (require RacketowerDB/util) + (require (submod RacketowerDB/util interfaces)) (require (submod RacketowerDB/util hashable)) (require RacketowerDB/ast) (require racket/hash) (provide read-schema-from-disk) (provide read-table-from-disk) - ;; (provide read-table-values-from-disk) + (provide read-table-values-from-disk) (define (read-schema-from-disk schema-name) (define (build-hash-from-line struct-instance line-in-bytes) @@ -123,46 +125,46 @@ make-hash))) (define (read-table-from-disk table-name) - (let* ((file-name (build-ndf-filename table-name)) + (let* ((file-name (build-ndf-filename #:data? 'entity table-name)) (in (open-input-file file-name #:mode 'binary))) (define-values (table table-consumed) (deserialize struct:table (port->bytes in))) - table))) + table)) - ;; (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)) - ;; (entity (hash-ref schema table-name))) - ;; (cond - ;; [(is-a? entity table%) - ;; (define (create-pair key-field) (cons (car key-field) (get-field type (cdr key-field)))) - ;; (define (sort-by-position key-field1 key-field2) - ;; (let ((p1 (get-field position (cdr key-field1))) - ;; (p2 (get-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 (get-field byte-size type)) - ;; (new-literal (send type from-bytes (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 (get-field fields entity)) - ;; (sort _ sort-by-position) - ;; (map create-pair _) - ;; (reconstruct-all-literals (list) _ byte-stream))] - ;; [(is-a? entity procedure%) (raise 'tried-deserialize-procedure-in-table-function)])))) + (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)) + (entity (hash-ref schema table-name))) + (cond + [(table? entity) + (define (create-pair key-field) (cons (car key-field) (fyeld-type (cdr key-field)))) + (define (sort-by-position key-field1 key-field2) + (let ((p1 (fyeld-position (cdr key-field1))) + (p2 (fyeld-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)])))) diff --git a/main.rkt b/main.rkt index ecb6918..27ec988 100644 --- a/main.rkt +++ b/main.rkt @@ -9,7 +9,7 @@ (check-equal? (+ 2 2) 4)) ;; http://docs.racket-lang.org/guide/Module_Syntax.html#%28part._main-and-test%29 -{module+ main +(module+ main (require racket/base) (require racket/serialize) (require racket/class) @@ -29,29 +29,28 @@ (car-table (table "table" 0 (make-hash `(("MODEL" . ,field-name) ("YEAR" . ,field-year))))) (procedure-test (procedure "procedure")) - (schema (make-hash (list)))) + (schema (make-hash (list))) + (row1 `(("NAME" . ,(stringl "Nathan")) + ("EDITOR" . ,(stringl "Visual Studio Code")))) + (row2 `(("NAME" . ,(stringl "Lemos")) + ("EDITOR" . ,(stringl "Emacs")))) + (row3 `(("MODEL" . ,(stringl "Ford")) + ("YEAR" . ,(integer32 1999)))) + (row4 `(("MODEL" . ,(stringl "Abc")) + ("YEAR" . ,(integer32 2013))))) (hash-set! schema "CAR" car-table) (hash-set! schema "TEST" procedure-test) (hash-set! schema "PROGRAMMER" programmer-table) (write-schema-to-disk schema) (set! schema (read-schema-from-disk "schema")) (println schema) - ;; (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2))) - ;; (println (read-table-values-from-disk schema "PROGRAMMER")) - ;; (define sample-input (open-input-string "CREATE RELATION CAR (MODEL STRING(5) YEAR INTEGER)")) - ;; (port-count-lines! sample-input) - ;; (write-table-to-disk table "PROGRAMMER") - ;; (let* ((read-table (read-table-from-disk schema "PROGRAMMER")) - ;; (thing (parse (lambda () (mappings/tokens sample-input)))) - ;; (new-table-name (car thing)) - ;; (new-table (cdr thing))) - ;; (write-table-to-disk new-table new-table-name) - ;; (hash-set! schema "PROGRAMMER" read-table) - ;; (set! schema (write-rows-to-disk schema "PROGRAMMER" (list row1 row2))) - ;; (hash-set! schema new-table-name new-table) - ;; (set! schema (write-rows-to-disk schema new-table-name (list row3 row4))) - ;; (println schema) - )} + (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)))) ;; (exit-handler) ;; (server-entrypoint) diff --git a/ndf/data/CAR.ndf b/ndf/data/CAR.ndf deleted file mode 100644 index 31955e4954a7283c95f2c005ae06d5bc15e86474..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 18 YcmZ?EFG^uJ&(6T$n3T-Ga2Ln`058V`OaK4? diff --git a/ndf/data/PROGRAMMER.ndf b/ndf/data/PROGRAMMER.ndf index a2b0a23da36d6231be60dda5d229cf30997249b5..3c3a039b20b86ea3ec283bf23cf049f2b4562fee 100644 GIT binary patch literal 24 fcmeZEEXhdBV+hMEE=}}F&CM@nU~tV%OfCihX~YOj literal 20 bcmWH`EG|v-ODxGqbj?jnF7`>y%`XN3QSS%d diff --git a/ndf/entities/PROGRAMMER.ndf b/ndf/entities/PROGRAMMER.ndf index b251e1a69c4dd830450ba0f0d8a2acdfbde4b294..aa69861fa4e4fe54ea5ffdc0ac0c49e348a7b4d0 100644 GIT binary patch literal 47 vcmZQzU|?VcVqbq3S04uUFvlQg562*Opa=^PN4h!&F|vF5g}A!A27v?smYW9K literal 48 pcmZQzU|?VaVpkW>5dR identifiable? string?)] [serialize (->* (serializable?) (#:size integer?) bytes?)] [deserialize (-> serializable? bytes? (values serializable? natural?))] - [from-bytes (-> byteable? bytes? byteable?)] + [from-bytes (-> byteable? bytes? serializable?)] [to-byte-size (-> byteable? natural?)]) serializable? byteable? @@ -90,7 +90,7 @@ (provide (contract-out [deserialize-hash-list (-> serializable? bytes? list? list?)] - [serialize-hash-list (-> (listof (cons/c string? serializable?)) bytes?)])) + [serialize-hash-list (-> (listof (cons/c string? serializable?)) boolean? bytes?)])) (define (deserialize-hash-list entity byte-stream accumulator) (define (deserialize-name more-bytes) @@ -108,7 +108,7 @@ (subbytes byte-stream (+ name-consumed thing-consumed) (bytes-length byte-stream)) (append accumulator (list (cons name thing))))))) - (define (serialize-hash-list named-values-list) + (define (serialize-hash-list named-values-list entity?) (define (serialize-name name) (let* ((name-bytes (string->bytes/utf-8 name)) (name-size (integer->integer-bytes (bytes-length name-bytes) 4 #t))) @@ -121,5 +121,5 @@ (serialize-name name) (serialize value)))) named-values-list) - (bytes-join _ #"")))) + (bytes-join _ (if entity? #"\n" #""))))) From e0de9430b241ae664cd3e909df5e9e72b2eff711 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:08:50 -0300 Subject: [PATCH 05/13] Fix typos on delimiters --- ast.rkt | 4 ++-- util.rkt | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ast.rkt b/ast.rkt index 1ef52a2..225fd77 100644 --- a/ast.rkt +++ b/ast.rkt @@ -117,6 +117,6 @@ #:methods gen:serializable [(define (serialize _self #:size [_size #f]) (bytes-append (string->bytes/utf-8 "procedures' serialization is not yet implemented"))) - {define (deserialize _self byte-stream) + (define (deserialize _self byte-stream) (println "procedures' deserialization is not yet implemented") - (values (procedure "procedure") (bytes-length byte-stream))}]) + (values (procedure "procedure") (bytes-length byte-stream)))]) diff --git a/util.rkt b/util.rkt index 63a752d..69c2058 100644 --- a/util.rkt +++ b/util.rkt @@ -16,7 +16,7 @@ (define (fix-one-turn inner-lines) (let ((newline-flag #f)) (foldl (lambda (line new-lines) - [if newline-flag + (if newline-flag (begin (begin (set! newline-flag #f) @@ -26,7 +26,7 @@ (begin (set! newline-flag #t) new-lines) - (append new-lines (list line)))]) (list) inner-lines))) + (append new-lines (list line))))) (list) inner-lines))) (define (stop-condition lines-to-check) (empty? (filter (lambda (line) (bytes=? #"" line)) lines-to-check))) (while (not (stop-condition lines)) (set! lines (fix-one-turn lines))) From f3532730961acf083b071999cad0085b8f16ec22 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:30:53 -0300 Subject: [PATCH 06/13] Add call-with-output-file function to output ports --- info.rkt | 3 ++- io.rkt | 33 ++++++++++++++++++--------------- 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/info.rkt b/info.rkt index d72de96..c535d05 100644 --- a/info.rkt +++ b/info.rkt @@ -3,7 +3,8 @@ (define deps '("racket" "threading-lib" "beautiful-racket" - "struct-update-lib")) + "struct-update-lib" + "compose-app")) (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib")) diff --git a/io.rkt b/io.rkt index 6b4ca28..4eb28b1 100644 --- a/io.rkt +++ b/io.rkt @@ -9,7 +9,8 @@ (require RacketowerDB/util) (require (submod RacketowerDB/util interfaces)) (require (submod RacketowerDB/util hashable)) - (require struct-update) + (require struct-update) + (require compose-app) (provide write-rows-to-disk) (provide write-table-to-disk) (provide write-schema-to-disk) @@ -39,11 +40,12 @@ (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)) - (out (open-output-file file-name #:exists 'can-update))) - (file-position out off-set) - (write-bytes converted-row out) - (close-output-port out) + (file-name (build-ndf-filename table-name #:data? 'data))) + (call-with-output-file file-name + (lambda (out) + (file-position out off-set) + (write-bytes converted-row out)) + #:exists 'can-update) (set! schema (update-row-id-table schema table-name (+ row-id 1))))] [(procedura? entity) (println "Don't write procedures yet")]) @@ -68,10 +70,10 @@ (define (write-table-to-disk table table-name) (let* ((serialized-table (serialize table)) - (file-name (build-ndf-filename table-name)) - (out (open-output-file file-name #:exists 'truncate))) - (write-bytes serialized-table out) - (close-output-port out))) + (file-name (build-ndf-filename table-name))) + (call-with-output-file file-name + (curry write-bytes serialized-table) + #:exists 'truncate))) (define (write-schema-to-disk schema) (define (write-entity-to-disk file-out entities-list) @@ -81,11 +83,12 @@ (write-bytes (serialize-hash-list entities-list #t) file-out) (newline file-out))) (let* ((schema-list (hash->list schema)) - (file-name (build-ndf-filename "schema" #:data? 'schema)) - (out (open-output-file file-name #:exists 'truncate))) - (~>> (group-by (lambda (x) (give-identifier (cdr x))) schema-list) - (map (curry write-entity-to-disk out))) - (close-output-port out)))) + (file-name (build-ndf-filename "schema" #:data? 'schema))) + (call-with-output-file file-name + (lambda (out) + (~>> (group-by (give-identifier .. cdr) schema-list) + (map (curry write-entity-to-disk out)))) + #:exists 'truncate)))) (module+ reader (require RacketowerDB/util) From 92e1966dbcf64351753f518593b0418b09f12c77 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:34:35 -0300 Subject: [PATCH 07/13] Swap eq? to equal? in ast.rkt --- ast.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ast.rkt b/ast.rkt index 225fd77..7e639e6 100644 --- a/ast.rkt +++ b/ast.rkt @@ -25,7 +25,7 @@ #:methods gen:byteable [(define (from-bytes self byte-stream) (let ((received-bytes-size (bytes-length byte-stream))) - (if (eq? received-bytes-size (type-byte-size self)) + (if (equal? received-bytes-size (type-byte-size self)) (case (list 'quote (string->symbol (type-name self))) [('INTEGER) (integer32 (integer-bytes->integer byte-stream #t))] [('VARCHAR) (stringl (bytes->string/utf-8 byte-stream))] From f36dc662c247c245042f2f2cbc7750a439fbf280 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:36:04 -0300 Subject: [PATCH 08/13] Add curry to remove extra lambda --- util.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util.rkt b/util.rkt index 69c2058..737972e 100644 --- a/util.rkt +++ b/util.rkt @@ -27,7 +27,7 @@ (set! newline-flag #t) new-lines) (append new-lines (list line))))) (list) inner-lines))) - (define (stop-condition lines-to-check) (empty? (filter (lambda (line) (bytes=? #"" line)) lines-to-check))) + (define (stop-condition lines-to-check) (empty? (filter (curry bytes=? #"") lines-to-check))) (while (not (stop-condition lines)) (set! lines (fix-one-turn lines))) lines) From 164a9b753f91998f05234d59188a10b64df0b8c4 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:40:34 -0300 Subject: [PATCH 09/13] Add extra optional flag when using in ports --- io.rkt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/io.rkt b/io.rkt index 4eb28b1..fad224a 100644 --- a/io.rkt +++ b/io.rkt @@ -115,7 +115,7 @@ (let* ((file-name (build-ndf-filename schema-name #:data? 'schema)) (in (open-input-file file-name #:mode 'binary)) (schema (make-immutable-hash (list))) - (real-lines (port->bytes-lines in)) + (real-lines (port->bytes-lines in #:close? #t)) (read-lines (fix-empty-read-bytes-lines real-lines))) (~> (foldl (lambda (line-in-bytes acc) @@ -130,13 +130,13 @@ (define (read-table-from-disk table-name) (let* ((file-name (build-ndf-filename #:data? 'entity table-name)) (in (open-input-file file-name #:mode 'binary))) - (define-values (table table-consumed) (deserialize struct:table (port->bytes in))) + (define-values (table table-consumed) (deserialize struct:table (port->bytes in #:close? #t))) table)) (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)) + (byte-stream (port->bytes in #:close? #t)) (entity (hash-ref schema table-name))) (cond [(table? entity) From 9a1e9efbce50da81bc260d895f7c31aa100b2cd5 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:43:38 -0300 Subject: [PATCH 10/13] Update logical description of entity PROGRAMMER --- ndf/entities/PROGRAMMER.ndf | Bin 47 -> 48 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/ndf/entities/PROGRAMMER.ndf b/ndf/entities/PROGRAMMER.ndf index aa69861fa4e4fe54ea5ffdc0ac0c49e348a7b4d0..bfaa93e02dd174af1fb71b0e44f211ef796f4da9 100644 GIT binary patch literal 48 rcmZQzU|?VaVpkW>5dR=X_AtjFXAj39R-h0I5c@g$x-!57*?|H8qNoQP literal 47 vcmZQzU|?VcVqbq3S04uUFvlQg562*Opa=^PN4h!&F|vF5g}A!A27v?smYW9K From 902c09ec08928a17221c58b4eca16bd24405eeb8 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 16:47:36 -0300 Subject: [PATCH 11/13] Remove third party dep to have function composition --- info.rkt | 3 +-- io.rkt | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/info.rkt b/info.rkt index c535d05..d72de96 100644 --- a/info.rkt +++ b/info.rkt @@ -3,8 +3,7 @@ (define deps '("racket" "threading-lib" "beautiful-racket" - "struct-update-lib" - "compose-app")) + "struct-update-lib")) (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib")) diff --git a/io.rkt b/io.rkt index fad224a..652117b 100644 --- a/io.rkt +++ b/io.rkt @@ -10,7 +10,6 @@ (require (submod RacketowerDB/util interfaces)) (require (submod RacketowerDB/util hashable)) (require struct-update) - (require compose-app) (provide write-rows-to-disk) (provide write-table-to-disk) (provide write-schema-to-disk) @@ -86,7 +85,7 @@ (file-name (build-ndf-filename "schema" #:data? 'schema))) (call-with-output-file file-name (lambda (out) - (~>> (group-by (give-identifier .. cdr) schema-list) + (~>> (group-by (compose give-identifier cdr) schema-list) (map (curry write-entity-to-disk out)))) #:exists 'truncate)))) From dd45e79ca93bf19648cec6577b539d409b1240ca Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 17:02:51 -0300 Subject: [PATCH 12/13] Add keyword in serialize-hash-list to improve readability --- ast.rkt | 2 +- io.rkt | 2 +- util.rkt | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ast.rkt b/ast.rkt index 7e639e6..e80e974 100644 --- a/ast.rkt +++ b/ast.rkt @@ -103,7 +103,7 @@ (let* ((row-id (table-row-id self)) (row-id-bytes (integer->integer-bytes row-id 4 #t)) (fields-list (hash->list (table-fields self)))) - (bytes-append row-id-bytes (serialize-hash-list fields-list #f)))) + (bytes-append row-id-bytes (serialize-hash-list fields-list #:entity? #f)))) (define (deserialize self byte-stream) (let* ((row-id-value (integer-bytes->integer (subbytes byte-stream 0 4) #t)) (fields-value (make-hash (deserialize-hash-list struct:fyeld (subbytes byte-stream 4) '())))) diff --git a/io.rkt b/io.rkt index 652117b..30793ba 100644 --- a/io.rkt +++ b/io.rkt @@ -79,7 +79,7 @@ (let* ((entity-name (give-identifier (cdr (car entities-list))))) (write-string entity-name file-out) (newline file-out) - (write-bytes (serialize-hash-list entities-list #t) file-out) + (write-bytes (serialize-hash-list entities-list #:entity? #t) file-out) (newline file-out))) (let* ((schema-list (hash->list schema)) (file-name (build-ndf-filename "schema" #:data? 'schema))) diff --git a/util.rkt b/util.rkt index 737972e..3fab3bd 100644 --- a/util.rkt +++ b/util.rkt @@ -90,7 +90,7 @@ (provide (contract-out [deserialize-hash-list (-> serializable? bytes? list? list?)] - [serialize-hash-list (-> (listof (cons/c string? serializable?)) boolean? bytes?)])) + [serialize-hash-list (-> (listof (cons/c string? serializable?)) #:entity? boolean? bytes?)])) (define (deserialize-hash-list entity byte-stream accumulator) (define (deserialize-name more-bytes) @@ -108,7 +108,7 @@ (subbytes byte-stream (+ name-consumed thing-consumed) (bytes-length byte-stream)) (append accumulator (list (cons name thing))))))) - (define (serialize-hash-list named-values-list entity?) + (define (serialize-hash-list named-values-list #:entity? entity?) (define (serialize-name name) (let* ((name-bytes (string->bytes/utf-8 name)) (name-size (integer->integer-bytes (bytes-length name-bytes) 4 #t))) From e70b7979ff5dd5f5a113236476272b8a77ec9990 Mon Sep 17 00:00:00 2001 From: EduardoLR10 Date: Sun, 12 Nov 2023 17:14:40 -0300 Subject: [PATCH 13/13] Improve readiability of call-with-output-file function calls --- io.rkt | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/io.rkt b/io.rkt index 30793ba..2839d15 100644 --- a/io.rkt +++ b/io.rkt @@ -40,11 +40,10 @@ (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 + (call-with-output-file file-name #:exists 'can-update (lambda (out) (file-position out off-set) - (write-bytes converted-row out)) - #:exists 'can-update) + (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")]) @@ -70,9 +69,8 @@ (define (write-table-to-disk table table-name) (let* ((serialized-table (serialize table)) (file-name (build-ndf-filename table-name))) - (call-with-output-file file-name - (curry write-bytes serialized-table) - #:exists 'truncate))) + (call-with-output-file file-name #:exists 'truncate + (curry write-bytes serialized-table)))) (define (write-schema-to-disk schema) (define (write-entity-to-disk file-out entities-list) @@ -83,11 +81,10 @@ (newline file-out))) (let* ((schema-list (hash->list schema)) (file-name (build-ndf-filename "schema" #:data? 'schema))) - (call-with-output-file file-name + (call-with-output-file file-name #:exists 'truncate (lambda (out) (~>> (group-by (compose give-identifier cdr) schema-list) - (map (curry write-entity-to-disk out)))) - #:exists 'truncate)))) + (map (curry write-entity-to-disk out)))))))) (module+ reader (require RacketowerDB/util)