Changeset 21087 in project


Ignore:
Timestamp:
10/26/10 10:13:14 (11 years ago)
Author:
Ivan Raikov
Message:

signal-diagram: transition improvements

Location:
release/4/signal-diagram/branches/regimes
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/signal-diagram/branches/regimes/examples/morris-lecar.scm

    r21012 r21087  
     1
     2;; (bib
     3;;     (author   "Morris, C" "Lecar, H")
     4;;     (title    "Voltage oscillations in the barnacle giant muscle fiber")
     5;;     (journal  "Biophys J")
     6;;     (year     "1981")
     7;;     (volume   "35")
     8;;     (pages    "193-213")
     9;;     (bibtype  "article"))
    110
    211
     
    7281(define (M-L-dataflow)
    7382  (let* ((f      (alist-ref 'f morris-lecar))
    74          (f1     (PURE dv))
    75          (f2     (SENSE '(v w Isyn gl vl v1 v2 gca vca gk vk c) f1))
    76          (f3     (ACTUATE '(nt vt) (Dh 't '(v) 'tstep f2)))
    77          (f4     (ACTUATE '(nt vt) (Dh 't '(w) 'tstep (SENSE '(w v phi v3 v4) (PURE dw)))))
    78          (f5     (UNION f3 f4))
    7983         (init   (alist-ref 'init morris-lecar))
    8084         (input  (map car init)))
    8185    (print "input = " input)
    82     (print "dataflow f1: " (dataflow (construct f1) input))
    83     (print "dataflow f2: " (dataflow (construct f2) input))
    84     (print "dataflow f3: " (dataflow (construct f3) input))
    85     (print "dataflow f4: " (dataflow (construct f4) input))
    86     (print "dataflow f5: " (dataflow (construct f5) input))
    8786    (print "dataflow f: "  (dataflow (construct f) input))
    8887    ))
     
    9089(define (M-L-codegen #!key (language 'scheme))
    9190  (let* ((f      (alist-ref 'f morris-lecar))
    92          (f1     (PURE dv))
    93          (f2     (SENSE '(v w Isyn gl vl v1 v2 gca vca gk vk c) f1))
    94          (f3     (ACTUATE '(nt vt) (Dh 't '(v) 'tstep f2)))
    95          (f4     (ACTUATE '(nt wt) (Dh 't '(w) 'tstep (SENSE '(w v phi v3 v4) (PURE dw)))))
    96          (f5     (UNION f3 f4))
    9791         (init   (alist-ref 'init morris-lecar))
    9892         (input  (map car init)))
  • release/4/signal-diagram/branches/regimes/signal-diagram.scm

    r21012 r21087  
    2727;; <http://www.gnu.org/licenses/>.
    2828;;
    29 ;; TODO: warn if the two arguments of RTRANSITION have non-overlapping state variables
    30 ;;
     29
    3130
    3231(module signal-diagram
    3332
    3433        (PURE IDENTITY SENSE ACTUATE SEQUENCE UNION DUP
    35          RTRANSITION LOOP D Dh
     34         LOOP D Dh TRANSITION RTRANSITION
    3635
    3736         function? make-function function-formals
     
    150149  (ACTUATE      (s symbol-pair?) (f diagram?))
    151150  (RTRANSITION  (f diagram?) (g diagram?) (ef symbol?) (eg symbol?) )
     151  (TRANSITION   (f diagram?) (g diagram?) (ef symbol?) )
    152152  (LOOP         (s (lambda (lst) (every symbol-pair? lst))) (f diagram?))
    153153  (D            (i symbol?) (d (lambda (lst) (every symbol? lst))) (f diagram?))
     
    160160
    161161(define-datatype value value?
    162   (V:C       (v (lambda (x) (or (symbol? x) (number? x)))))
     162  (V:C       (v (lambda (x) (or (symbol? x) (number? x) ))))
    163163  (V:Var     (name symbol?))
    164164  (V:Rec     (flds (lambda (x) (and (pair? x) (every (lambda (x) (and (symbol? (car x)) (value? (cadr x)))) flds)))))
     
    616616     )))
    617617
    618 (define (sf-rtransition0 f fk e ek  . rest)
     618;; Recurring state transitions
     619
     620(define (sf-rtransition0 f fk e ek)
    619621
    620622  (let* ((fe      (sfarrow-dfe f))
     
    632634         
    633635         )
    634 
    635     (let-optionals rest ((ef f) (fk fk) (ev e) (ek ek))
    636                    
    637       (make-sfarrow
    638        
    639        ;; dataflow equations
    640        (make-dfe
    641         ;; gen
    642         (lambda (s) (lset-union eq? (fe-gen s) (fke-gen s)))
    643        
    644         ;; kill
    645         (lambda (s) (lset-union eq? (fe-kill s) (fke-kill s)))
    646        
    647         ;; in
    648         (lambda (s) (lset-union eq? (fe-in s) (fke-in s) (list e ek)))
    649        
    650         ;; out
    651         (lambda (s) (lset-union eq? (fe-out s) (fke-out s))))
    652        
    653        ;; codegen
    654        (lambda (s env dfe)
    655          (let* (
    656                 (rv         (gensym 'trv))
    657                 (blender    (gensym 'blender))
    658                 (state      (gensym 'trst))
    659 
    660                 (blender-inputs     ((dfe-in dfe) s))
    661                 (blender-env        (map (lambda (s) (cons s s)) blender-inputs))
    662                 (blender-outputs    (lset-intersection eq? (fe-out s) (fke-out s)))
    663                 (blender-return     (lambda (kons codegen)
    664                                       (let ((renv (codegen-renv codegen)))
    665                                         (E:Ret (V:Prim kons
    666                                                        (list (V:Rec (map (lambda (p)
    667                                                                            (list (car p) (V:Sel (car p) (V:Var (cdr p)))))
    668                                                                          renv))))))))
    669 
    670                 (fenv   (list->cgenenv 'rtransition11 (fe-in s) blender-env))
    671                 (fkenv  (list->cgenenv 'rtransition12 (fke-in s) blender-env))
    672 
    673                 (fcodegen  ((sfarrow-codegen f)  (fe-in s)  fenv  (sfarrow-dfe f)))
    674                 (fkcodegen ((sfarrow-codegen fk) (fke-in s) fkenv (sfarrow-dfe fk)))
    675 
    676                 (ftrans  (lset-union eq? (lset-intersection eq? (fe-out s) (fke-in s))
    677                                      (list e)))
    678                 (fktrans (lset-union eq? (lset-intersection eq? (fke-out s) (fe-in s))
    679                                      (list ek)))
    680 
    681                 (fblend   (lambda (x)
    682                              (V:Prim 'tsCase
    683                                      (list (V:Fn '(x) (E:Ret (V:Rec (append
    684                                                                      (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
    685                                                                           blender-outputs)
    686                                                                      (map (lambda (s) (list s (V:Var s)))
    687                                                                           (lset-difference eq?
    688                                                                              (lset-union eq? ftrans fktrans)
    689                                                                              blender-outputs))))))
    690                                                                    
    691                                            (V:Fn '(x) (E:Ret (V:Rec (append
    692                                                                      (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
    693                                                                           blender-outputs)
    694                                                                      (map (lambda (s) (list s (V:Var s)))
    695                                                                           (lset-difference eq?
    696                                                                              (lset-union eq? ftrans fktrans)
    697                                                                              blender-outputs))))))
    698 
    699                                                                    
    700                                          (V:Var x)))))
    701                
    702                 (fkblend    (lambda (x)
    703                              (V:Prim 'tsCase
    704                                      (list (V:Fn '(x) (E:Ret (V:Rec (append
    705                                                                      (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
    706                                                                           blender-outputs)
    707                                                                      (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
    708                                                                           (lset-difference eq?
    709                                                                             ftrans
    710                                                                             blender-outputs))
    711                                                                      (map (lambda (s) (list s (V:Var s)))
    712                                                                           (lset-difference eq?
    713                                                                              fktrans
    714                                                                              blender-outputs))))))
    715                                            
    716                                            (V:Fn '(x) (E:Ret (V:Rec (append
    717                                                                      (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
    718                                                                           blender-outputs)
    719                                                                      (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
    720                                                                           (lset-difference eq?
    721                                                                             fktrans
    722                                                                             blender-outputs))
    723                                                                      (map (lambda (s) (list s (V:Var s)))
    724                                                                           (lset-difference eq?
    725                                                                              ftrans
    726                                                                              blender-outputs))))))
    727 
    728                                                                    
    729                                            (V:Var x)))))
    730          
    731                 )
    732 
    733            (if (null? blender-outputs)
    734                (error 'sf-rtransition "empty output of regime transition combinator" s))
     636   
     637    (make-sfarrow
     638     
     639     ;; dataflow equations
     640     (make-dfe
     641     
     642      ;; gen
     643      (lambda (s) (lset-union eq? (fe-gen s) (fke-gen s)))
     644     
     645      ;; kill
     646      (lambda (s) (lset-union eq? (fe-kill s) (fke-kill s)))
     647     
     648      ;; in
     649      (lambda (s) (lset-union eq? (fe-in s) (fke-in s) (filter-map identity (list e ek))))
     650     
     651      ;; out
     652      (lambda (s) (lset-union eq? (fe-out s) (fke-out s))))
     653     
     654     ;; codegen
     655     (lambda (s env dfe)
     656       (let* (
     657              (rv         (gensym 'trv))
     658              (blender    (gensym 'blender))
     659              (state      (gensym 'trst))
     660             
     661              (blender-inputs     ((dfe-in dfe) s))
     662              (blender-env        (map (lambda (s) (cons s s)) blender-inputs))
     663              (blender-outputs    (lset-intersection eq? (fe-out s) (fke-out s)))
     664              (blender-return     (lambda (kons codegen)
     665                                    (let ((renv (codegen-renv codegen)))
     666                                      (E:Ret (V:Prim kons
     667                                                     (list (V:Rec (map (lambda (p)
     668                                                                         (list (car p) (V:Sel (car p) (V:Var (cdr p)))))
     669                                                                       renv))))))))
     670             
     671              (fenv   (list->cgenenv 'rtransition11 (fe-in s) blender-env))
     672              (fkenv  (list->cgenenv 'rtransition12 (fke-in s) blender-env))
     673             
     674              (fcodegen  ((sfarrow-codegen f)  (fe-in s)  fenv  (sfarrow-dfe f)))
     675              (fkcodegen ((sfarrow-codegen fk) (fke-in s) fkenv (sfarrow-dfe fk)))
     676             
     677              (ftrans  (lset-union eq? (lset-intersection eq? (fe-out s) (fke-in s))
     678                                   (list e)))
     679              (fktrans (lset-union eq? (lset-intersection eq? (fke-out s) (fe-in s))
     680                                   (filter-map identity (list ek))))
     681             
     682              (fblend   (lambda (x)
     683                          (V:Prim 'tsCase
     684                                  (list (V:Fn '(x) (E:Ret (V:Rec (append
     685                                                                  (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
     686                                                                       blender-outputs)
     687                                                                  (map (lambda (s) (list s (V:Var s)))
     688                                                                       (lset-difference eq?
     689                                                                                        (lset-union eq? ftrans fktrans)
     690                                                                                        blender-outputs))))))
     691                                       
     692                                        (V:Fn '(x) (E:Ret (V:Rec (append
     693                                                                  (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
     694                                                                       blender-outputs)
     695                                                                  (map (lambda (s) (list s (V:Var s)))
     696                                                                       (lset-difference eq?
     697                                                                                        (lset-union eq? ftrans fktrans)
     698                                                                                        blender-outputs))))))
     699                                       
     700                                       
     701                                        (V:Var x)))))
     702             
     703              (fkblend    (lambda (x)
     704                            (V:Prim 'tsCase
     705                                    (list (V:Fn '(x) (E:Ret (V:Rec (append
     706                                                                    (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
     707                                                                         blender-outputs)
     708                                                                    (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
     709                                                                         (lset-difference eq?
     710                                                                                          ftrans
     711                                                                                          blender-outputs))
     712                                                                    (map (lambda (s) (list s (V:Var s)))
     713                                                                         (lset-difference eq?
     714                                                                                          fktrans
     715                                                                                          blender-outputs))))))
     716                                         
     717                                          (V:Fn '(x) (E:Ret (V:Rec (append
     718                                                                    (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
     719                                                                         blender-outputs)
     720                                                                    (map (lambda (s) (list s (V:Sel s (V:Var 'x))))
     721                                                                         (lset-difference eq?
     722                                                                                          fktrans
     723                                                                                          blender-outputs))
     724                                                                    (map (lambda (s) (list s (V:Var s)))
     725                                                                         (lset-difference eq?
     726                                                                                          ftrans
     727                                                                                          blender-outputs))))))
     728                                         
     729                                         
     730                                          (V:Var x)))))
     731             
     732              )
     733         
     734         (if (null? blender-outputs)
     735             (error 'sf-rtransition "empty output of recurrent transition combinator" s))
     736         
     737         (codegen-state
     738          (append
     739           (reverse
     740            (list
     741             (E:Val state
     742                    (V:Prim 'TRC
     743                            (list
     744                             (V:Stv
     745                              (V:Fn blender-inputs
     746                                    (E:Let (codegen-expr fcodegen)
     747                                           (blender-return 'TRSA fcodegen))))
     748                             (V:Stv
     749                              (V:Fn blender-inputs
     750                                    (E:Let (codegen-expr fkcodegen)
     751                                           (blender-return 'TRSB fkcodegen))))
     752                             (V:Fn (list 'x) (E:Ret (V:Prim 'tsCase
     753                                                            (list (V:Fn '(x) (E:Ret (V:Sel e (V:Var 'x))))
     754                                                                  (if ek
     755                                                                      (V:Fn '(x) (E:Ret (V:Sel ek (V:Var 'x))))
     756                                                                      (V:Fn '(x) (E:Ret (V:C 'false))))
     757                                                                  (V:Var 'x)))))
     758                             )))
     759             
     760             (E:Val blender
     761                    (V:Fn (cons state blender-inputs)
     762                          (E:Let `(
     763                                   ,(E:Val 'f     (V:Ldv (V:Prim 'trfOf (list (V:Var state)))))
     764                                   ,(E:Val 'e     (V:Prim 'treOf (list (V:Var state))))
     765                                   ,(E:Val 'fv    (V:Prim 'f (map V:Var blender-inputs)))
     766                                   ,(E:Val 'trp   (V:Prim 'e (list (V:Var 'fv))))
     767                                   )
     768                                 (E:Seq
     769                                  (list
     770                                   (E:Ife (V:Var 'trp)
     771                                          (E:Let `(
     772                                                   ,(E:Val 'fk (V:Ldv (V:Prim 'trfkOf (list (V:Var state)))))
     773                                                   )
     774                                                 (E:Seq
     775                                                  (list
     776                                                   (E:Ret (V:Prim 'trfSet  (list (V:Var state) (V:Var 'fk))))
     777                                                   (E:Ret (V:Prim 'trfkSet (list (V:Var state) (V:Var 'f))))
     778                                                   )))
     779                                          (E:Noop))
     780                                   
     781                                   (E:Ret
     782                                    (V:Ifv (V:Var 'trp) (fkblend 'fv) (fblend 'fv)))
     783                                   
     784                                   )))
     785                          ))
     786             ))
    735787           
    736            (codegen-state
    737             (append
    738              (reverse
    739               (list
    740                (E:Val state
    741                       (V:Prim 'TRC
    742                               (list
    743                                (V:Stv
    744                                 (V:Fn blender-inputs
    745                                       (E:Let (codegen-expr fcodegen)
    746                                              (blender-return 'TRSA fcodegen))))
    747                                (V:Stv
    748                                 (V:Fn blender-inputs
    749                                       (E:Let (codegen-expr fkcodegen)
    750                                              (blender-return 'TRSB fkcodegen))))
    751                                (V:Fn (list 'x) (E:Ret (V:Prim 'tsCase
    752                                                               (list (V:Fn '(x) (E:Ret (V:Sel e (V:Var 'x))))
    753                                                                     (V:Fn '(x) (E:Ret (V:Sel ek (V:Var 'x))))
    754                                                                     (V:Var 'x)))))
    755                                )))
    756                
    757                (E:Val blender
    758                       (V:Fn (cons state blender-inputs)
    759                             (E:Let `(
    760                                      ,(E:Val 'f     (V:Ldv (V:Prim 'trfOf (list (V:Var state)))))
    761                                      ,(E:Val 'e     (V:Prim 'treOf (list (V:Var state))))
    762                                      ,(E:Val 'fv    (V:Prim 'f (map V:Var blender-inputs)))
    763                                      ,(E:Val 'trp   (V:Prim 'e (list (V:Var 'fv))))
    764                                      )
    765                                    (E:Seq
    766                                     (list
    767                                      (E:Ife (V:Var 'trp)
    768                                             (E:Let `(
    769                                                      ,(E:Val 'fk (V:Ldv (V:Prim 'trfkOf (list (V:Var state)))))
    770                                                      )
    771                                                    (E:Seq
    772                                                     (list
    773                                                      (E:Ret (V:Prim 'trfSet  (list (V:Var state) (V:Var 'fk))))
    774                                                      (E:Ret (V:Prim 'trfkSet (list (V:Var state) (V:Var 'f))))
    775                                                      )))
    776                                             (E:Noop))
    777 
    778                                      (E:Ret
    779                                       (V:Ifv (V:Var 'trp) (fkblend 'fv) (fblend 'fv)))
    780 
    781                                      )))
    782                             ))
    783                ))
    784              
    785              (codegen-state)))
    786            
    787            
    788            (make-codegen
    789             rv
    790             (cgenenv-union (codegen-renv fcodegen) (codegen-renv fkcodegen))
    791             (list
    792              (E:Val rv
    793                     (V:Prim blender (cons (V:Var state)
    794                                           (map (lambda (s) (V:Sel s (V:Var (cgenenv-find 'rtransition22 s env))))
    795                                                blender-inputs)))))
    796             )))
    797        ;; signature
    798        `(RTRANSITION ,f ,fk ,e ,ek)
    799        ))))
     788           (codegen-state)))
     789         
     790         
     791         (make-codegen
     792          rv
     793          (cgenenv-union (codegen-renv fcodegen) (codegen-renv fkcodegen))
     794          (list
     795           (E:Val rv
     796                  (V:Prim blender (cons (V:Var state)
     797                                        (map (lambda (s) (V:Sel s (V:Var (cgenenv-find 'rtransition22 s env))))
     798                                             blender-inputs)))))
     799          )))
     800     
     801     ;; signature
     802     `(RTRANSITION ,f ,fk ,e ,ek)
     803     )))
    800804
    801805(define (sf-rtransition f fk e ek )  (sf-rtransition0 f fk e ek ))
    802806
     807;; One-time state transition
     808
     809(define (sf-transition f fk ev)  (sf-rtransition0 f fk ev #f))
    803810
    804811
     
    879886                  ))
    880887           ))
     888
    881889       ;; signature
    882890       `(LOOP ,p ,f)
     
    10061014         (LOOP (s f)      (sf-loop s (construct f)))
    10071015         (RTRANSITION (f g ef eg)  (sf-rtransition (construct f) (construct g) ef eg))
     1016         (TRANSITION (f g ef)      (sf-transition (construct f) (construct g) ef))
    10081017         (D  (x y f)      (sf-diff x y (construct f)))
    10091018         (Dh (x y h f)    (sf-diffh x y h (construct f)))
     
    11801189(define NONE #f)
    11811190(define SOME identity)
     1191
     1192(define false #f)
     1193(define true  #t)
     1194
    11821195(define equal equal?)
    11831196(define (swap x v) (or v x))
     
    14851498
    14861499
    1487 (define (sf-transition0 f fk ev . rest)
    1488   (let* ((fe      (sfarrow-dfe f))
    1489          (fke     (sfarrow-dfe fk))
    1490          
    1491          (fe-in   (dfe-in fe))   
    1492          (fe-out  (compose (dfe-out fe)  fe-in))
    1493          (fe-gen  (compose (dfe-gen fe)  fe-in))
    1494          (fe-kill (compose (dfe-kill fe) fe-in))
    1495          
    1496          (fke-in   (compose (dfe-in fke) (lambda (s) (lset-union eq? (fe-out s) s))))
    1497          (fke-out  (compose (dfe-out fke) fke-in))
    1498          (fke-gen  (compose (dfe-gen fke) fke-in))
    1499          (fke-kill (compose (dfe-gen fke) fke-in))
    1500          
    1501          )
    1502 
    1503   (let-optionals rest ((ef f) (transitioned? #f))
    1504 
    1505     (make-sfarrow
    1506 
    1507      ;; dataflow equations
    1508      (make-dfe
    1509       ;; gen
    1510       (lambda (s) (lset-union eq? (fe-gen s) (fke-gen s)))
    1511      
    1512       ;; kill
    1513       (lambda (s) (lset-union eq? (fe-kill s) (fke-kill s)))
    1514      
    1515       ;; in
    1516       (lambda (s) (lset-union eq? (fe-in s) (fke-in s)))
    1517      
    1518       ;; out
    1519       (lambda (s) (lset-union eq? (fe-out s) (fke-out s))))
    1520 
    1521      ;; codegen
    1522      (lambda (s env dfe)
    1523        (let* (
    1524               (rv    (gensym 'phi))
    1525               (fe    (gensym 'fe))
    1526               (state (gensym 'sphi))
    1527 
    1528               (fenv  (list->cgenenv 'transition11 (fe-in s) env))
    1529               (fkenv  (list->cgenenv 'transition12 (fke-in s) env))
    1530 
    1531               (fcodegen  ((sfarrow-codegen f)  (fe-in s) fenv (sfarrow-dfe f)))
    1532               (fkcodegen ((sfarrow-codegen fk) (fke-in s) fkenv (sfarrow-dfe fk)))
    1533               )
    1534 
    1535            (codegen-state
    1536             (append
    1537              (reverse
    1538               (list
    1539                (E:Val state (V:Stv (V:C 'NONE)))
    1540                (E:Val fe
    1541                       (V:Fn (cons state (fe-in s))
    1542                             (E:Ife (V:Prim 'equal (list (V:Ldv (V:Var state)) (V:C 'NONE)))
    1543                                    (E:Let (codegen-expr fcodegen)
    1544                                           (E:Seq
    1545                                            (list
    1546                                             (E:Ife (V:Prim 'equal (list (V:Var ev) (V:C 'NONE)))
    1547                                                    (E:Noop)
    1548                                                    (E:Set (V:Var state) (V:Var ev)))
    1549                                             (E:Ret (V:Var (codegen-rv fcodegen)))
    1550                                             )))
    1551                                    (E:Let (codegen-expr fkcodegen)
    1552                                           (E:Ret (V:Var (codegen-rv fkcodegen)))))))
    1553                ))
    1554              (codegen-state)
    1555              ))
    1556            
    1557            (make-codegen
    1558             rv
    1559             (cgenenv-union (codegen-renv fcodegen) (codegen-renv fkcodegen))
    1560             (list (E:Val rv (V:Prim fe (cons (V:Var state)
    1561                                              (map (lambda (s) (select-signal 'transition s env))
    1562                                                   ((dfe-in dfe) s)))))))
    1563 
    1564            ))
    1565      ))))
    1566 
    1567 (define (sf-transition f fk ev)  (sf-transition0 f fk ev))
    1568 
    15691500(define-values (sigenv-fresh sigenv-empty sigenv-map
    15701501                sigenv-add sigenv-union sigenv-partition
Note: See TracChangeset for help on using the changeset viewer.