Changeset 12116 in project


Ignore:
Timestamp:
10/07/08 04:49:51 (12 years ago)
Author:
Ivan Raikov
Message:

Support for unique names in state transition complexes.

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

Legend:

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

    r12006 r12116  
    9999                   (m-alpha    (or (lookup-field 'm-alpha alst)  `(/ ,m-inf-sym ,m-tau-sym)))
    100100                   (m-beta     (or (lookup-field 'm-beta alst)   `(/ (- 1 ,m-inf-sym) ,m-tau-sym)))
    101                    (open       (p$ ion 'mO))
    102                    (closed     (p$ ion 'mC))
     101                   (open       'O)
     102                   (closed     'C)
    103103                   (mst        `((power ,m-power)  (open  ,open)
    104104                                 (transitions (-> ,closed ,open ,m-alpha)
     
    123123                                       `(/ (- 1 ,h-inf) ,h-tau)))
    124124
    125                        (open       (p$ ion 'hO))
    126                        (closed     (p$ ion 'hC))
     125                       (open       'O)
     126                       (closed     'C)
    127127                       (hst        `((power ,h-power)
    128128                                     (open  ,open)
  • release/3/nemo/trunk/nemo-nmodl.scm

    r12113 r12116  
    5353                 
    5454
    55 (define (enumprocs expr ax)
     55(define (nmodl-state-name n s)
     56  (nmodl-name (s+ n s)))
     57
     58(define (enum-bnds expr ax)
    5659  (match expr
    57          (('if . es)  (fold enumprocs ax es))
    58          (('let bnds body)  (fold enumprocs (fold enumprocs ax (map cadr bnds)) body))
    59          ((s . es)    (if (symbol? s)  (cons s (fold enumprocs ax es)) ax))
    60          (else ax)))
    61 
    62 (define (enumbnds expr ax)
    63   (match expr
    64          (('if . es)        (fold enumbnds ax es))
    65          (('let bnds body)  (enumbnds body (append (map car bnds) (fold enumbnds ax (map cadr bnds)))))
    66          ((s . es)          (if (symbol? s)  (fold enumbnds ax es) ax))
     60         (('if . es)        (fold enum-bnds ax es))
     61         (('let bnds body)  (enum-bnds body (append (map car bnds) (fold enum-bnds ax (map cadr bnds)))))
     62         ((s . es)          (if (symbol? s)  (fold enum-bnds ax es) ax))
    6763         (else ax)))
    6864
     
    9086                            expr))
    9187         ((s . es)    (if (symbol? s)  (cons s (map (lambda (x) (rhsexpr x)) es)) expr))
    92          (id          (nmodl-name id))))
     88         (id          (if (symbol? id) (nmodl-name id) id))))
    9389
    9490
     
    329325        (pp indent ,nl (FUNCTION ,n (,(sl\ ", " vars)) "{" ))
    330326        (let* ((body1 (canonicalize-expr/NMODL (rhsexpr body)))
    331                (lbs   (enumbnds body1 (list))))
     327               (lbs   (enum-bnds body1 (list))))
    332328          (if (not (null? lbs)) (pp indent+ (LOCAL ,(sl\ ", " lbs))))
    333329          (if (and table? min-v max-v with)
     
    345341
    346342(define (state-eqs n initial open transitions power)
    347   (let* ((sn  (lambda (x) (string->symbol (s+ n ":" x))))
    348          (g   (make-digraph n (string-append (->string n) " transitions graph")))
     343  (let* ((subst-convert  (subst-driver (lambda (x) (and (symbol? x) x)) binding? identity bind subst-term))
     344         (g          (make-digraph n (string-append (->string n) " transitions graph")))
    349345         (add-node!  (g 'add-node!))
    350346         (add-edge!  (g 'add-edge!))
     
    356352                           (match (car tlst)
    357353                                  (('-> s0 s1 rate-expr)
    358                                    (loop (cons (sn s0) (cons (sn s1) lst)) (cdr tlst)))
     354                                   (loop (cons s0 (cons s1 lst)) (cdr tlst)))
    359355                                  (('-> _)
    360356                                   (nemo:error 'nemo:nmodl-state-eqs ": invalid transition equation "
     
    362358                                  (else (loop lst (cdr tlst)))))))
    363359         (node-ids      (list-tabulate (length node-list) identity))
    364          (name->id-map  (zip node-list node-ids)))
     360         (name->id-map  (zip node-list node-ids))
     361         (node-subs     (fold (lambda (s ax) (subst-extend s (nmodl-state-name n s) ax)) subst-empty node-list)))
    365362    ;; insert state nodes in the dependency graph
    366363    (for-each (lambda (i n) (add-node! i n)) node-ids node-list)
     
    370367      ;; create rate edges in the graph
    371368      (for-each (lambda (e)
    372                   (match e (('-> s0 s1 rate-expr)
    373                             (let ((i  (car (alist-ref (sn s0) name->id-map)))
    374                                   (j  (car (alist-ref (sn s1) name->id-map)))
     369                  (match e (('-> s0 s1 rexpr)
     370                            (let ((i  (car (alist-ref s0 name->id-map)))
     371                                  (j  (car (alist-ref s1 name->id-map)))
    375372                                  (x  (if (eq? s0 (second snode)) snex s0)))
    376                             (add-edge! (list i j `(* ,x ,rate-expr)))))
     373                              (add-edge! (list i j `(* ,(subst-convert x node-subs)
     374                                                       ,(subst-convert rexpr node-subs))))))
    377375                         (else (void))))
    378376                transitions)
     
    383381                                       (in    (in-edges (first s)))
    384382                                       (open? (eq? (second s) open))
    385                                        (name  (second s)))
     383                                       (name  (nmodl-name (lookup-def (second s) node-subs))))
    386384                                  (let* ((rhs1  (cond ((and (not (null? out)) (not (null? in)))
    387385                                                       `(+ (neg ,(sum (map third out)))
     
    403401  (let* ((init  (rhsexpr init))
    404402         (init1 (canonicalize-expr/NMODL init)))
    405     (list  n init1)))
     403    (list (nmodl-name n) init1)))
    406404
    407405(define (asgn-eq n rhs)
    408406  (let* ((fbody   (rhsexpr rhs))
    409407         (fbody1  (canonicalize-expr/NMODL fbody)))
    410     (list n fbody1)))
     408    (list (nmodl-name n) fbody1)))
    411409
    412410
    413411(define (stcomp-eq n open transitions)
    414   (list n open))
     412  (list (nmodl-name n) (nmodl-name (nmodl-state-name n open))))
    415413
    416414
     
    470468                               (cases nemo:quantity en
    471469                                      (TSCOMP  (name initial open transitions power)
    472                                                (cons* (state-init name initial) (state-init open name) ax))
     470                                               (cons* (state-init name initial)
     471                                                      (state-init (nmodl-state-name name open) name) ax))
    473472                                      (else  ax))
    474473                               ax))))
     
    607606           (for-each (lambda (st)
    608607                       (if (pair? st)
    609                            (apply define-state (list indent+ (->string (second st))))
     608                           (apply define-state (list indent+ (nmodl-state-name (first st) (second st))))
    610609                           (apply define-state (list indent+ st))))
    611610                     states)
Note: See TracChangeset for help on using the changeset viewer.