Ur/Web Examples
Check-in [7a264a41b0]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:add liftS3 / liftS3' to composableSignals library, with examples provided
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7a264a41b0e95c2006b2a452ce25e309580085f7
User & Date: beyert 2016-08-17 05:40:50
Context
2016-08-17
05:59
make composableSignals demo interactive to better illustrate the benefits of signal lifting check-in: c4437d6ed0 user: beyert tags: trunk
05:40
add liftS3 / liftS3' to composableSignals library, with examples provided check-in: 7a264a41b0 user: beyert tags: trunk
05:23
adjust composableSignals API check-in: 224be5ae9a user: beyert tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to composableSignals/composableSignals.ur.

13
14
15
16
17
18
19
20
21
22
23
24







25
26
27
28
29
30
31
32
33
34
35
36





37
38
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55




56
57
58

59



60
61

62
63
64
65
66
67
68
69
  s' <- s;
  pure (f s')

fun liftS [a] [b] (f: a -> b) (s: signal a) : signal b =
  s' <- s;
  pure (f s')

fun liftS2 [a] [b] [c] (f: a -> b -> c)
                       (s1: signal a) (s2: signal b) : signal c =
  s1' <- s1;
  s2' <- s2;
  pure (f s1' s2')








(* variations on the above functions with raw signals passed directly to (and
returned by) the function argument *)
fun mapS' [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS' [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS2' [a] [b] [c] (f: signal a -> signal b -> signal c)
                       (s1: signal a) (s2: signal b) : signal c =
  f s1 s2






fun main () : transaction page =
  srcN <- source (0: int);
  srcX <- source (3: int);
  srcY <- source (2: int);

  return <xml><head>
    <title>Test of map and lifted signals</title>
    </head>
    <body>

      <dyn signal={s' <- mapS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn sx sy => x <- sx; y <- sy;
                                    return (x + y)) (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn sx sy => x <- sx; y <- sy;
                                    pure (x * y)) (s srcX) (s srcY);




                   return <xml>{[x']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>

      <dyn signal={x' <- liftS2 (fn x y => x * y) (s srcX) (s srcY);



                   y' <- liftS (fn x => x + 11) (pure x');
                   return <xml>{[x']} {[y']}</xml>}/>

      <dyn signal={s' <- liftS (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- mapS (fn x => x - 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
    </body>
    </xml>







|
|



>
>
>
>
>
>
>









|
|

>
>
>
>
>










>




|
|


|
>
>
>
>



>
|
>
>
>
|
<
>








13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

82
83
84
85
86
87
88
89
90
  s' <- s;
  pure (f s')

fun liftS [a] [b] (f: a -> b) (s: signal a) : signal b =
  s' <- s;
  pure (f s')

fun liftS2 [a] [b] [c] (f: a -> b -> c) (s1: signal a) (s2: signal b) :
                       signal c =
  s1' <- s1;
  s2' <- s2;
  pure (f s1' s2')

fun liftS3 [a] [b] [c] [d] (f: a -> b -> c -> d) (s1: signal a) (s2: signal b)
                           (s3: signal c) : signal d =
  s1' <- s1;
  s2' <- s2;
  s3' <- s3;
  pure (f s1' s2' s3')

(* variations on the above functions with raw signals passed directly to (and
returned by) the function argument *)
fun mapS' [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS' [a] [b] (f: signal a -> signal b) (s: signal a) : signal b =
  f s

fun liftS2' [a] [b] [c] (f: signal a -> signal b -> signal c) (s1: signal a)
                        (s2: signal b) : signal c =
  f s1 s2

fun liftS3' [a] [b] [c] [d] (f: signal a -> signal b -> signal c -> signal d)
                            (s1: signal a) (s2: signal b) (s3: signal c) :
                            signal d =
  f s1 s2 s3

fun main () : transaction page =
  srcN <- source (0: int);
  srcX <- source (3: int);
  srcY <- source (2: int);

  return <xml><head>
    <title>Test of map and lifted signals</title>
    </head>
    <body>
      <h2>part one</h2>
      <dyn signal={s' <- mapS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn sx sy => x <- sx; y <- sy; pure (x + y))
                                 (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={x' <- liftS2' (fn sx sy => x <- sx; y <- sy;
                                   pure (x * y)) (s srcX) (s srcY);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={x' <- liftS3' (fn sx sy sz => x <- sx; y <- sy; z <- sz;
                                   pure (x * y * z)) (s srcX) (s srcY)
                                 (s srcN);
                   return <xml>{[x']}</xml>}/>
      <dyn signal={s' <- liftS' (fn x => y <- x; pure (y + 1)) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <h2>part two</h2>
      <dyn signal={w' <- liftS2 (fn x y => x * y) (s srcX) (s srcY);
                   x' <- liftS (fn x => x * 2) (pure w');
                   y' <- liftS3 (fn x y z => x * y * z)
                                (pure w') (s srcX) (pure x');
                   z' <- liftS (fn x => x + 11) (pure y');

                   return <xml>{[w']} {[x']} {[y']} {[z']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- mapS (fn x => x - 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
      <dyn signal={s' <- liftS (fn x => x + 1) (s srcN);
                   return <xml>{[s']}</xml>}/>
    </body>
    </xml>