Changeset 11596 in project


Ignore:
Timestamp:
08/11/08 10:30:40 (13 years ago)
Author:
Ivan Raikov
Message:

Added support for merging several conductance definitions for the same ion species.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/oru/nmodl.scm

    r11412 r11596  
    119119
    120120(define ifthen/NMODL  (doc:ifthen 2 (doc:text "if") (doc:text "") (doc:text "else")))
    121 (define letblk/NMODL  (doc:letblk 2 (doc:empty) (doc:text nl) (doc:empty)))
     121(define letblk/NMODL  (doc:letblk 2 (doc:empty) (doc:break) (doc:empty)))
    122122(define group/NMODL   (doc:block 2 (doc:text "(") (doc:text ")")))
    123123(define block/NMODL   (doc:block 2 (doc:text "{") (doc:text "}")))
     
    233233       (('let bindings body)
    234234        (letblk/NMODL
    235          ((doc:list indent (lambda (xv)
    236                               (match (second xv)
    237                                      (('if c t e)
    238                                       (ifthen/NMODL
    239                                        (group/NMODL (format-expr/NMODL indent c))
    240                                        (block/NMODL
    241                                         (binop/NMODL (doc:text (->string (first xv))) (doc:text " = ")
    242                                                      (format-expr/NMODL indent+ t)))
    243                                        (block/NMODL
    244                                         (binop/NMODL (doc:text (->string (first xv))) (doc:text " = ")
    245                                                      (format-expr/NMODL indent+ e) ))))
    246 
    247                                      (else
    248                                       (format-op/NMODL indent " = "
    249                                                        (list (format-expr/NMODL indent (first xv) )
    250                                                              (format-expr/NMODL indent+ (second xv)))))))
    251                     (lambda () (doc:text nl)))
    252           bindings)
     235         (fold-right
     236           (lambda (x ax)
     237             (letblk/NMODL
     238              (match (second x)
     239                     (('if c t e)
     240                      (ifthen/NMODL
     241                       (group/NMODL (format-expr/NMODL indent c))
     242                       (block/NMODL
     243                        (binop/NMODL (doc:text (->string (first x))) (doc:text " = ")
     244                                     (format-expr/NMODL indent+ t)))
     245                       (block/NMODL
     246                        (binop/NMODL (doc:text (->string (first x))) (doc:text " = ")
     247                                     (format-expr/NMODL indent+ e) ))))
     248                     
     249                     (else
     250                      (format-op/NMODL indent+ " = "
     251                                       (list (format-expr/NMODL indent+ (first x) )
     252                                             (format-expr/NMODL indent+ (second x))))))
     253              ax))
     254           (doc:empty) bindings)
    253255         (let ((body1 (doc:nest indent (format-expr/NMODL indent body))))
    254            (if rv
    255                (format-op/NMODL indent " = " (list (format-expr/NMODL indent+ rv ) body1))
     256           (if rv  (format-op/NMODL indent " = " (list (format-expr/NMODL indent+ rv ) body1))
    256257               body1))))
    257258       
     
    478479               (else  #f))  #f)))
    479480
     481(define (bucket-partition p lst)
     482  (let loop ((lst lst) (ax (list)))
     483    (if (null? lst) ax
     484        (let ((x (car lst)))
     485          (let bkt-loop ((old-bkts ax) (new-bkts (list)))
     486            (if (null? old-bkts) (loop (cdr lst) (cons (list x) new-bkts))
     487                (if (p x (caar old-bkts ))
     488                    (loop (cdr lst) (append (cdr old-bkts) (cons (cons x (car old-bkts)) new-bkts)))
     489                    (bkt-loop (cdr old-bkts) (cons (car old-bkts) new-bkts)))))))))
     490
    480491
    481492(define (oru:nmodl-translator sys)
     
    590601                                              (gmax  (car ((dis 'component-exports) sys pore)))
    591602                                              (pwrs  (map (lambda (n) (state-power sys n)) sts))
    592                                               (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs)))
    593                                               (expr0  (rhsexpr `(* ,gion (- v ,e))))
    594                                               (expr1  (canonicalize-expr/NMODL expr0)))
    595                                          (list i expr1)))))
     603                                              (gion  `(* ,gmax . ,(map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))))
     604                                         (list i e gion)))))
    596605                                 ionchs))
     606                      (i-bkts (bucket-partition (lambda (x y) (eq? (car x) (car y))) i-eqs))
     607                      (i-eqs  (fold (lambda (b ax)
     608                                      (match b
     609                                             ((i e gion)
     610                                              (let* ((expr0  (rhsexpr `(* ,gion (- v ,e))))
     611                                                     (expr1  (canonicalize-expr/NMODL expr0)))
     612                                                (cons (list i expr1) ax)))
     613                                                     
     614                                             ((and ps ((i e gion) . rst)) 
     615                                              (let* ((sum   `(* (+ . ,(map third ps)) (- v ,e)))
     616                                                     (sum0  (rhsexpr sum))
     617                                                     (sum1  (canonicalize-expr/NMODL sum0)))
     618                                                (cons (list i sum1) ax)))
     619
     620                                             (else ax)))
     621                                    (list) i-bkts))
    597622                      (locals (find-locals i-eqs)))
    598623                 (if (not (null? locals))   (pp indent+ (LOCAL ,(sl\ ", " locals))))
Note: See TracChangeset for help on using the changeset viewer.