suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Simplifying xexpr/callbacks? with corrext-xexpr?

Browse Source 
svn: r375
This commit is contained in:
Jay McCarthy 2005-07-13 14:41:46 +00:00
parent 596c62d299
commit 78bad3ef90
1 changed files with 4 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
collects/web-server/xexpr-callback.ss
View File

@ -2,88 +2,13 @@
;; Used for send/suspend/callback.
;; A xexpr/callback is one of:
;; - string
;; - symbol
;; - number
;; - comment
;; - processing instruction
;; - procedure
;; - (symbol xexpr/callback ...)
;; - (symbol ((symbol attrib-value) ...) xexpr/callback ...)
;; An attrib-value is one of:
;; - string
;; - procedure
(module xexpr-callback mzscheme
(require (lib "xml.ss" "xml"))
(provide xexpr/callback?)
;; Is it a Xexpr, or an Xexpr with procedures?
(define (xexpr/callback? x)
(correct-xexpr-callback? x #t #f))
;;; Copied and pasted from xml/private/xexpr.ss, then modified to include
;;; procedures.
;; correct-xexpr? : any any any -> any
(define (correct-xexpr-callback? x true false)
(cond
((string? x) true)
((symbol? x) true)
((number? x) true)
((comment? x) true)
((pi? x) true)
;; Modified here
((procedure? x) true)
;;
((list? x)
(or (null? x)
(if (symbol? (car x))
(if (has-attribute? x)
(and (attribute-pairs? (cadr x) true false)
(andmap (lambda (part)
(correct-xexpr-callback? part true false))
(cddr x))
true)
(andmap (lambda (part)
(correct-xexpr-callback? part true false))
(cdr x)))
false)))
(else false)))
;; has-attribute? : List -> Boolean
;; True if the Xexpr provided has an attribute list.
(define (has-attribute? x)
(and (> (length x) 1)
(list? (cadr x))
(andmap (lambda (attr)
(pair? attr))
(cadr x))))
;; attribute-pairs? : List any any -> any
;; True if the list is a list of pairs.
(define (attribute-pairs? attrs true false)
(or (and (null? attrs) true)
(let ((attr (car attrs)))
(if (pair? attr)
(and (attribute-symbol-string? attr true false)
(attribute-pairs? (cdr attrs) true false)
true)
false))))
;; attribute-symbol-string? : List any any
;; -> any
;; True if the list is a list of String,Symbol pairs.
(define (attribute-symbol-string? attr true false)
(if (symbol? (car attr))
(or (and (or (string? (cadr attr))
;; Modified here
(procedure? (cadr attr)))
;;
true)
false)
false))
)
(correct-xexpr? x
(lambda () #t)
(lambda (exn)
(procedure? (exn:invalid-xexpr-code exn))))))