Changeset 11797 in project


Ignore:
Timestamp:
08/29/08 09:43:59 (11 years ago)
Author:
Ivan Raikov
Message:

More updated to the NMODL backend.

File:
1 edited

Legend:

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

    r11763 r11797  
    6262         (else ax)))
    6363
    64 (define (enumvars expr ax)
    65   (match expr
    66          (('if . es)  (fold enumvars ax es))
    67          (('let bnds body)  (fold enumprocs (fold enumvars ax (map cadr bnds)) body))
    68          ((s . es)    (if (symbol? s)  (fold enumvars ax es) ax))
    69          (id          (if (symbol? id) (cons id ax) ax))))
    70 
    7164(define (enumbnds expr ax)
    7265  (match expr
    7366         (('if . es)        (fold enumbnds ax es))
    74          (('let bnds body)  (enumbnds body (append  (map car bnds) ax)))
     67         (('let bnds body)  (enumbnds body (append (map car bnds) (fold enumbnds ax (map cadr bnds)))))
    7568         ((s . es)          (if (symbol? s)  (fold enumbnds ax es) ax))
    7669         (else ax)))
    7770
     71
     72(define (enum-freevars expr bnds ax)
     73  (match expr
     74         (('if . es) 
     75          (fold (lambda (x ax) (enum-freevars x bnds ax)) ax es))
     76         (('let bnds body) 
     77          (let ((bnds1 (append (map first bnds) bnds)))
     78            (enum-freevars body bnds1 (fold (lambda (x ax) (enum-freevars x bnds ax)) ax (map second bnds)))))
     79         ((s . es)    (if (symbol? s)  (fold (lambda (x ax) (enum-freevars x bnds ax)) ax es) ax))
     80         (id          (if (and (symbol? id) (not (member id bnds)))  (cons id ax) ax))))
     81
    7882(define (rhsvars rhs)
    79   (enumvars rhs (list)))
     83  (enum-freevars rhs (list) (list)))
    8084
    8185(define (rhsexpr expr)
     
    116120    ((pp indent val ...) (ppf indent (quasiquote val) ...))))
    117121
    118 (define ifthen/NMODL  (doc:ifthen 2 (doc:text "if") (doc:text "") (doc:text "else")))
     122(define ifthen/NMODL  (doc:ifthen 0 (doc:text "if") (doc:text "") (doc:text "else")))
    119123(define letblk/NMODL  (doc:letblk 2 (doc:empty) (doc:break) (doc:empty)))
    120124(define group/NMODL   (doc:block 2 (doc:text "(") (doc:text ")")))
     
    189193  (match expr
    190194         (('let ((x ('if c t e))) y)
    191           (let ((ax (fold let-enum ax (list c t e))))
     195          (let ((ax (fold let-enum ax (list c ))))
    192196            (if (eq? x y)  (append ax (list (list x `(if ,c ,t ,e)))) ax)))
    193197
    194198         (('let bnds body)  (let-enum body (append ax bnds)))
    195199
    196          (('if c t e)  (fold let-enum ax (list c t e)))
     200         (('if c t e)  (let-enum ax c))
    197201
    198202         ((f . es)  (fold let-enum ax es))
     
    208212         (('let bnds body) (let-elim body))
    209213
    210          (('if c t e)  `(if . ,(map let-elim (list c t e))))
     214         (('if c t e)  `(if ,(let-elim c) ,(let-lift t) ,(let-lift e)))
    211215
    212216         ((f . es)  `(,f . ,(map let-elim es)))
     
    240244                      (ifthen/NMODL
    241245                       (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                      
     246                       (block/NMODL (format-expr/NMODL indent t (first x)))
     247                       (block/NMODL (format-expr/NMODL indent e (first x)))))
    249248                     (else
    250249                      (format-op/NMODL indent+ " = "
    251                                        (list (format-expr/NMODL indent+ (first x) )
    252                                              (format-expr/NMODL indent+ (second x))))))
     250                                       (list (format-expr/NMODL indent (first x) )
     251                                             (format-expr/NMODL indent (second x))))))
    253252              ax))
    254253           (doc:empty) bindings)
     
    306305         
    307306(define (expr->string/NMODL x . rest)
    308   (let-optionals rest ((rv #f) (width 64))
     307  (let-optionals rest ((rv #f) (width 72))
    309308    (sdoc->string (doc:format width (format-expr/NMODL 2 x rv)))))
    310309 
     
    318317          (body     (lookup-def 'body lst)))
    319318      (pp indent ,nl (FUNCTION ,n (,(sl\ ", " vars)) "{" ))
    320       (let* ((body1 (canonicalize-expr/NMODL body))
    321              (lbs (enumbnds body1 (list))))
    322         (if (not (null? lbs)) (pp indent (LOCAL ,(sl\ ", " lbs))))
     319      (let* ((body1 (canonicalize-expr/NMODL (rhsexpr body)))
     320             (lbs   (enumbnds body1 (list))))
     321        (if (not (null? lbs)) (pp indent+ (LOCAL ,(sl\ ", " lbs))))
    323322        (pp indent+ ,(expr->string/NMODL body1 n)))
    324323      (pp indent "}")))  )
     
    493492             (sfname  (string-append (->string sysname) ".mod"))
    494493             (deps*   ((dis 'depgraph*) sys))
     494             (consts  ((dis 'consts) sys))
    495495             (asgns   ((dis 'asgns) sys))
    496496             (states  ((dis 'states) sys))
     
    500500
    501501        (match-let (((state-list asgn-list g) deps*))
    502          (let ((poset     (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
    503                (perm-ions (delete-duplicates
    504                            (fold (lambda (n ax)
    505                                   (let* ((subcomps ((dis 'component-subcomps) sys n))
    506                                          (perm (lookup-def 'permeating-substance subcomps)))
    507                                     (if perm
    508                                         (case perm
    509                                           ((non-specific)   
    510                                             (let* ((erev (car ((dis 'component-exports) sys perm)))
    511                                                    (i    (nmodl-name 'i))
    512                                                    (e    (nmodl-name 'e)))
    513                                               (cons `(,perm ,i ,e ,erev) ax)))
    514                                           (else (let* ((erev (car ((dis 'component-exports) sys perm)))
    515                                                        (i    (nmodl-name (s+ 'i perm)))
    516                                                        (e    (nmodl-name (s+ 'e perm))))
    517                                                   (cons `(,perm ,i ,e ,erev) ax))))
    518                                         ax)))
    519                                 (list) ionchs)
    520                            (lambda (x y) (eq? (car x) (car y)))))
     502         (let* ((poset          (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
     503                (asgn-eq-defs   (poset->asgn-eq-defs poset sys))
     504                (perm-ions (delete-duplicates
     505                            (fold (lambda (n ax)
     506                                    (let* ((subcomps ((dis 'component-subcomps) sys n))
     507                                           (perm (lookup-def 'permeating-substance subcomps)))
     508                                      (if perm
     509                                          (case perm
     510                                            ((non-specific)   
     511                                             (let* ((erev (car ((dis 'component-exports) sys perm)))
     512                                                    (i    (nmodl-name 'i))
     513                                                    (e    (nmodl-name 'e)))
     514                                               (cons `(,perm ,i ,e ,erev) ax)))
     515                                            (else (let* ((erev (car ((dis 'component-exports) sys perm)))
     516                                                         (i    (nmodl-name (s+ 'i perm)))
     517                                                         (e    (nmodl-name (s+ 'e perm))))
     518                                                    (cons `(,perm ,i ,e ,erev) ax))))
     519                                          ax)))
     520                                  (list) ionchs)
     521                            (lambda (x y) (eq? (car x) (car y)))))
    521522               (acc-ions (delete-duplicates
    522523                           (fold (lambda (n ax)
     
    550551                               (USEION ,(first x) READ ,(third x) ", " ,(fourth x) WRITE ,(second x))))
    551552                         acc-ions)
     553               (let* ((const-names   (map first consts))
     554                      (is-const?     (lambda (x) (member x const-names)))
     555                      (range-consts  (delete-duplicates
     556                                      (fold (lambda (def ax)
     557                                              (let* ((rhs   (second def))
     558                                                     (vars  (rhsvars rhs)))
     559                                                (append (filter is-const? vars) ax)))
     560                                            (list) asgn-eq-defs ))))
     561                 (if (not (null? range-consts)) (pp indent+ (RANGE ,(sl\ ", " range-consts)))))
     562
    552563               
    553564               (pp indent "}")
     
    558569                                         (let ((v1 (canonicalize-expr/NMODL (second nv))))
    559570                                           (list (first nv) v1)))
    560                                        ((dis 'consts) sys)))
     571                                       consts))
    561572                      (locals  (find-locals const-defs)))
    562573                 (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     
    589600                   (begin
    590601                     (pp indent ,nl (PROCEDURE rates () "{"))
    591                      (let* ((eq-defs   (poset->asgn-eq-defs poset sys))
    592                             (locals    (find-locals eq-defs)))
     602                     (let ((locals    (find-locals asgn-eq-defs)))
    593603                       (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    594604                       (for-each (lambda (def)
    595605                             (let ((n (first def)) (b (second def)))
    596                                (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
     606                               (pp indent+ ,(expr->string/NMODL b n)))) asgn-eq-defs))
    597607
    598608                     (pp indent "}")))
     
    685695                      (locals     (concatenate (find-locals init-defs))))
    686696                 (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     697                 (if (not (null? asgns))  (pp indent+ (rates ())))
    687698                 (for-each (lambda (def)
    688699                             (let ((n (first def)) (b (second def)))
Note: See TracChangeset for help on using the changeset viewer.