Changeset 31354 in project


Ignore:
Timestamp:
09/10/14 05:35:40 (5 years ago)
Author:
Ivan Raikov
Message:

nemo: refactoring nmodl backend to using ersatz templates

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

Legend:

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

    r30637 r31354  
    33;; An extension for translating NEMO models to NMODL descriptions.
    44;;
    5 ;; Copyright 2008-2013 Ivan Raikov and the Okinawa Institute of Science and Technology
     5;; Copyright 2008-2014 Ivan Raikov and the Okinawa Institute of Science and Technology
    66;;
    77;; This program is free software: you can redistribute it and/or
     
    2828                           varsubst datatype
    2929                           nemo-core nemo-utils nemo-gate-complex nemo-synapse)
     30        (require-library ersatz-lib)
     31
     32        (import (prefix ersatz-lib ersatz: ))
     33
    3034
    3135(define (safe-car x)
     
    353357                   fe)))))))
    354358               
    355 
    356 (define (conserve-conseq->string/NMODL x val . rest)
    357   (let-optionals rest ((width 72))
    358     (s+ "CONSERVE " (sdoc->string (doc:format width (format-conseq/NMODL 2 x #f)))
    359         " = " (number->string val))))
    360  
    361 
    362 (define (make-define-fn)
    363   (lambda (indent n proc)
    364     (let ((lst (procedure-data proc))
    365           (indent+ (+ 2 indent)))
    366       (let ((rt       (lookup-def 'rt lst))
    367             (formals  (lookup-def 'formals lst))
    368             (vars     (lookup-def 'vars lst))
    369             (body     (lookup-def 'body lst)))
    370         (pp indent ,nl (FUNCTION ,(nmodl-name n) (,(slp ", " vars)) "{" ))
    371         (let* ((body0 (rhsexpr/NMODL body))
    372                (body1 (canonicalize-expr/NMODL body0))
    373                (lbs   (enum-bnds body1 (list))))
    374           (if (not (null? lbs)) (pp indent+ (LOCAL ,(slp ", " lbs))))
    375           (pp indent+ ,(expr->string/NMODL body1 (nmodl-name n))))
    376         (pp indent "}"))) 
    377     ))
    378        
    379359
    380360(define (reaction-keqs n initial open transitions power)
     
    454434
    455435
     436(define (instantiate-template tmpl tmpl-vars)
     437    (let ((ctx (ersatz:init-context models: tmpl-vars )))
     438      (display
     439       (ersatz:eval-statements
     440        tmpl
     441        env: (ersatz:template-std-env autoescape: #f)
     442        models: tmpl-vars ctx: ctx
     443        ))
     444      ))
     445
     446
     447(define (conserve-conseq->string/NMODL x val . rest)
     448  (let-optionals rest ((width 72))
     449    (s+ "CONSERVE " (sdoc->string (doc:format width (format-conseq/NMODL 2 x #f)))
     450        " = " (number->string val))))
     451
     452 
     453(define fn-template
     454  (ersatz:statements-from-string
     455   (ersatz:template-std-env autoescape: #f)
     456#<<EOF
     457
     458FUNCTION {{functionName}} ({{join(",", functionVars)}}) {
     459{% if (!(localVars == [])) %}
     460LOCAL {{join(",", localVars)}}
     461{% endif %}
     462{{ exprString }}
     463}
     464
     465EOF
     466))
     467
     468
     469(define (fn-translator n proc)
     470  (let ((lst (procedure-data proc))
     471        (indent+ 2))
     472   
     473    (let ((rt       (lookup-def 'rt lst))
     474          (formals  (lookup-def 'formals lst))
     475          (vars     (lookup-def 'vars lst))
     476          (body     (lookup-def 'body lst)))
     477     
     478      (let* ((body0 (rhsexpr/NMODL body))
     479             (body1 (canonicalize-expr/NMODL body0))
     480             (lbs   (enum-bnds body1 (list)))
     481             (tmpl-vars
     482              `(
     483                (functionName . ,(ersatz:sexpr->tvalue (nmodl-name n)))
     484                (functionVars . ,(ersatz:sexpr->tvalue vars))
     485                (localVars    . ,(if (null? lbs) (ersatz:Tlist '()) (ersatz:sexpr->tvalue lbs)))
     486                (exprString   . ,(ersatz:Tstr (expr->string/NMODL body1 (nmodl-name n))))
     487              ))
     488             )
     489
     490        (instantiate-template fn-template tmpl-vars)
     491        ))
     492    ))
     493
     494
     495(define prelude-template
     496  (ersatz:statements-from-string
     497   (ersatz:template-std-env autoescape: #f)
     498#<<EOF
     499TITLE {{modelName}}
     500
     501COMMENT
     502This file was generated by {{nemoVersionString}} on {{currentTimestamp}}
     503ENDCOMMENT
     504
     505EOF
     506))
     507
     508
     509(define neuron-template
     510  (ersatz:statements-from-string
     511   (ersatz:template-std-env autoescape: #f)
     512#<<EOF
     513
     514NEURON {
     515
     516{% if (hasEvents) %}
     517POINT_PROCESS {{modelName}}
     518{% endif %}
     519
     520;;
     521;; NMODL has a line character limit, so we limit the number of entries
     522;; in each RANGE stmt to 10
     523;;
     524{% for exportGroup in groupBy(exports, 10) %}
     525RANGE {{join(",", exportGroup)}}
     526{% endfor %}
     527
     528{% if (!(currents == [])) %}
     529RANGE {{join(",", currents)}}
     530{% endif %}
     531
     532{% for p in permeatingIons %}
     533{% if (p.species == "non-specific") %}
     534RANGE {{p.e}}
     535{% else %}
     536;; if rev potential is defined for this ion, declare the ionic current
     537;; and reversal potential as range variables, otherwise declare only
     538;; the ionic current as a range variable
     539{% if p.erev  %}
     540RANGE {{p.i}}, {{p.e}}
     541{% else %}
     542RANGE {{p.i}}
     543{% endif %}
     544{% endif %}
     545{% endfor %}
     546
     547{% if (accumulatingIons == []) %}
     548{% for p in poolIons %}
     549RANGE {{p.in}}, {{p.out}}
     550{% endfor %}
     551{% for m in modulatingIons %}
     552RANGE {{m.in}}, {{m.out}}
     553{% endif %}
     554{% else %}
     555{% for a in accumulatingIons %}
     556RANGE {{a.i}}
     557{% endfor %}
     558{% endif %}
     559
     560{% for parameterGroup in groupBy(rangeParameters, 10) %}
     561RANGE {{join(",", rangeParameters)}}
     562{% endfor %}
     563
     564{% for useion in useIons %}
     565{% if (useIon.nonSpecific) %}
     566NONSPECIFIC_CURRENT {{useion.name}}
     567{% else %}
     568{% if (useIon.valence) %}
     569{% if (useIon.write == []) %}
     570USEION {{useion.name}} READ {{join (", ", useion.read)}} VALENCE {{useion.valence}}
     571{% else %}
     572USEION {{useion.name}} READ {{join (", ", useion.read)}} WRITE {{join (", ", useion.write)}} VALENCE {{useion.valence}}
     573{% endif %}
     574{% else %}
     575{% if (useIon.write == []) %}
     576USEION {{useion.name}} READ {{join (", ", useion.read)}}
     577{% else %}
     578USEION {{useion.name}} READ {{join (", ", useion.read)}} WRITE {{join (", ", useion.write)}}
     579{% endif %}
     580{% endif %}
     581{% endif %}
     582{% endfor %}
     583
     584}
     585EOF
     586))
    456587
    457588(define (nemo:nmodl-translator sys . rest)
     
    503634                                                `(,comp ,(nmodl-name i) ,(nmodl-name e) ,erev #f)))
    504635                                 (lookup-def 'perm-ions gate-complex-info)))
    505              (acc-ions      (map (match-lambda ((comp i in out)
    506                                                 `(,comp ,@(map nmodl-name (list i in out)))))
    507                                  (lookup-def 'acc-ions gate-complex-info)))
     636             (acc-ions      (delete-duplicates
     637                             (map (match-lambda ((comp i in out)
     638                                                 `(,comp ,@(map nmodl-name (list i in out)))))
     639                                  (lookup-def 'acc-ions gate-complex-info))
     640                             (lambda (x y) (eq? (car x) (car y)))))
    508641             (mod-ions      (lookup-def 'mod-ions gate-complex-info))
    509642             (epools        (lookup-def 'pool-ions gate-complex-info))
     
    691824                                                  (list (second acc-ion))
    692825                                                  #f))))
    693                                   (delete-duplicates acc-ions (lambda (x y) (eq? (car x) (car y))))))
    694                          ))
     826                                  acc-ions)
     827                         )))
    695828
    696829             (useions   (consolidate-useions useions))
     
    833966               
    834967               (locals (find-locals (map second i-eqs)))
    835              )
    836 
    837         (pp indent ,nl (TITLE ,sysname))
    838 
    839         (pp indent ,nl
    840             (COMMENT)
    841             (This file was generated by ,(nemo:version-string) on ,(seconds->string (current-seconds)))
    842             (ENDCOMMENT))
     968
     969               (tmpl-vars
     970                `(
     971                  (modelName         . ,sysname)
     972                  (currentTimestamp  . ,(seconds->string (current-seconds)))
     973                  (nemoVersionString . ,(nemo:version-string))
     974                  (exports           . ,exports)
     975                  (currents          . ,(append
     976                                         (map (lambda (gate-complex) (nmodl-name (s+ 'i_ (first gate-complex)))) gate-complexes )
     977                                         (map (lambda (i-gate) (nmodl-name (s+ 'i_ (second i-gate)))) i-gates )))
     978                  (permeatingIons    . ,(map
     979                                         (match-lambda
     980                                          ((comp i e erev val)
     981                                           `((species . ,comp) (i . ,(nmodl-name i))
     982                                             (e . ,(nmodl-name e)) (erev . ,erev) (valence . ,val)))
     983                                          ((comp i e erev)
     984                                           `((species . ,comp) (i . ,(nmodl-name i))
     985                                             (e . ,(nmodl-name e)) (erev . ,erev))))
     986                                         perm-ions))
     987                  (modulatingIons     . ,(filter-map
     988                                          (match-lambda
     989                                           ((ion in-conc out-conc val)
     990                                            (let ((qs (filter (lambda (x) (and x (member-imports x imports)) )
     991                                                              (list in-conc out-conc))))
     992                                              (and (not (null? qs))
     993                                                   `((in . ,in-conc) (out . ,out-conc))))))
     994                                           mod-ions))
     995                  (accumulatingIons   . ,(map
     996                                          (match-lambda ((comp i in out)
     997                                                         `((species . ,comp) (i . ,(nmodl-name i))
     998                                                           (in . ,(nmodl-name in)) (out . ,(nmodl-name out)))))
     999                                          acc-ions))
     1000                 
     1001                  (useIons            . ,(map
     1002                                          (lambda (x)
     1003                                            (let ((u (cdr x)))
     1004                                              (cases useion u
     1005                                                     (UseIon (name read write valence)
     1006                                                             `((nonSpecific . #f)
     1007                                                               (name . ,name)
     1008                                                               (read . ,read)
     1009                                                               (write . ,write)
     1010                                                               (valence . ,valence)))
     1011                                                     (NonSpecific (name)
     1012                                                                  `((nonSpecific . #t)
     1013                                                                    (name . ,name))))
     1014                                              ))
     1015                                          useions))
     1016
     1017                  (rangeParameters    .  ,(let* (
     1018                                                 (param-names  (map (compose nmodl-name first) parameter-defs))
     1019                                                 (is-const?    (lambda (x) (member x param-names)))
     1020                                                 )
     1021                                           (delete-duplicates
     1022                                            (fold (lambda (def ax)
     1023                                                    (let* ((rhs   (second def))
     1024                                                           (vars  (cond ((nemo:rhs? rhs)
     1025                                                                         (rhsvars rhs))
     1026                                                                        ((extended-procedure? rhs)
     1027                                                                         (let* ((fd  (procedure-data rhs))
     1028                                                                                (cs  (lookup-def 'consts fd)))
     1029                                                                           (map (compose nmodl-name first) cs)
     1030                                                                           ))
     1031                                                                        (else '())
     1032                                                                        ))
     1033                                                           )
     1034                                                      (append (filter is-const? vars) ax)))
     1035                                                  (list)
     1036                                                  (append asgn-eq-defs rate-eq-defs reaction-eq-defs defuns )))))
     1037
     1038                  ))
     1039               )
     1040
     1041        (pp indent
     1042
     1043            ,(instantiate-template prelude-template tmpl-vars)
     1044            ,(instantiate-template neuron-template tmpl-vars)
     1045
     1046            )
    8431047       
    844         (pp indent ,nl (NEURON "{"))
    845 
    846         (if has-events?
    847             (pp indent+ (POINT_PROCESS ,sysname)))
    848 
    849         (let recur ((exports exports))
    850           (if (not (null? exports))
    851               (begin
    852                 (pp indent+ (RANGE ,(slp ", " (map nmodl-name (take exports (min 10 (length exports)))))))
    853                 (recur (drop exports (min 10 (length exports)))))))
    854        
    855         (let ((currents (append (map (lambda (gate-complex) (nmodl-name (s+ 'i_ (first gate-complex)))) gate-complexes )
    856                                 (map (lambda (i-gate) (nmodl-name (s+ 'i_ (second i-gate)))) i-gates ))))
    857           (if (not (null? currents)) (pp indent+ (RANGE ,(slp ", " currents)))))
    858 
    859         (for-each (lambda (x)
    860                        (case (first x)
    861                          ((non-specific)
    862                           (pp indent+ (RANGE ,(third x))))
    863                          (else
    864                           (cond ((fourth x)
    865                                  (pp indent+  (RANGE ,(second x)) (RANGE ,(third x))))
    866                                 (else (pp indent+ (RANGE ,(second x))))))))
    867                   (delete-duplicates perm-ions (lambda (x y) (eq? (car x) (car y)))))
    868 
    869         (if (null? acc-ions)
    870             (begin
    871               (for-each (lambda (pool-ion)
    872                           (pp indent+ (RANGE ,(slp ", " (list (pool-ion-in pool-ion) (pool-ion-out pool-ion))))))
    873                         pool-ions)
    874 
    875               (for-each (lambda (mod-ion)
    876                           (let ((qs (filter (lambda (x) (and x (member-imports x imports)) )
    877                                             (list (second mod-ion) (third mod-ion)))))
    878                             (if (not (null? qs))
    879                                 (pp indent+ (RANGE ,(slp ", " qs)))
    880                                 )))
    881                         mod-ions)
    882               )
    883             (for-each (lambda (acc-ion)
    884                         (pp indent+ (RANGE ,(second acc-ion))))
    885                       (delete-duplicates acc-ions (lambda (x y) (eq? (car x) (car y))))))
    886 
    887         (let* ((param-names   (map (compose nmodl-name first) parameter-defs))
    888                (is-const?     (lambda (x) (member x param-names)))
    889                (range-consts  (delete-duplicates
    890                                (fold (lambda (def ax)
    891                                        (let* ((rhs   (second def))
    892                                               (vars  (cond ((nemo:rhs? rhs)
    893                                                             (rhsvars rhs))
    894                                                            ((extended-procedure? rhs)
    895                                                             (let* ((fd  (procedure-data rhs))
    896                                                                    (cs  (lookup-def 'consts fd)))
    897                                                               (map (compose nmodl-name first) cs)
    898                                                               ))
    899                                                            (else '())
    900                                                            ))
    901                                               )
    902                                          (append (filter is-const? vars) ax)))
    903                                      (list) (append asgn-eq-defs rate-eq-defs reaction-eq-defs defuns ))))
    904                )
    905           (if (not (null? range-consts)) (pp indent+ (RANGE ,(slp ", " range-consts)))))
    906 
    907 
    908         (for-each (lambda (x)
    909                     (let ((u (cdr x)))
    910                       (cases useion u
    911                              (UseIon (name read write valence)
    912                                      (if valence
    913                                          (if (null? write)
    914                                              (pp indent+ (USEION ,name READ ,(slp ", " read) VALENCE ,valence))
    915                                              (pp indent+ (USEION ,name READ ,(slp ", " read) WRITE ,(slp ", " write) VALENCE ,valence)))
    916                                          (if (null? write)
    917                                              (pp indent+ (USEION ,name READ ,(slp ", " read)))
    918                                              (pp indent+ (USEION ,name READ ,(slp ", " read) WRITE ,(slp ", " write))))
    919                                          ))
    920                              (NonSpecific (name)
    921                                           (pp indent+ (NONSPECIFIC_CURRENT ,name))
    922                                           ))
    923                       ))
    924                   useions)
    925 
    926        
    927         (pp indent "}")
    9281048           
    929         (let* ((define-fn (make-define-fn)))
    930           (for-each (lambda (fndef)
    931                       (if (not (member (car fndef) builtin-fns))
    932                           (apply define-fn (cons indent fndef))))
    933                     defuns))
     1049        (for-each (lambda (fndef)
     1050                    (if (not (member (car fndef) builtin-fns))
     1051                        (apply fn-translator fndef)))
     1052                  defuns)
    9341053       
    9351054        (let* (
  • release/4/nemo/trunk/nemo-version.scm

    r29934 r31354  
    11
    2 (define nemo-version "8.46")
     2(define nemo-version "9.0")
Note: See TracChangeset for help on using the changeset viewer.