; This file is generated by an LAML script based on the LAML tool tools/xml-in-laml/xml-in-laml.scm. DO NOT EDIT! ; ; lib/xml-in-laml/xml-in-laml.scm is not loaded here. ; You must load it your self prior to the loading of this file.![]()
![]()
(define bike-management-xml-transliterate-character-data? #t)![]()
![]()
(define bike-management-xml-char-transformation-table html-char-transformation-table)![]()
![]()
(define bike-management-xml-non-transliteration-elements '())![]()
![]()
(define bike-management-xml-pass-default-dtd-attributes? #f)![]()
![]()
(define bike-management-xml-accept-only-string-valued-attributes? #t)![]()
![]()
(define bike-management-xml-document-type-declaration "")![]()
![]()
(define bike-management-xml-represent-white-space? #t) ; Empty temporary language map (set! temp-language-map (quote ())) ;;; The validation procedures![]()
![]()
(define (bikes-bike-management-laml-validate! el-name attributes contents overlap-check?) (let ((attributes-of-elements (quote ())) (req-n 0)) (if (and overlap-check? xml-check-language-overlap?) (check-language-overlap! (as-symbol "bikes"))) (if xml-check-attributes? (xml-check-attributes! attributes attributes-of-elements req-n "bikes")) (if xml-validate-contents? (validate-contents! contents (zero-or-more "bike") "bikes"))))![]()
![]()
(define (bike-bike-management-laml-validate! el-name attributes contents overlap-check?) (let ((attributes-of-elements (quote (("kind" ("mountain-bike, racer-bike, tourist-bike, other") "tourist-bike")))) (req-n 0)) (if (and overlap-check? xml-check-language-overlap?) (check-language-overlap! (as-symbol "bike"))) (if xml-check-attributes? (xml-check-attributes! attributes attributes-of-elements req-n "bike")) (if xml-validate-contents? (validate-contents! contents bike-bike-management-checker? "bike"))))![]()
![]()
(define (frame-bike-management-laml-validate! el-name attributes contents overlap-check?) (let ((attributes-of-elements (quote (("frame-number" "CDATA" "#REQUIRED")))) (req-n 1)) (xml-check-for-empty-contents! contents "frame") (if (and overlap-check? xml-check-language-overlap?) (check-language-overlap! (as-symbol "frame"))) (if xml-check-attributes? (xml-check-attributes! attributes attributes-of-elements req-n "frame"))))![]()
![]()
(define (wheel-bike-management-laml-validate! el-name attributes contents overlap-check?) (let ((attributes-of-elements (quote (("size" "CDATA" "#REQUIRED") ("tube-kind" "CDATA" "#IMPLIED")))) (req-n 1)) (xml-check-for-empty-contents! contents "wheel") (if (and overlap-check? xml-check-language-overlap?) (check-language-overlap! (as-symbol "wheel"))) (if xml-check-attributes? (xml-check-attributes! attributes attributes-of-elements req-n "wheel"))))![]()
![]()
(define (brake-bike-management-laml-validate! el-name attributes contents overlap-check?) (let ((attributes-of-elements (quote (("kind" "CDATA" "#IMPLIED") ("brand" "CDATA" "#IMPLIED")))) (req-n 0)) (xml-check-for-empty-contents! contents "brake") (if (and overlap-check? xml-check-language-overlap?) (check-language-overlap! (as-symbol "brake"))) (if xml-check-attributes? (xml-check-attributes! attributes attributes-of-elements req-n "brake"))))![]()
![]()
(define (lock-bike-management-laml-validate! el-name attributes contents overlap-check?) (let ((attributes-of-elements (quote (("insurance-approved" ("true" "false") "#REQUIRED") ("brand" "CDATA" "#IMPLIED")))) (req-n 1)) (xml-check-for-empty-contents! contents "lock") (if (and overlap-check? xml-check-language-overlap?) (check-language-overlap! (as-symbol "lock"))) (if xml-check-attributes? (xml-check-attributes! attributes attributes-of-elements req-n "lock")))) ;;; Make and put XML mirror functions in the temporary language map (set! temp-mirror-function (generate-xml-mirror-function bikes-bike-management-laml-validate! "bikes" (quote ()) (quote double) (quote bike-management) #f #f)) (set! temp-language-map (put-mirror-function temp-language-map "bikes" temp-mirror-function)) (set! temp-mirror-function (generate-xml-mirror-function bikes-bike-management-laml-validate! "bikes" (quote ()) (quote double) (quote bike-management) #t bikes!))![]()
![]()
(define bikes temp-mirror-function) (set! temp-mirror-function (generate-xml-mirror-function bike-bike-management-laml-validate! "bike" (quote (kind "tourist-bike")) (quote double) (quote bike-management) #f #f)) (set! temp-language-map (put-mirror-function temp-language-map "bike" temp-mirror-function)) (set! temp-mirror-function (generate-xml-mirror-function bike-bike-management-laml-validate! "bike" (quote (kind "tourist-bike")) (quote double) (quote bike-management) #t #f))![]()
![]()
(define bike temp-mirror-function) (set! temp-mirror-function (generate-xml-mirror-function frame-bike-management-laml-validate! "frame" (quote ()) (quote single) (quote bike-management) #f #f)) (set! temp-language-map (put-mirror-function temp-language-map "frame" temp-mirror-function)) (set! temp-mirror-function (generate-xml-mirror-function frame-bike-management-laml-validate! "frame" (quote ()) (quote single) (quote bike-management) #t #f))![]()
![]()
(define frame temp-mirror-function) (set! temp-mirror-function (generate-xml-mirror-function wheel-bike-management-laml-validate! "wheel" (quote ()) (quote single) (quote bike-management) #f #f)) (set! temp-language-map (put-mirror-function temp-language-map "wheel" temp-mirror-function)) (set! temp-mirror-function (generate-xml-mirror-function wheel-bike-management-laml-validate! "wheel" (quote ()) (quote single) (quote bike-management) #t #f))![]()
![]()
(define wheel temp-mirror-function) (set! temp-mirror-function (generate-xml-mirror-function brake-bike-management-laml-validate! "brake" (quote ()) (quote single) (quote bike-management) #f #f)) (set! temp-language-map (put-mirror-function temp-language-map "brake" temp-mirror-function)) (set! temp-mirror-function (generate-xml-mirror-function brake-bike-management-laml-validate! "brake" (quote ()) (quote single) (quote bike-management) #t #f))![]()
![]()
(define brake temp-mirror-function) (set! temp-mirror-function (generate-xml-mirror-function lock-bike-management-laml-validate! "lock" (quote ()) (quote single) (quote bike-management) #f #f)) (set! temp-language-map (put-mirror-function temp-language-map "lock" temp-mirror-function)) (set! temp-mirror-function (generate-xml-mirror-function lock-bike-management-laml-validate! "lock" (quote ()) (quote single) (quote bike-management) #t #f))![]()
![]()
(define lock temp-mirror-function) ; Register the name of the language (register-xml-in-laml-language (quote bike-management) temp-language-map) ; Define the language variable![]()
![]()
(define bike-management (activator-via-language-map (quote bike-management))) ;;; Manually programmed validation predicates![]()
![]()
![]()
(define (bike-bike-management-checker? contents) (let ((contents-1 (if (list? contents) (filter (negate white-space-related?) contents) contents))) (cond ((not (list? contents-1)) ; #f - no contents probably (xml-add-problem! (xml-enrich-error-message "The bike element cannot be empty: it must at least have a frame and a wheel element" contents-1))) ((and (list? contents-1) (null? contents-1)) (xml-add-problem! (xml-enrich-error-message "The bike element cannot be empty: it must at least have a frame and a wheel element" contents-1))) ((and (list? contents-1) (= (length contents-1) 1)) (xml-add-problem! (xml-enrich-error-message "A bike element must be a frame element and at least one wheel" contents-1))) ((and (list? contents-1) (>= (length contents-1) 1) (not (equal? (ast-element-name (first contents-1)) "frame"))) (xml-add-problem! (xml-enrich-error-message "The first element of a bike element must be a frame element" contents-1))) ((and (list? contents-1) (>= (length contents-1) 2) (not (equal? (ast-element-name (second contents-1)) "wheel"))) (xml-add-problem! (xml-enrich-error-message "The second element of a bike element must be a wheel element" contents-1))) ((and (list? contents-1) (>= (length contents-1) 2) (equal? (ast-element-name (second contents-1)) "wheel")) (check-star-sequence! (list "wheel" "brake" "lock") (cddr contents-1) "bike")) (else #f)))) ; Assume that seq-list is a list of strings, of the form ("x" "y" "z"), zero or more elements. ; Check that contents satisfy the content model x*, y*, z* .![]()
![]()
(define (check-star-sequence! seq-list contents el-name) (check-star-sequence-1! seq-list contents el-name seq-list))![]()
![]()
(define (check-star-sequence-1! seq-list contents el-name orig-seq-list) (let ((pp-with-stars (lambda (lst) (list-to-string (map (lambda (e) (string-append e "*")) lst) " ")))) (cond ((null? contents) #t) ; Accepted ((and (null? seq-list) (not (null? contents))) (xml-add-problem! (xml-enrich-error-message (string-append "The " el-name " element instance does not have " (pp-with-stars orig-seq-list) " as a suffix") contents))) ((not (null? seq-list)) (if (equal? (ast-element-name (first contents)) (car seq-list)) (check-star-sequence-1! seq-list (cdr contents) el-name orig-seq-list) (check-star-sequence-1! (cdr seq-list) contents el-name orig-seq-list))))))