Artifact b4377f6efb38955835cdec3b3e7af6c779498c79:
- File sql-null.sls — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 1818)
0000: 3b 3b 3b 20 22 73 71 6c 2d 6e 75 6c 6c 2e 73 63 ;;; "sql-null.sc 0010: 6d 22 20 2d 2d 20 53 51 4c 20 4e 55 4c 4c 20 6f m" -- SQL NULL o 0020: 62 6a 65 63 74 20 61 6e 64 20 74 68 65 20 74 65 bject and the te 0030: 72 6e 61 72 79 20 6c 6f 67 69 63 20 20 2d 2a 2d rnary logic -*- 0040: 20 53 63 68 65 6d 65 20 2d 2a 2d 0a 0a 3b 3b 3b Scheme -*-..;;; 0050: 20 49 76 61 6e 20 53 68 6d 61 6b 6f 76 2c 20 32 Ivan Shmakov, 2 0060: 30 30 37 20 20 54 68 69 73 20 63 6f 64 65 20 69 007 This code i 0070: 73 20 69 6e 20 70 75 62 6c 69 63 20 64 6f 6d 61 s in public doma 0080: 69 6e 2e 0a 0a 28 6c 69 62 72 61 72 79 20 28 73 in...(library (s 0090: 71 6c 2d 6e 75 6c 6c 29 0a 20 20 28 65 78 70 6f ql-null). (expo 00a0: 72 74 20 73 71 6c 2d 6e 75 6c 6c 20 73 71 6c 2d rt sql-null sql- 00b0: 6e 75 6c 6c 3f 20 73 71 6c 2d 6e 6f 74 20 73 71 null? sql-not sq 00c0: 6c 2d 6f 72 20 73 71 6c 2d 6f 72 20 73 71 6c 2d l-or sql-or sql- 00d0: 61 6e 64 20 73 71 6c 2d 63 6f 61 6c 65 73 63 65 and sql-coalesce 00e0: 29 0a 0a 20 20 28 69 6d 70 6f 72 74 20 28 63 68 ).. (import (ch 00f0: 65 7a 73 63 68 65 6d 65 29 29 0a 0a 20 20 3b 3b ezscheme)).. ;; 0100: 66 72 6f 6d 20 63 68 69 63 6b 65 6e 20 64 61 74 from chicken dat 0110: 61 2d 73 74 72 75 63 74 75 72 65 73 2e 73 63 6d a-structures.scm 0120: 20 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 Copyright (c) 0130: 32 30 30 38 2d 32 30 31 34 2c 20 54 68 65 20 43 2008-2014, The C 0140: 68 69 63 6b 65 6e 20 54 65 61 6d 0a 20 20 28 64 hicken Team. (d 0150: 65 66 69 6e 65 20 28 63 6f 6e 73 74 61 6e 74 6c efine (constantl 0160: 79 20 2e 20 78 73 29 0a 20 20 20 20 28 69 66 20 y . xs). (if 0170: 28 65 71 3f 20 31 20 28 6c 65 6e 67 74 68 20 78 (eq? 1 (length x 0180: 73 29 29 0a 09 28 6c 65 74 20 28 5b 78 20 28 63 s))..(let ([x (c 0190: 61 72 20 78 73 29 5d 29 0a 09 20 20 28 6c 61 6d ar xs)]).. (lam 01a0: 62 64 61 20 5f 20 78 29 20 29 0a 09 28 6c 61 6d bda _ x) )..(lam 01b0: 62 64 61 20 5f 20 28 61 70 70 6c 79 20 76 61 6c bda _ (apply val 01c0: 75 65 73 20 78 73 29 29 20 29 20 29 0a 0a 20 20 ues xs)) ) ).. 01d0: 3b 3b 20 57 65 20 63 6f 75 6c 64 20 61 6c 73 6f ;; We could also 01e0: 20 28 64 65 66 69 6e 65 2d 72 65 63 6f 72 64 20 (define-record 01f0: 73 71 6c 2d 6e 75 6c 6c 29 20 61 6e 64 20 61 6c sql-null) and al 0200: 69 61 73 20 73 71 6c 2d 6e 75 6c 6c 20 74 6f 20 ias sql-null to 0210: 6d 61 6b 65 2d 73 71 6c 2d 6e 75 6c 6c 0a 20 20 make-sql-null. 0220: 3b 3b 20 62 75 74 20 74 68 61 74 20 69 6d 70 6c ;; but that impl 0230: 69 65 73 20 63 72 65 61 74 69 6e 67 20 6d 61 6e ies creating man 0240: 79 20 6e 65 77 20 6f 62 6a 65 63 74 73 2c 20 77 y new objects, w 0250: 68 69 63 68 20 77 65 20 64 6f 6e 27 74 20 77 61 hich we don't wa 0260: 6e 74 2e 0a 20 20 28 64 65 66 69 6e 65 2d 72 65 nt.. (define-re 0270: 63 6f 72 64 2d 74 79 70 65 20 73 71 6c 2d 6e 75 cord-type sql-nu 0280: 6c 6c 2d 74 79 70 65 29 0a 20 20 28 64 65 66 69 ll-type). (defi 0290: 6e 65 20 73 71 6c 2d 6e 75 6c 6c 2d 6f 62 6a 65 ne sql-null-obje 02a0: 63 74 20 28 6d 61 6b 65 2d 73 71 6c 2d 6e 75 6c ct (make-sql-nul 02b0: 6c 2d 74 79 70 65 29 29 0a 20 20 28 64 65 66 69 l-type)). (defi 02c0: 6e 65 20 73 71 6c 2d 6e 75 6c 6c 20 28 63 6f 6e ne sql-null (con 02d0: 73 74 61 6e 74 6c 79 20 73 71 6c 2d 6e 75 6c 6c stantly sql-null 02e0: 2d 6f 62 6a 65 63 74 29 29 0a 20 20 28 64 65 66 -object)). (def 02f0: 69 6e 65 20 73 71 6c 2d 6e 75 6c 6c 3f 20 73 71 ine sql-null? sq 0300: 6c 2d 6e 75 6c 6c 2d 74 79 70 65 3f 29 0a 0a 20 l-null-type?).. 0310: 20 28 64 65 66 69 6e 65 20 28 73 71 6c 2d 6e 6f (define (sql-no 0320: 74 20 6f 29 0a 20 20 20 20 28 69 66 20 28 73 71 t o). (if (sq 0330: 6c 2d 6e 75 6c 6c 3f 20 6f 29 20 6f 20 28 6e 6f l-null? o) o (no 0340: 74 20 6f 29 29 29 0a 0a 20 20 28 64 65 66 69 6e t o))).. (defin 0350: 65 2d 73 79 6e 74 61 78 20 73 71 6c 2d 6f 72 0a e-syntax sql-or. 0360: 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 (syntax-rule 0370: 73 20 28 29 0a 20 20 20 20 20 20 28 28 73 71 6c s (). ((sql 0380: 2d 6f 72 20 61 20 2e 2e 2e 29 0a 20 20 20 20 20 -or a ...). 0390: 20 20 28 73 71 6c 2d 6f 72 2f 6e 75 6c 6c 20 23 (sql-or/null # 03a0: 66 20 61 20 2e 2e 2e 29 29 29 29 0a 0a 20 20 28 f a ...)))).. ( 03b0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 73 71 define-syntax sq 03c0: 6c 2d 6f 72 2f 6e 75 6c 6c 0a 20 20 20 20 28 73 l-or/null. (s 03d0: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 yntax-rules (). 03e0: 20 20 20 20 20 28 28 73 71 6c 2d 6f 72 2f 6e 75 ((sql-or/nu 03f0: 6c 6c 20 6e 75 6c 6c 29 0a 20 20 20 20 20 20 20 ll null). 0400: 6e 75 6c 6c 29 0a 20 20 20 20 20 20 28 28 73 71 null). ((sq 0410: 6c 2d 6f 72 2f 6e 75 6c 6c 20 6e 75 6c 6c 20 61 l-or/null null a 0420: 20 62 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 28 b ...). ( 0430: 6c 65 74 20 28 28 65 61 20 61 29 29 0a 09 20 28 let ((ea a)).. ( 0440: 63 6f 6e 64 20 28 28 73 71 6c 2d 6e 75 6c 6c 3f cond ((sql-null? 0450: 20 65 61 29 20 28 73 71 6c 2d 6f 72 2f 6e 75 6c ea) (sql-or/nul 0460: 6c 20 65 61 20 20 20 20 62 20 2e 2e 2e 29 29 0a l ea b ...)). 0470: 09 20 20 20 20 20 20 20 28 28 6e 6f 74 20 65 61 . ((not ea 0480: 29 20 20 20 20 20 20 20 28 73 71 6c 2d 6f 72 2f ) (sql-or/ 0490: 6e 75 6c 6c 20 6e 75 6c 6c 20 62 20 2e 2e 2e 29 null null b ...) 04a0: 29 0a 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 ).. (else 04b0: 20 20 20 20 20 20 20 20 20 20 65 61 29 29 29 29 ea)))) 04c0: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 2d 73 79 )).. (define-sy 04d0: 6e 74 61 78 20 73 71 6c 2d 61 6e 64 0a 20 20 20 ntax sql-and. 04e0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 04f0: 29 0a 20 20 20 20 20 20 28 28 73 71 6c 2d 61 6e ). ((sql-an 0500: 64 20 61 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 d a ...). 0510: 28 73 71 6c 2d 61 6e 64 2f 6e 75 6c 6c 20 23 74 (sql-and/null #t 0520: 20 61 20 2e 2e 2e 29 29 29 29 0a 0a 20 20 28 64 a ...)))).. (d 0530: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 73 71 6c efine-syntax sql 0540: 2d 61 6e 64 2f 6e 75 6c 6c 0a 20 20 20 20 28 73 -and/null. (s 0550: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 yntax-rules (). 0560: 20 20 20 20 20 28 28 73 71 6c 2d 61 6e 64 2f 6e ((sql-and/n 0570: 75 6c 6c 20 6e 75 6c 6c 29 0a 20 20 20 20 20 20 ull null). 0580: 20 6e 75 6c 6c 29 0a 20 20 20 20 20 20 28 28 73 null). ((s 0590: 71 6c 2d 61 6e 64 2f 6e 75 6c 6c 20 6e 75 6c 6c ql-and/null null 05a0: 20 61 20 62 20 2e 2e 2e 29 0a 20 20 20 20 20 20 a b ...). 05b0: 20 28 6c 65 74 20 28 28 65 61 20 61 29 29 0a 09 (let ((ea a)).. 05c0: 20 28 63 6f 6e 64 20 28 28 73 71 6c 2d 6e 75 6c (cond ((sql-nul 05d0: 6c 3f 20 65 61 29 20 28 73 71 6c 2d 61 6e 64 2f l? ea) (sql-and/ 05e0: 6e 75 6c 6c 20 65 61 20 20 20 20 62 20 2e 2e 2e null ea b ... 05f0: 29 29 0a 09 20 20 20 20 20 20 20 28 65 61 20 20 )).. (ea 0600: 20 20 20 20 20 20 20 20 20 20 20 28 73 71 6c 2d (sql- 0610: 61 6e 64 2f 6e 75 6c 6c 20 6e 75 6c 6c 20 62 20 and/null null b 0620: 2e 2e 2e 29 29 0a 09 20 20 20 20 20 20 20 28 65 ...)).. (e 0630: 6c 73 65 20 20 20 20 20 20 20 20 20 20 20 65 61 lse ea 0640: 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e )))))).. (defin 0650: 65 2d 73 79 6e 74 61 78 20 73 71 6c 2d 63 6f 61 e-syntax sql-coa 0660: 6c 65 73 63 65 0a 20 20 20 20 28 73 79 6e 74 61 lesce. (synta 0670: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 x-rules (). 0680: 20 28 28 73 71 6c 2d 63 6f 61 6c 65 73 63 65 29 ((sql-coalesce) 0690: 0a 20 20 20 20 20 20 20 28 73 71 6c 2d 6e 75 6c . (sql-nul 06a0: 6c 29 29 0a 20 20 20 20 20 20 28 28 73 71 6c 2d l)). ((sql- 06b0: 63 6f 61 6c 65 73 63 65 20 61 20 62 20 2e 2e 2e coalesce a b ... 06c0: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 ). (let (( 06d0: 65 61 20 61 29 29 0a 09 20 28 69 66 20 28 73 71 ea a)).. (if (sq 06e0: 6c 2d 6e 75 6c 6c 3f 20 65 61 29 0a 09 20 20 20 l-null? ea).. 06f0: 20 20 28 73 71 6c 2d 63 6f 61 6c 65 73 63 65 20 (sql-coalesce 0700: 62 20 2e 2e 2e 29 0a 09 20 20 20 20 20 65 61 29 b ...).. ea) 0710: 29 29 29 29 0a 0a 20 20 29 0a )))).. ).