Changeset 11895 in project


Ignore:
Timestamp:
09/05/08 04:04:45 (12 years ago)
Author:
Ivan Raikov
Message:

Bug fixes related to SXML frontend.

Location:
release/3/nemo/trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • release/3/nemo/trunk/SXML.scm

    r11858 r11895  
    6161      (map (lambda (node) (sxml:attr node name)) (cons node lst))))
    6262
     63 
     64
     65 
  • release/3/nemo/trunk/core.scm

    r11847 r11895  
    782782        (let ((decl (car ds)))
    783783          (let ((qs1  (match decl
    784                             ;; imported quantities
    785                             (('input . lst)
    786                              (cond ((every (lambda (x) (or (symbol? x) (list? x))) lst)
    787                                     (fold (lambda (x ax)
    788                                             (match x
    789                                                    ((? symbol?) 
    790                                                     (((nemo-core 'add-external!) sys) x `(input ,x ,x #f))
    791                                                     (cons x ax))
    792                                                    ((id1 'as x1)
    793                                                     (((nemo-core 'add-external!) sys) x `(input ,id1 ,x1 #f))
    794                                                     (cons x1 ax))
    795                                                    ((id1 'from n1)
    796                                                     (((nemo-core 'add-external!) sys) x `(input ,id1 ,id1 ,n1))
    797                                                     (cons id1 ax))
    798                                                    ((id1 'as x1 'from n1)
    799                                                     (((nemo-core 'add-external!) sys) x `(input ,id1 ,x1 ,n1))
    800                                                     (cons x1 ax))
    801                                                    ))
    802                                           qs lst))
    803                                    (else (nemo:error 'eval-nemo-system-decls
    804                                                         "import statement must be of the form: "
    805                                                         "input id1 [as x1] ... "))))
     784                             ;; imported quantities
     785                             (('input . lst)
     786                              (cond ((every (lambda (x) (or (symbol? x) (list? x))) lst)
     787                                     (fold (lambda (x ax)
     788                                             (match x
     789                                                    ((? symbol?) 
     790                                                     (((nemo-core 'add-external!) sys) x `(input ,x ,x #f))
     791                                                     (cons x ax))
     792                                                    ((id1 'as x1)
     793                                                     (((nemo-core 'add-external!) sys) x `(input ,id1 ,x1 #f))
     794                                                     (cons x1 ax))
     795                                                    ((id1 'from n1)
     796                                                     (((nemo-core 'add-external!) sys) x `(input ,id1 ,id1 ,n1))
     797                                                     (cons id1 ax))
     798                                                    ((id1 'as x1 'from n1)
     799                                                     (((nemo-core 'add-external!) sys) x `(input ,id1 ,x1 ,n1))
     800                                                     (cons x1 ax))
     801                                                    ))
     802                                           qs lst))
     803                                    (else (nemo:error 'eval-nemo-system-decls
     804                                                      "import statement must be of the form: "
     805                                                      "input id1 [as x1] ... "))))
    806806
    807807                            ;; exported quantities
     
    918918                                                (if (null? lst)
    919919                                                    (list (list (car (reverse ax))) #f (cdr (reverse ax)))
    920                                                     (match lst
    921                                                            (((? symbol?) . rest)
    922                                                             (loop (cdr lst) (cons (car lst) ax)))
    923                                                            (((x . rest))
    924                                                             (if (and (symbol? x) (every list? rest))
    925                                                                 (list (reverse ax) x rest)
    926                                                                 (list (reverse ax) #f lst)))
    927                                                            (else  (list (reverse ax) #f lst)))))))
     920                                                    (begin
     921                                                      (match lst
     922                                                             (((? symbol?) . rest)
     923                                                              (loop (cdr lst) (cons (car lst) ax)))
     924                                                             (((x . rest))
     925                                                              (if (and (symbol? x) (every list? rest))
     926                                                                  (list (reverse ax) x rest)
     927                                                                  (list (reverse ax) #f lst)))
     928                                                             (else  (list (reverse ax) #f lst))))))))
     929
    928930                                             (let ((name (or name (qname tag))))
    929931                                               (((nemo-core 'env-extend!) sys) name  typ alst)
    930932                                               (cons name qs)))
    931933                                 (nemo:error 'eval-nemo-system-decls "extended declarations must be of the form: "
    932                                                 "declaration (name (properties ...)"))))))
     934                                                "declaration (name (properties ...)")))
     935                            )))
    933936                           
    934937                           
  • release/3/nemo/trunk/examples/AKP06/PotIhCa.sxml

    r11888 r11895  
    1 ;;  -*- Hen -*-
     1(*TOP* (*PI* (xml (@ (version 1.0))))
     2       (ncml:model (@ (name PotIhCa))
     3                   (ncml:input (@ (id v)))
     4                   (ncml:input (@ (id cai)))
     5                   (ncml:input (@ (id cao)))
    26
    3 (ncml:model (@ (name PotIhCa))
    4             (ncml:input (@ (id v)))
    5             (ncml:input (@ (id cai)))
    6             (ncml:input (@ (id cao)))
     7                   (ncml:const (@ (id Vrest)) (expr -68))
     8                   (ncml:const (@ (id diam)) (expr 20))
     9                   (ncml:const (@ (id celsius)) (expr 24))
     10                   (ncml:const (@ (id F)) (expr 96485.0))
     11                   (ncml:const (@ (id R)) (expr 8.3145))
     12                   (ncml:const (@ (id temp_adj)) (expr (ncml:pow 3 (ncml:div (ncml:sub (ncml:id celsius) 22) 10))))
    713
    8             (ncml:const (@ (id Vrest))    -68)
    9             (ncml:const (@ (id diam))     20)
    10             (ncml:const (@ (id celsius))  24)
     14                   (ncml:component (@ (type ion-channel))
    1115
    12             (ncml:const (@ (id F))  96485.0)
    13             (ncml:const (@ (id R))  8.3145)
    14        
    15             (ncml:const (@ (id temp_adj))  (pow 3 (/ (- celsius 22) 10)))
     16                                   (ncml:component (@ (type pore))
     17                                                   (ncml:const (@ (id gbar_Kv1)) (expr 0.011))
     18                                                   (ncml:output (@ (id gbar_Kv1 ))))
    1619
    17             (ncml:component (@ (type ion-channel)) ;; Kv1 current
    18                        
    19                (ncml:component (@ (type gate))
    20                                  
    21                ;; rate functions
    22                (ncml:const (@ (id cma))   0.12889)
    23                (ncml:const (@ (id cka))   -33.90877)
    24                (ncml:const (@ (id cva))   45)
    25                                  
    26                (defun Kv1_amf (v) (* temp_adj cma (exp (neg (/ (+ v cva) cka)))))
    27                                  
    28                (ncml:const (@ (id cmb))   0.12889)
    29                (ncml:const (@ (id ckb))   12.42101)
    30                (ncml:const (@ (id cvb))   45)
    31                (ncml:defun (@ (id Kv1_bmf))
    32                            (ncml:arg v)
    33                            (ncml:body (* temp_adj cmb (exp (neg (/ (+ v cvb) ckb))))))
    34                
    35                (ncml:hh-ionic-conductance
    36                 (@ (id Kv1))
    37                 ;; ion name: exported variables will be of the form {ion}_{id}
    38                  (ncml:initial_m (/ (Kv1_amf Vrest) (+ (Kv1_amf Vrest) (Kv1_bmf Vrest))) )
    39                  (ncml:m_power   4)
    40                  (ncml:h_power   0)
    41                  (ncml:m_alpha   (Kv1_amf v))
    42                  (ncml:m_beta    (Kv1_bmf v))))
    43                )
    44             )
     20                                   (ncml:component (@ (type "permeating-substance") (name k))
     21                                                   (ncml:const  (@ (id e_Kv1)) (expr -85))
     22                                                   (ncml:output (@ (id e_Kv1 ))))
     23 
     24                                   (ncml:component (@ (type gate))
     25                                                   (ncml:const (@ (id cma)) (expr 0.12889))
     26                                                   (ncml:const (@ (id cka)) (expr -33.90877))
     27                                                   (ncml:const (@ (id cva)) (expr 45))
     28                                                   (ncml:defun (@ (id Kv1_amf)) (ncml:arg v)
     29                                                               (ncml:body
     30                                                                (ncml:mul
     31                                                                 (ncml:id temp_adj) (ncml:id cma)
     32                                                                 (ncml:exp
     33                                                                  (ncml:neg
     34                                                                   (ncml:div
     35                                                                    (ncml:sum (ncml:id v) (ncml:id cva))
     36                                                                    (ncml:id cka)))))))
     37
     38                                                   (ncml:const (@ (id cmb)) (expr 0.12889))
     39                                                   (ncml:const (@ (id ckb)) (expr 12.42101))
     40                                                   (ncml:const (@ (id cvb)) (expr 45))
     41
     42                                                   (ncml:defun (@ (id Kv1_bmf)) (ncml:arg v)
     43                                                               (ncml:body
     44                                                                (ncml:mul
     45                                                                 (ncml:id temp_adj) (ncml:id cmb)
     46                                                                 (ncml:exp (ncml:neg
     47                                                                            (ncml:div
     48                                                                             (ncml:sum (ncml:id v)
     49                                                                                       (ncml:id cvb))
     50                                                                             (ncml:id ckb)))))))
     51
     52                                                   (ncml:hh_ionic_conductance
     53                                                    (@ (id Kv1))
     54                                                    (ncml:initial_m (ncml:div (ncml:apply (ncml:id Kv1_amf)
     55                                                                                          (ncml:id Vrest))
     56                                                                              (ncml:sum (ncml:apply (ncml:id Kv1_amf)
     57                                                                                                    (ncml:id Vrest))
     58                                                                                        (ncml:apply (ncml:id Kv1_bmf)
     59                                                                                                    (ncml:id Vrest)))))
     60                                                    (ncml:m_power 4)
     61                                                    (ncml:h_power 0)
     62                                                    (ncml:m_alpha (ncml:apply (ncml:id Kv1_amf) (ncml:id v)))
     63                                                    (ncml:m_beta (ncml:apply (ncml:id Kv1_bmf) (ncml:id v))))))))
  • release/3/nemo/trunk/extensions/nemo-hh.scm

    r11845 r11895  
    3030(define (s+ . lst)    (string-concatenate (map ->string lst)))
    3131
    32 (define ($ p n) (string->symbol (s+ (->string p) "_" (->string n))))
     32(define (p$ p n) (string->symbol (s+ (->string p) "_" (->string n))))
    3333
    3434
     
    6565         ((or (('hh 'ionic 'conductance)  ('name (? symbol? ion)) . alst)
    6666              (('hh-ionic-conductance)    ('name (? symbol? ion)) . alst))
    67           (print "hh-transformer: en = " en)
    6867          (check-decls ion '(m-power h-power) alst)
    6968          (let ((suffix (->string ion))
     
    10099                   (m-beta     (or (lookup-field 'm-beta alst)
    101100                                   `(/ (- 1 ,m-inf) ,m-tau)))
    102                    (open       ($ ion 'mO))
    103                    (closed     ($ ion 'mC))
     101                   (open       (p$ ion 'mO))
     102                   (closed     (p$ ion 'mC))
    104103                   (mst        `((power ,m-power)
    105104                                 (open  ,open)
    106105                                 (transitions (-> ,closed ,open ,m-alpha)
    107106                                              (-> ,open ,closed ,m-beta)))))
    108               (apply env-extend! (cons* ($ ion 'm) '(tscomp) initial-m mst))
    109               (add-external! ($ ion 'm) 'output)
    110               (component-extend! comp ($ ion 'm))
     107              (apply env-extend! (cons* (p$ ion 'm) '(tscomp) initial-m mst))
     108              (add-external! (p$ ion 'm) 'output)
     109              (component-extend! comp (p$ ion 'm))
    111110              )
    112111           
     
    121120                                       `(/ (- 1 ,h-inf) ,h-tau)))
    122121
    123                        (open       ($ ion 'hO))
    124                        (closed     ($ ion 'hC))
     122                       (open       (p$ ion 'hO))
     123                       (closed     (p$ ion 'hC))
    125124                       (hst        `((power ,h-power)
    126125                                     (open  ,open)
    127126                                     (transitions (-> ,closed ,open ,h-alpha)
    128127                                                  (-> ,open ,closed ,h-beta)))))
    129                   (apply env-extend! (cons* ($ ion 'h) '(tscomp) initial-h hst))
    130                   (add-external! ($ ion 'h) 'output)
    131                   (component-extend! comp ($ ion 'h))
     128                  (apply env-extend! (cons* (p$ ion 'h) '(tscomp) initial-h hst))
     129                  (add-external! (p$ ion 'h) 'output)
     130                  (component-extend! comp (p$ ion 'h))
    132131                  ))))
    133132         (else (list))))
  • release/3/nemo/trunk/nemo-macros.scm

    r11870 r11895  
    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 
    5042(define-macro (nemo-transform sys declarations)
    5143  `(begin
  • release/3/nemo/trunk/nemo.scm

    r11888 r11895  
    3434            (match kv ((k v) v) (else (cdr kv)))))))
    3535
     36(define ($ x)  (and x (string->symbol (->string x))))
    3637
    3738;;; Procedures for string concatenation and pretty-printing
     
    5152  (print-error-message message (current-output-port) "Warning")
    5253  (print (string-concatenate (map ->string specialising-msgs))))
    53 
    54 (require-extension  stx-engine)
    55 (require-extension  sxpath-plus)
    56 (require-extension  sxml-transforms)
    57 (require-extension  sxml-tools)
    58 
    59 (include "SXML.scm")
    60 (include "SSAX.scm")
    61 (include "SXML-to-XML.scm")
    62 
    63 
    6454
    6555(define opts
     
    10191
    10292
    103 (define (nemoml:sxpath query doc)
     93(define (ncml:sxpath query doc)
    10494  ((sxpath query '((ncml . "ncml"))) doc))
    10595
     
    115105  (let ((lst ((sxpath query '((ncml . "ncml") )) doc)))
    116106    (and (not (null? lst)) lst)))
     107         
     108 
     109(define (ncml-expr->expr node)
     110  (match node
     111         ((? number?)    node)
     112         ((? string?)    (sxml:number node))
     113         (('ncml:id id)  (string->symbol (->string id)))
     114         (('ncml:apply ('ncml:id id) . args)  (cons (string->symbol (->string id)) (map ncml-expr->expr args)))
     115         (((and op (? symbol?)) . args)       (cons (ncml-op->op op) (map ncml-expr->expr args)))))
     116 
     117
     118(define (ncml-op->op op)
     119  (case op
     120    ((ncml:sum)    '+)
     121    ((ncml:sub)    '-)
     122    ((ncml:mul)    '*)
     123    ((ncml:div)    '/)
     124    ((ncml:gt)     '>)
     125    ((ncml:lt)     '<)
     126    ((ncml:lte)    '<=)
     127    ((ncml:gte)    '>=)
     128    ((ncml:eq)     '=)
     129    (else          (match (string-split (->string op) ":")
     130                          ((pre op)  (string->symbol op))
     131                          (else (error 'ncml-op->op "invalid operator" op))))))
     132
     133(require-extension  stx-engine)
     134(require-extension  sxpath-plus)
     135(require-extension  sxml-transforms)
     136(require-extension  sxml-tools)
     137
     138(include "SXML.scm")
     139(include "SSAX.scm")
     140(include "SXML-to-XML.scm")
     141
     142
     143(define null-template `(*default* ,(lambda (node bindings root env) '())))
     144
     145(define-syntax  sxml:make-null-ss
     146   (syntax-rules  ()
     147      ((stx rule ...)
     148       (list
     149        ; default handler
     150        null-template
     151        ; handler for textual nodes
     152        (list '*text*  (lambda (text) text))
     153        rule ...))))
    117154
    118155
     
    122159        (sxml:match 'ncml:input
    123160                    (lambda (node bindings root env)
    124                       (let ((id   (sxml:attr 'id node))
    125                             (from (sxml:kidn 'from node))
    126                             (as   (sxml:kidn 'as node)))
     161                      (let ((id    (sxml:attr node 'id))
     162                            (from  (sxml:kidn 'from node))
     163                            (as    (sxml:kidn 'as node)))
    127164                        (if (not id) (error 'input-template "input declaration requires id attribute"))
    128                         (cond ((and from as)  `(input (,(string->symbol id) as ,(string->symbol as)
    129                                                        from ,(string->symbol from))))
    130                               (from           `(input (,(string->symbol id) from ,(string->symbol from))))
    131                               (as             `(input (,(string->symbol id) as ,(string->symbol as))))
    132                               (else           `(input ,(string->symbol id))))))))
     165                        (cond ((and from as)  `(input (,($ id) as ,($ (second as) ) from ,($ (second from)) )))
     166                              (from           `(input (,($ id) from ,($ (second from)))))
     167                              (as             `(input (,($ id) as ,($ (second as)))))
     168                              (else           `(input ,($ id))))))))
    133169       
    134170       (output-template
    135171        (sxml:match 'ncml:output
    136172                    (lambda (node bindings root env)
    137                       (let ((id   (sxml:attr 'id node)))
     173                      (let ((id   (sxml:attr node 'id)))
    138174                        (if (not id) (error 'output-template "output declaration requires id attribute"))
    139                         `(output ,(string->symbol id))))))
     175                        `(output ,($ id))))))
    140176       
    141177       (const-template
    142178        (sxml:match 'ncml:const
    143179                    (lambda (node bindings root env)
    144                       (let ((id   (sxml:attr 'id node))
    145                             (expr ((lambda (x)
    146                                      (if (not x) 
    147                                           (error 'const-template "const declaration requires expr element")
    148                                           (ncml-expr->expr x)))
     180                      (let* ((id   (sxml:attr node 'id))
     181                             (expr ((lambda (x)
     182                                      (if (not x) 
     183                                          (error 'const-template "const declaration " id " requires expr element")
     184                                          (ncml-expr->expr (second x))))
    149185                                   (sxml:kidn 'expr node))))
    150186                        (if (not id) (error 'const-template "const declaration requires id attribute"))
    151                         `(const ,(string->symbol id) = ,expr)))))
     187                        `(const ,($ id) = ,expr)))))
    152188       
    153189       (state-complex-transition-template
    154190        (sxml:match 'ncml:transition
    155191                    (lambda (node bindings root env)
    156                       (let ((src  (sxml:attr 'src node))
    157                             (dest (sxml:attr 'dest node))
     192                      (let ((src  (sxml:attr node 'src))
     193                            (dest (sxml:attr node 'dest))
    158194                            (expr ((lambda (x)
    159195                                     (if (not x) 
    160196                                         (error 'state-complex-transition-template
    161197                                                "state complex transition requires rate element")
    162                                          (ncml-expr->expr x)))
     198                                         (ncml-expr->expr (second x))))
    163199                                   (sxml:kidn 'rate node))))
    164200                        (if (not src) (error 'state-complex-transition-template
     
    166202                        (if (not dest) (error 'state-complex-transition-template
    167203                                              "state complex transition requires dest attribute"))
    168                         `(-> ,(string->symbol src) ,(string->symbol dest) ,rate)))))
     204                        `(-> ,($ src) ,($ dest) ,rate)))))
    169205       
    170206       (asgn-template
    171207        (sxml:match 'ncml:asgn
    172208                    (lambda (node bindings root env)
    173                       (let ((id   (sxml:attr 'id node))
     209                      (let ((id   (sxml:attr node 'id))
    174210                            (expr ((lambda (x)
    175211                                     (if (not x) 
    176212                                          (error 'asgn-template "algebraic assignment requires expr element")
    177                                           (ncml-expr->expr x)))
     213                                          (ncml-expr->expr (second x))))
    178214                                   (sxml:kidn 'expr node))))
    179215                        (if (not id) (error 'asgn-template "algebraic assignment requires id attribute"))
    180                         `(,(string->symbol id) = ,expr)))))
     216                        `(,($ id) = ,expr)))))
    181217       
    182218       
     
    184220        (sxml:match 'ncml:state_complex
    185221                    (lambda (node bindings root env)
    186                       (let ((id   (sxml:attr 'id node))
     222                      (let ((id   (sxml:attr node 'id))
    187223                            (initial ((lambda (x)
    188224                                        (if (not x) 
    189225                                            (error 'state-complex-template
    190226                                                   "state complex declaration requires initial element")
    191                                             (ncml-expr->expr x)))
     227                                            (ncml-expr->expr (second x))))
    192228                                      (sxml:kidn 'initial node)))
    193229                            (open ((lambda (x)
     
    195231                                         (error 'state-complex-template
    196232                                                "state complex declaration requires open element")
    197                                          (string->symbol x)))
     233                                         ($ (second x))))
    198234                                   (sxml:kidn 'open node)))
    199235                            (power ((lambda (x)
     
    201237                                          (error 'state-complex-template
    202238                                                 "state complex declaration requires open element")
    203                                           (string->integer x)))
     239                                          (string->integer (second x))))
    204240                                    (sxml:kidn 'power node)))
    205241                            (transitions ((lambda (x)
     
    215251                                             (transitions ,transitions)))))))
    216252
     253
    217254       (defun-template
    218255        (sxml:match 'ncml:defun
    219256                    (lambda (node bindings root env)
    220                       (let ((id    (sxml:attr 'id node))
     257                      (let ((id    (sxml:attr node 'id))
    221258                            (args  ((lambda (x)
    222259                                      (if (null? x) 
    223260                                          (error 'defun-template
    224261                                                 "function definition requires at least one arg element")
    225                                           (map string->symbol x)))
     262                                          (map (compose $ second) x)))
    226263                                    (sxml:kidsn 'ncml:arg node)))
    227264                            (body ((lambda (x)
     
    229266                                         (error 'defun-template
    230267                                                "function definition requires body element")
    231                                          (ncml-expr->expr x)))
     268                                         (ncml-expr->expr (second x))))
    232269                                   (sxml:kidn 'ncml:body node))))
    233270                        (if (not id) (error 'defun-template "function definition requires id attribute"))
    234                         `(defun (,id ,args ,body))))))
    235 
    236        (component-template 
    237         (sxml:match 'ncml:component 
     271                        `(defun ,id ,args ,body)))))
     272
     273       (component-template
     274        (sxml:match 'ncml:component
    238275                    (lambda (node bindings root env)
    239                       (let ((name (sxml:attr 'name node))
    240                             (type (sxml:attr 'type node)))
     276                      (let ((name (sxml:attr node 'name))
     277                            (type (sxml:attr node 'type)))
    241278                        (if (not type) (error 'component-template "component definition requires type attribute"))
    242279                        (if name
    243                             `(component (type ,type) (name ,name) ,(ncml->decls node))
    244                             `(component (type ,type) ,(ncml->decls node)))))))
    245 
    246        
    247        
     280                            `(component (type ,($ type)) (name ,($ name)) ,@(ncml->decls (sxml:kids node)))
     281                            `(component (type ,($ type)) ,@(ncml->decls (sxml:kids node))))))))
     282
     283       (hh-template
     284        (sxml:match 'ncml:hh_ionic_conductance
     285                    (lambda (node bindings root env)
     286                      (let* ((or-expr   (lambda (x) (and x (ncml-expr->expr (second x)))))
     287                             (id         (sxml:attr node 'id))
     288                             (initial_m  (or-expr (sxml:kidn 'ncml:initial_m node)))
     289                             (initial_h  (or-expr (sxml:kidn 'ncml:initial_h node)))
     290                             (m_power    (or-expr (sxml:kidn 'ncml:m_power node)))
     291                             (h_power    (or-expr (sxml:kidn 'ncml:h_power node)))
     292                             (m_alpha    (or-expr (sxml:kidn 'ncml:m_alpha node)))
     293                             (m_beta     (or-expr (sxml:kidn 'ncml:m_beta node)))
     294                             (h_alpha    (or-expr (sxml:kidn 'ncml:h_alpha node)))
     295                             (h_beta     (or-expr (sxml:kidn 'ncml:h_beta node)))
     296                             (m_tau      (or-expr (sxml:kidn 'ncml:m_tau node)))
     297                             (m_inf      (or-expr (sxml:kidn 'ncml:m_inf node)))
     298                             (h_tau      (or-expr (sxml:kidn 'ncml:h_tau node)))
     299                             (h_inf      (or-expr (sxml:kidn 'ncml:h_inf node))))
     300                        (if (not id)
     301                            (error 'hh-template "hh ionic conductance definition requires id attribute"))
     302                        `(hh-ionic-conductance
     303                          (,($ id)
     304                           ,@(if initial_m `((initial-m ,initial_m)) `())
     305                           ,@(if initial_h `((initial-h ,initial_h)) `())
     306                           ,@(if m_power `((m-power ,m_power)) '())
     307                           ,@(if h_power `((h-power ,h_power)) '())
     308                           ,@(if m_alpha `((m-alpha ,m_alpha)) '())
     309                           ,@(if h_alpha `((h-alpha ,h_alpha)) '())
     310                           ,@(if m_beta  `((m-beta ,m_beta)) '())
     311                           ,@(if h_beta  `((h-beta ,h_beta)) '())
     312                           ,@(if m_inf   `((m-inf ,m_inf)) '())
     313                           ,@(if h_inf   `((h-inf ,h_inf)) '())
     314                           ,@(if m_tau   `((m-tau ,m_tau)) '())
     315                           ,@(if h_tau   `((h-tau ,h_tau)) '())
     316                           ))))))
     317
    248318        )
     319
    249320    (stx:apply-templates ncml:model (sxml:make-null-ss input-template
    250321                                                       output-template
     
    253324                                                       state-complex-template
    254325                                                       defun-template
    255                                                        component-template)
     326                                                       component-template
     327                                                       hh-template)
    256328                         ncml:model (list))))
    257329
    258330(define (ncml->nmodl options doc)
    259   (let* ((ncml:model   (ncml:sxpath '(ncml:model) doc))
    260          (model-name   (sxml:attr 'name ncml:model))
    261          (model-decls  (ncml->decls ncml:model)))
    262     (match  (nemo-constructor model-name model-decls)
    263             ((model nemo)
    264              (let ((model-1 (nemo:hh-transformer model)))
    265                (if (assoc 'depgraph options) (print "dependency graph: " ((nemo 'depgraph*) model-1)))
    266                (if (assoc 'exports options) (print "exports: " ((nemo 'exports) model-1)))
    267                (if (assoc 'imports options) (print "imports: " ((nemo 'imports) model-1)))
    268                (if (assoc 'components options)
    269                    (for-each (lambda (x)
    270                                (print "component " x ": " ((nemo 'component-exports) model-1 (second x)))
    271                                (print "component " x " subcomponents: " ((nemo 'component-subcomps) model-1 (second x))))
    272                              ((nemo 'components) model-1)))
    273              (nemo:nmodl-translator model-1 (lookup-def 'nmodl-method options) (lookup-def 'table options) -150 150 1)
    274              )))))
     331  (let* ((ncml:model   (car (ncml:sxpath '(ncml:model) doc)))
     332         (model-name   (sxml:attr ncml:model 'name))
     333         (model-decls  (ncml->decls (sxml:kids ncml:model))))
     334    (let* ((model+nemo  (nemo-constructor model-name model-decls))
     335           (model (first model+nemo))
     336           (nemo  (second model+nemo)))
     337      (let ((model-1 (nemo:hh-transformer model)))
     338        (if (assoc 'depgraph options) (print "dependency graph: " ((nemo 'depgraph*) model-1)))
     339        (if (assoc 'exports options) (print "exports: " ((nemo 'exports) model-1)))
     340        (if (assoc 'imports options) (print "imports: " ((nemo 'imports) model-1)))
     341        (if (assoc 'components options)
     342            (for-each (lambda (x)
     343                        (print "component " x ": " ((nemo 'component-exports) model-1 (second x)))
     344                        (print "component " x " subcomponents: " ((nemo 'component-subcomps) model-1 (second x))))
     345                      ((nemo 'components) model-1)))
     346        (nemo:nmodl-translator model-1 (lookup-def 'nmodl-method options) (lookup-def 'table options) -150 150 1)
     347        ))))
     348
     349
     350(define (nemo-constructor name declarations)
     351  (let* ((nemo   (make-nemo-core))
     352         (sys    ((nemo 'system) name)))
     353    (eval-nemo-system-decls nemo name sys declarations)
     354    (list sys nemo)))
    275355
    276356 
     
    279359      (for-each
    280360       (lambda (operand)
    281          (let ((read-xml  (lambda (name) (call-with-input-file name
    282                                            (lambda (port) (ssax:xml->sxml port '((ncml . "ncml")))) )))
    283                (read-sxml  (lambda (name) (call-with-input-file name read)))
    284                (doc        (cond ((lookup-def 'i options) => (lambda (x)
    285                                                                (case (string->symbol x)
    286                                                                  ((sxml)  (read-sxml operand))
    287                                                                  ((xml)   (read-xml operand))
    288                                                                  (else    (error 'nemo "unknown input format" x)))))
    289                                  (else  (case ((lambda (x) (or (not x) (string->symbol x)))
    290                                                (pathname-extension operand))
     361         (let* ((read-xml  (lambda (name) (call-with-input-file name
     362                                            (lambda (port) (ssax:xml->sxml port '((ncml . "ncml")))) )))
     363                (read-sxml  (lambda (name) (call-with-input-file name read)))
     364                (doc        (cond ((lookup-def 'i options) => (lambda (x)
     365                                                                (case ($ x)
     366                                                                  ((sxml)  (read-sxml operand))
     367                                                                  ((xml)   (read-xml operand))
     368                                                                  (else    (error 'nemo "unknown input format" x)))))
     369                                  (else  (case ((lambda (x) (or (not x) ($ x)))
     370                                                (pathname-extension operand))
    291371                                          ((xml)   (read-xml operand))
    292372                                          ((sxml)  (read-sxml operand))
    293373                                          (else    (read-xml operand))))))
    294                (sxml-fname  ((lambda (x) (and x (if (string? (cdr x)) (s+ (pathname-strip-extension (cdr x)) ".sxml")
    295                                                    (s+  (pathname-strip-extension operand) ".sxml"))))
    296                             (assoc 'sxml options)))
    297                (mod-fname  ((lambda (x) (and x (if (string? (cdr x)) (s+ (pathname-strip-extension (cdr x)) ".mod")
    298                                                    (s+  (pathname-strip-extension operand) ".mod"))))
    299                             (assoc 'nmodl options)))
    300                (nmodl-method
    301                 (let ((method  ((lambda (x) (and x (string->symbol x))) (lookup-def 'nmodl-method options) )))
    302                   (case method
    303                     ((cnexp derivimplicit #f) method)
    304                     (else (error "nmodl-method must be one of cnexp, derivimplicit"))))))
     374                (sxml-fname  ((lambda (x) (and x (if (string? (cdr x)) (s+ (pathname-strip-extension (cdr x)) ".sxml")
     375                                                     (s+  (pathname-strip-extension operand) ".sxml"))))
     376                              (assoc 'sxml options)))
     377                (mod-fname  ((lambda (x) (and x (if (string? (cdr x)) (s+ (pathname-strip-extension (cdr x)) ".mod")
     378                                                    (s+  (pathname-strip-extension operand) ".mod"))))
     379                             (assoc 'nmodl options)))
     380                (nmodl-method
     381                 (let ((method  ($ (lookup-def 'nmodl-method options) )))
     382                   (case method
     383                     ((cnexp derivimplicit #f) method)
     384                     (else (error "nmodl-method must be one of cnexp, derivimplicit"))))))
    305385           (if sxml-fname (with-output-to-file sxml-fname (lambda () (print doc))))
    306386           (with-output-to-file
    307                mod-fname  (lambda () (ncml->nmodl `((method . ,method)
    308                                                     (table  . ,(assoc 't options))) doc)))
     387               mod-fname  (lambda ()
     388                            (ncml->nmodl `((method . ,nmodl-method)
     389                                           (table  . ,(assoc 't options))) doc)))
    309390           ))
    310391       operands)))
  • release/3/nemo/trunk/nemo.setup

    r11870 r11895  
    9393 'nemo
    9494 
    95  `("enmo" )
     95 `("nemo" )
    9696
    9797  ; Assoc list with properties for the program:
  • release/3/nemo/trunk/nmodl.scm

    r11857 r11895  
    497497             (indent+ (+ 2 indent ))
    498498             (sysname (nmodl-name ((dis 'sysname) sys)))
    499              (sfname  (string-append (->string sysname) ".mod"))
    500499             (deps*   ((dis 'depgraph*) sys))
    501500             (consts  ((dis 'consts) sys))
     
    540539               )
    541540               
    542            (with-output-to-file sfname
    543              (lambda ()
    544                (pp indent ,nl (TITLE ,sysname))
    545 
    546                (pp indent ,nl (NEURON "{"))
    547                (if (not (null? exports)) (pp indent+ (RANGE ,(sl\ ", " exports))))
    548                (for-each (lambda (x)
    549                            (case (first x)
    550                              ((non-specific)
    551                               (pp indent+ (RANGE ,(third x))
    552                                   (NONSPECIFIC_CURRENT ,(second x))))
    553                              (else
    554                               (pp indent+ (RANGE ,(second x))
    555                                   (USEION ,(first x) READ ,(third x) WRITE ,(second x))))))
    556                          perm-ions)
    557                (for-each (lambda (x)
    558                            (pp indent+ (RANGE ,(second x))
    559                                (USEION ,(first x) READ ,(third x) ", " ,(fourth x) WRITE ,(second x))))
    560                          acc-ions)
    561                (let* ((const-names   (map first consts))
    562                       (is-const?     (lambda (x) (member x const-names)))
    563                       (range-consts  (delete-duplicates
    564                                       (fold (lambda (def ax)
    565                                               (let* ((rhs   (second def))
    566                                                      (vars  (rhsvars rhs)))
    567                                                 (append (filter is-const? vars) ax)))
    568                                             (list) asgn-eq-defs ))))
    569                  (if (not (null? range-consts)) (pp indent+ (RANGE ,(sl\ ", " range-consts)))))
    570 
    571                
    572                (pp indent "}")
    573 
    574 
    575                (pp indent ,nl (PARAMETER "{"))
    576                (let* ((const-defs (map (lambda (nv)
    577                                          (let ((v1 (canonicalize-expr/NMODL (second nv))))
    578                                            (list (first nv) v1)))
    579                                        consts))
    580                       (locals  (find-locals const-defs)))
    581                  (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    582                  (for-each (lambda (def)
    583                              (let ((n (first def)) (b (second def)))
    584                                (pp indent+ ,(expr->string/NMODL b n)))) const-defs))
    585                (pp indent "}")
    586 
    587                (let* ((with      (inexact->exact (round (/ (abs (- max-v min-v)) step))))
    588                       (define-fn (make-define-fn table? min-v max-v with depend)))
    589                  (for-each (lambda (fndef)
    590                              (if (not (member (car fndef) builtin-fns))
    591                                  (apply define-fn (cons indent fndef))))
    592                            defuns))
    593 
    594 
    595                (pp indent ,nl (STATE "{"))
    596                (for-each (lambda (st) (apply define-state (list indent+ st)))
    597                          states)
    598                (for-each (lambda (st) (apply define-state (list indent+ st)))
    599                          stcomps)
    600                (pp indent "}")
    601 
    602                (pp indent ,nl (ASSIGNED "{"))
    603                (let* ((asgns0 (append asgns (map first imports)
    604                                       (map second perm-ions) (map third perm-ions)
    605                                       (map second acc-ions) (map fourth acc-ions)))
    606                       (asgns1 (delete-duplicates asgns0)))
    607                  (for-each (lambda (x) (pp indent+ ,x)) asgns1)
    608                (pp indent "}")
    609 
    610                (if (not (null? asgns))
    611                    (begin
    612                      (pp indent ,nl (PROCEDURE rates () "{"))
    613                      (let ((locals    (find-locals asgn-eq-defs)))
    614                        (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals)))))
     541           (pp indent ,nl (TITLE ,sysname))
     542           
     543           (pp indent ,nl (NEURON "{"))
     544           (if (not (null? exports)) (pp indent+ (RANGE ,(sl\ ", " exports))))
     545           (for-each (lambda (x)
     546                       (case (first x)
     547                         ((non-specific)
     548                          (pp indent+ (RANGE ,(third x))
     549                              (NONSPECIFIC_CURRENT ,(second x))))
     550                         (else
     551                          (pp indent+ (RANGE ,(second x))
     552                              (USEION ,(first x) READ ,(third x) WRITE ,(second x))))))
     553                     perm-ions)
     554           (for-each (lambda (x)
     555                       (pp indent+ (RANGE ,(second x))
     556                           (USEION ,(first x) READ ,(third x) ", " ,(fourth x) WRITE ,(second x))))
     557                     acc-ions)
     558           (let* ((const-names   (map first consts))
     559                  (is-const?     (lambda (x) (member x const-names)))
     560                  (range-consts  (delete-duplicates
     561                                  (fold (lambda (def ax)
     562                                          (let* ((rhs   (second def))
     563                                                 (vars  (rhsvars rhs)))
     564                                            (append (filter is-const? vars) ax)))
     565                                        (list) asgn-eq-defs ))))
     566             (if (not (null? range-consts)) (pp indent+ (RANGE ,(sl\ ", " range-consts)))))
     567           
     568           
     569           (pp indent "}")
     570           
     571           
     572           (pp indent ,nl (PARAMETER "{"))
     573           (let* ((const-defs (map (lambda (nv)
     574                                     (let ((v1 (canonicalize-expr/NMODL (second nv))))
     575                                       (list (first nv) v1)))
     576                                   consts))
     577                  (locals  (find-locals const-defs)))
     578             (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     579             (for-each (lambda (def)
     580                         (let ((n (first def)) (b (second def)))
     581                           (pp indent+ ,(expr->string/NMODL b n)))) const-defs))
     582           (pp indent "}")
     583           
     584           (let* ((with      (inexact->exact (round (/ (abs (- max-v min-v)) step))))
     585                  (define-fn (make-define-fn table? min-v max-v with depend)))
     586             (for-each (lambda (fndef)
     587                         (if (not (member (car fndef) builtin-fns))
     588                             (apply define-fn (cons indent fndef))))
     589                       defuns))
     590           
     591           
     592           (pp indent ,nl (STATE "{"))
     593           (for-each (lambda (st) (apply define-state (list indent+ st)))
     594                     states)
     595           (for-each (lambda (st) (apply define-state (list indent+ st)))
     596                     stcomps)
     597           (pp indent "}")
     598           
     599           (pp indent ,nl (ASSIGNED "{"))
     600           (let* ((asgns0 (append asgns (map first imports)
     601                                  (map second perm-ions) (map third perm-ions)
     602                                  (map second acc-ions) (map fourth acc-ions)))
     603                  (asgns1 (delete-duplicates asgns0)))
     604             (for-each (lambda (x) (pp indent+ ,x)) asgns1)
     605             (pp indent "}")
     606             
     607             (if (not (null? asgns))
     608                 (begin
     609                   (pp indent ,nl (PROCEDURE rates () "{"))
     610                   (let ((locals    (find-locals asgn-eq-defs)))
     611                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals)))))
     612                   (for-each (lambda (def)
     613                               (let ((n (first def))
     614                                     (b (second def)))
     615                                 (pp indent+ ,(expr->string/NMODL b n)))) asgn-eq-defs)
     616                   (pp indent "}")))
     617             
     618             (if (not (null? stcomps))
     619                 (begin
     620                   (pp indent ,nl (PROCEDURE stcomps () "{"))
     621                   (let* ((eq-defs   (poset->stcomp-eq-defs poset sys))
     622                          (locals    (find-locals eq-defs)))
     623                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    615624                     (for-each (lambda (def)
    616                                  (let ((n (first def))
    617                                        (b (second def)))
    618                                    (pp indent+ ,(expr->string/NMODL b n)))) asgn-eq-defs)
    619                      (pp indent "}")))
    620 
    621                (if (not (null? stcomps))
    622                    (begin
    623                      (pp indent ,nl (PROCEDURE stcomps () "{"))
    624                      (let* ((eq-defs   (poset->stcomp-eq-defs poset sys))
    625                             (locals    (find-locals eq-defs)))
    626                        (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    627                        (for-each (lambda (def)
    628                              (let ((n (first def)) (b (second def)))
    629                                (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
    630 
    631                      (pp indent "}")))
    632                
    633                (pp indent ,nl (BREAKPOINT "{"))
    634                (let* ((i-eqs (filter-map
    635                               (lambda (n)
    636                                 (let* ((subcomps ((dis 'component-subcomps) sys n))
    637                                        (acc   (lookup-def 'accumulating-substance subcomps))
    638                                        (perm  (lookup-def 'permeating-substance subcomps))
    639                                        (pore  (lookup-def 'pore subcomps))
    640                                        (gate  (lookup-def 'gate subcomps))
    641                                        (sts   (and gate ((dis 'component-exports) sys gate))))
    642                                   (cond ((and perm pore gate)
    643                                          (case perm
    644                                            ((non-specific)
    645                                             (let* ((i     (nmodl-name 'i))
    646                                                    (e     (nmodl-name 'e))
    647                                                    (gmax  (car ((dis 'component-exports) sys pore)))
    648                                                    (pwrs  (map (lambda (n) (state-power sys n)) sts))
    649                                                    (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))))
    650                                               (list i e gion)))
    651                                            (else
    652                                             (let* ((i     (nmodl-name (s+ 'i perm)))
    653                                                    (e     (nmodl-name (s+ 'e perm)))
    654                                                    (gmax  (car ((dis 'component-exports) sys pore)))
    655                                                    (pwrs  (map (lambda (n) (state-power sys n)) sts))
    656                                                    (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))))
    657                                               (list i e gion)))))
    658                                          ((and acc pore gate)
    659                                           (let* ((i     (nmodl-name (s+ 'i acc)))
     625                                 (let ((n (first def)) (b (second def)))
     626                                   (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
     627                   
     628                   (pp indent "}")))
     629             
     630             (pp indent ,nl (BREAKPOINT "{"))
     631             (let* ((i-eqs (filter-map
     632                            (lambda (n)
     633                              (let* ((subcomps ((dis 'component-subcomps) sys n))
     634                                     (acc   (lookup-def 'accumulating-substance subcomps))
     635                                     (perm  (lookup-def 'permeating-substance subcomps))
     636                                     (pore  (lookup-def 'pore subcomps))
     637                                     (gate  (lookup-def 'gate subcomps))
     638                                     (sts   (and gate ((dis 'component-exports) sys gate))))
     639                                (cond ((and perm pore gate)
     640                                       (case perm
     641                                         ((non-specific)
     642                                          (let* ((i     (nmodl-name 'i))
     643                                                 (e     (nmodl-name 'e))
    660644                                                 (gmax  (car ((dis 'component-exports) sys pore)))
    661645                                                 (pwrs  (map (lambda (n) (state-power sys n)) sts))
    662646                                                 (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))))
    663                                            (list i #f gion)))
    664                                          (else (nemo:error 'nemo:nmodl-translator ": invalid ion channel definition " n))
    665                                         )))
    666                                  ionchs))
    667                       (i-bkts (bucket-partition (lambda (x y) (eq? (car x) (car y))) i-eqs))
    668                       (i-eqs  (fold (lambda (b ax)
    669                                       (match b
    670                                              ((and ps ((i e gion) . rst)) 
    671                                               (let* ((sum   (if e `(* ,(sum (map third ps)) (- v ,e))
    672                                                                 (sum (map third ps))))
    673                                                      (sum0  (rhsexpr sum))
    674                                                      (sum1  (canonicalize-expr/NMODL sum0)))
    675                                                 (cons (list i sum1) ax)))
    676 
    677                                              ((i e gion)
    678                                               (let* ((expr0  (rhsexpr (if e `(* ,gion (- v ,e)) gion)))
    679                                                      (expr1  (canonicalize-expr/NMODL expr0)))
    680                                                 (cons (list i expr1) ax)))
    681                                                      
    682 
    683                                              (else ax)))
    684                                     (list) i-bkts))
    685                       (locals (find-locals i-eqs)))
    686                  (if (not (null? locals))   (pp indent+ (LOCAL ,(sl\ ", " locals))))
    687                  (if (not (null? asgns))    (pp indent+ (rates ())))
    688                  (if (not method) (pp indent+ (SOLVE states))
    689                      (pp indent+ (SOLVE states METHOD ,method)))
    690                  (if (not (null? stcomps))  (pp indent+ (stcomps ())))
    691                  (for-each (lambda (p) (pp indent+ ,(expr->string/NMODL (second p) (first p)))) i-eqs)
    692                  (pp indent "}"))
    693 
    694                (if (not (null? states))
    695                    (begin
    696                      (pp indent ,nl (DERIVATIVE states "{"))
    697                      (let* ((eq-defs (reverse (poset->state-eq-defs poset sys)))
    698                             (locals (find-locals eq-defs)))
    699                        (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    700                        (for-each (lambda (def)
    701                              (let ((n (first def)) (b (second def)))
    702                                (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
    703                      (pp indent "}")))
    704 
    705                (pp indent ,nl (INITIAL "{"))
    706                (let* ((init-defs  (poset->state-init-defs poset sys))
    707                       (locals     (concatenate (find-locals init-defs))))
    708                  (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    709                  (if (not (null? asgns))  (pp indent+ (rates ())))
    710                  (for-each (lambda (def)
    711                              (let ((n (first def)) (b (second def)))
    712                                (pp indent+ ,(expr->string/NMODL b n)))) init-defs)
    713                  (for-each (lambda (x)  (pp indent+ (,(third x) = ,(fourth x))))
    714                            perm-ions))
    715                (pp indent "}")
    716 
    717                )))
    718          )))))))
     647                                            (list i e gion)))
     648                                         (else
     649                                          (let* ((i     (nmodl-name (s+ 'i perm)))
     650                                                 (e     (nmodl-name (s+ 'e perm)))
     651                                                 (gmax  (car ((dis 'component-exports) sys pore)))
     652                                                 (pwrs  (map (lambda (n) (state-power sys n)) sts))
     653                                                 (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))))
     654                                            (list i e gion)))))
     655                                      ((and acc pore gate)
     656                                       (let* ((i     (nmodl-name (s+ 'i acc)))
     657                                              (gmax  (car ((dis 'component-exports) sys pore)))
     658                                              (pwrs  (map (lambda (n) (state-power sys n)) sts))
     659                                              (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))))
     660                                         (list i #f gion)))
     661                                      (else (nemo:error 'nemo:nmodl-translator ": invalid ion channel definition " n))
     662                                      )))
     663                            ionchs))
     664                    (i-bkts (bucket-partition (lambda (x y) (eq? (car x) (car y))) i-eqs))
     665                    (i-eqs  (fold (lambda (b ax)
     666                                    (match b
     667                                           ((and ps ((i e gion) . rst)) 
     668                                            (let* ((sum   (if e `(* ,(sum (map third ps)) (- v ,e))
     669                                                              (sum (map third ps))))
     670                                                   (sum0  (rhsexpr sum))
     671                                                   (sum1  (canonicalize-expr/NMODL sum0)))
     672                                              (cons (list i sum1) ax)))
     673                                           
     674                                           ((i e gion)
     675                                            (let* ((expr0  (rhsexpr (if e `(* ,gion (- v ,e)) gion)))
     676                                                   (expr1  (canonicalize-expr/NMODL expr0)))
     677                                              (cons (list i expr1) ax)))
     678                                           
     679                                           
     680                                           (else ax)))
     681                                  (list) i-bkts))
     682                    (locals (find-locals i-eqs)))
     683               (if (not (null? locals))   (pp indent+ (LOCAL ,(sl\ ", " locals))))
     684               (if (not (null? asgns))    (pp indent+ (rates ())))
     685               (if (not method) (pp indent+ (SOLVE states))
     686                   (pp indent+ (SOLVE states METHOD ,method)))
     687               (if (not (null? stcomps))  (pp indent+ (stcomps ())))
     688               (for-each (lambda (p) (pp indent+ ,(expr->string/NMODL (second p) (first p)))) i-eqs)
     689               (pp indent "}"))
     690             
     691             (if (not (null? states))
     692                 (begin
     693                   (pp indent ,nl (DERIVATIVE states "{"))
     694                   (let* ((eq-defs (reverse (poset->state-eq-defs poset sys)))
     695                          (locals (find-locals eq-defs)))
     696                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     697                     (for-each (lambda (def)
     698                                 (let ((n (first def)) (b (second def)))
     699                                   (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
     700                   (pp indent "}")))
     701             
     702             (pp indent ,nl (INITIAL "{"))
     703             (let* ((init-defs  (poset->state-init-defs poset sys))
     704                    (locals     (concatenate (find-locals init-defs))))
     705               (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     706               (if (not (null? asgns))  (pp indent+ (rates ())))
     707               (for-each (lambda (def)
     708                           (let ((n (first def)) (b (second def)))
     709                             (pp indent+ ,(expr->string/NMODL b n)))) init-defs)
     710               (for-each (lambda (x)  (pp indent+ (,(third x) = ,(fourth x))))
     711                         perm-ions))
     712             (pp indent "}")
     713             
     714             )))
     715        )))))
Note: See TracChangeset for help on using the changeset viewer.