├── .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 | --------------------------------------------------------------------------------