Changeset 27339 in project


Ignore:
Timestamp:
08/30/12 12:35:20 (9 years ago)
Author:
Ivan Raikov
Message:

nemo: added equational representation backend

Location:
release/4/nemo/trunk
Files:
1 added
3 edited

Legend:

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

    r27305 r27339  
    144144  (string->symbol (string-append (->string scope) ":" (->string sym))))
    145145
    146 (define fresh gensym)
     146(define fresh (compose string->symbol symbol->string gensym))
    147147
    148148(define (alist? x)
  • release/4/nemo/trunk/nemo.scm

    r27335 r27339  
    4949(define nemo-nest?        (extension-information 'nemo-nest))
    5050(define nemo-pyparams?    (extension-information 'nemo-pyparams))
     51(define nemo-eqn?        (extension-information 'nemo-eqn))
    5152
    5253(if nemo-nmodl?   (use nemo-nmodl))
     
    5455(if nemo-nest?    (use nemo-nest))
    5556(if nemo-pyparams?    (use nemo-pyparams))
     57(if nemo-eqn?    (use nemo-eqn))
    5658
    5759(define (lookup-def k lst . rest)
     
    104106            ))
    105107
     108    (plain
     109     "write plain text output to file (default: <model-name>.txt)"
     110     (value (optional FILENAME)
     111            ))
     112
    106113    (xml
    107114     "write XML output to file (default: <model-name>.xml)"
     
    116123    (hh-markov
    117124     "convert HH rate equations to Markov chain form")
     125
     126    ,@(if nemo-eqn?
     127          `(
     128            (eqn
     129             "write EQN output to the given file (default: <model-name>.eqn)"
     130             (value (optional FILENAME)))
     131            )
     132          `())
    118133
    119134    ,@(if nemo-nest?
     
    315330
    316331
     332(define model->eqn
     333  (if nemo-eqn?
     334      (lambda (options model)
     335        (nemo:eqn-translator model (lookup-def 'filename options)))
     336      (lambda (options model)
     337        (void))))
     338
    317339(define model->matlab
    318340  (if nemo-matlab?
     
    378400         ((id expr)  `(ncml:bnd (@ (id ,id)) (ncml:expr ,(expr->ncml-expr expr))))
    379401         (else (error 'binding->ncml-binding "invalid binding " bnd))))
     402
    380403 
    381404(define (expr->ncml-expr x)
     
    407430    ((=)  'ncml:eq)
    408431    (else  (string->symbol (string-append "ncml:" (->string op))))))
     432
    409433
    410434
     
    483507                           ,@(map (declaration->ncml parse-expr) lst)))
    484508         )))
     509
    485510
    486511(define (make-component->ncml dis model parse-expr)
     
    556581           (component->ncml (make-component->ncml dis model parse-expr)))
    557582       `(ncml:model (@ (name ,sysname)) ,@(component->ncml (nemo-intern 'toplevel))))))
     583           
     584
     585(define (transition->text-transition x)
     586  (match x
     587         (('-> src dst rate)
     588          `(-> ,src ,dst ,(expr->text-expr rate) ))
     589         ((src '-> dst rate)
     590          `(-> ,src ,dst ,(expr->text-expr rate) ))
     591         (('<-> src dst rate1 rate2)
     592          `(<-> ,src ,dst ,(expr->text-expr rate) ))
     593         (('src <-> dst rate1 rate2)
     594          `(<-> ,src ,dst ,(expr->text-expr rate) ))
     595         (else (error 'transition->text-transition "invalid transition " x))))
     596
     597
     598(define (conseq->text-conseq parse-expr)
     599  (lambda (x)
     600    (match x
     601           (((and i (? integer?)) '= rhs)
     602            `(,(->string i) =
     603              ,(expr->text-expr (parse-expr rhs))))
     604           (else (error 'conseq->text-conseq "invalid linear equation " x)))))
     605
     606
     607(define (binding->text-binding bnd)
     608  (match bnd
     609         ((id expr)  `(,id = ,(expr->text-expr expr)))
     610         (else (error 'binding->text-binding "invalid binding " bnd))))
     611
     612 
     613(define (expr->text-expr x)
     614  (match x
     615         ((? number?)    x)
     616         ((? symbol?)    x)
     617         (('let bnds expr)
     618          `(let (,(map binding->text-binding bnds))
     619             ,(expr->text-expr expr)))
     620         (((and op (? symbol?)) . args)
     621          (let ((ncml-expr `(apply ,op ,@(map expr->text-expr args))))
     622            ncml-expr))
     623         (else (error 'expr->text-expr "unknown expression " x))))
     624
     625
     626(define (make-component->text dis model parse-expr)
     627  (lambda (x)
     628    (let ((en (hash-table-ref model x)))
     629        (cond ((procedure? en)
     630               (let ((fd (procedure-data en)))
     631                 `(function ,x
     632                            ,(lookup-def 'vars fd) =
     633                            ,(expr->text-expr (lookup-def 'body fd)))
     634                 ))
     635              (else
     636               (match en
     637                      (($ nemo:quantity 'LABEL  v)
     638                       `(label ,name = ,v))
     639                     
     640                      (($ nemo:quantity 'EXTERNAL local-name name namespace)
     641                       (if namespace
     642                           `(input ,name  as ,local-name from ,namespace)
     643                           `(input ,name  as ,local-name)))
     644
     645                      (($ nemo:quantity 'CONST  name value)
     646                       `(const ,name = ,value))
     647                     
     648                      (($ nemo:quantity 'ASGN name value rhs)
     649                       (let ((expr (expr->text-expr rhs)))
     650                         `(,name = ,expr)))
     651                     
     652                      (($ nemo:quantity 'RATE name initial rhs power)
     653                       (let ((expr (expr->ncml-expr rhs))
     654                             (initial (and initial (expr->text-expr initial)))
     655                             (power (or (and power (expr->text-expr power))
     656                                        (expr->text-expr 1.0))))
     657
     658                         `(d (,name) = (,expr)
     659                             (initial: ,initial)
     660                             (power: ,power))
     661                         ))
     662
     663                     
     664                      (($ nemo:quantity 'REACTION name initial open trs cons p)
     665                       (let ((sxml-trs (append-map transition->text-transition trs)))
     666                         `(reaction  ,name
     667                                     (open-state: ,open)
     668                                     (initial: ,(expr->text-expr initial))
     669                                     (conserve: ,(map (conseq->text-conseq identity) cons))
     670                                     (transitions: ,text-trs)
     671                                     (power: ,(expr->ncml-expr p))
     672                                     )))
     673
     674                     
     675                      (($ nemo:quantity 'COMPONENT name type lst)
     676                       (let ((component->text (make-component->text dis model parse-expr))
     677                             (component-exports ((dis 'component-exports) model x)))
     678                         (case type
     679                           ((toplevel) `(,@(map component->text lst)
     680                                         ,@(map (lambda (x) `(output ,x)) component-exports)))
     681                           (else `(component ,name (type: ,(->string type) )
     682                                                  ,@(filter-map component->text lst)
     683                                                  ,@(map (lambda (x) `(output ,x)) component-exports)
     684                                                  )))))
     685                     
     686                      (($ nemo:quantity 'FUNCTOR name args type lst)
     687                       (let ((component->ncml (make-component->ncml dis model parse-expr)))
     688                         `(functor ,name (type: ,(->string type) )
     689                                   (parameters: ,(string-intersperse (map ->string args) ","))
     690                                   ,@(filter-map (declaration->ncml parse-expr) lst)
     691                                   )))
     692                     
     693                      (else #f)))
     694              ))
     695    ))
     696   
     697
     698(define (model->text model parse-expr)
     699  (match-let ((($ nemo:quantity 'DISPATCH  dis)     
     700               (hash-table-ref model (nemo-intern 'dispatch))))
     701     (let ((sysname     ((dis 'sysname) model))
     702           (component->text (make-component->text dis model parse-expr)))
     703       `(model ,sysname ,@(component->text (nemo-intern 'toplevel)))
     704       )))
    558705           
    559706
     
    11521299                   (sysname             ((dis 'sysname) model))
    11531300                   (dirname             (pathname-directory operand))
     1301                   (eqn-fname           (make-output-fname dirname sysname ".eqn"  (opt 'eqn) ))
     1302                   (plain-fname         (make-output-fname dirname sysname ".txt"  (opt 'plain) ))
    11541303                   (sxml-fname          (make-output-fname dirname sysname  ".sxml" (opt 'sxml) ))
    11551304                   (surface-xml-fname   (make-output-fname dirname sysname ".xml"  (opt 'surface-xml) ))
     
    11591308                   (vclamp-octave-fname (make-output-fname dirname sysname "_vclamp.m" (opt 'vclamp-octave) ))
    11601309                 
     1310                   (eqn            (opt 'eqn))
    11611311                   (nest           (opt 'nest))
    11621312                   (matlab         (opt 'matlab))
     
    11651315                   (vclamp-octave  (opt 'vclamp-octave))
    11661316                 
    1167                   (nmodl-depend  (opt 'nmodl-depend))
    1168                  
    1169                   (nmodl-method
    1170                    (let ((method  ($ (opt 'nmodl-method) )))
    1171                      (case method
    1172                        
    1173                        ((adams runge euler adeuler heun adrunge gear
    1174                                newton simplex simeq seidel sparse derivimplicit cnexp clsoda
    1175                                after_cvode cvode_t cvode_t_v expeuler #f) method)
    1176                        (else (error "unknown nmodl-method " method)))))
    1177                  
    1178                   (octave-method
    1179                    (let ((method  ($ (opt 'octave-method) )))
    1180                      (case method
    1181                        ((lsode odepkg #f) method)
    1182                        (else (error "unknown octave method " method)))))
     1317                   (nmodl-depend  (opt 'nmodl-depend))
     1318                   
     1319                   (nmodl-method
     1320                    (let ((method  ($ (opt 'nmodl-method) )))
     1321                      (case method
     1322                       
     1323                        ((adams runge euler adeuler heun adrunge gear
     1324                                newton simplex simeq seidel sparse derivimplicit cnexp clsoda
     1325                                after_cvode cvode_t cvode_t_v expeuler #f) method)
     1326                        (else (error "unknown nmodl-method " method)))))
     1327                   
     1328                   (octave-method
     1329                    (let ((method  ($ (opt 'octave-method) )))
     1330                      (case method
     1331                        ((lsode odepkg #f) method)
     1332                        (else (error "unknown octave method " method)))))
    11831333
    11841334
     
    12211371              (if (and xml-fname surface-xml-fname)
    12221372                  (error 'nemo "both --xml and --surface-xml options are not permitted"))
     1373
     1374              (if plain-fname
     1375                  (with-output-to-file plain-fname
     1376                    (lambda () (pretty-print (model->text model parse-expr)))))
    12231377             
    12241378              (if sxml-fname
     
    12381392                 (with-output-to-file surface-xml-fname
    12391393                   (lambda () (print-fragments  (entry->surface-xml model-decls)))))
     1394
     1395             (if eqn (model->eqn `((filename  . ,eqn-fname)) model))
    12401396
    12411397             (if mod-fname
  • release/4/nemo/trunk/nemo.setup

    r27304 r27339  
    235235
    236236
     237(if (file-exists? "nemo-eqn.scm")
     238    (begin
     239      (make (
     240             ((dynld-name "nemo-eqn") ("nemo-eqn.scm")
     241              (compile -no-trace -O -d2 -s nemo-eqn.scm -j nemo-eqn))
     242             
     243             ((dynld-name "nemo-eqn.import") ("nemo-eqn.import.scm")
     244              (compile -no-trace -O2 -s nemo-eqn.import.scm))
     245             )
     246        (list (dynld-name "nemo-eqn")
     247              (dynld-name "nemo-eqn.import"))
     248        )))
     249
     250
     251(if (file-exists? "nemo-eqn.scm")
     252    (install-extension
     253     
     254     ;; Name of your extension:
     255     'nemo-eqn
     256     
     257     ;; Files to install for your extension:
     258     `(,(dynld-name "nemo-eqn")  ,(dynld-name "nemo-eqn.import")  )
     259     
     260     ;; Assoc list with properties for your extension:
     261     `((version ,nemo-version))))
     262
     263
    237264(make (
    238265       ((dynld-name "nemo-hh") ("extensions/nemo-hh.scm")
     
    285312(make (
    286313       ("nemo" ("nemo.scm")
    287         (compile -no-trace -uses files -O -d2 nemo.scm))
     314        (compile -uses files -O -d2 nemo.scm))
    288315       )
    289316  "nemo")
Note: See TracChangeset for help on using the changeset viewer.