Changeset 27120 in project


Ignore:
Timestamp:
07/24/12 08:38:55 (8 years ago)
Author:
Ivan Raikov
Message:

nemo: better diagnostic messages, some reorganization of example models, bug fixes in code generation

Location:
release/4/nemo/trunk
Files:
2 added
2 deleted
8 edited
10 copied
3 moved

Legend:

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

    r27093 r27120  
    6161                  [(exn) dflt]))
    6262
    63 (define (hh-ionic-gate-transform sys parse-expr subst-expr scope-subst scope eval-const env-extend! add-external! component-extend! comp en markov?)
     63(define (hh-ionic-gate-transform sys parse-expr subst-expr scope-subst scope
     64                                 eval-const env-extend! add-external! component-extend!
     65                                 comp en markov?)
    6466  (define (and-parse-expr scope-subst x . rest)
    6567    (and x (subst-expr (apply parse-expr (cons x rest)) scope-subst)))
     
    8587                                                        `(hh-ionic-gate ,ion (m-power))
    8688                                                        )
    87                                             scope-subst)))
     89                                            scope-subst)
     90                                       (sprintf "~A.m-power" ion)))
    8891                  (h-power (eval-const sys (subst-expr
    8992                                            (parse-expr (lookup-field 'h-power alst 0)
    9093                                                        `(hh-ionic-gate ,ion (h-power))
    9194                                                        )
    92                                           scope-subst))))
     95                                            scope-subst)
     96                                       (sprintf "~A.h-power" ion)
     97                                       ))
     98                  )
    9399
    94100
     
    118124                                               (parse-expr x `(hh-ionic-gate ,ion (initial-m)))
    119125                                               scope-subst)))
    120                                     (handle (lambda () (eval-const sys expr)) expr)))
     126                                    (handle (lambda () (eval-const sys expr (sprintf "~A.initial-m" ion))) expr)))
    121127                                (lookup-field 'initial-m alst)))
    122128                   (m-inf      (and-parse-expr scope-subst
     
    178184                                                   (parse-expr x `(hh-ionic-gate ,ion (initial-h)))
    179185                                                   scope-subst)))
    180                                         (handle (lambda () (eval-const sys expr)) expr)))
     186                                        (handle (lambda () (eval-const sys expr (sprintf "~A.initial-h" ion))) expr)))
    181187                                    (lookup-field 'initial-h alst)))
    182188                       (h-inf      (and-parse-expr scope-subst
  • release/4/nemo/trunk/extensions/nemo-vclamp.scm

    r27093 r27120  
    121121            (let* ((indent        0)
    122122                   (indent+       (+ 2 indent ))
    123                    (eval-const    (dis 'eval-const))
    124123                   
    125124                   (sysname       (hoc-name ((dis 'sysname) sys)))
  • release/4/nemo/trunk/nemo-core.scm

    r27113 r27120  
    295295  ;; 1. make sure all constants in an expression are flonums
    296296  ;; 2. fold expressions like (+ a b c d) into nested binops
    297   (define (make-normalize-expr arity-check)
    298     (lambda (expr)
    299       (let recur ((expr expr))
     297  (define (make-normalize-expr arity-check symbol-check)
     298    (lambda (expr loc)
     299      (let recur ((expr expr) (lbs '()))
    300300        (match expr
    301                (('let bs e)         (let ((normalize-bnd  (lambda (x) `(,(first x) ,(recur (second x))))))
    302                                       `(let ,(map normalize-bnd bs) ,(recur e))))
    303                (('if c t e)         `(if ,(recur c) ,(recur t) ,(recur e)))
    304                (('+ . es)           (binop-fold '+ (map recur es)))
    305                (('- . es)           (let ((es1 (map recur es)))
     301               (('let bs e)         (let ((normalize-bnd  (lambda (x) `(,(first x) ,(recur (second x) lbs))))
     302                                          (lbs1 (append (map first bs) lbs)))
     303                                      `(let ,(map normalize-bnd bs) ,(recur e lbs1))))
     304               (('if c t e)         `(if ,(recur c lbs) ,(recur t lbs) ,(recur e lbs)))
     305               (('+ . es)           (binop-fold '+ (map (lambda (x) (recur x lbs)) es)))
     306               (('- . es)           (let ((es1 (map (lambda (x) (recur x lbs)) es)))
    306307                                      (binop-fold '+ (cons (car es1) (map negate (cdr es1))))))
    307                (('* . es)           (binop-fold '* (map recur es)))
    308                (('/ . es)           (binop-fold '/ (map recur es)))
     308               (('* . es)           (binop-fold '* (map (lambda (x) (recur x lbs)) es)))
     309               (('/ . es)           (binop-fold '/ (map (lambda (x) (recur x lbs)) es)))
    309310               (('fix n)            n)
    310311               ((s . es)            (begin
    311                                       (arity-check s es)
    312                                       (cons s (map recur es))))
    313                (x                   (if (number? x) (exact->inexact x) x))))))
     312                                      (arity-check s es loc)
     313                                      (cons s (map (lambda (x) (recur x lbs)) es))))
     314               (x                   (cond ((number? x) (exact->inexact x))
     315                                          ((symbol? x) (begin (symbol-check x loc lbs) x))
     316                                          (else x)))
     317                                                             
     318               ))))
    314319
    315320  (define (make-base-env)
     
    377382
    378383
     384  (define (make-symbol-check nemo-env)
     385    (lambda (s loc . rest)
     386      (let-optionals rest ((lbs '()))
     387        (if (and (not (hash-table-exists? nemo-env s))
     388                 (not (member s lbs)))
     389            (nemo:error 'symbol-check: s " in the definition of " loc " is not defined")
     390            ))
     391      ))
     392
     393
    379394  (define (make-arity-check nemo-env)
    380     (lambda (s args)
     395    (lambda (s args loc)
    381396      (if (hash-table-exists? nemo-env s)
    382397          (let ((op (hash-table-ref nemo-env s)))
     
    386401                 
    387402                  (if (not (= (length fms) (length args)))
    388                       (nemo:error 'eval-expr "procedure " s
     403                      (nemo:error 'arity-check: "procedure " s
    389404                                  " called with incorrect number of arguments: "
    390405                                  args)))))
    391           (nemo:error 'eval-expr "symbol " s " is not defined")
     406          (nemo:error 'arity-check: "symbol " s " is not defined")
    392407          )))
    393408
     
    397412       (let* ((sym (if (symbol? name) name (string->symbol name)))
    398413              (arity-check (make-arity-check nemo-env))
    399               (normalize-expr (make-normalize-expr arity-check)))
     414              (symbol-check (make-symbol-check nemo-env))
     415              (normalize-expr (make-normalize-expr arity-check symbol-check)))
    400416
    401417        (if (hash-table-exists? nemo-env sym)
     
    433449                            (if (not rhs)
    434450                                (nemo:error 'env-extend! ": state function definitions require an equation"))
    435                             (let ((expr1 (normalize-expr rhs)))
     451                            (let ((expr1 (normalize-expr rhs (sprintf "assignment ~A" sym))))
    436452                              (hash-table-set! nemo-env sym (ASGN name 0.0 expr1)))
    437453                            ))
    438454
    439               (('rate)    (let ((rhs (lookup-def 'rhs alst))
    440                                 (power (lookup-def 'power alst)))
     455              (('rate)    (let* ((rhs (lookup-def 'rhs alst))
     456                                 (power (lookup-def 'power alst))
     457                                 (local-env (let ((local-env (hash-table-copy nemo-env)))
     458                                              (hash-table-set! local-env name #t)
     459                                              local-env))
     460                                 (symbol-check (make-symbol-check local-env))
     461                                 (normalize-expr (make-normalize-expr arity-check symbol-check))
     462                                 )
     463
    441464                            (if (not (rhs? rhs))
    442                                 (nemo:error 'env-extend! ": rate law definitions require an equation"))
    443 
    444                             (hash-table-set! nemo-env sym (RATE name (and initial (normalize-expr initial))
    445                                                                 (normalize-expr rhs) power))))
     465                                (nemo:error 'env-extend! ": rate equation definitions require an equation"))
     466
     467                            (let ((initial-expr
     468                                   (and initial
     469                                        (normalize-expr initial
     470                                                        (sprintf "initial value for rate equation ~A" sym))))
     471                                  (rhs-expr (normalize-expr rhs (sprintf "rate equation ~A" sym))))
     472                              (hash-table-set! nemo-env sym (RATE name initial-expr rhs-expr power)))
     473
     474                            ))
    446475
    447476              (('reaction)  (begin
     
    451480                                          (match t
    452481                                                 (( '<-> (and src (? symbol?)) (and dst (? symbol?)) r1 r2) 
    453                                                   `( <-> ,src ,dst ,(normalize-expr r1) ,(normalize-expr r2)))
     482                                                  (let ((r1-expr
     483                                                         (normalize-expr
     484                                                          r1 (sprintf "forward transition rate between states ~A and ~A in reaction ~A "
     485                                                                      src dst sym)))
     486                                                        (r2-expr
     487                                                         (normalize-expr
     488                                                          r2 (sprintf "backward transition rate between states ~A and ~A in reaction ~A "
     489                                                                      src dst sym)))
     490                                                        )
     491                                                  `( <-> ,src ,dst ,r1-expr ,r2-expr)))
    454492
    455493                                                 (( '-> (and src (? symbol?)) (and dst (? symbol?)) r1) 
    456                                                   `( -> ,src ,dst ,(normalize-expr r1) ))
     494                                                  (let ((r1-expr
     495                                                         (normalize-expr
     496                                                          r1 (sprintf "transition rate between states ~A and ~A in reaction ~A "
     497                                                                      src dst sym))))
     498                                                  `( -> ,src ,dst ,(normalize-expr r1) )))
    457499
    458500                                                 (else
     
    471513                                              " requires an integer power (" power  " was given)"))
    472514                             
    473                               (let ((en (REACTION name (and initial (normalize-expr initial))
     515                              (let ((en (REACTION name (and initial (normalize-expr initial (sprintf "initial value for reaction ~A" sym)))
    474516                                                  open transitions
    475517                                                  (and conserve (list conserve)) power)))
     
    527569
    528570  (define (defun! nemo-env)
    529     (define arity-check (make-arity-check nemo-env))
    530     (define normalize-expr (make-normalize-expr arity-check))
    531571
    532572    (lambda (name formals body)
    533         (let ((const-env (make-const-env nemo-env))
    534               (sym (if (symbol? name) name (string->symbol name))))
     573        (let* ((const-env (make-const-env nemo-env))
     574               (local-env (let ((local-env (hash-table-copy nemo-env)))
     575                            (for-each (lambda (s) (hash-table-set! local-env s #t))  formals)
     576                            local-env))
     577               (arity-check (make-arity-check local-env))
     578               (symbol-check (make-symbol-check local-env))
     579               (normalize-expr (make-normalize-expr arity-check symbol-check))
     580               (sym (if (symbol? name) name (string->symbol name))))
    535581          (letrec ((enumconsts
    536582                    (lambda (lb)
     
    563609                (nemo:error 'defun! ": quantity " sym " already defined")
    564610                (let* (
    565                        (body    (normalize-expr body))
     611                       (body    (normalize-expr body (sprintf "function definition ~A" sym)))
    566612                       (consts  (delete-duplicates ((enumconsts formals) body (list))
    567613                                                   (lambda (x y) (equal? (car x) (car y)))))
     
    844890                     (RATE     (name initial rhs power)
    845891                               (begin
    846                                  (fprintf out "~a: rate law\n" name)
     892                                 (fprintf out "~a: rate equation\n" name)
    847893                                 (fprintf out "    rhs: ~a\n" rhs)
    848894                                 (if power (fprintf out "    power: ~a\n" power))
     
    857903                            (apply (car expr1) (cdr expr1))))))
    858904
    859   (define (eval-const nemo-env expr)
     905  (define (eval-const nemo-env expr qname)
    860906    (let* ((arity-check (make-arity-check nemo-env))
    861            (normalize-expr (make-normalize-expr arity-check)))
    862       (let ((expr1 (normalize-expr expr))
     907           (symbol-check (make-symbol-check nemo-env))
     908           (normalize-expr (make-normalize-expr arity-check symbol-check)))
     909      (let ((expr1 (normalize-expr expr (sprintf "constant ~A" qname)))
    863910            (const-env (make-const-env nemo-env)))
    864911        (condition-case
     
    10831130(define (eval-nemo-system-decls nemo-core name sys declarations . rest)
    10841131  (let-optionals rest ((parse-expr (lambda (x . rest) x)))
    1085    (define (eval-const x) (and x ((nemo-core 'eval-const) sys x)))
     1132   (define (eval-const x loc) (and x ((nemo-core 'eval-const) sys x loc)))
    10861133   (define env-extend!  ((nemo-core 'env-extend!) sys))
    10871134   (define (compute-qid id scope scope-subst) (or (and scope scope-subst (nemo-scoped scope id)) id))
     
    11551202                             (let* ((qid    (compute-qid id scope scope-subst))
    11561203                                    (qexpr  (subst-expr (parse-expr expr `(const ,qid)) scope-subst))
    1157                                     (qval   (eval-const qexpr)))
     1204                                    (qval   (eval-const qexpr id)))
    11581205                               (env-extend! qid '(const) qval)
    11591206                               (list (cons qid qs) (update-subst id qid scope-subst))
     
    11681215                                    (power        (lookup-def 'power alst))
    11691216                                    (power-val    (if (expr? power)
    1170                                                       (eval-const (subst-expr (parse-expr power loc) scope-subst))
     1217                                                      (eval-const (subst-expr (parse-expr power loc) scope-subst)
     1218                                                                  (sprintf "~A.power" id))
    11711219                                                      (nemo:error 'eval-nemo-system-decls
    11721220                                                                  "invalid power expression" power
     
    12161264                                                           (let ((loc `(,@loc (init. eq.))))
    12171265                                                             (subst-expr (parse-expr initial loc) scope-subst))))
    1218                                         (initial-val  (and initial-expr (eval-const initial-expr))))
     1266                                        (initial-val  (and initial-expr (eval-const initial-expr
     1267                                                                                    (sprintf "~A.initial" id)))))
    12191268                                   (let ((lst (cons* qid '(reaction) initial-val
    12201269                                                     `(power ,power-val)
     
    12261275                           
    12271276                           
    1228                             ;; rate law
     1277                            ;; rate equation
    12291278                            (((or 'd 'D) ((and id (? symbol?))) '= (and expr (? expr?) )
    12301279                              . rest)
     
    12381287
    12391288                               (env-extend! qid '(rate)
    1240                                             (and initial (eval-const initial))
     1289                                            (and initial (eval-const initial (sprintf "~A.initial" id)) )
    12411290                                            `(rhs ,qexpr))
    12421291                                           
  • release/4/nemo/trunk/nemo-matlab.scm

    r27113 r27120  
    261261
    262262(define (reaction-eq n open transitions conserve)
    263   (match-let (((g cnode node-subs)  (transitions-graph n open transitions conserve matlab-state-name)))
    264     (let ((nodes ((g 'nodes))))
    265 ;      (if (< 2 (length nodes))
    266 ;         (list (matlab-name n) `(abs (/ ,(matlab-state-name n open)
    267 ;                                        ,(sum (filter-map (lambda (x) (and (not (= (first x) (first cnode)))
    268 ;                                                                           (matlab-state-name n (second x)))) nodes)))))
    269           (list (matlab-name n) (matlab-state-name n open)))))
     263  (if (symbol? open)
     264      (list (matlab-name n) (matlab-state-name n open))
     265      (list (matlab-name n) (sum (map (lambda (x) (matlab-state-name n x)) open)))
     266      ))
    270267
    271268
     
    685682      (let* ((indent      0)
    686683             (indent+     (+ 2 indent ))
    687              (eval-const  (dis 'eval-const))
    688684             (sysname     (matlab-name ((dis 'sysname) sys)))
    689685             (prefix      (->string sysname))
     
    736732                              (sts               (and gate ((dis 'component-exports) sys (cid gate)))))
    737733
    738                          (if (null? permqs)
     734                         (if (and pore (null? permqs))
    739735                             (nemo:error 'nemo:matlab-translator ": ion channel definition " label
    740736                                         "permeating-ion component lacks exported quantities"))
  • release/4/nemo/trunk/nemo-nest.scm

    r27113 r27120  
    222222
    223223(define (reaction-eq n open transitions conserve)
    224   (match-let (((g cnode node-subs)  (transitions-graph n open transitions conserve nest-state-name)))
    225     (let ((nodes ((g 'nodes))))
    226       (list (nest-name n) (nest-state-name n open)))))
     224  (if (symbol? open)
     225      (list (nest-name n) (nest-state-name n open))
     226      (list (nest-name n) (sum (map (lambda (x) (nest-state-name n x)) open)))
     227      ))
    227228
    228229
     
    14601461             (indent+     (+ 2 indent ))
    14611462
    1462              (eval-const  (dis 'eval-const))
    14631463             (sysname     (nest-name ((dis 'sysname) sys)))
    14641464             (prefix      (->string sysname))
     
    15121512                              (sts               (and gate ((dis 'component-exports) sys (cid gate)))))
    15131513
    1514                          (if (null? permqs)
     1514                         (if (and pore (null? permqs))
    15151515                             (nemo:error 'nemo:nest-translator ": ion channel definition " label
    15161516                                         "permeating-ion component lacks exported quantities"))
  • release/4/nemo/trunk/nemo-nmodl.scm

    r27113 r27120  
    357357                 `(let ,bnds ,(expeuler dt name body)))
    358358               
    359                 (else (nemo:error 'nemo:expeuler ": unable to rewrite equation " rhs
     359                (else (nemo:error 'nemo:expeuler: "unable to rewrite equation " rhs
    360360                                  "in exponential Euler form")))))
    361361
     
    375375                                       (open? (eq? (second s) open))
    376376                                       (name  (nmodl-name (lookup-def (second s) node-subs))))
     377
    377378                                  (let* ((rhs1  (cond ((and (not (null? out)) (not (null? in)))
    378379                                                       `(+ (neg ,(sum (map third out)))
     
    382383                                                      ((and (null? out) (not (null? in)))
    383384                                                       (sum (map third in)))))
     385
    384386                                         (fbody0 (rhsexpr/NMODL rhs1))
    385387                                         (fbody1 (case method
     
    410412                                       (loop (cons* s0 s1 lst) (cdr tlst)))
    411413                                      (else
    412                                        (nemo:error 'nemo:nmodl-reaction-keqs ": invalid transition equation "
     414                                       (nemo:error 'nemo:nmodl-reaction-keqs: "invalid transition equation "
    413415                                                   (car tlst) " in state complex " n))
    414416                                      (else (loop lst (cdr tlst)))))))
     
    446448                   
    447449                   
    448                     (else (nemo:error 'nemo:nmodl-reaction-keqs ": invalid transition equation "
     450                    (else (nemo:error 'nemo:nmodl-reaction-keqs: "invalid transition equation "
    449451                                      e " in state complex " n))))
    450452           transitions))))
     
    465467
    466468(define (reaction-eq n open transitions conserve)
    467   (list (nmodl-name n) (nmodl-state-name n open)))
     469  (if (symbol? open)
     470      (list (nmodl-name n) (nmodl-state-name n open))
     471      (list (nmodl-name n) (sum (map (lambda (x) (nmodl-state-name n x)) open)))
     472      ))
     473
    468474
    469475(define (poset->reaction-eq-defs poset sys kinetic)
     
    848854                                   (sts               (and gate ((dis 'component-exports) sys (cid gate)))))
    849855
    850                               (if (null? permqs)
    851                                   (nemo:error 'nemo:nmodl-translator ": ion channel definition " label
     856                              (if (and pore (null? permqs))
     857                                  (nemo:error 'nemo:nmodl-translator: "ion channel definition " label
    852858                                              "permeating-ion component lacks exported quantities"))
     859
    853860                              (if (null? sts)
    854                                   (nemo:error 'nemo:nmodl-translator ": ion channel definition " label
     861                                  (nemo:error 'nemo:nmodl-translator: "ion channel definition " label
    855862                                              "gate component lacks exported quantities"))
    856863
    857864                              (if (not (or pore permeability))
    858                                   (nemo:error 'nemo:nmodl-translator ": ion channel definition " label
     865                                  (nemo:error 'nemo:nmodl-translator: "ion channel definition " label
    859866                                              "lacks any pore or permeability components"))
    860867 
     
    897904                                          (list i e gmax (nmodl-name (s+ 'i_ label)))))
    898905                                       (else
    899                                         (nemo:error 'nemo:nmodl-translator ": ion channel definition " label
     906                                        (nemo:error 'nemo:nmodl-translator: "ion channel definition " label
    900907                                                    (s+ "(" n ")")
    901908                                                    "lacks gate component"))))
     
    909916                                       (list i #f gion (nmodl-name (s+ 'i_ label) ))))
    910917                                   
    911                                     (else (nemo:error 'nemo:nmodl-translator ": invalid ion channel definition "
     918                                    (else (nemo:error 'nemo:nmodl-translator: "invalid ion channel definition "
    912919                                                      label))
    913920                                    )))
     
    10151022           
    10161023           
    1017            (let ((locals (concatenate (find-locals (map second state-init-defs)))) )
     1024           (let ((locals (find-locals (map second state-init-defs))))
    10181025               (pp indent ,nl (INITIAL "{"))
    10191026               (if (not (null? locals)) (pp indent+ (LOCAL ,(slp ", " locals))))
  • release/4/nemo/trunk/nemo-pyparams.scm

    r27093 r27120  
    522522      (let* ((indent      0)
    523523             (indent+     (+ 2 indent ))
    524              (eval-const  (dis 'eval-const))
    525524             (sysname     (python-name ((dis 'sysname) sys)))
    526525             (prefix      sysname)
  • release/4/nemo/trunk/nemo.setup

    r27108 r27120  
    1313
    1414       ((dynld-name "nemo-core") ("nemo-core.scm" "expr.grm.scm")
    15         (compile -no-trace -O -d2 -s nemo-core.scm -j nemo-core))
     15        (compile -no-trace -O2 -d0 -s nemo-core.scm -j nemo-core))
    1616
    1717       ((dynld-name "nemo-core.import") ("nemo-core.import.scm")
Note: See TracChangeset for help on using the changeset viewer.