├── .gitignore
├── LICENSE
├── README.md
├── examples
├── average.idr
├── averageEff.idr
└── integration.idr
├── farrp.ipkg
└── src
├── FarRP.idr
├── FarRP
├── Combinators.idr
├── Core.idr
├── DecDesc.idr
├── SigVect.idr
└── Time.idr
└── idris_farrp_time.h
/.gitignore:
--------------------------------------------------------------------------------
1 | *.ibc
2 | *~
3 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU LESSER GENERAL PUBLIC LICENSE
2 | Version 3, 29 June 2007
3 |
4 | Copyright (C) 2007 Free Software Foundation, Inc.
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 |
9 | This version of the GNU Lesser General Public License incorporates
10 | the terms and conditions of version 3 of the GNU General Public
11 | License, supplemented by the additional permissions listed below.
12 |
13 | 0. Additional Definitions.
14 |
15 | As used herein, "this License" refers to version 3 of the GNU Lesser
16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU
17 | General Public License.
18 |
19 | "The Library" refers to a covered work governed by this License,
20 | other than an Application or a Combined Work as defined below.
21 |
22 | An "Application" is any work that makes use of an interface provided
23 | by the Library, but which is not otherwise based on the Library.
24 | Defining a subclass of a class defined by the Library is deemed a mode
25 | of using an interface provided by the Library.
26 |
27 | A "Combined Work" is a work produced by combining or linking an
28 | Application with the Library. The particular version of the Library
29 | with which the Combined Work was made is also called the "Linked
30 | Version".
31 |
32 | The "Minimal Corresponding Source" for a Combined Work means the
33 | Corresponding Source for the Combined Work, excluding any source code
34 | for portions of the Combined Work that, considered in isolation, are
35 | based on the Application, and not on the Linked Version.
36 |
37 | The "Corresponding Application Code" for a Combined Work means the
38 | object code and/or source code for the Application, including any data
39 | and utility programs needed for reproducing the Combined Work from the
40 | Application, but excluding the System Libraries of the Combined Work.
41 |
42 | 1. Exception to Section 3 of the GNU GPL.
43 |
44 | You may convey a covered work under sections 3 and 4 of this License
45 | without being bound by section 3 of the GNU GPL.
46 |
47 | 2. Conveying Modified Versions.
48 |
49 | If you modify a copy of the Library, and, in your modifications, a
50 | facility refers to a function or data to be supplied by an Application
51 | that uses the facility (other than as an argument passed when the
52 | facility is invoked), then you may convey a copy of the modified
53 | version:
54 |
55 | a) under this License, provided that you make a good faith effort to
56 | ensure that, in the event an Application does not supply the
57 | function or data, the facility still operates, and performs
58 | whatever part of its purpose remains meaningful, or
59 |
60 | b) under the GNU GPL, with none of the additional permissions of
61 | this License applicable to that copy.
62 |
63 | 3. Object Code Incorporating Material from Library Header Files.
64 |
65 | The object code form of an Application may incorporate material from
66 | a header file that is part of the Library. You may convey such object
67 | code under terms of your choice, provided that, if the incorporated
68 | material is not limited to numerical parameters, data structure
69 | layouts and accessors, or small macros, inline functions and templates
70 | (ten or fewer lines in length), you do both of the following:
71 |
72 | a) Give prominent notice with each copy of the object code that the
73 | Library is used in it and that the Library and its use are
74 | covered by this License.
75 |
76 | b) Accompany the object code with a copy of the GNU GPL and this license
77 | document.
78 |
79 | 4. Combined Works.
80 |
81 | You may convey a Combined Work under terms of your choice that,
82 | taken together, effectively do not restrict modification of the
83 | portions of the Library contained in the Combined Work and reverse
84 | engineering for debugging such modifications, if you also do each of
85 | the following:
86 |
87 | a) Give prominent notice with each copy of the Combined Work that
88 | the Library is used in it and that the Library and its use are
89 | covered by this License.
90 |
91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license
92 | document.
93 |
94 | c) For a Combined Work that displays copyright notices during
95 | execution, include the copyright notice for the Library among
96 | these notices, as well as a reference directing the user to the
97 | copies of the GNU GPL and this license document.
98 |
99 | d) Do one of the following:
100 |
101 | 0) Convey the Minimal Corresponding Source under the terms of this
102 | License, and the Corresponding Application Code in a form
103 | suitable for, and under terms that permit, the user to
104 | recombine or relink the Application with a modified version of
105 | the Linked Version to produce a modified Combined Work, in the
106 | manner specified by section 6 of the GNU GPL for conveying
107 | Corresponding Source.
108 |
109 | 1) Use a suitable shared library mechanism for linking with the
110 | Library. A suitable mechanism is one that (a) uses at run time
111 | a copy of the Library already present on the user's computer
112 | system, and (b) will operate properly with a modified version
113 | of the Library that is interface-compatible with the Linked
114 | Version.
115 |
116 | e) Provide Installation Information, but only if you would otherwise
117 | be required to provide such information under section 6 of the
118 | GNU GPL, and only to the extent that such information is
119 | necessary to install and execute a modified version of the
120 | Combined Work produced by recombining or relinking the
121 | Application with a modified version of the Linked Version. (If
122 | you use option 4d0, the Installation Information must accompany
123 | the Minimal Corresponding Source and Corresponding Application
124 | Code. If you use option 4d1, you must provide the Installation
125 | Information in the manner specified by section 6 of the GNU GPL
126 | for conveying Corresponding Source.)
127 |
128 | 5. Combined Libraries.
129 |
130 | You may place library facilities that are a work based on the
131 | Library side by side in a single library together with other library
132 | facilities that are not Applications and are not covered by this
133 | License, and convey such a combined library under terms of your
134 | choice, if you do both of the following:
135 |
136 | a) Accompany the combined library with a copy of the same work based
137 | on the Library, uncombined with any other library facilities,
138 | conveyed under the terms of this License.
139 |
140 | b) Give prominent notice with the combined library that part of it
141 | is a work based on the Library, and explaining where to find the
142 | accompanying uncombined form of the same work.
143 |
144 | 6. Revised Versions of the GNU Lesser General Public License.
145 |
146 | The Free Software Foundation may publish revised and/or new versions
147 | of the GNU Lesser General Public License from time to time. Such new
148 | versions will be similar in spirit to the present version, but may
149 | differ in detail to address new problems or concerns.
150 |
151 | Each version is given a distinguishing version number. If the
152 | Library as you received it specifies that a certain numbered version
153 | of the GNU Lesser General Public License "or any later version"
154 | applies to it, you have the option of following the terms and
155 | conditions either of that published version or of any later version
156 | published by the Free Software Foundation. If the Library as you
157 | received it does not specify a version number of the GNU Lesser
158 | General Public License, you may choose any version of the GNU Lesser
159 | General Public License ever published by the Free Software Foundation.
160 |
161 | If the Library as you received it specifies that a proxy can decide
162 | whether future versions of the GNU Lesser General Public License shall
163 | apply, that proxy's public statement of acceptance of any version is
164 | permanent authorization for you to choose that version for the
165 | Library.
166 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # FarRP
3 |
4 | FarRP is an arrowized FRP library for Idris which uses dependent types to
5 | provide static guarantees. It is based on Neil Sculthorpe and Henrik Nilsson's
6 | paper ["Safe Functional Reactive Programming through Dependent Types"](http://www.cs.rhul.ac.uk/home/ucac009/publications/safe-FRP-types.pdf).
7 |
8 | ## Contributing
9 |
10 | Contributions in the form of pull requests, bug reports, and thoughts on how to
11 | improve this library would be most appreciated. In particular there are several
12 | open problems that could be worked on.
13 |
14 | - Making stepSF total. Currently the case for SFLoop uses non-terminating
15 | recursion. This is probably the most pressing issue.
16 |
17 | - Verifying that the implementation follows the semantics given in the paper.
18 | When implementing this system I didn't pay strict attention to the formal
19 | semantics, but it should be verified that these semantics are followed.
20 |
21 | - Raising functions with pi types (e.g. (x : a) -> P x) to the SF level. This is
22 | a long term goal.
23 |
24 | I should stress that bug reports would be most helpful, especially considering
25 | how new this library is.
26 |
27 | ## Examples
28 |
29 | Examples can be found in the examples/ directory. An example session of running
30 | an example is given below.
31 |
32 | ```
33 | > idris --build farrp.ipkg
34 | Entering directory `./src'
35 | Type checking ./FarRP/Time.idr
36 | Type checking ./FarRP/SigVect.idr
37 | Type checking ./FarRP/DecDesc.idr
38 | Type checking ./FarRP/Core.idr
39 | Type checking ./FarRP/Combinators.idr
40 | Type checking ./FarRP.idr
41 | Leaving directory `./src'
42 |
43 | > cd examples
44 | > idris average.idr -i ../src -o avg
45 | > ./avg
46 | 1
47 | 1
48 | 2
49 | 1.5
50 | 3
51 | 2
52 | 4
53 | 2.5
54 | 5
55 | 3
56 | ^C
57 | ```
58 |
59 | # License
60 |
61 | Copyright (C) 2018 Taran Lynn <>
62 |
63 | This library is licensed under the LGPLv3 (see LICENSE file).
64 |
--------------------------------------------------------------------------------
/examples/average.idr:
--------------------------------------------------------------------------------
1 | {-
2 | This program simply computes the average of a set of given inputs.
3 | -}
4 |
5 | import FarRP
6 | import FarRP.Time
7 |
8 | import Data.String
9 |
10 |
11 | sum' : SF [E Double] [E Double] Cau
12 | sum' = evFold 0 (+)
13 |
14 | count : SF [E Double] [E Double] Cau
15 | count = evFold 0 (\_, acc => acc + 1)
16 |
17 | average : SF [E Double] [E Double] Cau
18 | average = (sum' &&& count) >>> merge (\x, y => x / y)
19 |
20 | loop : SF [E Double] [E Double] Cau -> DiffTimer -> IO ()
21 | loop sf diffTimer = do str <- getLine
22 | case parseDouble str of
23 | Nothing => putStrLn "Couldn't parse input"
24 | Just x => do (dt, diffTimer') <- stepDiffTimer' diffTimer
25 | let (sf', avg) = stepSFE sf dt x
26 | case eHead avg of
27 | Nothing => pure ()
28 | Just x => printLn x
29 | loop sf' diffTimer'
30 |
31 | main : IO ()
32 | main = do diffTimer <- newDiffTimer'
33 | loop average diffTimer
34 |
--------------------------------------------------------------------------------
/examples/averageEff.idr:
--------------------------------------------------------------------------------
1 | {-
2 | This program simply computes the average of a set of given inputs.
3 | This version uses the effects library.
4 | -}
5 |
6 | import FarRP
7 | import FarRP.Time
8 |
9 | import Effects
10 | import Effect.StdIO
11 | import Data.String
12 |
13 |
14 | sum' : SF [E Double] [E Double] Cau
15 | sum' = evFold 0 (+)
16 |
17 | count : SF [E Double] [E Double] Cau
18 | count = evFold 0 (\_, acc => acc + 1)
19 |
20 | average : SF [E Double] [E Double] Cau
21 | average = (sum' &&& count) >>> merge (\x, y => x / y)
22 |
23 | loop : SF [E Double] [E Double] Cau -> DiffTimer -> Eff () [STDIO, TIME]
24 | loop sf diffTimer = do str <- getStr
25 | case parseDouble str of
26 | Nothing => putStrLn "Couldn't parse input"
27 | Just x => do (dt, diffTimer') <- stepDiffTimer diffTimer
28 | let (sf', avg) = stepSFE sf dt x
29 | case eHead avg of
30 | Nothing => pure ()
31 | Just x => printLn x
32 | loop sf' diffTimer'
33 |
34 | main' : Eff () [STDIO, TIME]
35 | main' = do diffTimer <- newDiffTimer
36 | loop average diffTimer
37 |
38 | main : IO ()
39 | main = run $ main'
40 |
--------------------------------------------------------------------------------
/examples/integration.idr:
--------------------------------------------------------------------------------
1 | {-
2 | This program simply integrates over a set of given inputs with respect to time.
3 | -}
4 |
5 | import FarRP
6 | import FarRP.Time
7 |
8 | import Effects
9 | import Effect.StdIO
10 | import Data.String
11 |
12 |
13 | loop : SF [C Ini Double] [C Ini Double] Cau -> DiffTimer -> Eff () [STDIO, TIME]
14 | loop sf diffTimer = do str <- getStr
15 | case parseDouble str of
16 | Nothing => putStrLn "Couldn't parse input"
17 | Just x => do (dt, diffTimer') <- stepDiffTimer diffTimer
18 | let (sf', CCons v _) = stepSFC sf dt x
19 | printLn v
20 | loop sf' diffTimer'
21 |
22 | main' : Eff () [STDIO, TIME]
23 | main' = do diffTimer <- newDiffTimer
24 | loop (integrate 0) diffTimer
25 |
26 | main : IO ()
27 | main = run $ main'
28 |
--------------------------------------------------------------------------------
/farrp.ipkg:
--------------------------------------------------------------------------------
1 | package farrp
2 |
3 | sourcedir = src
4 |
5 | modules = FarRP
6 | , FarRP.Core
7 | , FarRP.Combinators
8 | , FarRP.DecDesc
9 | , FarRP.SigVect
10 | , FarRP.Time
11 |
12 | pkgs = effects
13 |
14 | objs = idris_farrp_time.h
15 |
--------------------------------------------------------------------------------
/src/FarRP.idr:
--------------------------------------------------------------------------------
1 |
2 | module FarRP
3 |
4 | import public FarRP.Core
5 | import public FarRP.Combinators
6 | import public FarRP.DecDesc
7 | import public FarRP.SigVect
8 |
--------------------------------------------------------------------------------
/src/FarRP/Combinators.idr:
--------------------------------------------------------------------------------
1 |
2 | module FarRP.Combinators
3 |
4 | import FarRP.Core
5 | import FarRP.DecDesc
6 | import FarRP.SigVect
7 | import FarRP.Time
8 |
9 |
10 | %access export
11 | %default total
12 |
13 |
14 | -- Basic Combinators
15 |
16 | pure : (a -> b) -> SF [C i a] [C i b] Cau
17 | pure {i} f = SFPrim (pure' i) ()
18 | where
19 | pure' Ini dt () (CCons x xs) = ((), CCons (f x) xs)
20 | pure' Uni dt () (CCons x xs) = ((), CCons (f x) xs)
21 | pure' Uni dt () (UnInitCons xs) = ((), UnInitCons xs)
22 |
23 | pureE : (a -> b) -> SF [E a] [E b] Cau
24 | pureE f = SFPrim pureE' ()
25 | where
26 | pureE' dt () (ECons x xs) = ((), ECons (map f x) xs)
27 |
28 | constant : b -> SF as [C Ini b] Dec
29 | constant x = SFDPrim (\_, _ => (const (), CCons x SVRNil)) ()
30 |
31 | join : (a -> b -> c) -> SF (C Ini a :: C Ini b :: as) (C Ini c :: as) Cau
32 | join f = SFPrim join' ()
33 | where
34 | join' _ _ (CCons x (CCons y xs)) = ((), CCons (f x y) xs)
35 |
36 | ||| Merges two event streams, using the given function to combine values that
37 | ||| occur at the same time.
38 | merge : (a -> a -> a) -> SF (E a :: E a :: xs) (E a :: xs) Cau
39 | merge {a} f = SFPrim merge' ()
40 | where
41 | merge'' : Maybe a -> Maybe a -> Maybe a
42 | merge'' Nothing Nothing = Nothing
43 | merge'' (Just x) Nothing = Just x
44 | merge'' Nothing (Just y) = Just y
45 | merge'' (Just x) (Just y) = Just (f x y)
46 |
47 | merge' _ _ (ECons x (ECons y xs)) = ((), ECons (merge'' x y) xs)
48 |
49 |
50 | -- Combinator Operators
51 |
52 | infixl 9 >>>
53 | (>>>) : SF as bs d1 -> SF bs cs d2 -> SF as cs (d1 /\ d2)
54 | (>>>) = SFComp
55 |
56 | infixr 9 <<<
57 | (<<<) : SF bs cs d2 -> SF as bs d1 -> SF as cs (d1 /\ d2)
58 | (<<<) = flip SFComp
59 |
60 | infixr 3 ***
61 | (***) : SF as bs d1 -> SF cs ds d2 -> SF (as ++ cs) (bs ++ ds) (d1 \/ d2)
62 | (***) = SFPair
63 |
64 | infixr 3 &&&
65 | (&&&) : SF as bs d1 -> SF as cs d2 -> SF as (bs ++ cs) (d1 \/ d2)
66 | (&&&) sf1 sf2 = replace cauMeet (double >>> (sf1 *** sf2))
67 | where
68 | double : SF as (as ++ as) Cau
69 | double = SFPrim (\_, _, svr => ((), svr ++ svr)) ()
70 |
71 |
72 | -- Event Combinators
73 |
74 | ||| Never produces a signal output.
75 | never : SF as [E b] Dec
76 | never = SFDPrim (\_, _ => (\_ => (), eEmpty)) ()
77 |
78 | ||| Produces a signal output now, but never again.
79 | now : SF as [E Unit] Dec
80 | now = SFDPrim now' True
81 | where
82 | now' _ True = (const False, eSingle ())
83 | now' _ False = (const False, eEmpty)
84 |
85 | ||| Produces an event whenever the input changes from False to True.
86 | edge : SF [C Ini Bool] [E Unit] Cau
87 | edge = SFPrim edge' False
88 | where
89 | edge' _ False (CCons True xs) = (True, ECons (Just ()) xs)
90 | edge' _ _ (CCons x xs) = (x, ECons Nothing xs)
91 |
92 | hold : a -> SF [E a] [C Ini a] Cau
93 | hold x = SFPrim hold' x
94 | where
95 | hold' _ _ (ECons (Just x') xs) = (x', CCons x' xs)
96 | hold' _ x' (ECons Nothing xs) = (x', CCons x' xs)
97 |
98 | evFold : b -> (a -> b -> b) -> SF [E a] [E b] Cau
99 | evFold x f = SFPrim evFold' x
100 | where
101 | evFold' _ x (ECons Nothing xs) = (x, ECons Nothing xs)
102 | evFold' _ x (ECons (Just x') xs) = let r = f x' x
103 | in (r, ECons (Just r) xs)
104 |
105 |
106 | -- Pre Combinators
107 |
108 | ||| Delays a signal for the smallest possible time. Must be initialized.
109 | pre : SF [C Ini a] [C Uni a] Dec
110 | pre = SFDPrim pre' Nothing
111 | where
112 | pre' : DTime -> Maybe (SVRep [C Ini a])
113 | -> (SVRep [C Ini a] -> Maybe (SVRep [C Ini a]), SVRep [C Uni a])
114 | pre' _ Nothing = (Just, UnInitCons SVRNil)
115 | pre' _ (Just (CCons x xs)) = (Just, (CCons x xs))
116 |
117 | ||| Initializes an input signal with a starting value.
118 | initialize' : b -> SF [C Uni b] [C Ini b] Cau
119 | initialize' x = SFPrim init' ()
120 | where
121 | init' _ _ (CCons x' xs) = ((), CCons x' xs)
122 | init' _ _ (UnInitCons xs) = ((), CCons x xs)
123 |
124 | ||| Initializes an SF with a starting value.
125 | initialize : b -> SF as [C i b] d -> SF as [C Ini b] d
126 | initialize {i=Ini} x sf = sf
127 | initialize {i=Uni} x sf = replace (trans meetSym cauMeet)
128 | (sf >>> initialize' x)
129 |
130 |
131 | -- Integration and Differentiation Combinators
132 |
133 | ||| Integrates the input signal over time.
134 | integrate : Double -> SF [C Ini Double] [C Ini Double] Cau
135 | integrate c = SFPrim integ' c
136 | where
137 | integ' dt c (CCons x xs) = let r = x * (dtimeToDouble dt) + c
138 | in (r, CCons r xs)
139 |
140 | ||| Differentiates the input signal with respect to time.
141 | diff : SF [C Ini Double] [C Ini Double] Cau
142 | diff = SFPrim diff' ()
143 | where
144 | diff' dt _ (CCons x xs) = ((), CCons (x * dtimeToDouble dt) xs)
145 |
--------------------------------------------------------------------------------
/src/FarRP/Core.idr:
--------------------------------------------------------------------------------
1 |
2 | module FarRP.Core
3 |
4 | import FarRP.DecDesc
5 | import FarRP.SigVect
6 | import FarRP.Time
7 |
8 |
9 | %access export
10 | %default total
11 |
12 |
13 | ||| A state function, which can be abstractly thought of as `(Time -> SVRep as)
14 | ||| -> (Time -> SVRep bs)`.
15 | public export
16 | data SF : SVDesc -> SVDesc -> DecDesc -> Type where
17 | SFPrim : {State : Type} -> (DTime -> State -> SVRep as -> (State, SVRep bs))
18 | -> State -> SF as bs Cau
19 |
20 | ||| Conceptually, the type of this should be SF as bs Dec, but since Dec <:
21 | ||| Cau it may also have the type SF as bs Cau.
22 | SFDPrim : {State : Type} -> (DTime -> State -> (SVRep as -> State, SVRep bs))
23 | -> State -> SF as bs d
24 |
25 | SFComp : SF as bs d1 -> SF bs cs d2 -> SF as cs (d1 /\ d2)
26 |
27 | SFPair : SF as bs d1 -> SF cs ds d2 -> SF (as ++ cs) (bs ++ ds) (d1 \/ d2)
28 |
29 | SFLoop : SF (as ++ cs) (bs ++ ds) d -> SF ds cs Dec -> SF as bs d
30 |
31 | SFSwitch : SF as (E e :: bs) d1 -> (e -> SF as bs d2) -> SF as bs (d1 \/ d2)
32 |
33 | SFDSwitch : SF as (E e :: bs) d1 -> (e -> SF as bs d2) -> SF as bs (d1 \/ d2)
34 |
35 |
36 | ||| A postulate that Dec is a subtype of Cau when considering a SF.
37 | subtypeWeaken : SF as bs Dec -> SF as bs Cau
38 | subtypeWeaken = weaken'
39 | where
40 | weaken' : SF as bs d -> SF as bs Cau
41 | weaken' sf@(SFPrim _ _) = sf
42 | weaken' (SFDPrim f s) = SFDPrim f s
43 | weaken' (SFComp x y) = SFComp (weaken' x) (weaken' y)
44 | weaken' (SFPair x y) = SFPair (weaken' x) (weaken' y)
45 | weaken' (SFLoop x y) = SFLoop (weaken' x) y
46 | weaken' (SFSwitch x f) = SFSwitch (weaken' x) (\e => weaken' (f e))
47 | weaken' (SFDSwitch x f) = SFDSwitch (weaken' x) (\e => weaken' (f e))
48 |
49 | joinWeaken : SF as bs d -> SF as bs (d' \/ d)
50 | joinWeaken {d' = Dec} {d = Dec} sf = sf
51 | joinWeaken {d' = Dec} {d = Cau} sf = sf
52 | joinWeaken {d' = Cau} {d = Dec} sf = subtypeWeaken sf
53 | joinWeaken {d' = Cau} {d = Cau} sf = sf
54 |
55 |
56 | -- TODO: Split into smaller functions.
57 | ||| Steps a state function through one moment in time, given the change in time
58 | ||| since the last step and the input for the current time. Returns an updated
59 | ||| version of the state function and its output.
60 | partial
61 | stepSF : SF as bs d -> DTime -> SVRep as -> (SF as bs d, SVRep bs)
62 | stepSF (SFPrim f st) dt xs = let r = f dt st xs in (SFPrim f (fst r), snd r)
63 | stepSF (SFDPrim f st) dt xs = let r = f dt st in (SFDPrim f (fst r xs), snd r)
64 | stepSF (SFComp sf1 sf2) dt xs = let r1 = stepSF sf1 dt xs
65 | r2 = stepSF sf2 dt (snd r1)
66 | in (SFComp (fst r1) (fst r2), snd r2)
67 | stepSF (SFPair sf1 sf2) dt xs = let pxs = split xs
68 | r1 = stepSF sf1 dt (fst pxs)
69 | r2 = stepSF sf2 dt (snd pxs)
70 | in (SFPair (fst r1) (fst r2), (snd r1) ++ (snd r2))
71 | stepSF (SFLoop {as} {bs} {cs} {ds} {d} sf1 sf2) dt xs =
72 | (SFLoop (fst r1) (fst r2), fst $ split $ snd r1)
73 | where
74 | mutual
75 | partial
76 | r1 : (SF (as ++ cs) (bs ++ ds) d, SVRep (bs ++ ds))
77 | r1 = stepSF sf1 dt (xs ++ (snd r2))
78 |
79 | partial
80 | r2 : (SF ds cs Dec, SVRep cs)
81 | r2 = stepSF sf2 dt (snd $ split $ snd r1)
82 | stepSF (SFSwitch sf f) dt xs = let r1 = stepSF sf dt xs
83 | in
84 | case snd r1 of
85 | ECons Nothing svr => (SFSwitch (fst r1) f, svr)
86 | ECons (Just e) svr =>
87 | let r2 = stepSF (f e) dt xs
88 | in (joinWeaken (fst r2), svr)
89 | stepSF (SFDSwitch sf f) dt xs = let r1 = stepSF sf dt xs
90 | in
91 | case snd r1 of
92 | ECons Nothing svr => (SFSwitch (fst r1) f, svr)
93 | ECons (Just e) svr =>
94 | let r2 = (stepSF (f e) dt xs)
95 | in (joinWeaken (fst r2), snd r2)
96 |
97 |
98 | ||| Like stepSF, but with the input being an empty event signal.
99 | partial
100 | stepSFEE : SF [E a] bs d -> DTime -> (SF [E a] bs d, SVRep bs)
101 | stepSFEE sf dt = stepSF sf dt eEmpty
102 |
103 | ||| Like stepSF, but with the input being an inhabited event signal.
104 | partial
105 | stepSFE : SF [E a] bs d -> DTime -> a -> (SF [E a] bs d, SVRep bs)
106 | stepSFE sf dt x = stepSF sf dt (eSingle x)
107 |
108 | ||| Like stepSF, but with the input being part of a continuous signal.
109 | partial
110 | stepSFC : SF [C i a] bs d -> DTime -> a -> (SF [C i a] bs d, SVRep bs)
111 | stepSFC sf dt x = stepSF sf dt (cSingle x)
112 |
--------------------------------------------------------------------------------
/src/FarRP/DecDesc.idr:
--------------------------------------------------------------------------------
1 |
2 | module FarRP.DecDesc
3 |
4 | import FarRP.Time
5 |
6 |
7 | %access public export
8 | %default total
9 |
10 |
11 | ||| A decoupledness descriptor for SFs.
12 | data DecDesc : Type where
13 | ||| A decoupled SF descriptor, which is a subtype of casual SF.
14 | Dec : DecDesc
15 | ||| A casual SF descriptor.
16 | Cau : DecDesc
17 |
18 | infixr 5 \/
19 | ||| The join (as in subtyping) of two decoupledness descriptors.
20 | (\/) : DecDesc -> DecDesc -> DecDesc
21 | (\/) Dec Dec = Dec
22 | (\/) _ _ = Cau
23 |
24 | infixr 5 /\
25 | ||| The meet (as in subtyping) of two decoupledness descriptors.
26 | (/\) : DecDesc -> DecDesc -> DecDesc
27 | (/\) Cau Cau = Cau
28 | (/\) _ _ = Dec
29 |
30 | joinSym : {d1 : DecDesc} -> {d2 : DecDesc}
31 | -> d1 \/ d2 = d2 \/ d1
32 | joinSym {d1 = Dec} {d2 = Dec} = Refl
33 | joinSym {d1 = Dec} {d2 = Cau} = Refl
34 | joinSym {d1 = Cau} {d2 = Dec} = Refl
35 | joinSym {d1 = Cau} {d2 = Cau} = Refl
36 |
37 | meetSym : {d1 : DecDesc} -> {d2 : DecDesc}
38 | -> d1 /\ d2 = d2 /\ d1
39 | meetSym {d1 = Dec} {d2 = Dec} = Refl
40 | meetSym {d1 = Dec} {d2 = Cau} = Refl
41 | meetSym {d1 = Cau} {d2 = Dec} = Refl
42 | meetSym {d1 = Cau} {d2 = Cau} = Refl
43 |
44 | decJoin : {d : DecDesc} -> Dec \/ d = d
45 | decJoin {d = Dec} = Refl
46 | decJoin {d = Cau} = Refl
47 |
48 | cauMeet : {d : DecDesc} -> Cau /\ d = d
49 | cauMeet {d = Dec} = Refl
50 | cauMeet {d = Cau} = Refl
51 |
--------------------------------------------------------------------------------
/src/FarRP/SigVect.idr:
--------------------------------------------------------------------------------
1 |
2 | module FarRP.SigVect
3 |
4 | import FarRP.Time
5 |
6 |
7 | %access public export
8 | %default total
9 |
10 |
11 | ||| A descriptor for the initialization state of a signal.
12 | data Init : Type where
13 | ||| An initialized signal (ie. one that has a starting value).
14 | Ini : Init
15 | ||| An uninitialized signal (ie. one that needs a starting value).
16 | Uni : Init
17 |
18 | ||| A signal description.
19 | data SigDesc : Type where
20 | ||| An event signal description, which contains the event output type.
21 | E : Type -> SigDesc
22 | ||| A continuous signal description, which contains the initialization state
23 | ||| and output type of the signal.
24 | C : Init -> Type -> SigDesc
25 |
26 | SVDesc : Type
27 | SVDesc = List SigDesc
28 |
29 | data SVRep : SVDesc -> Type where
30 | SVRNil : SVRep []
31 | ECons : Maybe a -> SVRep as -> SVRep ((E a) :: as)
32 | CCons : a -> SVRep as -> SVRep ((C i a) :: as)
33 | UnInitCons : SVRep as -> SVRep ((C Uni a) :: as)
34 |
35 | ||| An empty event.
36 | eEmpty : SVRep [E a]
37 | eEmpty = ECons Nothing SVRNil
38 |
39 | ||| An event containing a value.
40 | eSingle : a -> SVRep [E a]
41 | eSingle x = ECons (Just x) SVRNil
42 |
43 | cSingle : a -> SVRep [C i a]
44 | cSingle x = CCons x SVRNil
45 |
46 | eHead : SVRep (E a :: as) -> Maybe a
47 | eHead (ECons x _) = x
48 |
49 | cHead : SVRep (C i a :: as) -> Maybe a
50 | cHead (CCons x _) = Just x
51 | cHead (UnInitCons _) = Nothing
52 |
53 | tail : SVRep (a :: as) -> SVRep as
54 | tail (ECons _ xs) = xs
55 | tail (CCons _ xs) = xs
56 | tail (UnInitCons xs) = xs
57 |
58 |
59 | ||| Concatenates two signal vector representations together.
60 | (++) : SVRep as -> SVRep bs -> SVRep (as ++ bs)
61 | (++) {as = []} SVRNil svr2 = svr2
62 | (++) {as} {bs = []} svr1 SVRNil = replace (sym $ appendNilRightNeutral as) svr1
63 | (++) {as = (E a) :: as'} (ECons x xs) svr2 = ECons x (xs ++ svr2)
64 | (++) {as = (C Ini a) :: as'} (CCons x xs) svr2 = CCons x (xs ++ svr2)
65 | (++) {as = (C Uni a) :: as'} (CCons x xs) svr2 = CCons x (xs ++ svr2)
66 | (++) {as = (C Uni a) :: as'} (UnInitCons xs) svr2 = UnInitCons (xs ++ svr2)
67 |
68 |
69 | ||| Splits a signal vector representation into two SVRs.
70 | split : SVRep (as ++ bs) -> (SVRep as, SVRep bs)
71 | split {as = []} {bs = []} svr = (SVRNil, SVRNil)
72 | split {as = []} svr = (SVRNil, svr)
73 | split {as} {bs = []} svr = (replace {P = SVRep} (appendNilRightNeutral as) svr, SVRNil)
74 | split {as = (E a) :: as'} (ECons x xs) = let r = split xs
75 | in (ECons x (fst r), snd r)
76 | split {as = (C Ini a) :: as'} (CCons x xs) = let r = split xs
77 | in (CCons x (fst r), snd r)
78 | split {as = (C Uni a) :: as'} (CCons x xs) = let r = split xs
79 | in (CCons x (fst r), snd r)
80 | split {as = (C Uni a) :: as} (UnInitCons xs) = let r = split xs
81 | in (UnInitCons (fst r), snd r)
82 |
--------------------------------------------------------------------------------
/src/FarRP/Time.idr:
--------------------------------------------------------------------------------
1 |
2 | module FarRP.Time
3 |
4 | import Control.IOExcept
5 | import Effects
6 | import System
7 |
8 |
9 | %include C "idris_farrp_time.h"
10 |
11 | %access export
12 | %default total
13 |
14 |
15 | ||| A time delta in seconds.
16 | public export
17 | data DTime = MkDTime Double
18 |
19 | dtimeToDouble : DTime -> Double
20 | dtimeToDouble (MkDTime x) = x
21 |
22 | public export
23 | Num DTime where
24 | (+) (MkDTime x) (MkDTime y) = MkDTime (x + y)
25 | (*) (MkDTime x) (MkDTime y) = MkDTime (x * y)
26 | fromInteger n = MkDTime (fromInteger n)
27 |
28 | public export
29 | Neg DTime where
30 | negate (MkDTime x) = MkDTime (negate x)
31 | (-) (MkDTime x) (MkDTime y) = MkDTime (x - y)
32 |
33 | public export
34 | Abs DTime where
35 | abs (MkDTime x) = MkDTime (abs x)
36 |
37 | getTime' : IO Double
38 | getTime' = foreign FFI_C "getTime" (IO Double)
39 |
40 |
41 | public export
42 | data Time : Effect where
43 | GetTime : sig Time Double
44 |
45 | public export
46 | Handler Time IO where
47 | handle () GetTime k = do t <- getTime'; k t ()
48 |
49 | public export
50 | Handler Time (IOExcept a) where
51 | handle () GetTime k = do t <- ioe_lift getTime'; k t ()
52 |
53 | public export
54 | TIME : EFFECT
55 | TIME = MkEff () Time
56 |
57 | ||| Get the time in seconds since the Epoch.
58 | getTime : Eff Double [TIME]
59 | getTime = call $ GetTime
60 |
61 |
62 | ||| Produces time deltas in an IO context.
63 | data DiffTimer : Type where
64 | MkDiffTimer : Double -> DiffTimer
65 |
66 | newDiffTimer' : IO DiffTimer
67 | newDiffTimer' = map MkDiffTimer getTime'
68 |
69 | newDiffTimer : Eff DiffTimer [TIME]
70 | newDiffTimer = do t <- getTime
71 | pure $ MkDiffTimer t
72 |
73 | stepDiffTimer' : DiffTimer -> IO (DTime, DiffTimer)
74 | stepDiffTimer' (MkDiffTimer oldtime) = do newtime <- getTime'
75 | let dt = newtime - oldtime
76 | pure (MkDTime dt, MkDiffTimer newtime)
77 |
78 | stepDiffTimer : DiffTimer -> Eff (DTime, DiffTimer) [TIME]
79 | stepDiffTimer (MkDiffTimer oldtime) = do newtime <- getTime
80 | let dt = newtime - oldtime
81 | pure (MkDTime dt, MkDiffTimer newtime)
82 |
--------------------------------------------------------------------------------
/src/idris_farrp_time.h:
--------------------------------------------------------------------------------
1 |
2 | #include
3 | #include
4 |
5 | #ifndef IDRIS_FARRP_TIME_H
6 | #define IDRIS_FARRP_TIME_H
7 |
8 | double getTime() {
9 | struct timeval tv;
10 | gettimeofday(&tv, NULL);
11 | return tv.tv_sec + tv.tv_usec / 1e6;
12 | }
13 |
14 | #endif /* IDRIS_FARRP_TIME_H */
15 |
--------------------------------------------------------------------------------