aliens/tekuti
1
0
Fork 0
Code Activity

move up let-request definition

Browse source 
* tekuti/request.scm (let-request): Move definition up.
This commit is contained in:
Andy Wingo 2010-10-14 13:28:32 +02:00
parent 29f45c45bb
commit 10095abd48
1 changed files with 18 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
tekuti/request.scm
View file

@ -1,5 +1,5 @@
;; Tekuti
;; Copyright (C) 2008 Andy Wingo <wingo at pobox dot com>
;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@ -72,6 +72,23 @@
(method . ,(lambda (r)
(header-ref (rref r 'headers '()) "method" "GET")))))
(define-syntax let-request
(lambda (stx)
(define (make-binding b)
(syntax-case b ()
((id option ...)
(identifier? #'id)
#'(id (rref request-var 'id option ...)))
(id
(identifier? #'id)
#'(id (rref request-var 'id)))))
(syntax-case stx ()
((_ request (binding ...) body ...)
(with-syntax (((binding ...) (map make-binding #'(binding ...))))
#'(let ((request-var request))
(let (binding ...)
body ...)))))))
(define (request-form-data request)
(let-request request (headers post-data)
(if (string-null? post-data)
@ -129,23 +146,6 @@
#f)
#f)))))
(define-syntax let-request
(lambda (stx)
(define (make-binding b)
(syntax-case b ()
((id option ...)
(identifier? #'id)
#'(id (rref request-var 'id option ...)))
(id
(identifier? #'id)
#'(id (rref request-var 'id)))))
(syntax-case stx ()
((_ request (binding ...) body ...)
(with-syntax (((binding ...) (map make-binding #'(binding ...))))
#'(let ((request-var request))
(let (binding ...)
body ...)))))))
(define-syntax path-proc-case
(lambda (stx)
(define (optional-argument? arg)