Changeset 29625 in project


Ignore:
Timestamp:
08/23/13 04:17:47 (7 years ago)
Author:
Ivan Raikov
Message:

nemo: tweaks to NineML XML parsing

Location:
release/4/nemo/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/nemo/trunk/nemo-version.scm

    r29619 r29625  
    11
    2 (define nemo-version "8.33")
     2(define nemo-version "8.34")
  • release/4/nemo/trunk/nemo.scm

    r29619 r29625  
    827827(include "stx-engine.scm")
    828828
    829 
    830 (define null-template
    831   `(*default* ,(lambda (node bindings root env)
    832                  (begin
    833                    (warn "Unrecognized input element:" node)
    834                    '()))))
    835 
    836 
    837 (define-syntax  sxml:make-null-ss
    838    (syntax-rules  ()
    839       ((stx rule ...)
    840        (list
    841         ; default handler
    842         null-template
    843         ; handler for textual nodes
    844         (list '*text*  (lambda (text) text))
    845         rule ...))))
    846829
    847830
     
    14721455              (lambda (node bindings root env)
    14731456                (let (
    1474                       (name  (sxml:text (sxml:kidn* 'nmlb:name node)))
     1457                      (name  (sxml:attr node 'name))
    14751458                      (value (sxml:text (sxml:kidn* 'nmlb:value node)))
    14761459                      (unit  (sxml:kidn 'nmlb:unit node))
     
    16311614(define (nineml->model-decls options doc)
    16321615
     1616  (define (load-ss in)
     1617    (eval `(begin
     1618             ,@sxslt-preamble
     1619             (sxml:make-ss ,@(read in))
     1620             )))
     1621
     1622  (define (make-ss-fname dirname fname)
     1623    (or (and dirname (make-pathname dirname fname)) fname))
     1624
    16331625  (let* ((source-path   (lookup-def 'source-path options))
    16341626         (dirname       (pathname-directory source-path))
    16351627         (parse-expr    (or (lookup-def 'parse-expr options) identity))
     1628
    16361629         (nmlb:model    ((lambda (x)
    1637                            (if (null? x) (error 'nineml->model "nmlb:Biophysics element not found in input document") (car x)))
     1630                           (if (null? x) (error 'nineml->model "NineML Biophysics element not found in input document") (car x)))
    16381631                         (nmlb:sxpath '(// nmlb:Biophysics) `(*TOP* . ,doc))))
    16391632         (model-name     ($ (or (sxml:attr nmlb:model 'name) (gensym 'model))))
    1640          (ncml-decls     (stx:apply-templates (sxml:kids nmlb:model) nineml-ss doc (list)))
     1633
     1634         (nmlb-ss        (ncml:sxpath '(// nmlb:sxslt) `(*TOP* . ,nmlb:model)))
     1635         (nmlb-decls     ((lambda (doc)
     1636                            (if (null? nmlb-ss) doc
     1637                                (let ((ss (map
     1638                                           (lambda (x)
     1639                                             (let ((fn (sxml:attr x 'filename)))
     1640                                               (or (and fn (call-with-input-file (make-ss-fname dirname fn) load-ss))
     1641                                                   (call-with-input-string (sxml:text x) load-ss))
     1642                                               ))
     1643                                           nmlb-ss)))
     1644                                  (fold (lambda (s doc) (stx:apply-templates doc s doc (list))) doc ss))
     1645                                ))
     1646                          (sxml:kids nmlb:model)))
     1647
     1648         (ncml-decls     (stx:apply-templates (sxml:kids nmlb:model) nineml-ss nmlb-decls (list)))
    16411649         (model-decls    (ncml->declarations ncml-decls parse-expr))
    16421650         )
     
    20982106          (let* ((u     (lookup-def 'unit rest)))
    20992107            (if (number? value)
    2100                 (sprintf "<~AParameter>~%<~Aname>~A</~Aname>~%~A<~Avalue>~A</~Avalue>~%</~AParameter>~%"
    2101                          ns-prefix ns-prefix name ns-prefix (unit-str u) ns-prefix value ns-prefix ns-prefix)
    2102                 (sprintf "<~AParameter>~%<~Aname>~A</~Aname>~%~A<~Avalue>~A</~Avalue>~%</~AParameter>~%"
    2103                          ns-prefix ns-prefix name ns-prefix (unit-str u) ns-prefix (xmlstr value) ns-prefix ns-prefix)
     2108                (sprintf "<~AParameter name=\"~A\">~%~A<~Avalue>~A</~Avalue>~%</~AParameter>~%"
     2109                         ns-prefix name (unit-str u) ns-prefix value ns-prefix ns-prefix)
     2110                (sprintf "<~AParameter name=\"~A\">~%~A<~Avalue>~A</~Avalue>~%</~AParameter>~%"
     2111                         ns-prefix name (unit-str u) ns-prefix (xmlstr value) ns-prefix ns-prefix)
    21042112                )))
    21052113
Note: See TracChangeset for help on using the changeset viewer.