Changeset 11870 in project


Ignore:
Timestamp:
09/03/08 05:00:44 (12 years ago)
Author:
Ivan Raikov
Message:

Added stx-macros and some initial xml templates in nemo.scm.

Location:
release/3/nemo/trunk
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/nemo/trunk/nemo-macros.scm

    r11845 r11870  
    4040                   
    4141
     42(define-macro (nemo-constructor name declarations)
     43  `(begin
     44     (let* ((nemo   (make-nemo-core))
     45            (,name     ((nemo 'system) ',name)))
     46       (eval-nemo-system-decls nemo ',name ,name (list ,@(map (lambda (x) (list 'quasiquote x)) declarations)))
     47       (list ,name nemo))))
     48                   
     49
    4250(define-macro (nemo-transform sys declarations)
    4351  `(begin
  • release/3/nemo/trunk/nemo.scm

    r11858 r11870  
    2222(require-extension  syntax-case)
    2323(require-extension  matchable)
    24 (require-extension  stx-engine)
    25 (require-extension  sxpath-plus)
    26 (require-extension  sxml-transforms)
    27 (require-extension  sxml-tools)
     24
    2825(require-extension  nemo-macros)
    2926(require-extension  nemo-nmodl)
     
    5552  (print (string-concatenate (map ->string specialising-msgs))))
    5653
     54(require-extension  stx-engine)
     55(require-extension  sxpath-plus)
     56(require-extension  sxml-transforms)
     57(require-extension  sxml-tools)
     58
    5759(include "SXML.scm")
    5860(include "SSAX.scm")
     
    6365(define opts
    6466  `(
     67    ,(args:make-option (i)       (required: "FORMAT")   
     68                       (s+ "specify input format (xml, sxml)")
     69                       (string->symbol arg))
     70    ,(args:make-option (o)       (required: "FORMAT")   
     71                       (s+ "specify output format (nmodl, sxml)")
     72                       (string->symbol arg))
     73    ,(args:make-option (sxml-file)       (required: "FILE")   
     74                       (s+ "write SXML output to file (default: <model-name>.sxml)"))
     75    ,(args:make-option (nmodl-file)       (required: "FILE")   
     76                       (s+ "write NMODL output to file"))
    6577    ,(args:make-option (nmodl-file)       (required: "FILE")   
    6678                       (s+ "write NMODL output to file"))
    6779    ,(args:make-option (nmodl-method)       (required: "METHOD")
    68                        (s+ "specify NMODL integration method (cnexp, derivimplicit, expeuler)")
     80                       (s+ "specify NMODL integration method (cnexp, derivimplicit)")
    6981                       (string->symbol arg))
    7082    ,(args:make-option (t)       #:none
    7183                       (s+ "use interpolation tables")
    7284                       #t)
    73     ,(args:make-option (sxml-file)       (optional: "FILE")   
    74                        (s+ "write SXML output to file (default: <file>.sxml)")
    75                        arg)
    7685    ,(args:make-option (h help)  #:none               "Print help"
    7786                       (usage))
     
    92101
    93102;; Process arguments and collate options and arguments into OPTIONS
    94 ;; alist, and operands (filenames) into OPERANDS.  You can handle
    95 ;; options as they are processed, or afterwards.
     103;; alist, and operands (filenames) into OPERANDS. 
    96104(define args    (command-line-arguments))
    97105(set!-values (options operands)  (args:parse args opts))
     106
     107
     108(define (nemoml:sxpath query doc)
     109  ((sxpath query '((ncml . "ncml"))) doc))
     110
     111(define (ncml:car-sxpath query doc)
     112  (let ((lst ((sxpath query '((ncml . "ncml") )) doc)))
     113    (car lst)))
     114
     115(define (ncml:if-car-sxpath query doc)
     116  (let ((lst ((sxpath query '((ncml . "ncml") )) doc)))
     117    (and (not (null? lst)) (car lst))))
     118
     119(define (ncml:if-sxpath query doc)
     120  (let ((lst ((sxpath query '((ncml . "ncml") )) doc)))
     121    (and (not (null? lst)) lst)))
     122
     123
     124(define (ncml->decls ncml:model)
     125  (letrec
     126      ((input-template
     127        (sxml:match 'ncml:input
     128                    (lambda (node bindings root env)
     129                      (let ((id   (sxml:attrv 'id node))
     130                            (from (sxml:kidn 'from node))
     131                            (as   (sxml:kidn 'as node)))
     132                        (if (not id) (error 'input-template "input declaration requires id attribute"))
     133                        (cond ((and from as)  `(input (,(string->symbol id) as ,(string->symbol as)
     134                                                       from ,(string->symbol from))))
     135                              (from           `(input (,(string->symbol id) from ,(string->symbol from))))
     136                              (as             `(input (,(string->symbol id) as ,(string->symbol as))))
     137                              (else           `(input ,(string->symbol id))))))))
     138       
     139       (output-template
     140        (sxml:match 'ncml:output
     141                    (lambda (node bindings root env)
     142                      (let ((id   (sxml:attrv 'id node)))
     143                        (if (not id) (error 'output-template "output declaration requires id attribute"))
     144                        `(output ,(string->symbol id))))))
     145       
     146       (const-template
     147        (sxml:match 'ncml:const
     148                    (lambda (node bindings root env)
     149                      (let ((id   (sxml:attrv 'id node))
     150                            (expr ((lambda (x)
     151                                     (if (not x) 
     152                                          (error 'const-template "const declaration requires expr element")
     153                                          (ncml-expr->expr x)))
     154                                   (sxml:kidn 'expr node))))
     155                        (if (not id) (error 'const-template "const declaration requires id attribute"))
     156                        `(const ,(string->symbol id) = ,expr)))))
     157       
     158       (state-complex-transition-template
     159        (sxml:match 'ncml:transition
     160                    (lambda (node bindings root env)
     161                      (let ((src  (sxml:attrv 'src node))
     162                            (dest (sxml:attrv 'dest node))
     163                            (expr ((lambda (x)
     164                                     (if (not x) 
     165                                         (error 'state-complex-transition-template
     166                                                "state complex transition requires rate element")
     167                                         (ncml-expr->expr x)))
     168                                   (sxml:kidn 'rate node))))
     169                        (if (not src) (error 'state-complex-transition-template
     170                                             "state complex transition requires src attribute"))
     171                        (if (not dest) (error 'state-complex-transition-template
     172                                              "state complex transition requires dest attribute"))
     173                        `(-> ,(string->symbol src) ,(string->symbol dest) ,rate)))))
     174       
     175       (asgn-template
     176        (sxml:match 'ncml:asgn
     177                    (lambda (node bindings root env)
     178                      (let ((id   (sxml:attrv 'id node))
     179                            (expr ((lambda (x)
     180                                     (if (not x) 
     181                                          (error 'asgn-template "algebraic assignment requires expr element")
     182                                          (ncml-expr->expr x)))
     183                                   (sxml:kidn 'expr node))))
     184                        (if (not id) (error 'asgn-template "algebraic assignment requires id attribute"))
     185                        `(,(string->symbol id) = ,expr)))))
     186       
     187       
     188       (state-complex-template
     189        (sxml:match 'ncml:state_complex
     190                    (lambda (node bindings root env)
     191                      (let ((id   (sxml:attrv 'id node))
     192                            (initial ((lambda (x)
     193                                        (if (not x) 
     194                                            (error 'state-complex-template
     195                                                   "state complex declaration requires initial element")
     196                                            (ncml-expr->expr x)))
     197                                      (sxml:kidn 'initial node)))
     198                            (open ((lambda (x)
     199                                     (if (not x) 
     200                                         (error 'state-complex-template
     201                                                "state complex declaration requires open element")
     202                                         (string->symbol x)))
     203                                   (sxml:kidn 'open node)))
     204                            (power ((lambda (x)
     205                                      (if (not x) 
     206                                          (error 'state-complex-template
     207                                                 "state complex declaration requires open element")
     208                                          (string->integer x)))
     209                                    (sxml:kidn 'power node)))
     210                            (transitions ((lambda (x)
     211                                            (if (not x) 
     212                                                (error 'state-complex-template
     213                                                       "state complex declaration requires transitions element")
     214                                                (let ((tmpl (sxml:make-null-ss state-complex-transition-template)))
     215                                                  (stx:apply-templates x tmpl root env))))
     216                                          (sxml:kidn 'transitions node))))
     217                                         
     218                        (if (not id) (error 'state-complex-template "state complex transition requires id attribute"))
     219                        `(state-complex (,id (initial ,initial) (open ,open) (power ,power)
     220                                             (transitions ,transitions)))))))
     221
     222       (defun-template
     223        (sxml:match 'ncml:defun
     224                    (lambda (node bindings root env)
     225                      (let ((id    (sxml:attrv 'id node))
     226                            (args  ((lambda (x)
     227                                      (if (null? x) 
     228                                          (error 'defun-template
     229                                                 "function definition requires at least one arg element")
     230                                          (map string->symbol x)))
     231                                    (sxml:kidsn 'arg node)))
     232                            (body ((lambda (x)
     233                                     (if (not x) 
     234                                         (error 'defun-template
     235                                                "function definition requires body element")
     236                                         (ncml-expr->expr x)))
     237                                   (sxml:kidn 'body node))))
     238                        (if (not id) (error 'defun-template "function definition requires id attribute"))
     239                        `(defun (,id ,args ,body))))))
     240
     241       
     242       
     243        )
     244    (stx:apply-templates ncml:model (sxml:make-null-ss input-template
     245                                                       output-template
     246                                                       const-template
     247                                                       asgn-template
     248                                                       state-complex-template
     249                                                       defun-template)
     250                         ncml:model (list))))
     251
     252(define (ncml->nmodl options doc)
     253  (let* ((ncml:model   (ncml:sxpath '(ncml:model) doc))
     254         (model-name  (sxml:attrv 'name ncml:model))
     255         (model-decls (ncml->decls ncml:model)))
     256    (match  (nemo-constructor model-name model-decls)
     257            ((model nemo)
     258             (let ((model-1 (nemo:hh-transformer model)))
     259               (if (assoc 'depgraph options) (print "dependency graph: " ((nemo 'depgraph*) model-1)))
     260               (if (assoc 'exports options) (print "exports: " ((nemo 'exports) model-1)))
     261               (if (assoc 'imports options) (print "imports: " ((nemo 'imports) model-1)))
     262               (if (assoc 'components options)
     263                   (for-each (lambda (x)
     264                               (print "component " x ": " ((nemo 'component-exports) model-1 (second x)))
     265                               (print "component " x " subcomponents: " ((nemo 'component-subcomps) model-1 (second x))))
     266                             ((nemo 'components) model-1)))
     267             (nemo:nmodl-translator model-1 (lookup-def 'nmodl-method options) (lookup-def 'table options) -150 150 1)
     268             )))))
    98269
    99270 
     
    102273      (for-each
    103274       (lambda (operand)
    104          (let ((doc (call-with-input-file operand
    105                       (lambda (port) (ssax:xml->sxml port '((cml . "http://morphml.org/channelml/schema")
    106                                                             (meta . "http://morphml.org/metadata/schema"))))))
    107                (mod-fname  (s+ (lookup-def 'mod-file options (pathname-strip-extension operand)) ".mod"))
     275         (let ((doc        (call-with-input-file operand (lambda (port) (ssax:xml->sxml port '((ncml . "ncml")))) ))
     276               (mod-fname  (s+ (lookup-def 'nmodl-file options (pathname-strip-extension operand)) ".mod"))
    108277               (sxml-fname ((lambda (x) (and x (if (string? (cdr x)) (s+ (pathname-strip-extension (cdr x)) ".sxml")
    109278                                                   (s+  (pathname-strip-extension operand) ".sxml"))))
    110279                            (assoc 'sxml-file options)))
    111                (method      (let ((method  ((lambda (x) (and x (string->symbol x))) (lookup-def 'method options) )))
    112                               (case method
    113                                 ((cnexp derivimplicit expeuler #f) method)
    114                                 (else (error "method must be one of cnexp, derivimplicit, expeuler"))))))
     280               (nmodl-method
     281                (let ((method  ((lambda (x) (and x (string->symbol x))) (lookup-def 'nmodl-method options) )))
     282                  (case method
     283                    ((cnexp derivimplicit #f) method)
     284                    (else (error "nmodl-method must be one of cnexp, derivimplicit"))))))
    115285           (if sxml-fname (with-output-to-file sxml-fname (lambda () (print doc))))
    116286           (with-output-to-file
    117                mod-fname  (lambda () (cml->neuron `((method . ,method)
    118                                                     (table  . ,(assoc 'table options))) doc)))
     287               mod-fname  (lambda () (ncml->nmodl `((method . ,method)
     288                                                    (table  . ,(assoc 't options))) doc)))
    119289           ))
    120290       operands)))
  • release/3/nemo/trunk/nemo.setup

    r11847 r11870  
    8888    ,@(if has-exports? `((exports "nemo-hh.exports")) (list)) ))
    8989
     90(compile -O2 nemo.scm -lchicken)
     91
     92(install-program
     93 'nemo
     94 
     95 `("enmo" )
     96
     97  ; Assoc list with properties for the program:
     98  '((version 1.0)
     99    (documentation "nemo.html")))
Note: See TracChangeset for help on using the changeset viewer.