;;; sql-generate.scm   --  Jens Axel Søgaard

; TODO
;  - unquote expressions
;  - is (select-statement) a legal SQL-expression?
;  - in generate-expr, check whether the number
;    of actual and formal arguments match

; SQLite statements not implemented
;  - CREATE *
;  - BEGIN/COMMIT/END/ROLLBACK TRANSACTION

;  - ALTER TABLE
;  - ANALYZE
;  - ATTACH/DETACH DATABASE
;  - DROP *
;  - EXPLAIN
;  - PRAGMA
;  - REINDEX
;  - VACUUM

; NOTE: DELETE and REPLACE are sugar for SELECT.
;       They are handled in sql.scm.


(module sql-generate mzscheme
  (provide (all-defined))
  
  (require (lib "stx.ss" "syntax"))
  
  ;
  ;    ### #  ######  ###     ######    ####  #######
  ;   #   ##   #   #   #       #   #   #   #  #  #  #
  ;   #        # #     #       # #    #          #   
  ;    ####    ###     #       ###    #          #   
  ;        #   # #     #       # #    #          #   
  ;        #   #       #   #   #      #          #   
  ;   ##   #   #   #   #   #   #   #   #   #     #   
  ;   # ###   ######  ######  ######    ###     ###  
  ;
  
  ;  sql-statement  ::=  SELECT [ALL | DISTINCT] result 
  ;                      [FROM table-list]
  ;                    	 [WHERE expr]
  ;		    	 [GROUP BY expr-list]
  ;			 [HAVING expr]
  ;			 [compound-op select]*
  ;			 [ORDER BY sort-expr-list]
  ;			 [LIMIT integer [( OFFSET | , ) integer]]
  (define (generate-select loc stx)
    (syntax-case stx (SELECT ALL DISTINCT)
      [(SELECT ALL result . clauses)
       #`(SELECT ALL #,(generate-result #'result)
                  #,@(generate-select-from stx #'clauses))]
      [(SELECT ALL)
       (raise-syntax-error #f "SELECT ALL <result> <clause>* expected" loc loc)]
      [(SELECT DISTINCT)
       (raise-syntax-error #f "SELECT DISTINCT <result> <clause>* expected" loc loc)]
      [(SELECT result)
       #`(SELECT #,(generate-result #'result))]
      [(SELECT DISTINCT result . clauses)
       #`(SELECT DISTINCT #,(generate-result #'result)
                  #,@(generate-select-from stx #'clauses))]
      [(SELECT result . clauses)
       #`(SELECT #,(generate-result #'result)
                  #,@(generate-select-from stx #'clauses))]
      [(SELECT)
       (raise-syntax-error #f "bad syntax in SELECT from" stx stx)]
      [else
       (raise-syntax-error #f "(SELECT ...) expected" loc stx)]))
  
  (define (generate-select-from loc stx)
    (syntax-case stx (FROM)
      [(FROM table-list . clauses )
       #`(FROM #,(generate-table-list loc #'table-list)
               #,@(generate-select-where loc #'clauses))]
      [(FROM)
       (raise-syntax-error #f "<table-list> missing in the FROM clause" loc stx)]
      [(clause ...)
       (generate-select-where loc stx)]))
  
  ;  ... [WHERE expr] ...
  (define (generate-select-where loc stx)
    (syntax-case stx (WHERE)
      [(WHERE expr . clauses)
       #`(WHERE #,(generate-expr stx #'expr)
                #,@(generate-select-group-by loc #'clauses))]
      [(WHERE)
       (raise-syntax-error #f "<expr> missing in the WHERE clause" loc stx)]
      [(clause ...)
       (generate-select-group-by loc stx)]))
  
  ; ... [GROUP BY expr-list] ...
  (define (generate-select-group-by loc stx)
    (syntax-case stx (GROUP-BY)
      [(GROUP-BY expr-list . clauses)
       #`(GROUP-BY #,(generate-expr-list stx #'expr-list)
                   #,@(generate-select-group-by loc #'clauses))]
      [(GROUP-BY)
       (raise-syntax-error #f "<expr> missing in the GROUP-BY clause" loc stx)]
      [(clause ...)
       (generate-select-having loc stx)]))
  
  ; ... [HAVING expr] ...
  (define (generate-select-having loc stx)
    (syntax-case stx (HAVING)
      [(HAVING expr . clauses)
       #`(HAVING #,(generate-expr stx #'expr)
                 #,@(generate-select-compound-op loc #'clauses))]
      [(HAVING)
       (raise-syntax-error #f "<expr> missing in the HAVING clause" loc stx)]
      [(clause ...)
       (generate-select-compound-op loc stx)]))
  
  ; ... [compound-op select]* ...
  ;  compound_op  ::=  UNION | UNION ALL | INTERSECT | EXCEPT
  (define (generate-select-compound-op loc stx)
    (syntax-case stx (UNION UNION-ALL INTERSECT EXCEPT)
      [(UNION select . clauses)
       #`(UNION #,(generate-select stx #'select)
                #,@(generate-select-compound-op loc #'clauses))]
      [(UNION-ALL select . clauses)
       #`(UNION-ALL #,(generate-select stx #'select)
                    #,@(generate-select-compound-op loc #'clauses))]
      [(INTERSECT select . clauses)
       #`(INTERSECT #,(generate-select stx #'select)
                    #,@(generate-select-compound-op loc #'clauses))]
      [(EXCEPT select . clauses)
       #`(EXCEPT #,(generate-select stx #'select)
                 #,@(generate-select-compound-op loc #'clauses))]
      [(UNION)
       (raise-syntax-error #f "<select> missing in the UNION clause" loc stx)]
      [(UNION-ALL)
       (raise-syntax-error #f "<select> missing in the UNION-ALL clause" loc stx)]
      [(INTERSECT)
       (raise-syntax-error #f "<select> missing in the INTERSECT clause" loc stx)]
      [(EXCEPT)
       (raise-syntax-error #f "<select> missing in the EXCEPT clause" loc stx)]
      [(clause ...)
       (generate-select-order-by loc stx)]))
  
  ; ... [ORDER BY sort-expr-list] ...
  (define (generate-select-order-by loc stx)
    (syntax-case stx (ORDER-BY)
      [(ORDER-BY sort-expr-list . clauses)
       #`(ORDER-BY #,(generate-sort-expr-list stx #'sort-expr-list)
                   #,@(generate-select-limit loc #'clauses))]
      [(ORDER-BY)
       (raise-syntax-error #f "<sort-expr-list> missing in the ORDER-BY clause" loc stx)]
      [(clause ...)
       (generate-select-limit loc stx)]))
  
  ; ... [LIMIT integer [( OFFSET | , ) integer]]
  (define (generate-select-limit loc stx)
    (syntax-case stx (LIMIT OFFSET)
      [(LIMIT integer)
       #`(LIMIT #,#'integer)]
      [(LIMIT integer OFFSET integer2)
       #`(LIMIT #,#'integer OFFSET #,#'integer2)]
      [(LIMIT integer integer2)
       #`(LIMIT #,#'integer #,#'integer2)]
      [()
       #'()]
      [else
       (raise-syntax-error #f "<limit> expected" loc stx)]))
  
  ;  sort-expr-list ::= 	expr [sort-order] [, expr [sort-order]]*
  ;  sort-order     ::= 	[ COLLATE collation-name ] [ ASC | DESC ]
  (define (generate-sort-expr-list loc stx)
    (syntax-case stx (COLLATE ASC DESC)
      [()
       (raise-syntax-error #f "<sort-expr-list> expected" loc stx)]
      [(sort-order . more)
       (generate-sort-expr-list-more stx stx)]
      [else
       (raise-syntax-error #f "<sort-order-list> expected" loc stx)]))
  
  ; ... [, expr [sort-order]]*
  (define (generate-sort-expr-list-more loc stx)
    (syntax-case stx (COLLATE ASC DESC)
      (display stx)
      [(COLLATE . more)
       (raise-syntax-error #f "<expr> expected" stx stx)]
      [(ASC . more)
       (raise-syntax-error #f "<expr> expected" stx stx)]
      [(DESC . more)
       (raise-syntax-error #f "<expr> expected" stx stx)]
      [(expr)
       #`(#,(generate-expr #'expr #'expr))]
      [(expr ASC . more)
       #`(#,(generate-expr #'expr #'expr) ASC #,@(generate-sort-expr-list-more stx #'more))]
      [(expr DESC . more )
       #`(#,(generate-expr #'expr #'expr) DESC #,@(generate-sort-expr-list-more stx #'more))]
      [(expr COLLATE collation-name . more)
       #`(#,(generate-expr #'expr #'expr) COLLATE #,#'collation-name #,@(generate-sort-expr-list-more stx #'more))]
      [(expr . more)
       #`(#,(generate-expr #'expr #'expr) #,@(generate-sort-expr-list-more stx #'more))]
      [()
       #'()]))
  
  ;  table-list ::= table [join-op table join-args]*
  ;  table      ::= table-name [AS alias] 
  ;              |  ( select ) [AS alias]                 <------ TODO TODO
  (define (generate-table-list loc stx)
    (syntax-case stx (AS)
      [(unquote sexp)
       (eq? 'unquote (syntax-e #'unquote))    ; TODO: Adding unquote as a keyword didn't work, why?
       #',sexp]
      [(table AS alias . more)
       #`(#,#'table AS #,#'alias #,@(generate-table-list loc #'more))]
      [(table . more)
       #`(#,#'table #,@(generate-table-list-more loc #'more))]
      [()
       #'()]
      [table
       #`#,#'table]))
  
  ;  join-op        ::=	, | [NATURAL] [LEFT | RIGHT | FULL] [OUTER | INNER | CROSS] JOIN
  ;  join-args      ::= 	[ON expr] [USING ( id-list )]
  (define (generate-table-list-more loc stx)
    (syntax-case stx (NATURAL LEFT RIGHT FULL OUTER INNER CROSS JOIN ON USING)
      [(NATURAL . more)
       #`(NATURAL #,@(generate-table-list-more loc #'more))]
      [(LEFT . more)
       #`(LEFT #,@(generate-table-list-more loc #'more))]
      [(RIGHT . more)
       #`(RIGHT #,@(generate-table-list-more loc #'more))]
      [(FULL . more)
       #`(FULL #,@(generate-table-list-more loc #'more))]
      [(OUTER . more)
       #`(OUTER #,@(generate-table-list-more loc #'more))]
      [(INNER . more)
       #`(INNER #,@(generate-table-list-more loc #'more))]
      [(CROSS . more)
       #`(CROSS #,@(generate-table-list-more loc #'more))]
      [(JOIN table)
       #`(JOIN #,(generate-table #'table))]
      [(JOIN table ON expr)
       #`(JOIN #,(generate-table #'table) ON #,(generate-expr #'expr #'expr))]
      [(JOIN table ON expr USING (id ...))
       #`(JOIN #,(generate-table #'table) ON #,(generate-expr #'expr #'expr)
               USING (PAREN-COMMA-LIST #,@(generate-id-list #'(id ...))))]
      [(JOIN table USING (id ...))
       #`(JOIN #,(generate-table #'table) USING #,(generate-id-list #'(id ...)))]
      [else
       (raise-syntax-error #f "<table-list> ::= (<table> [<join-op> <table> [ON <expr>][USING (<id-list>)]]*  exptected" loc stx)]))
  
  (define (generate-id-list stx)
    (syntax-case stx ()
      [(id ...)
       #'(id ...)]))
  
  (define (generate-table stx)
    ; TODO: Add   (select ) [AS alias]   
    (syntax-case stx (AS)
      [(table AS alias)
       #`(#,#'table AS #,#'alias)]
      [(table)
       #`(#,#'table)]
      [table
       #'table]))
  
  
  
  ;;  result  ::=  result-column [, result-column]*
  (define (generate-result stx)
    (syntax-case stx ()
      [(result-column ...)
       `(COMMA-LIST ,@(map generate-result-column
                           (syntax->list #'(result-column ...))))]
      [else
       (raise-syntax-error #f "<result> ::= (<result-column> ...) expected" stx)]))
  
  ;;  result-column  ::=  * | table-name.* | expr [ [AS] string ]
  (define (generate-result-column stx)
    (syntax-case stx (* unquote AS)
      [(*)    
       "*"]
      ; tablename.* 
      ;[(table-name *) (string-append (generate-table-name #'table-name) ".*")]
      [(expr AS string)
       #`(#,(generate-expr #'expr) " AS " #,#'string)]
      [expr
       #`(#,(generate-expr #'expr #'expr))]))
  
  ;; expr
;  (define (generate-expr loc stx)
    ; TODO
;    stx)
  
  (define (generate-expr-list loc stx)
    `(COMMA-LIST 
      ,@(map (lambda (s) (generate-expr loc s))
            (syntax->list stx))))
  
  ;
  ;   ### ### #####   ####      ##    ####### ###### 
  ;    #   #   #   #   #  #      #    #  #  #  #   # 
  ;    #   #   #   #   #   #    # #      #     # #   
  ;    #   #   #   #   #   #    # #      #     ###   
  ;    #   #   ####    #   #    # #      #     # #   
  ;    #   #   #       #   #    ###      #     #     
  ;    #   #   #       #  #    #   #     #     #   # 
  ;     ###   ###     ####    ### ###   ###   ###### 
  ;
  
  
  ;;; UPDATE    <http://www.sqlite.org/lang_update.html>
  ; sql-statement   ::=   UPDATE [ OR conflict-algorithm ] [database-name .] table-name
  ;                       SET assignment [, assignment]*
  ;                       [WHERE expr]
  (define (generate-update loc stx)
    (syntax-case stx (UPDATE OR)
      [(UPDATE OR conflict-algorithm table-name . more)
       #`(UPDATE OR #,(generate-conflict-algorithm stx #'conflict-algorithm)
                  #,@(generate-update-set stx #'more))]
      [(UPDATE table-name . more)
       #`(UPDATE table-name #,@(generate-update-set stx #'more))]
      [(UPDATE . more)
       (raise-syntax-error 
        #f "(UPDATE [OR conflict-algorithm] table-name SET (assignment ...) [WHERE expr] expected" loc stx)]
      [else
       (raise-syntax-error #f "(UPDATE ...) expected" loc stx)]))
  
  (define (generate-update-set loc stx)
    (syntax-case stx (SET WHERE)
      [(SET assignment assignments ... WHERE expr)
       #`(SET (COMMA-LIST #,(generate-assignment stx #'assignment)
                          #,@(generate-assignments stx #'(assignments ...)))
              WHERE #,(generate-expr stx #'expr))]
      [(SET assignment assignments ... WHERE)
       (raise-syntax-error #f "SET assignment assignment ... [WHERE expr]  expected" loc stx)]
      [(SET assignment assignments ...)
       #`(SET (COMMA-LIST #,(generate-assignment stx #'assignment)
                          #,@(generate-assignments stx #'(assignments ...))))]
      [(SET . more)
       (raise-syntax-error #f "SET assignment assignment ... [WHERE expr]  expected" loc stx)]
      [else
       (raise-syntax-error 
        #f "(UPDATE [OR conflict-algorithm] table-name SET (assignment ...) [WHERE expr] expected" loc stx)]))
  
  ; conflict-clause     ::= ON CONFLICT conflict-algorithm
  ; conflict-algorithm  ::= ROLLBACK | ABORT | FAIL | IGNORE | REPLACE
  (define (generate-conflict-algorithm loc stx)
    (syntax-case stx (ROLLBACK ABORT FAIL IGNORE REPLACE)
      [ROLLBACK #'ROLLBACK]
      [ABORT    #'ABORT]
      [FAIL     #'FAIL]
      [IGNORE   #'IGNORE]
      [REPLACE  #'REPLACE]
      [else
       (raise-syntax-error #f "conflict-algorithm  ::= ROLLBACK | ABORT | FAIL | IGNORE | REPLACE   expected" loc stx)]))
  
  ; assignment    ::= 	column-name = expr
  (define (generate-assignment loc stx)
    (syntax-case stx ()
      [(column-name = expr)
       (and (eq? (syntax-e #'=) '=)
            (identifier? #'column-name))
       #`(column-name "=" #,(generate-expr stx #'expr))]
      [else
       (raise-syntax-error #f "assignment ::= (<column-name> = <expr>)    exptected, " loc stx)]))
  
  (define (generate-assignments loc stx)
    (map (lambda (s) (generate-assignment loc s))
         (syntax->list stx)))
  
  ;
  ;    ##### ###  ###  ### #  ######  #####   #######
  ;      #    ##   #  #   ##   #   #   #   #  #  #  #
  ;      #    # #  #  #        # #     #   #     #   
  ;      #    # #  #   ####    ###     #   #     #   
  ;      #    #  # #       #   # #     ####      #   
  ;      #    #  # #       #   #       #  #      #   
  ;      #    #   ##  ##   #   #   #   #   #     #   
  ;    ##### ###  ##  # ###   ######  ###   #   ###  
  ;
  
  ;  sql-statement ::= INSERT [OR conflict-algorithm] INTO [database-name .] table-name [(column-list)] VALUES(value-list) 
  ;                 |  INSERT [OR conflict-algorithm] INTO [database-name .] table-name [(column-list)] select-statement
  (define (generate-insert loc stx)
    (syntax-case stx (INSERT OR INTO VALUES)
      [(INSERT OR conflict-algorithm INTO table-name column-list VALUES value-list)
       #`(INSERT OR #,(generate-conflict-algorithm stx #'conflict-algorithm)
                  INTO #,(generate-table-name stx #'table-name)
                  (PAREN-COMMA-LIST #,@(generate-column-list stx #'column-list))
                  VALUES (PAREN-COMMA-LIST #,@(generate-value-list stx #'value-list)))]
      [(INSERT OR conflict-algorithm INTO table-name #'column-list VALUES)
       (raise-syntax-error 
        #f "(INSERT [OR conflict-algorithm] INTO table-name [column-list] VALUES value-list  expected" loc stx)]
      [(INSERT OR conflict-algorithm INTO table-name column-list select-statement)
       #`(INSERT OR #,(generate-conflict-algorithm stx #'conflict-algorithm)
                  INTO #,(generate-table-name stx #'table-name)
                  (PAREN-COMMA-LIST #,@(generate-column-list stx #'column-list))
                  #,@(stx-cdr (generate-select stx #'select-statement)))]
      [(INSERT INTO table-name column-list VALUES value-list)
       #`(INSERT INTO #,(generate-table-name stx #'table-name)
                 (PAREN-COMMA-LIST #,@(generate-column-list stx #'column-list))
                  VALUES (PAREN-COMMA-LIST #,@(generate-value-list stx #'value-list)))]
      [(INSERT INTO table-name column-list VALUES)
       (raise-syntax-error 
        #f "(INSERT [OR conflict-algorithm] INTO table-name [column-list] VALUES value-list  expected" loc stx)]
      [(INSERT INTO table-name column-list select-statement)
       #``(INSERT INTO #,(generate-table-name stx #'table-name)
                  (PAREN-COMMA-LIST #,@(generate-column-list stx #'column-list))
                  #,@(generate-select stx #'select-statement))]
      [(INSERT . more)
       (raise-syntax-error 
        #f (string-append "    (INSERT [OR conflict-algorithm] INTO table-name [column-list] VALUES value-list\n"
                          " or (INSERT [OR conflict-algorithm] INTO table-name [column-list] (SELECT ...)     expected") loc stx)]
      [else
       (raise-syntax-error #f "(INSERT ...) expected" loc stx)]))
  
  (define (generate-value-list loc stx)
    (map (lambda (s) (generate-value loc s))
         (syntax->list stx)))
  
  (define (generate-value loc stx)
    ; TODO
    `(STRING ,stx))
  
  (define (generate-table-name loc stx)
    stx)
  
  (define (generate-column-list loc stx)
    (map (lambda (s) (generate-column loc s))
         (syntax->list stx)))
  
  (define (generate-column loc stx)
    ; TODO
    stx)
  
  ;  
  ;   ####    ######  ###     ######  ####### ###### 
  ;    #  #    #   #   #       #   #  #  #  #  #   # 
  ;    #   #   # #     #       # #       #     # #   
  ;    #   #   ###     #       ###       #     ###   
  ;    #   #   # #     #       # #       #     # #   
  ;    #   #   #       #   #   #         #     #     
  ;    #  #    #   #   #   #   #   #     #     #   # 
  ;   ####    ######  ######  ######    ###   ###### 
  ;
  
  ; sql-statement ::= DELETE FROM [database-name .] table-name [WHERE expr]
  
  (define (generate-delete loc stx)
    (syntax-case stx (DELETE FROM WHERE)
      [(DELETE FROM table-name WHERE expr)
       #`(DELETE FROM #,(generate-table-name stx #'table-name) WHERE #,(generate-expr stx #'expr))]
      [(DELETE FROM table-name WHERE)
       (raise-syntax-error 
        #f "DELETE FROM [database-name .]table-name [WHERE expr]  expected" loc stx)]
      [(DELETE FROM table-name)
       #`(DELETE FROM #,(generate-table-name stx #'table-name) WHERE #,(generate-expr stx #'expr))]
      [(DELETE . more)
       (raise-syntax-error 
        #f "DELETE FROM [database-name .]table-name [WHERE expr]  expected" loc stx)]
      [else
       (raise-syntax-error 
        #f "(DELETE ...)  expected" loc stx)]))
  
  
  
;                                                                                  
;   ######  ### ### #####   #####   ######   ### #   ### #   #####    ###  ###  ###
;    #   #   #   #   #   #   #   #   #   #  #   ##  #   ##     #     #   #  ##   # 
;    # #      # #    #   #   #   #   # #    #       #          #    #     # # #  # 
;    ###       #     #   #   #   #   ###     ####    ####      #    #     # # #  # 
;    # #       #     ####    ####    # #         #       #     #    #     # #  # # 
;    #        # #    #       #  #    #           #       #     #    #     # #  # # 
;    #   #   #   #   #       #   #   #   #  ##   #  ##   #     #     #   #  #   ## 
;   ######  ### ### ###     ###   # ######  # ###   # ###    #####    ###  ###  ## 
;                                                                                  

  (define binary-operators
    `(; highest precendence
      ,(string->symbol "||")      
      * / %
      + -
      << >> & ,(string->symbol "|")
      < <= > >=
      = == != <> IN
      AND
      ; lowest precedence
      OR))
  
  (define (binary-operator? sym)
    (member sym binary-operators))
    
  (define unary-operators
    '(- + ! ~ NOT))
  
  (define (unary-operator? sym)
    (member sym unary-operators))
  
  (define function-names
    '(abs coalesce glob ifnull last_insert_rowid length
          like lower max min nullif #;quote
          random round soundex sqlite_version
          substr typeof upper
          ; aggregate functions
          avg count max min sum total))

  (define (function-name? sym)
    (member sym function-names))
  
  (define (string->sql-string s)
    ; An sql-string is enclosed in single quotes (').
    ; A single quote within the string is encoded by putting two single quotes in a row.
    ; C-style escapes (with backslash) is not supported (they are not standard SQL).
    (string-append "'" (regexp-replace* "'" s "''") "'"))
  
  
  (define like-operators
    '(LIKE GLOB REGEXP))
  
  (define (like-operator? sym)
    (member sym like-operators))
  
  (define (generate-expr loc stx)
    (define (g s) (generate-expr s s))
    ; http://www.sqlite.org/lang_expr.html
    (syntax-case stx (NOT ESCAPE ISNULL NOTNULL BETWEEN AND IN EXISTS CASE WHEN THEN ELSE END CAST AS ? : $)
      [(unquote sexp)
       (eq? 'unquote (syntax-e #'unquote))
       #',sexp]
      ; expr binary-op expr
      [(bin-op expr1 expr2)
       (binary-operator? (syntax-e #'bin-op))
       #`(PAREN (PAREN #,(g #'expr1)) bin-op (PAREN #,(g #'expr2)))]
      ; expr [NOT] like-op expr [ESCAPE expr]
      [(like-op expr1 expr2)
       (like-operator? (syntax-e #'like-op))
       #`(PAREN (#,(g #'expr1)) like-op (#,(g #'expr2)))]
      [(NOT like-op expr1 expr2)
       (like-operator? (syntax-e #'like-op))
       #`(PAREN (#,(g #'expr1)) NOT like-op (#,(g #'expr2)))]
      [(like-op expr1 expr2 ESCAPE expr3)
       (like-operator? (syntax-e #'like-op))
       #`(PAREN (#,(g #'expr1)) like-op (#,(g #'expr2)) ESCAPE (#,(g #'expr3)))]
      [(NOT like-op expr1 expr2 ESCAPE expr3)
       (like-operator? (syntax-e #'like-op))
       #`(PAREN (#,(g #'expr1)) NOT like-op (#,(g #'expr2)) ESCAPE (#,(g #'expr3)))]
      ; unary-op expr
      [(unary-op expr)
       (unary-operator? (syntax-e #'unary-op))
       #`((unary-op (PAREN #,(g #'expr))))]
      ; parameter
      [(? NNN)   ; numbered parameter
       (let ([n (syntax-e #'NNN)])
         (unless (and (integer? n) (<= 1 n 999))
           (raise-syntax-error #f "a parameter number must be between 1 and 999" loc stx))
         #`(#,(format " ?~a " n)))]
      [(?)
       #'" ? "]
      [?
       #'" ? "]
      [(: AAAA)  ; named parameter
       (unless (identifier? #'AAAA)
         (raise-syntax-error #f "a parameter name expected" loc stx))
       #`(#,(format " :~a " (syntax-e #'AAAA)))]
      [(ISNULL expr)
       #`((PAREN #,(g #'expr)) ISNULL)]
      [(NOTNULL expr)
       #`((PAREN #,(g #'expr)) NOTNULL)]
      [(BETWEEN expr1 expr2 expr3)
       #`((PAREN #,(g #'expr1)) BETWEEN (PAREN #,(g #'expr2)) AND (PAREN #,(g #'expr3)))]
      [(NOT BETWEEN expr1 expr2 expr3)
       #`((#,(g #'expr1)) NOT BETWEEN (#,(g #'expr2)) AND (#,(g #'expr3)))]
      ; IN  ... TODO TODO TODO TODO TODO TODO TODO TODO
      ; [EXISTS] ( select-statement ) 
      [(EXISTS select-statement)
       #`("[EXISTS](" #,(generate-select #'select-statement #'select-statement) ")")]
      ; TODO: Is (select-statement) a legal expression?
      ; CASE [expr] ( WHEN expr THEN expr )+ [ELSE expr] END 
      [(CASE (WHEN expr2 THEN expr3) (WHEN expr4 THEN expr5) ... (ELSE expr6))
       #`(CASE (WHEN (#,(g #'expr2)) THEN (#,(g #'expr3)))
               #,@(with-syntax ([(e4 ...) (map g (syntax->list #'(expr4 ...)))]
                                [(e5 ...) (map g (syntax->list #'(expr5 ...)))])
                    #'((WHEN (e4) THEN (e5)) ...))
               (ELSE (#,(g #'expr6)))
               END)]
      [(CASE (WHEN expr2 THEN expr3) (WHEN expr4 THEN expr5) ...)
       #`(CASE (WHEN (#,(g #'expr2)) THEN (#,(g #'expr3)))
               #,@(with-syntax ([(e4 ...) (map g (syntax->list #'(expr4 ...)))]
                                [(e5 ...) (map g (syntax->list #'(expr5 ...)))])
                    #'((WHEN (e4) THEN (e5)) ...))
               END)]
      [(CASE expr1 (WHEN expr2 THEN expr3) (WHEN expr4 THEN expr5) ... (ELSE expr6))
       #`(CASE (#,(g #'expr1)) 
               (WHEN (#,(g #'expr2)) THEN (#,(g #'expr3)))
               #,@(with-syntax ([(e4 ...) (map g (syntax->list #'(expr4 ...)))]
                                [(e5 ...) (map g (syntax->list #'(expr5 ...)))])
                    #'((WHEN (e4) THEN (e5)) ...))
               (ELSE (#,(g #'expr6)))
               END)]
      [(CASE expr1 (WHEN expr2 THEN expr3) (WHEN expr4 THEN expr5) ...)
       #`(CASE (#,(g #'expr1)) 
               (WHEN (#,(g #'expr2)) THEN (#,(g #'expr3)))
               #,@(with-syntax ([(e4 ...) (map g (syntax->list #'(expr4 ...)))]
                                [(e5 ...) (map g (syntax->list #'(expr5 ...)))])
                    #'((WHEN (e4) THEN (e5)) ...))
               END)]
      ; CAST ( expr AS type )
      [(CAST expr AS type)
       ; TODO: check type is a type
       #`(CAST (PAREN (PAREN #,(g #'expr)) AS type))]
      [(function-name expr ...)
       (function-name? (syntax-e #'function-name))
       #`(function-name (PAREN-COMMA-LIST #,@(map g (syntax->list #'(expr ...)))))]
      ; column-name | table-name.column-name | database-name.table-name.column-name
      [id
       (identifier? #'id)
       #'id]
      ; literal-value
      [lit
       (literal? (syntax-e #'lit))
       (generate-literal #'lit #'lit)]
      [else
       (raise-syntax-error 
        #f "<expression> expected" loc stx)]))
  
  
;                                                          
;   ###      #####  ####### ######  #####     ##    ###    
;    #         #    #  #  #  #   #   #   #     #     #     
;    #         #       #     # #     #   #    # #    #     
;    #         #       #     ###     #   #    # #    #     
;    #         #       #     # #     ####     # #    #     
;    #   #     #       #     #       #  #     ###    #   # 
;    #   #     #       #     #   #   #   #   #   #   #   # 
;   ######   #####    ###   ######  ###   # ### ### ###### 
;                                                          
  
  (define (literal? o)
    (or (number? o)
        (string? o)
        ; (blob? ...)
        (eq? o 'NULL)))
  
  (define (generate-literal loc stx)
    (unless (literal? (syntax-e stx))
      (raise-syntax-error #f "<literal> expected" loc stx))
    (let ([lit (syntax-e stx)])
      (cond
        [(number? lit) lit]
        [(string? lit) (string->sql-string lit)]
        [else          (error)])))

  
  
  )