Changeset 14673 in project


Ignore:
Timestamp:
05/17/09 13:43:53 (10 years ago)
Author:
sjamaan
Message:

Port the sql-null egg to Chicken 4, and add sql-coalesce macro

Location:
release/4/sql-null
Files:
1 deleted
2 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/sql-null/sql-null.meta

    r9305 r14673  
    33((egg "sql-null.egg")
    44 (synopsis "A convenience extension for representing SQL NULL values")
    5  (needs syntax-case)
    65 (category db)
    76 (license "Public Domain")
    87 (doc-from-wiki)
    98 (author "Ivan Shmakov")
    10  (files "sql-null.setup" "sql-null.scm" "sql-null-support.scm" "sql-null.html"))
     9 (files "sql-null.setup" "sql-null.scm" "sql-null.html"))
  • release/4/sql-null/sql-null.scm

    r6433 r14673  
    33;;; Ivan Shmakov, 2007  This code is in public domain.
    44
    5 ;;; Code:
     5(module sql-null
     6  (sql-null sql-null? sql-not sql-or sql-or sql-and sql-coalesce)
    67
    7 (cond-expand
    8   (hygienic-macros
     8(import chicken scheme)
    99
    10     (define-syntax sql-or
    11       (syntax-rules ()
    12         ((sql-or a ...)
    13          (sql-or/null #f a ...))))
     10;; We could also (define-record sql-null) and alias sql-null to make-sql-null
     11;; but that implies creating many new objects, which we don't want.
     12(define-record sql-null-type)
     13(define sql-null-object (make-sql-null-type))
     14(define sql-null (lambda () sql-null-object))
     15(define sql-null? sql-null-type?)
    1416
    15     (define-syntax sql-or/null
    16       (syntax-rules ()
    17         ((sql-or/null null)
    18          null)
    19         ((sql-or/null null a b ...)
    20          (let ((ea a))
    21            (cond ((sql-null? ea) (sql-or/null ea    b ...))
    22                  ((not ea)       (sql-or/null null b ...))
    23                  (else           ea))))))
     17(define (sql-not o)
     18  (if (sql-null? o) o (not o)))
    2419
    25     (define-syntax sql-and
    26       (syntax-rules ()
    27         ((sql-and a ...)
    28          (sql-and/null #t a ...))))
     20(define-syntax sql-or
     21  (syntax-rules ()
     22    ((sql-or a ...)
     23     (sql-or/null #f a ...))))
    2924
    30     (define-syntax sql-and/null
    31       (syntax-rules ()
    32         ((sql-and/null null)
    33          null)
    34         ((sql-and/null null a b ...)
    35          (let ((ea a))
    36            (cond ((sql-null? ea) (sql-and/null ea    b ...))
    37                  (ea             (sql-and/null null b ...))
    38                  (else           ea)))))) )
     25(define-syntax sql-or/null
     26  (syntax-rules ()
     27    ((sql-or/null null)
     28     null)
     29    ((sql-or/null null a b ...)
     30     (let ((ea a))
     31       (cond ((sql-null? ea) (sql-or/null ea    b ...))
     32             ((not ea)       (sql-or/null null b ...))
     33             (else           ea))))))
    3934
    40   (else
     35(define-syntax sql-and
     36  (syntax-rules ()
     37    ((sql-and a ...)
     38     (sql-and/null #t a ...))))
    4139
    42     (define-macro (sql-or/null ?null . ?exprs)
    43       (if (null? ?exprs)
    44           `,?null
    45           (let ((?expr (car ?exprs))
    46                 (?exprs (cdr ?exprs))
    47                 (?expr-var (gensym)))
    48             `(let ((,?expr-var ,?expr))
    49                (cond ((sql-null? ,?expr-var)
    50                         (sql-or/null ,?expr-var ,@?exprs))
    51                       ((not ,?expr-var)
    52                         (sql-or/null ,?null ,@?exprs))
    53                       (else
    54                         ,?expr-var ) ) ) ) ) )
     40(define-syntax sql-and/null
     41  (syntax-rules ()
     42    ((sql-and/null null)
     43     null)
     44    ((sql-and/null null a b ...)
     45     (let ((ea a))
     46       (cond ((sql-null? ea) (sql-and/null ea    b ...))
     47             (ea             (sql-and/null null b ...))
     48             (else           ea))))))
    5549
    56     (define-macro (sql-or . ?exprs)
    57       `(sql-or/null #f ,@?exprs) )
     50(define-syntax sql-coalesce
     51  (syntax-rules ()
     52    ((sql-coalesce)
     53     (sql-null))
     54    ((sql-coalesce a b ...)
     55     (let ((ea a))
     56       (if (sql-null? ea)
     57           (sql-coalesce b ...)
     58           ea)))))
    5859
    59     (define-macro (sql-and/null ?null . ?exprs)
    60       (if (null? ?exprs)
    61           `,?null
    62           (let ((?expr (car ?exprs))
    63                 (?exprs (cdr ?exprs))
    64                 (?expr-var (gensym)))
    65             `(let ((,?expr-var ,?expr))
    66                (cond ((sql-null? ,?expr-var)
    67                         (sql-and/null ,?expr-var ,@?exprs))
    68                       (,?expr-var
    69                         (sql-and/null ,?null ,@?exprs))
    70                       (else
    71                         ,?expr-var ) ) ) ) ) )
    72 
    73     (define-macro (sql-and . ?exprs)
    74       `(sql-and/null #t ,@?exprs) ) ) )
    75 
    76 ;;; sql-null.scm ends here
     60)
Note: See TracChangeset for help on using the changeset viewer.