;;; ;;; database.ss ;;; UVA CS200 Spring 2003 ;;; Final ;;; ;;; Version 1.0.1 - new for Spring 2003 (require (lib "trace.ss")) (load "listprocs.ss") ;;; We represent a table using a cons cell of the list of fields and the list of entries. ;;; Each field is a quoted symbol (e.g., 'name). Each entry is a list of values, where ;;; the nth value in the list gives the value of the nth field for this entry. ;;; (define (make-new-table fieldlist) (cons fieldlist null)) (define (make-table fieldlist entries) (cons fieldlist entries)) (define (table-fields table) (car table)) (define (table-entries table) (cdr table)) (define (num-entries table) (length (table-entries table))) ;;; We use assert to check properties that must be true. If an assertion fails, ;;; it probably means there is a bug in your code. (define (assert pred) (if (not pred) (error "Assertion failed!"))) (define (find-field-number table field) (find-element-number (table-fields table) field)) (define (table-select table field proc) (make-table (table-fields table) (let ((fieldno (find-field-number table field))) (filter (lambda (x) (proc (get-nth x fieldno))) (table-entries table))))) (define (table-delete! table field proc) (set-cdr! table (table-entries (table-select table field (lambda (e) (not (proc e))))))) ;;; Inserts an entry into a table (define (table-insert! table entry) ;;; The entry must have the right number of values --- one for each field in the table (assert (= (length entry) (length (table-fields table)))) (if (null? (table-entries table)) (set-cdr! table (list entry)) (append! (table-entries table) (list entry))) (void)) ;;; don't evaluate to a value ;;; Replaces a certain number in the list with a new value: (define (replace-nth! list num new-val) (if (= num 1) (set-car! list new-val) (replace-nth! (cdr list) (- num 1) new-val))) ;;; Inserts a new value into the specified place in the table: (define (table-update! table field entry new-val) (replace-nth! (get-entry entry table) (find-field table field) new-val)) ;;; This constant determines the maximum display width for printing tables. (define display-width 80) (define (make-string-selector match) (lambda (fval) (string=? fval match))) (define (make-string-length s len) (assert (> len 0)) (if (>= (string-length s) len) (substring s 0 len) (string-append s (make-string (- len (string-length s)) #\space)))) (define (print-list-width lst fieldwidth) (if (null? lst) (newline) (begin (printf "~a " (make-string-length (format "~a" (car lst)) fieldwidth)) (print-list-width (cdr lst) fieldwidth)))) (define (make-constant-function cst) (lambda (p) cst)) (define (table-display table) ;;; Prints out the table in columns (let ((fieldwidth (floor (/ display-width (length (table-fields table)))))) (print-list-width (table-fields table) fieldwidth) ;;; Yes, make-constant-function (from the last year's sample Exam 1) really is useful! (print-list-width (map (make-constant-function "-------------------------") (table-fields table)) fieldwidth) (map (lambda (entry) (print-list-width entry fieldwidth)) (table-entries table)) (void)))