Changeset 30916 in project


Ignore:
Timestamp:
05/25/14 11:35:25 (6 years ago)
Author:
Ivan Raikov
Message:

signal-diagram: added ON combinator

Location:
release/4/signal-diagram/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/signal-diagram/trunk/expr-utils.scm

    r30104 r30916  
    3838         (V:Var 'null))
    3939        (else
    40          (error 'sexp->value "invalid value s-expression" sexp))))
     40         (error 'sexp->value "invalid value s-expression" sexp)))
     41  )
    4142
    4243
  • release/4/signal-diagram/trunk/signal-diagram.scm

    r30882 r30916  
    3434         SENSE ACTUATE SEQUENCE UNION REDUCE
    3535         INTEGRAL INTEGRALH
    36          TRANSITION RTRANSITION TRANSIENT
     36         TRANSITION RTRANSITION TRANSIENT ON
    3737
    3838         function? make-function function-formals function-body
     
    4444
    4545         construct dataflow events codegen/Octave codegen/scheme codegen/ML
     46
    4647         )
    4748
     
    200201  (TRANSITION   (f diagram?) (g diagram?) (ef symbol?) (s symbol?))
    201202  (TRANSIENT    (f diagram?) (g diagram?) (e symbol?) )
     203  (ON           (f diagram?) (e symbol?) )
    202204  (INTEGRAL     (i symbol?) (d symbol-list?) (f function-list?))
    203205  (INTEGRALH    (i symbol?) (d symbol-list?) (h (lambda (x) (or (symbol? x) (number? x))))
     
    268270              )
    269271
    270 
    271272          (make-codegen
    272273           rv2
     
    278279                  ((prim? fd)
    279280                   (list (prim->expr name fd) ))
    280                   (else '()))
     281                  (else (error 'sf "unknown function object" fd)))
    281282
    282283            (cond ((function? fd)
     
    301302                     )
    302303                 
    303                   (else '())
     304                  (else (error 'sf "unknown function object" fd))
    304305                  )
    305306            ))
     
    600601               (rv  (gensym 'sequence))
    601602               )
    602  
     603
    603604          (make-codegen
    604605           rv
     
    618619      ;; relations
    619620      (append (sfarrow-relations f) (sfarrow-relations g))
     621      )))
     622
     623
     624;; The [on] combinator takes the value of f when b is true, otherwise
     625;; it is equivalent to identity
     626
     627(define (sf-on f e)
     628
     629   (let* ((fe      (sfarrow-dfe f))
     630
     631          (fe-in   (dfe-in fe))   
     632          (fe-out  (compose (dfe-out fe) fe-in))
     633          (fe-gen  (compose (dfe-gen fe) fe-in))
     634          (fe-kill (compose (dfe-kill fe) fe-in))
     635
     636          )
     637
     638     (make-sfarrow
     639     
     640      ;; dataflow equations
     641      (make-dfe
     642       ;; gen
     643       (lambda (s) (fe-gen s))
     644       
     645       ;; kill
     646       (lambda (s) ((dfe-kill fe) s))
     647       
     648       ;; in
     649       (lambda (s)  (lset-union eq? (fe-in s)
     650                                (lset-union eq? (fe-out s) (list e))))
     651       
     652       ;; out
     653       (lambda (s) (lset-union eq? (fe-out s) (list e)))
     654       
     655       )
     656
     657      ;; codegen
     658      (lambda (s env dfe)
     659        (let* (
     660               
     661               (fenv (list->cgenenv 'on1 (fe-in s) env))
     662               (fcodegen ((sfarrow-codegen f) (fe-in s) fenv fe))
     663
     664               (fld  (lambda (codegen)
     665                       (let ((renv (codegen-renv codegen)))
     666                         (lambda (x)
     667                           (list x (select-signal 'on2 x renv))))))
     668               
     669               (ev (select-signal 'on3 e env))
     670
     671               (rv  (gensym 'onrv))
     672               (onf (gensym 'onf))
     673               )
     674
     675          (make-codegen
     676           rv
     677           (fold (lambda (name env) (cgenenv-add name rv env)) cgenenv-empty ((dfe-out dfe) s))
     678           (list
     679            (B:Val onf (V:Fn (fe-in s)
     680                             (E:Let (append
     681                                     (relations-codegen f env)
     682                                     (codegen-expr fcodegen))
     683                                    (E:Ret (V:Rec (delete-duplicates
     684                                                   (cons (list e ev) (map (fld fcodegen) (fe-out s)))))))))
     685            (B:Val rv  (V:Ifv ev
     686                              (V:Op onf (map (lambda (x) (select-signal 'on4 x env)) (fe-in s)))
     687                              (V:Rec (delete-duplicates
     688                                      (cons (list e ev) (map (lambda (x) (list x (select-signal 'on5 x env)))
     689                                                             ((dfe-out dfe) s)))))))
     690            ))
     691          ))
     692      ;; signature
     693      `(ON ,(sfarrow-sig f) ,e)
     694      ;; children
     695      `(ON ,f)
     696      ;; relations
     697      (sfarrow-relations f)
    620698      )))
    621699
     
    13091387         (TRANSITION (f g ef s)      (sf-transition (construct1 f) (construct1 g) ef s))
    13101388         (TRANSIENT (f g e)          (sf-transient (construct1 f) (construct1 g) e))
     1389         (ON (f e)                   (sf-on (construct1 f) e))
    13111390         (INTEGRAL  (x ys fs)        (sf-integral x ys fs))
    13121391         (INTEGRALH (x ys h fs)      (sf-integralh x ys h fs))
     
    13371416             (fold recur ax1 (cdr (sfarrow-children f)))
    13381417             )))
     1418        ((ON)
     1419         (let ((e (third sig)))
     1420           (let* ((ax1 (cons e ax)))
     1421             (fold recur ax1 (cdr (sfarrow-children f)))
     1422             )))
    13391423        ((SF)
    13401424         (let ((evs (fifth sig)))
    1341            (append evs ax)))
     1425           (if (null? evs) ax (append evs ax))))
    13421426        (else (fold recur ax (cdr (sfarrow-children f))))
    13431427        ))
  • release/4/signal-diagram/trunk/signal-diagram.setup

    r30878 r30916  
    44  (make-pathname #f fn ##sys#load-dynamic-extension))   
    55
    6 (define version 3.2)
     6(define version 3.4)
    77
    88(use make)
Note: See TracChangeset for help on using the changeset viewer.