Changeset 27335 in project


Ignore:
Timestamp:
08/30/12 10:54:39 (9 years ago)
Author:
Ivan Raikov
Message:

nemo: added option --surface-sxml for sexp to surface XML translation

Location:
release/4/nemo/trunk
Files:
1 deleted
1 edited

Legend:

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

    r27093 r27335  
    9898     (value (required FORMAT)
    9999            (transformer ,string->symbol)))
     100
     101    (surface-xml
     102     "write surface XML translation of input to file (default: <model-name>.xml)"
     103     (value (optional FILENAME)
     104            ))
    100105
    101106    (xml
     
    927932
    928933
     934(define (entry->surface-xml x)
     935
     936  (match x
     937         (('nemo-model name decls)
     938          (map entry->surface-xml decls))
     939
     940         (('output . names)
     941          (string-concatenate (map (lambda (name) (sprintf "<output name=\"~A\"/>~%" name)) names)))
     942
     943         (('input . names)
     944          (string-concatenate (map (lambda (name)
     945                                     (match name
     946                                            ((and name (? symbol?))
     947                                             (sprintf "<input name=\"~A\"/>~%" name))
     948
     949                                            ((name 'from ns)
     950                                             (sprintf "<input name=\"~A\" from=\"~A\"/>~%" name ns))
     951                                           
     952                                            ))
     953                                   names)))
     954
     955         (('const name '= value)
     956          (if (number? value)
     957              (sprintf "<const name=\"~A\" value=\"~A\"/>~%"
     958                      name value)
     959              (sprintf "<const name=\"~A\">~%~A~%</const>~%"
     960                      name value)))
     961
     962         (('defun name args body)
     963          (sprintf "<defun name=\"~A\">~%~A~%<body>~A</body>~%</defun>~%"
     964                  name (string-concatenate (map (lambda (x) (sprintf "<arg>~A</arg>" x)) args)) body))
     965         
     966         ((name '= expr)
     967          (sprintf "<asgn name=\"~A\"><body>~A</body>~%</asgn>~%"
     968                  name expr))
     969         
     970         (('d ( name ) '= expr)
     971          (sprintf "<rate name=\"~A\"><expr>~A</expr>~%</rate>~%"
     972                  name expr))
     973         
     974         (('d ( name ) '= expr ('initial initial-expr))
     975          (sprintf "<rate name=\"~A\"><expr>~A</expr>~%<initial>~A</initial>~%</rate>~%"
     976                  name expr initial-expr))
     977         
     978         (('hh-ionic-gate
     979           (ion
     980            ('initial-m  initial-m-expr)
     981            ('initial-h  initial-h-expr)
     982            ('m-power    m-power)
     983            ('h-power    h-power)
     984            ('m-inf      m-inf-expr)
     985            ('m-tau      m-tau-expr)
     986            ('h-inf      h-inf-expr)
     987            ('h-tau      h-tau-expr)
     988            ))
     989         
     990          (sprintf "<hh_ionic_gate name=\"~A\">~%<initial_m>~A</initial_m>~%<initial_h>~A</initial_h>~%<m_power>~A</m_power>~%<h_power>~A</h_power>~%<m_inf>~A</m_inf>~%<m_tau>~A</m_tau>~%<h_inf>~A</h_inf>~%<h_tau>~A</h_tau>~%</hh_ionic_gate>~%"
     991                  ion initial-m-expr initial-h-expr m-power h-power
     992                  m-inf-expr m-tau-expr h-inf-expr h-tau-expr))
     993         
     994         (('hh-ionic-gate
     995           (ion
     996            ('initial-m  initial-m-expr)
     997            ('m-power    m-power)
     998            ('h-power    h-power)
     999            ('m-inf      m-inf-expr)
     1000            ('m-tau      m-tau-expr)
     1001            ))
     1002         
     1003          (sprintf "<hh_ionic_gate name=\"~A\">~%<initial_m>~A</initial_m>~%<m_power>~A</m_power>~%<h_power>~A</h_power>~%<m_inf>~A</m_inf>~%<m_tau>~A</m_tau>~%</hh_ionic_gate>~%"
     1004                  ion initial-m-expr m-power h-power
     1005                  m-inf-expr m-tau-expr))
     1006         
     1007         (('hh-ionic-gate
     1008           (ion
     1009            ('initial-m  initial-m-expr)
     1010            ('m-power    m-power)
     1011            ('h-power    h-power)
     1012            ('m-tau      m-tau-expr)
     1013            ('m-inf      m-inf-expr)
     1014            ))
     1015         
     1016          (sprintf "<hh_ionic_gate name=\"~A\">~%<initial_m>~A</initial_m>~%<m_power>~A</m_power>~%<h_power>~A</h_power>~%<m_inf>~A</m_inf>~%<m_tau>~A</m_tau>~%</hh_ionic_gate>~%"
     1017                  ion initial-m-expr m-power h-power
     1018                  m-inf-expr m-tau-expr))
     1019         
     1020         (('hh-ionic-gate
     1021           (ion
     1022            ('initial-m  initial-m-expr)
     1023            ('initial-h  initial-h-expr)
     1024            ('m-power    m-power)
     1025            ('h-power    h-power)
     1026            ('m-alpha      m-alpha-expr)
     1027            ('m-beta       m-beta-expr)
     1028            ('h-alpha      h-alpha-expr)
     1029            ('h-beta       h-beta-expr)
     1030            ))
     1031                   
     1032          (sprintf "<hh_ionic_gate name=\"~A\">~%<initial_m>~A</initial_m>~%<initial_h>~A</initial_h>~%<m_power>~A</m_power>~%<h_power>~A</h_power>~%<m_alpha>~A</m_alpha>~%<m_beta>~A</m_beta>~%<h_alpha>~A</h_alpha>~%<h_beta>~A</h_beta>~%</hh_ionic_gate>~%"
     1033                  ion initial-m-expr initial-h-expr m-power h-power
     1034                  m-alpha-expr m-beta-expr h-alpha-expr h-beta-expr))
     1035         
     1036         (('hh-ionic-gate
     1037           (ion
     1038            ('initial-m  initial-m-expr)
     1039            ('m-power    m-power)
     1040            ('h-power    h-power)
     1041            ('m-alpha      m-alpha-expr)
     1042            ('m-beta       m-beta-expr)
     1043            ))
     1044         
     1045          (sprintf "<hh_ionic_gate name=\"~A\">~%<initial_m>~A</initial_m>~%<m_power>~A</m_power>~%<h_power>~A</h_power>~%<m_alpha>~A</m_alpha>~%<m_beta>~A</m_beta>~%</hh_ionic_gate>~%"
     1046                  ion initial-m-expr m-power h-power
     1047                  m-alpha-expr m-beta-expr))
     1048         
     1049         (('component ('type ty) ('name name) . rest)
     1050          (sprintf "<component type=\"~A\" name=\"~A\">~%~A</component>~%"
     1051                  ty name (string-concatenate (map entry->surface-xml rest))))
     1052
     1053         (('component ('type ty) . rest)
     1054          (sprintf "<component type=\"~A\">~%~A</component>~%"
     1055                  ty (string-concatenate (map entry->surface-xml rest))))
     1056
     1057
     1058         (else (error 'nemo "unknown declaration" x))
     1059         ))
     1060
     1061
     1062
     1063
     1064
    9291065 
    9301066(define (main opt operands)
     
    9341070
    9351071      (let (
    936             (models.iexpr
     1072            (models.model-decls.iexpr
    9371073             (map (lambda (operand)
    9381074                    (let* ((read-xml   (lambda (name) (call-with-input-file name
     
    9901126                                          (else    (error 'nemo "unknown input format" in-format)))) 
    9911127                           
    992                            (model       (case in-format
    993                                           ((sxml xml ixml)     (ncml->model `((hh-markov . ,(opt 'hh-markov))
    994                                                                               (parse-expr . ,parse-expr))
    995                                                                             (car doc.iexpr)))
    996                                           ((sexp)               (sexp->model `((hh-markov . ,(opt 'hh-markov)))
    997                                                                              (car doc.iexpr) parse-expr))
    998                                           ((nemo)              (sexp->model `((hh-markov . ,(opt 'hh-markov)))
    999                                                                             (car doc.iexpr) parse-expr))
    1000                                           (else    (error 'nemo "unknown input format" in-format))))
     1128                           (model
     1129                            (case in-format
     1130                              ((sxml xml ixml)     (ncml->model `((hh-markov . ,(opt 'hh-markov))
     1131                                                                  (parse-expr . ,parse-expr))
     1132                                                                (car doc.iexpr)))
     1133                              ((sexp)              (sexp->model `((hh-markov . ,(opt 'hh-markov)))
     1134                                                                 (car doc.iexpr) parse-expr))
     1135                              ((nemo)              (sexp->model `((hh-markov . ,(opt 'hh-markov)))
     1136                                                                (car doc.iexpr) parse-expr))
     1137                              (else    (error 'nemo "unknown input format" in-format))))
    10011138                           )
    1002                       (cons model (cdr doc.iexpr))))
     1139                      (cons model doc.iexpr)
     1140                      ))
    10031141                  operands)))
    10041142        (for-each
    1005          (lambda (operand model.iexpr)
    1006 
    1007            (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref (car model.iexpr) (nemo-intern 'dispatch))))
     1143         (lambda (operand model.model-decls.iexpr)
     1144
     1145           (match-let* (((model model-decls . iexpr?)
     1146                         model.model-decls.iexpr)
     1147                        (($ nemo:quantity 'DISPATCH  dis)
     1148                         (hash-table-ref model (nemo-intern 'dispatch)))
     1149                        )
    10081150                     
    1009             (let* ((model (car model.iexpr))
    1010                    (iexpr? (cdr model.iexpr))
    1011 
     1151            (let* (
    10121152                   (sysname             ((dis 'sysname) model))
    10131153                   (dirname             (pathname-directory operand))
    10141154                   (sxml-fname          (make-output-fname dirname sysname  ".sxml" (opt 'sxml) ))
     1155                   (surface-xml-fname   (make-output-fname dirname sysname ".xml"  (opt 'surface-xml) ))
    10151156                   (xml-fname           (make-output-fname dirname sysname ".xml"  (opt 'xml) ))
    10161157                   (mod-fname           (make-output-fname dirname sysname ".mod"  (opt 'nmodl) ))
     
    10771218
    10781219                  )
    1079              (if sxml-fname (with-output-to-file sxml-fname
    1080                               (lambda () (pretty-print (model->ncml model parse-expr)))))
    1081              (if xml-fname  (let* ((doc  (model->ncml model parse-expr))
    1082                                    (doc1 (ensure-xmlns
    1083                                           (cond ((eq? (car doc) '*TOP*) (assoc 'ncml:model (cdr doc)))
    1084                                                 (else doc)))))
    1085                               (with-output-to-file xml-fname
    1086                                 (lambda () (print-fragments (generate-XML `(begin ,doc1)))))))
     1220
     1221              (if (and xml-fname surface-xml-fname)
     1222                  (error 'nemo "both --xml and --surface-xml options are not permitted"))
     1223             
     1224              (if sxml-fname
     1225                  (with-output-to-file sxml-fname
     1226                    (lambda () (pretty-print (model->ncml model parse-expr)))))
     1227             
     1228              (if xml-fname
     1229                  (let* ((doc  (model->ncml model parse-expr))
     1230                         (doc1 (ensure-xmlns
     1231                                (cond ((eq? (car doc) '*TOP*) (assoc 'ncml:model (cdr doc)))
     1232                                      (else doc)))))
     1233                    (with-output-to-file xml-fname
     1234                      (lambda () (print-fragments (generate-XML `(begin ,doc1)))))))
     1235
     1236
     1237             (if surface-xml-fname   
     1238                 (with-output-to-file surface-xml-fname
     1239                   (lambda () (print-fragments  (entry->surface-xml model-decls)))))
     1240
    10871241             (if mod-fname
    10881242                 (with-output-to-file
     
    11121266             
    11131267             )))
    1114          operands models.iexpr)
     1268         operands models.model-decls.iexpr)
    11151269       
    11161270        (let ((pyparams (opt 'pyparams)))
Note: See TracChangeset for help on using the changeset viewer.