Bridge meta/dspm with rai. RAI: practical (working) C code generator with ad-hoc model. DSPM: collection of Haskell type classes, extracting the useful combinators. The 4 problems: - properly relate composition of implementation of state machines to arrows. their behavior is already arrow like. - time domain: represent sub/super-sampling. some ad-hoc implementation of this exists. find a way to abstract. - integrate spatial domain operations as presented in Feldspar - allow for the abstraction of data primitives (e.g. parameterize over the the instruction set of a DSP). Entry: Revisit after RAI implementation Date: Sun Jul 19 14:23:52 EDT 2015 An attempt to write out the core of RAI as Haskell combinators, to see them in isolation and to see how they compose/commute. In the current racket implementation, most of these topics are inside the exploratory big ball of mud. It's nice to have something that produces working C code, but it's probably a good time now to formalize - 2015/07/19. * composition of state machines with state type 'accumulation'. See http://zwizwa.be/darcs/meta/dspm : SSM.hs Sys.hs The base abstraction is simple, but it misses a good link to Arrow. TODO: formalize the "flattening" or "erasing" operation. * introduction of block-rate and other sample rate up/down conversion TODO: * spatial operations (essentially feldspar) TODO: this is likely just commutation of fold and map. * abstraction of data primitives (with control being fixed). TODO. The current approach (dspm/Data.hs) had this part fixed in a Entry: Causal or not? Date: Sun Jul 19 16:44:16 EDT 2015 Let's take a more abstract view. Signal processors are Arrows. In fact they are the school book example[1]. The "growing state" problem is because of the "view". Some symmetry is broken because of extra constraints introduced: Signal processors are constrained to the causal kind: those that can be represented by difference equations. (s,i) -> (s,o) This then breaks the Arrow abstraction. How to create a morphism that allows to reconstruct operations in the SSM domain from Arrow operations in the specification domain? I.e. the important question is: Arrows are the right abstraction. How to "lift" those to "Implementation Arrows"? What would an implementation arrow look like? Essentially, this is a version of the arrow laws that has an extra parameter that is somehow constrained. [1] https://www.haskell.org/arrows/ Entry: Let's ask on the Haskell list Date: Sun Jul 19 17:55:57 EDT 2015 ( this is turning into a rubber duck debugging session... ) Does this ring a bell? Compared to Arrow's (>>>) :: a b c -> a c d -> a b d Is there something that captures the idea of "growing arrows"? (>>>') :: a s1 b c -> a s2 c d -> a (s1,s2) b d It pops up in multi-stage programming, when composing code that has an interpretation that behaves as an arrow. For instance: (s,i) -> (s,o), not an Arrow instance, corresponds to the code of a stream processing function ([i] -> [o]), which is an Arrow instance. What I want to do is to use the Arrow class to build compositions that eventuall look like [i] -> [o], and then recover the corresponding (s,i) -> (s,o). E.g. lift all the >>> to >>>' It seems that a key point here is a way to replay the compositions. Don't focus on the types: focus on how things are connected, then replay. Why not represent things as (f,c) where f is a functional model and c is code. f is actually derived from c. So: - Use arrows for composition - Pass in different primitive types to evaluate. Actually, 's' in s -> (a i o) could be a network, represented as a list of operations on a primitive set. Start simple: a concatenative program, and after generalize that to arbitrary arrow ops. Then to build the program, interpret it to "unfold" into a structure. So instead of thinking of the state as a parameter, think of the semantics as a parameter. Entry: Parameterized arrow Date: Sun Jul 19 20:19:28 EDT 2015 It is possible to "partially apply" type constructors to create instances that require smaller kinds. E.g. the Applicative class requires kind * -> *, while function application is of kind * -> * -> *. To fix this, an arbitrary type a can be used to create: Applicative ((->) a) The same can be done for building parameterized arrows. Given a type Proc x i o where x represents the semantics (eXplanation for lack of better mnemonic. s is taken for state in SSM), create the arrow instance Arrow (Proc x) What constraints are there on x? What is Proc? Let's try. data Proc x i o = ... SSM ... The question is how to shoe-horn SSM into Proc somehow.. data Monad m => SSM m s i o = SSM ((s, i) -> m (s, o)) (m s) Any concrete SSM has an associated state. There will be many instances of that type parameter. It seems that the objective is to find a way to somehow tuck s inside of x. One way to do this as explained above is to think of (s,i) -> (s,o) as the end result of a combination of a set of primitives. This "type" is then constant and is what x should be. So what we do is to somehow "record" all the compositons into a value, a program constructor, and then evaluate that to build interpretations: - a model = a haskell function that can be - code: a representation that can be compiled e.g. to C - others... 'x' is a program. Let's call it p. This is actually more general: an arrow constructor class, so let's call it that. It's getting circular in it's vagueness. Time to disambiguate the strange loop.. Let's try first to build this arrow constructor class. Entry: This is a problem of levels Date: Sun Jul 19 22:00:32 EDT 2015 Obviously... multi-level programming. However it is easy to get confused about not properly separating levels. The morphisms are easily seen as same. So let's start here: - (s,i) -> (s,o) is not an Arrow - A generator of a (s,i) -> (s,o) can be an Arrow This is similar to Staapl: programs are stateful, but the generator is functional. Also corresponds to thinking of a monad as the generator of a stateful program: There's a level thing. The level thing is key! So let's build it. What does a SSM constructor look like? Problem: why are there no constraints on the kind of function you can lift? Because this is about structure: *any* pure function can be inserted inside the network. The constraints on functions just comes from the constraints on the type of the composotion maybe? Entry: Very interesting problem Date: Sun Jul 19 23:05:29 EDT 2015 Questions to answer: - composition: easy: pick the arrow functions. - what is a primitive? composing two machines: More abstractly: where do all these types come from? Essentially, the compositions builds a p. That p: - takes a collection of primitives - spits out the composition so p is really: [prim] -> composite I keep running into the problem that you really can't hide those state types anywhere! There is a cycle reasoning in my mind I don't see. Actually. The types are visible. They are just very complex: The "generator" looks something like: ( (s1,a) -> (s1, b) , (s2,a) -> (s2, b, c) , ... ) -> (sx,(a,b,c)) -> (sx, (d, e f)) with sx = (s1,(s1,(s2, .... ))) So what the generator does is to convert a known type: a list of the primitives of the language, into a re-tupled type, parameterized by the type parameters in the list of primitives. This requires two steps: - selection of primitives - recording of combination of these (selection, composition) This gets quite complex, and it seems that hiding the composition isn't all that useful. So no, 1) I don't see it clearly. 2) if it is what I think it is I don't see the point of the complexity. Unless 'p' is constant, it is useless. Entry: I'm looking at it the wrong way Date: Sun Jul 19 23:23:43 EDT 2015 I'm solving the wrong problem. What's the point? Create a Haskell model and a representation of a program form the same program text. There is no reason to ever have to use explicit (s,i) -> (s,o) functions in Haskell. It is enough to stick with (S i) -> (S o) where S is an abstract representation of a stream. State can be (and should be?) invisible. Only in the generated code is it relevant, and as such it can probably just be hidden, or "erased early". The code will be well typed, and can be "retyped" easily. How can you represent all possible programs in a single type? It is possible using the trick described above. The value is that by not erasing the type, it can be re-interpreted. So it might be valueable to have a map: generator :: language -> program Entry: Only unit delay? Date: Mon Jul 20 00:48:44 EDT 2015 In RAI, the (s,i)->(s,o) type is explicit. Maybe this is not good? Maybe there should just be a delay operator defined on streams? That would get rid of the need for state stuff. The arrow feedback operator can then be used in combination with the delay operator to do essentially the same. Summary: - Explicit state types are hard to represent. - They might not be necessary - Streams + z might be easier: texbook example Arrow - Explcit z also allows for abstract z^n as extension? Entry: Stop Date: Mon Jul 20 01:08:47 EDT 2015 It took one day to go from super motivated and interested to hopelessly confused.. Entry: generator = language -> program Date: Mon Jul 20 01:48:38 EDT 2015 So what is the language? - delay operator - pure functions (data flow) - output feedback + other control structs, e.g. representations of map, fold (spatial part), subsampling, ... this relates to the 4 parts above. The important part now is the output feedback. Can ArrowLoop be used? loop :: a (b, d) (c, d) -> a b c Maybe it is a good example to implement this for streams, and then generalize from there? The more I think about this, the more I realize that it should be actually quite simple. What's in the way is my mental representation: it is too complex. Too much indirect. How to trust the types? I wonder though about loop: how to impose unit delay in feedback? The types don't prevent this (a shifted stream is still a stream) but the laws might make it hard. Maybe it will be clear later what to do in this case. Entry: Phantom types and existential types Date: Mon Jul 20 01:59:41 EDT 2015 Phantom type representation would be simple: inside it could be lists of strings, outside it could be Arrow (S i o). More interesting are existential types. But they are hard to use if I recall.. Is it possible to have something that is type S x But internally looks like (s, s->(x,s)) This might be key actually. A phantom type as a reduction? E.g. the outside looks like a proton, but the inside looks like a bunch of quarks? EDIT: Going in circles. Sys.hs already has this existential type for what is called compilable SSMs (CSSM). class CSSM stx m s i o where ssmCompile :: SSM m s i o -> stx This can even fit evaluation if stx is [i] -> [o]. EDIT: Evaluation can be done directly on the CSSM type, feeding s into (s,i)->(s,o) and recursing. [1] https://wiki.haskell.org/Existential_type Entry: Quarks? Date: Mon Jul 20 02:52:42 EDT 2015 There's a point to make about: data Op i o = forall s. (Comp s i o) => (s, (s,i)->(s,o)) Without the Comp constraint -- which would implement some kind of access to do compilation of the internals -- this can be flattened to [i] -> [o] or some other collection K i -> K o, without knowing anything about s. But that's the only thing that can be done! Entry: TODO Date: Mon Jul 20 03:03:24 EDT 2015 Find out where I left off. I believe this was mostly about the core language. It has lambda. Is that really necessary? It seems all so complex... Maybe it's best to stick to a model of RAI using the Sys approach. Also to decouple all those things.. Entry: Pick apart Date: Mon Jul 20 08:07:13 EDT 2015 Running into errors I don't understand. Start over, keeping SSM.hs SSM.hs: - why is the monad necessary? for code generation. Sys.hs: - Something isn't right with the code generator constraints on the category instance. Do this again from scratch. Maybe eliminate the Monad, then re-introduce I wonder if this Sys.hs thing ever worked.. It can't be that hard... Make the category instance work first. Ok, so this never worked. There is no example. Next: continue on SSMArrow.hs That it's ok to tuple up. Entry: Getting used to types Date: Mon Jul 20 13:03:23 EDT 2015 There has to be a way to make this more ordinary. Entry: Dont expose the state Date: Mon Jul 20 17:44:33 EDT 2015 So what does this look like for code generation? Entry: Code gen / Existentials Date: Tue Jul 21 19:29:56 EDT 2015 If existentials are used, they pop up in weird places where I don't understand how to specify the constraints, as in the Arrow instance. This is an interesting problem in itself, to try to understand Haskell better. That seems to be the real problem here: how to navigate all that type candy. Entry: The problem is not the Arrow instance Date: Tue Jul 21 20:58:12 EDT 2015 -- Simplification of Sys. -- A state space model maps state and input to state and output. -- The monad is needed for code generation. type Siso m s i o = (s,i) -> m (s,o) -- Represent a system as initial value + update function. -- State is anstract to allow this to fit the Category / Arrow instances. -- Observe that this is roughly equivalent to [i] -> m [o] (s eliminated). data Sys m i o = forall s. (GenVal s) => Sys s (Siso m s i o) -- Value generation stub. This is for being able to generate values to -- feed the state machine. class GenVal s where genVal :: s instance (GenVal s1, GenVal s2) => GenVal (s1,s2) where genVal = (genVal, genVal) instance GenVal () where genVal = () instance Monad m => Category (Sys m) where id = Sys () (\((), i) -> return ((), i)) (Sys sg g) . (Sys sf f) = Sys (sg, sf) (\((sg, sf), i) -> do (sf', x) <- f (sf, i) (sg', o) <- g (sg, x) return ((sg', sf'), o)) instance Monad m => Arrow (Sys m) where arr f = Sys () (\((),i) -> return ((), f i)) first (Sys sf f) = Sys sf (\(sf, (i,x)) -> do (sf', o) <- f (sf, i) return (sf', (o,x))) Entry: Figure out the code generation existential Date: Tue Jul 21 20:58:47 EDT 2015 Basically, you don't know the type of s. So anything that you want to do with the Sys instance needs to not talk about it. Two things need to be done: - Compile initial s to a representation - Feed an (s,i) into the update function and record the representation of output and side effects. The trick in the compilation is to abstract this as just one s->s parameter. No. Entry: Compilation monad Date: Tue Jul 21 22:26:10 EDT 2015 The trick is to tuck everything away in the Monad that pops up as a parameter in Siso. Obvious in retrospect! class Monad m => CompileSys m s where compileInit :: s -> m s -- In: initial state, Out: test value for update compileUpdate :: s -> m () -- In: result of applying test value to update function That should be enough so 's' makes an appearance only for what is needed, and then disappears into m (). Bottom line: type 's' doesn't need to be known during the composition phase, except for how it interacts with 'm', the compilation monad, which basically contains the compiler (meaning of the language). Got it: -- The interaction s and m can be kept mininal: enough to generate a -- test value to feed into the update equation, and a function to save -- all state data/code into the monad. class Monad m => CompileSys m s where -- Generate state input expression from type. -- The input value is ignored. genStateIn :: s -> m s -- Save initial state, state input expression, state output -- expression (result of evaluating update) into the compilation -- monad. saveState :: (s,s,s) -> m () Entry: Removing the 2 approaches comment Date: Wed Jul 22 00:50:11 EDT 2015 -- Representing programs that implement state space models as Arrows. --------------------------------------------------------------------- -- -- Approach A -- -- * A state space model update function (s,i) -> (s,o) is not an -- Arrow: state accumulates s1 x s2 -> (s1,s2) -- -- * However, a _generator_ of such an update model is an Arrow -- -- Moral of the story: the representation problem can be solved by -- shifting a level from thing to constructor of thing. -- -- generator = language -> program -- -- What does language look like? Something that contains: -- - unit delay -- - pure functions -- - spatial combinators (representations of map, (comm)fold, ..) -- The rest is an instance of ArrayLoop -- Approach B -- -- * A stream operator is represented by an existential type -- -- See Sys.hs for a complete example (FIXME: doesn't work any more -- / probably never has.) Entry: Data spec Date: Wed Jul 22 08:31:45 EDT 2015 The operation "kinds" can probably be separated from the ops themselves, since it is a requirement that the operations are pure. Next: fill in a compiler instance. Entry: Compiler instance Date: Wed Jul 22 17:12:17 EDT 2015 Seems straightforward, though with a bit of work in figuring out how to ball up several monads into one. Entry: Next Date: Thu Jul 23 22:01:30 EDT 2015 - nuts & bolts monads & moand transformers: tranlate RAI-style compilation to Haskell An interesting part as this is useful for other things. Straightforward but not simple. - primitives, data structures (commutation of representation and structuring), loops - spatial: integrate Feldspar, or use its abstractions Entry: Representation type constructor Date: Thu Jul 23 22:04:19 EDT 2015 This (phantom type?) trick doesn't pop up any more. Why? class (Repr r, Monad m) => DataRing m r t | r -> m where add :: r t -> r t -> m (r t) ... I believe the point of that was exactly to embed constructors: r (x, y) <-> (r x, r y) I got this out of one of Charette / Kiseljov papers.. Maybe the "finally tagless" papers. Entry: Target Assembly Date: Fri Jul 24 01:50:56 EDT 2015 So it should now be possible to: - Define a generic set of primitives for the "standard library" - Implement these in terms of machine primitives Entry: Data.hs from meta/dspm Date: Fri Jul 24 13:12:40 EDT 2015 It should be possible to build on the previous implementation now. A lot of the work is already done; though it needs some cleanup. It seems the next thing to fix is structvar, which generally is a problem of commutation of representation and structuring. I believe the implementation is only abot (,) which is enough for now. A problem appears in StructVar which is a compiler internal. Maybe it can be removed and tucked away like the previous existential? Let's remove Struct.hs as it introduces some seemingly badly constructed type juggling.. Entry: s -> i -> (s, o) Date: Fri Jul 24 23:40:38 EDT 2015 Don't try to be different: use stardard curried form. The tupled form is equivalent anyway.. Entry: Structuring Date: Fri Jul 24 23:51:40 EDT 2015 I noticed that in RAI, structuring isn't really necessary. What works well is lifting (mapping / folding). In this case there is already a Sys, so it might be interesting to provide lifted instances that use Sys as a generic fold. ( With this in mind, I'm going to clean up the old Struct stuff. ) Point being that in the kind of music DSP algorithms this is targeted for, mixing is much more common than keeping parallel signals around. What gets big: - state - static parameters Entry: nesting Sys Date: Sat Jul 25 00:09:25 EDT 2015 To nest sys: - subsampled - spatial next: oscillator bank Entry: Compilation monad Date: Sat Jul 25 02:31:30 EDT 2015 Starting bottom up: bind method of merging two SSA contexts. Been here before, and found it awful! The trouble is mainly that variable names need to be merged. dspm stuff used state continuation monad. I don't remember exactly why, but it's probably what this one needs.. It uses the continuation monad for let insertions. What is the state part for? Entry: Compiling Sys Date: Sat Jul 25 14:08:12 EDT 2015 compSys (acc :: Sys MCode' (Code Tint) (Code Tint)) Let (Var (Type AInt 0) "t0") (Lit (Type AInt 0) "0") ( Let (Var (Type AInt 0) "t3") (Op (Type AInt 0) "add" [Ref (Var (Type AInt 0) "t1"),Ref (Var (Type AInt 0) "t2")]) ( Set (Var (Type AInt 0) "t1") (Ref (Var (Type AInt 0) "t3")) ( SM [(Var (Type AInt 0) "t1",Ref (Var (Type AInt 0) "t0"))] [Var (Type AInt 0) "t2"] (Ref (Var (Type AInt 0) "t3"))))) It's a bit annoying that the SM constructor is the innermost expression. This is a consequence of using the SC monad for let insertion, and mVar constraining the type to (Code Term). Entry: next: define Ring over (,) Date: Sat Jul 25 16:51:40 EDT 2015 *SisoTest> compSys $ acc . dup . acc . acc . acc :96:11: No instance for (Ring MCode' ((,) CI) CI) Reading a bit, this seems to not be such a good idea.. Entry: next: Space Date: Sun Jul 26 16:19:19 EDT 2015 Next is to lift operations over arrays. It seems best to do this reusing Sys, which gives both fold and map. EDIT: I've been procrastinating. Adding partial eval. How to do the space thing? Entry: Space Date: Sun Jul 26 23:13:43 EDT 2015 An important constraint is: should dimensions be fixed? Essentially, this should be a type constraint. Let's look at that first. Two things need solving: - Lifting to vector types - Representing an interation over a Sys EDIT: The typical case is an oscillator bank: state. Start with a trivial example. Using Sys won't work, since the output state is needed. Keep only last value? The core idea is to lift. What is being lifted? A Sys is lifted over an input array, and (for now) the outputs are summed. Start with Data.hs Entry: Liftable... Date: Wed Jul 29 21:57:54 EDT 2015 What am I trying to do? Given DataRing m r t => DataRing m r (Vec t) Should Vec be a concrete type then? Can't be. Needs to be a class. Entry: So what's the type for mix? Date: Wed Jul 29 22:11:50 EDT 2015 mix :: ... the point is to _avoid_ higher order functions. these are functionals as in backus' formulation. this means that functions should never be values, and that 'mix' itself acts as a macro. so 1: mix operates on arrows (systems and signals). -- Mix multiple signal generators. -- Each generator is parameterized by an integer. mix :: Ring m r o => (r Int) -> (r Int -> Sys m () (r o)) -> Sys m () (r o) mix num body = undefined See Lib.hs The more general question is how to map an arrow.. Some other ideas: -- Mix multiple signal generators. -- Each generator is parameterized by an integer. mix :: (Vec a i, Ring m r o) => Int -> -- nb of instances (known at compile time) (r Int -> Sys m (r i) (r o)) -- instance generator -> Sys m (r (v i)) (r o) -- resulting system mix num body = undefined -- Map Sys maps :: (Vec ai i, Vec ao o) => Sys m (r i) (r o) -> Sys m (r (ai i)) (r (ao o)) maps sys = undefined But this seems better: class Vec v t where vec :: t -> v t -- Note: 'r' is always the outer type constructor wrt. 'v'. -- And 'm' is outer wrt. 'r'. class (Vec v t1, Vec v t2, Data m r) => VecMap v m r t1 t2 where vmap :: (r a -> m (r b)) -> r (v a) -> r (v b) class (Vec v e, Data m r) => VecFold v m r e a where vfold :: (r e -> r a -> m (r a)) -> r a -> r (v e) -> m (r a) Now let's try to implement this for Eval. Entry: Representation of Collection, or collection of representations? Date: Wed Jul 29 23:48:17 EDT 2015 It keeps bugging me. So basically, as long as the language does not have any types: r (a -> b) It is a first order language. A type (r a) -> (r b) is a meta-language function. So "vfold" is really "for". Entry: weird error Date: Fri Jul 31 00:52:58 EDT 2015 Why is this duplicate? Duplicate instance declarations: instance (Vec v, TypeOf t) => TypeOf (v t) -- Defined at Vec.hs:26:10 instance (Repr r, TypeOf t) => TypeOf (r t) -- Defined in `Data' Instantiation is not search! [1] instance (Repr r, TypeOf t) => TypeOf (r t) where typeOf _ = typeOf $ unRepr (undefined :: r t) Above, (r t) is very generic. The compiler will match that to anything and then add constraints. It won't pick an instance based on constraints satisfied. Essentially, instance resolution is quite "dumb". [1] https://mail.haskell.org/pipermail/haskell-cafe/2008-October/049777.html Entry: next: fold Date: Fri Jul 31 01:25:55 EDT 2015 essentially, evaluate (generate) full body, then encapsulate it. the tree "splits" here. evaluation needs to be triggered, but the state needs to be threaded still after the evaluation is done. Entry: Dumping state Date: Sat Aug 1 02:17:25 EDT 2015 Trouble is that inserting Let fixes the type of the return value (final continuation) to Term. To recover the state at the end of a computation, it needs to be embedded in Term. Entry: Next: fish out state Date: Sat Aug 1 02:59:38 EDT 2015 In order to "fork" a compilation to compile a separate code body, the state needs to be recovered. This is done by passing it to the "return" continuation, tagging the "Return" constructor. However, this is nested deep into the data structure. Fish that State constructor out. Entry: Continuation Monad - reasoning problems Date: Sun Aug 2 10:47:44 EDT 2015 Think of it like this: C.M is only used for inserting "wrappers" around the current value. I.e. the current continuation is replaced with one that inserts a wrapper, then passes control to the current continuation. 'k' is goto with arguments. What keeps tripping me up is switching between: - "normal view", what is exposed by >>= and do. - "raw view", where continuations and state are manipulated as lambda expressions. Trouble is that the statecont monad is good for variable binding because it mimicks usual control flow, but no good for "just put this thing there" kind of operations. Entry: State as hierarchical binding constructs Date: Sun Aug 2 11:00:15 EDT 2015 It might be best to insert state binding constructs and initial values hierarchically in the code. Use the State monad only for tracking numbering state. It seems packaged better that way: binding constructs are closer to where they are used. It's easy to fish them out later. Entry: GHC error Date: Sun Aug 2 11:27:17 EDT 2015 make -C ~/meta/siso all clean make: Entering directory `/home/tom/pub/darcs/meta/siso' ghc Test.hs [ 9 of 10] Compiling Code ( Code.hs, Code.o ) ghc: panic! (the 'impossible' happened) (GHC version 7.4.1 for x86_64-unknown-linux): compiler/rename/RnSource.lhs:429:14-81: Irrefutable pattern failed for pattern Data.Maybe.Just (inst_tyvars, _, SrcLoc.L _ cls, _) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Entry: CompRed try Date: Sun Aug 2 12:59:39 EDT 2015 tom@zoo:~/meta$ darcs wh hunk ./siso/Code.hs 200 -class CompRed t o where - compRed :: t -> Comp o - -instance (MakeVar i, Flatten i) => [_$_] - CompRed (i -> Comp o) -> o where - compRed f = makeVar >>= fun >>= f hunk ./siso/Code.hs 201 -instance CompRed (Sys Comp i o) o where [_$_] - compRef (Sys stateInit update) = do - f <- compRed $ flip update +appFun :: (MakeVar i, Flatten i, Flatten o) => (i -> Comp o) -> Comp o +appFun f = makeVar >>= fun >>= f + +appSys (Sys stateInit update) = do hunk ./siso/Code.hs 206 - (stateNext, out) <- f stateVar + (stateNext, out) <- appFun $ update stateVar hunk ./siso/Code.hs 211 +--class CompRed t o where compRed :: t -> Comp o +--instance (MakeVar i, Flatten i) => CompRed (i -> Comp o) o where compRed = appFun +--instance (MakeVar i, Flatten i) => CompRed (Sys Comp i o) o where compRed = appSys + [_$_] + hunk ./siso/Code.hs 232 -compFun :: (MakeVar i, Flatten i, Flatten o) => - State -> - (i -> Comp o) -> (State, Term) -compFun s f = compSC s $ appFun f - -compSys :: (MakeVar i, Flatten i, Flatten o) => - State -> - Sys Comp i o -> (State, Term) -compSys s sys = compSC s (appSys sys) +comp :: CompRed t o => State -> t -> (State, Term) +comp s f = compSC s $ compRed f Entry: Next: generic Term traversal Date: Sun Aug 2 13:42:44 EDT 2015 Term is now a fairly direct representation of actual code, so it needs some traversal to gather things. Do this generically. It is not a traversible because this doesn't contain any "data" in a generic way. To make it so, find a way to define Functor first. Start from what is necessary, then generalize: - bubble up Context - bubble up Return These are the same. Don't perform transformation: just pick up return value. Entry: commutation again Date: Sun Aug 2 16:16:27 EDT 2015 This time v (a, b) <-> (v a, v b) Essentially, I'd like to fold over a vector of tuples. Maide a pair/unpair addition to Rep Ming with Pair then boils down to: No instances for (TypeOf (v0 (a0, b0)), TypeOf (a0, b0)) Which is meaningless. TypeOf needs to be removed as constraint. Or it needs to commute with (,) ? Entry: Multiple vectors Date: Sun Aug 2 20:48:48 EDT 2015 Looks like it works now: -- compSys vpadd2: fun [(^r0,^r1)] fold [(r6,r7),(r2,r3),(0,0),(r4,r5),(^r0,^r1)] r8 = add[r2,r4] r9 = add[r3,r5] ret [(r8,r9)] ret [(r6,r7)] Fixme: since this needed pairs in the intermediate language, maybe good to get rid of flattening. Entry: fold over sys Date: Sun Aug 2 22:07:01 EDT 2015 Currently fold can't refer to external state. This is one of the important properties of RAI: to create state for collections of signals. So, take a bunch of arrows, and sum their output. So basically, this should work with fold. Let's try first to add two signals. The output of an Arrow forms an applicative. But this only works for pure operations. What about monadic operations? Basically that's the trick.. So maybe work with signals instead of systems? Would that work? EDIT: Applicative is useful. Just needs join! Entry: lifting Ring over Sys Date: Mon Aug 3 02:12:50 EDT 2015 That seems to be the ultimate goal. add' x y = add <$> x <*> y *Lib> :t add' add' :: (Applicative f, Ring m r t) => f (r t) -> f (r t) -> f (m (r t)) Trouble is that the last one should be: m (f (r t)) That way (f (r .)) = (r' . ) ?? Entry: (a -> a -> m a ) -> m a -> m a -> m a Date: Mon Aug 3 02:19:54 EDT 2015 Does that work better to combine with applicative? been there actually... Copying the monadic values works (of course?), but will introduce variables multiple times, one for each use. add' x y = do x' <- x y' <- y add x' y' Entry: Next Date: Mon Aug 3 02:29:18 EDT 2015 figure out a way to define a representation that is a system, to shoe-horn into: r t -> r t -> m (r t) Basically, what does this mean: f (m (r t)) -> m (f (r t)) A system with a (double wrapped) monadic output, maps to a monadic value of a signal. This should give interesting things like: - compile once to get a Sys - compile a second time to get Code This should be the goal probably: every variable is a signal. Rewrite Sys to use that approach? Start out like that: - Systems are defined in terms of Data - Data is then again defined in terms of Systems (signals) It seems that these are two layers that are otherwise implicit or ambiguous in rai. In Haskell the types enforce explicit layers. Entry: Applicative: Conclusions & Questions Date: Mon Aug 3 10:07:32 EDT 2015 - It seems the applicative instances allows proper sequencing of the monadic operations to yield "pure" operations on signals. Still, there is the question of duplication. It's too abstract for me to see this atm.. - Can the applicative approach be used with _just_ a couple of primitive signals? To try this out, first use RSig wrapper. Looks like the main question is: can an integrator be represented? Basically, does this make sense as a system: r i -> Sig m r o It doesn't. But something like this does: Sig m r i -> Sig m r o Can that represent an accumulator? Entry: Duplication Date: Mon Aug 3 13:43:08 EDT 2015 So, what about this: r <- ramp mul r r it would be easy to see the duplication. So this clearly means: copy the signals. ramp2 = joinSys $ mul <$> ramp <*> ramp *Test> compTest_I ramp2 state r0 : 0 state r1 : 0 fun r2 = add[r0,1] r3 = add[r1,1] r4 = mul[r2,r3] r0 <- r2 r1 <- r3 r4 How to re-arrange things to reuse? *Test> state r0 : 0 fun r1 = add[r0,1] r2 = mul[r1,r1] r0 <- r1 r2 So functionality is there. The userinterface isn't though.. It it possible to use the monad for this? yes square x = mul x x ramp2'' = joinSys $ square <$> ramp -- compSys ramp2'': state r0 : 0 fun r1 = add[r0,1] r2 = mul[r1,r1] r0 <- r1 r2 So the trick is this: signals used in the Applicative <*> get instantiated once for every use, but duplication in the lifted monadic expressions is shared. This seems most flexible, but also quite low-level. What I want is to have every variable be a signal, and essentially map a monadic scalar program over them. This boils down to wanting to introduce signals inside a monadic scalar program. I.e. something like: \f1 f2 -> do x1 <- osc f1 x2 <- osc f2 add x1 x2 Where this would be equivalent to \f1 f2 -> ( joinSys $ (\x1 x2 -> add x1 x2) <$> osc f1 <*> osc f2 ) Entry: Applicative signal processor Date: Tue Aug 4 22:03:22 EDT 2015 Is it possible to have a type Sig i -> (m) Sig o representing say an accumulator say using Applicative? If so, then instantiating Data for Sig is the only thing that needs to be done. E.g. Arrow isn't necessary: (->) is enough. Let's see. The core is: (Sig f0 f) <*> (Sig a0 a) = Sig (f0, a0) fa where fa (sf, sa) = do -- Set order left-to-right (sf', f') <- f sf (sa', a') <- a sa return ((sf', sa'), f' a') It doesn't look like applicative itself can do antyhing but combining pure functions with effects (the Applicative "container"). The construction of signal processors then has to come from extra functionality. Primitives are constructed separately. -- Construct primitive signal processors from update equations. type Update m s i o = i -> s -> m (s, o) type Proc m i o = Sig m i -> (Sig m o) proc :: SigState m s => s -> Update m s i o -> Proc m i o proc u0 u (Sig i0 i) = Sig o0 o where o0 = (i0, u0) o (si, su) = do (si', i') <- i si (su', o') <- u i' su return $ ((si', su'), o') What comes out here naturally, is that input arrays are better represented by input signals! So Somewhat surprising signals are "pure". The monad is completely inside. So the next question is: how to share signals? Turn the above into a monad: (Sig m i) -> (i -> Sig m o) -> (Sig m i) The funny thing is that in writing this instance, it seems as if too much flexibility is introduced: it is not true that a single input value can influence w hole output Signal. i.e. i -> Sig m o Doesn't make sense. This leads me to believe that sharing (memoization) is not a monad. Entry: The other monad Date: Wed Aug 5 00:45:25 EDT 2015 Use a `copy` operator? Lift every operation with Applicative? Define an extra Monad that performs a join? The Applicative will create things like: (Sig m (m a)) And we want m (Sig m a) return . joinSig? joinSig :: (Sig m (m o)) -> (Sig m o) joinSig (Sig f0 f) = (Sig f0 f') where f' s = do (s', mo) <- f s o <- mo -- (*) return (s', o) (*) This ensures the computation is sequenced. So return . joinSig is proper. So how to take a sig and make it shared? Applying the lifted identity? That doesn't sound right... Nonsense.. time for bed. EDIT: Basically, joinSig is enough for operations on signals. The problem is in using things like: let x = primitive_signal mul x x x <- copy primitive_signal mul x x It seems the copy is essential, as in Comp it introduces a variable for the output of the signal, and it is that variable that is then fed into mul. Call copy 'fanout' ? Or just wrap all systems in a copy? Hmm.. Try it with some examples. Entry: It's the outputs. Date: Wed Aug 5 21:58:13 EDT 2015 A sig is a value inside a monad. That's really all. Sig m a, where m' = Sig m a -> Sig m a I tried this before. So what is bind? I keep going back to flattening lists. That doesn't work. Can't flatten infinite lists.. There is another way to make a list into a monad, right? But there is a stream instance: http://stackoverflow.com/questions/11684759/definition-of-the-monad-instance-of-data-stream It takes the "main diagonal". Entry: Monad... Date: Wed Aug 5 22:22:41 EDT 2015 Actually what I want is: Stream -> m Stream Ok... time to get the meandering under control.. I clearly don't understand something deep enough.. While it is trivial to map monadic functions over instances, it is somehow not so simple to do this the other way around (defining the individual functions over the signals). Entry: Prelim conclusion Date: Wed Aug 5 23:38:15 EDT 2015 - Missing link is RSig -> RSig to Sys translation, since Comp requires that form for code generation (which is equivalent (proof: construct maps ??)) - Continue using RSig.hs to construct applicative programs (as opposed to compositional programs using the Category and Arrow instances of Sys.) Once compilation work, it is easy to verify if there are sharing issues. If there are, try to fix them manually. Entry: Applicative remarks Date: Thu Aug 6 23:10:28 EDT 2015 - Keep representation applicative: Sig -> Sig -> ... - Be careful about representation issues: (r a, r b) <-> r (a, b) - Use un currying for code generation: a -> b -> c -> (a,b)->c For code gen, currying isn't necessary. The trick is the generation if Sig m i, which boils down to generating something like "in[n]", together with a (fake, ignored) state. Entry: Seq? Date: Fri Aug 7 00:03:32 EDT 2015 Sig m (m t) -> m (Sig m t) looks like [m t] -> m [t] Entry: Ordinary state monad Date: Fri Aug 7 00:16:25 EDT 2015 So it is clear now that a signal is a mix of the "semantics" monad and the state monad s->(s,t). s -> m (s, t) Is this a standard state transformer? It is [1] [1] https://en.wikibooks.org/wiki/Haskell/Monad_transformers Entry: Two things to solve by re-arranging Date: Sun Aug 9 08:17:46 EDT 2015 - Make Sig the main representation - Avoid RSig (focus on making Functor work) Just do this: there is apparently no point for Sys. Entry: Signal-oriented.. Date: Sun Aug 9 23:35:09 EDT 2015 The more I think about it, the more I like the "applicative" approach of signals as values, and functions between them. Signal = array. This works for inputs, but also for outputs. Think of assignment as binding. Entry: Only applicative? Date: Tue Aug 11 11:42:29 EDT 2015 Semantics (Eval) doesn't need the Monad. Is there a way to use Applicative, forget about sharing, and somehow reconstruct it as part of implementation? Basically, there is a canonical way to introduce sharing. Does it have to be explicit? Put otherwise: is there a way to introduce the extra structure canonically, keeping one end of the morphism Applicative, and the other Monad? Entry: Signals and connectors. Date: Tue Aug 11 12:07:43 EDT 2015 Thing about it this way: the problem is composing signals, and signal connectors ("scalar" monadic programs). It is easy when all signals are lifted to be inputs of the scalar monadic program, then lift the program over the signals. What is difficult is to express the program in terms of signals as opposed to scalars. It seems as if (Sig m) should be the Monad, but it isn't. Can't construct Join for (Sig m (Sig m t)). Or can we? What would it _mean_ ? Simpler to understand: what would bind mean? Sig m a -> (f -> Sig m b) -> Sig m b This needs a different monad interface, one that wraps signals, so the Bind would be: m' (Sig m a) -> f -> m' (Sig m b) -> m' (Sig m b) Then the behavior of this monad is to just "tuck underneath" the other one. And what would m' look like? Is this another continuation monad? Entry: SysState, StateFB, StateFold Date: Thu Aug 13 10:44:11 EDT 2015 Renamed and put in different module since it's used in Siso and Sig. Now, what would StateFB be? Is there a simpler way to express the interface? Probably, but currently having separate stateIn / stateOut seems most convenient. Actually, this might be simpler: s -> s -> m (s, t) -> m t The existence of such a method also implies that somehow state is "not there". I.e. it would abstract the natural fold that can already be done without knowing anything about the type. But let's fix this after moving to Sig as main representation. EDIT: trying this in: appSys (Sys stateInit update) = do i <- makeVar >>= fun stateFold stateInit $ (flip update) i Which has the effect of placing the state generation inside the function instead of outside. Shouldn't be a problem, so I'm just going to change stateFB to stateFold. EDIT: It actually seems quite important to make this abstract, i.e. just use stateFold, not stateIn, stateOut. However, I find it difficult to write a StateFold instance for (,). Somehow I can't "split" f. It should be the inside-out of this: stateFold (i1, i2) f = mt where f' (s1, s2) = do t1 <- stateFold i1 s1 t2 <- stateFold i2 s2 return (t1,t 2) This looks like it needs knot-tying, something I'm not too familar with.. Or there's another trick. I have (s1,s2) -> m ((s1,s2), t) and s -> (s -> m(s, t)) for s1 and s2, and for any t. The trick is probably to tunnel one of the functions through t. Entry: Not getting it Date: Thu Aug 13 14:45:10 EDT 2015 I keep running into functions like: i -> m o Where m really is just [] or Stream, but I can't have the semantics of the List monad (= flattening). In the language, m really just expresses: - compilability (representability) - sharing (or strictness) There are two monads I'm confusing: - One just does sharing (scalar) - The other implements the sequence semantics This is especially clear in: class Monad m => StateFold m s where stateFold :: s -> (s -> m (s, t)) -> m t The first m is the 'scalar' monad. The other is a representation of a sequence. Maybe this should be made into: class (Monad m, Applicative m) => StateFold m a s where stateFold :: s -> (s -> m (s, t)) -> m (a t) where a captures the sequence part. No. What StateFold expresses is not really a fold. It expresses that we are part of a context that expresses that the state can be ignored locally. It actually means something like: Take this initial value and scalar function and abstract away the time component such that we can focus on composing and sharing the current values. Smells like comonad? Another vaguification: You know, this got an s that you can't touch, but hey just take it off with this here. Entry: Missing Link: generate Comp signals Date: Thu Aug 13 16:38:16 EDT 2015 So it's been fairly obvious that compiling things like: Sig m i -> Sig m o Boils down to just generating a value for Sig m i, which is pretty much the same as generating a scalar value. State isn't even necessary. Time indexing can be used. Entry: Comp (Sig Comp o) -> Sig Comp o Date: Thu Aug 13 19:02:50 EDT 2015 I'm running into another plumbing function type :: Comp (Sig Comp o) -> Sig Comp o Is it possible to write it? m (s -> m (s, o)) -> (s -> m (s, o)) Doesn't seem so. So something else is wrong. The Sig is inside Comp because of makeVar. Maybe it's best to move that inside of appSig. Something is really wrong here... Does it actually make sense to have generic functions of the form s -> m (s, i) -> s -> m (s, o) For m = code, problem is that it is not possible to construct a value :: Sig m t Only :: m (Sig m t) Is it possible to run this? m (Sig m t) m (s -> m (s, o)) -> s -> m (s, o) EDIT: Trick is to generate :: Sig m t from m t using mSig v = Sig () $ \() -> liftM ((),) v Entry: Unweildy Date: Fri Aug 14 15:12:00 EDT 2015 Time to clean up the type products: - vectors - signals - tuples - curry Entry: Taking out Siso.hs Date: Fri Aug 14 15:24:45 EDT 2015 So with everything seemingly working using just Applicative, there is no need any more for the Siso.hs abstraction. Taking it out. Entry: Allowing expressions Date: Fri Aug 14 16:53:57 EDT 2015 -- Allow use of nested expression syntax when sharing is not an issue. -- expr2 :: Monad m => (a -> b -> m c) -> m a -> m b -> m c -- expr2 f a b = join $ liftM2 f a b -- Allow expression syntax. class MExpr f1 f2 where mexpr :: f1 -> f2 instance MRepr m r => MExpr (r a -> r a -> m (r b)) (m (r a) -> m (r a) -> m (r b)) where mexpr f x y = join $ liftM2 f x y instance MRepr m r => MExpr (r a -> r a -> m (r b)) (r a -> m (r a) -> m (r b)) where mexpr f x y = do; y' <- y; f x y'; instance MRepr m r => MExpr (r a -> r a -> m (r b)) (m (r a) -> r a -> m (r b)) where mexpr f x y = do; x' <- x; f x' y; This doesn't work so well. I want to express this: If the argument is (m (r (m (r t)))) then join it, else leave it flat. class Monad m => MaybeJoin m r t t' where maybeJoin :: m t' -> m (r t) instance Monad m => MaybeJoin m r t (r t) where maybeJoin = id instance Monad m => MaybeJoin m r t (m (r t)) where maybeJoin = join But this whole thing seems to be ill-conceived because of the way type inference works. The bottom case needs to be tagged somehow. Tried this, but I'm loosing energy.. Still ambiguous types. data V t = V t class Monad m => VJoin m t' t where vJoin :: m t' -> m (V t) instance Monad m => VJoin m (V t) t where vJoin = id instance VJoin m t' t => VJoin m (m t') t where vJoin = vJoin . join v2 f a b = do V a' <- vJoin $ return a V b' <- vJoin $ return b r <- f a' b' return $ V r *Lib> :t v2 add (V zero) (V zero) v2 add (V zero) (V zero) :: (Ring m2 r2 t2, Ring m1 r1 t1, Ring m r t, VJoin m (V (r1 t1)) (r t), VJoin m (V (r2 t2)) (r t)) => m (V (r t)) data V t = V t class Monad m => VJoin m t' t | t' -> t where vJoin :: m t' -> m (V t) instance Data m r => VJoin m (V (r t)) (r t) where vJoin = id instance VJoin m t' (r t) => VJoin m (m t') (r t) where vJoin = vJoin . join v2 :: (Ring m r t, VJoin m t1 (r t), VJoin m t2 (r t)) => (r t -> r t -> m (r t)) -> t1 -> t2 -> m (V (r t)) v2 f a b = do V a' <- vJoin $ return a V b' <- vJoin $ return b r <- f a' b' return $ V r Entry: Expression syntax Date: Fri Aug 14 18:12:42 EDT 2015 I can't get it to work, so just use manual annotation for the lifted operations, and possibly write a template haskell frontend for translating nested expressions to do notation. Entry: Pair Date: Fri Aug 14 19:47:53 EDT 2015 If it's so easy to translate between (r (a, b)) and (r a, r b), why should I have to? Somehow it seems that the plumbing necessary to pack/unpack between these two can be avoided. EDIT: The difference is visible in Eval quite clearly: [(a,b)] is not the same as ([a],[b]). The former definitely seems more appropriate. What about this: - internally, use currying and tupling - externally: curry and pair input/output This is about "canonical forms". Do this automatically. Entry: Status Date: Fri Aug 14 19:50:12 EDT 2015 So it seems to be mostly working with a couple of minor things open: - pair vs. repr - curry Entry: m Date: Fri Aug 14 20:10:17 EDT 2015 I'm wondering if it isn't better to use (m (r t)) for everything, and use an explicit "let" operator that can be used for sharing. The monad is really annoying.. Entry: Eval: finite lists? Date: Sat Aug 15 17:37:05 EDT 2015 Would be nice to have finite lists. Seems simplest to just feed infinite lists (cycle) and truncate the output. Entry: Feedback does produce "infinite lists" Date: Sat Aug 15 20:22:24 EDT 2015 Everything will be lifted to time. So Feedback really is a fold. In fact, [] could be used as a phantom type for temporal values in Code as well. Let's give this a try. Trouble is that it's outside of r. Maybe Sig needs r? Trouble with that was defining functor. Quick try brings up all sorts of issues when adding another type parameter: feedback :: s -> (s -> m (s, t)) -> m (l t) But it does indicate that this might be list of representations instead of representation of list. Anyway: making it explicit is not good. I guess it's time to deal with the core confusion: is it a scalar or a stream? The way around it is the same as for RAI: everything is a stream. But it Haskell the jump/lift needs to be done somewhere. And that is at Feedback. feedback :: s -> (s -> m (s, t)) -> m t' where t -> t' r a -> r (l a) I've been sloppy with (r a, r b) and r (a, b), so maybe this needs to be cleared up first? Doesn't seem so, as meta/target flexibility is useful. So, problem: r [a] would actually work, but needs 'r' inside everything (Feedback and Signal) and this interferes with a lot. So maybe try that first? EDIT: If r is a functor / applicative, then this is actually not that hard. Entry: Trying out Applicative representation Date: Mon Aug 17 10:09:24 EDT 2015 This instances gives trouble when Feedback is changed to [] instance (Feedback m r s1, Feedback m r s2) => Feedback m r (s1, s2) where feedback (i1, i2) f = feedback i1 $ \s1 -> feedback i2 $ \s2 -> do ((s1', s2'), o) <- f (s1, s2) return (s2', (s1', o)) So let's first to the Applicative r change, then figure out the fold. Entry: Pair again Date: Mon Aug 17 10:21:34 EDT 2015 It's giving me trouble. Since this is just a bijection, should I refrain from any "meta" constructs, e.g. never use (r a, r b) except for plumbing functions, and always use r (a, b) in the interfaces? This would make the embedding possibly more difficult. Otoh this could be solved in a single pack/unpack wrapper around body definitions. Should state be representable? YES It seems like the cleanest solution, so let's do that and see how it propagates down to the DSL. Pushing the applicative under the representation does give weird things like: joinSignal :: -- (r s -> m (r s, r (m o)) -- -> (r s -> m (r s, r o)) I'm going to abor the effort. Something is not right in how this all fits together. Why is this so complicated? I'm copying what I have and will restore. EDIT: Applicative is necessary for building "meta structures". This is why it needs to be "outside" the representation. So need to find a different way to express time behavior. Also: Code is not a Functor: it's a phantom type wrapping a non-parameterized Term type. All this is an intricate play, isn't it? Entry: Expressing temporal behavior Date: Mon Aug 17 11:19:19 EDT 2015 class Monad m => Feedback m s where feedback :: s -> (s -> m (s, t)) -> m t Here (m t) should be something like (m (r (Stream t))). How to get that 'r' in there? Any parameter added propagates to places where it is in the way. So the conly conclusion I have now is that in the feedback equations, the base types are already streams. The 'r' is already Sig r. But I can't express it because of how the 'm' is on the outside. Weird.. This needs some sink-in time.. Entry: goals recap Date: Mon Aug 17 17:03:05 EDT 2015 How are we doing wrt. the goals in the head? The 4 problems: - properly relate composition of implementation of state machines to arrows. their behavior is already arrow like. FIXED: * using phantom types and an interface to state * these are static arrows: using Applicative instead But still there is a conceptual problem in the fold. - time domain: represent sub/super-sampling. some ad-hoc implementation of this exists. find a way to abstract. - integrate spatial domain operations as presented in Feldspar - allow for the abstraction of data primitives (e.g. parameterize over the the instruction set of a DSP). all these are TODO. Entry: What does it mean? Date: Mon Aug 17 17:06:18 EDT 2015 class Monad m => Feedback m s where feedback :: s -> (s -> m (s, t)) -> m t This isomorphic to Sig m t -> m t So what it says is that the compilation monad can turn a signal into a monadic value. This makes absolutely no sense, except that it "shifts the universe", meaning the base types are no longer scalars, but signals. What happens when this gets applied multiple times? Also doesn't make sense. Nonsense. It needs to be tagged somehow. If it is tagged as (m l t) then some things are needed to manipulate l. Go for another blind run... Failed again.. Whatever I try to change, there is always something that messes things up in a way I that seems impossible to solve.. Some more questions: - why is feedback meaningful for Code, but not for Eval? - why is unfold meaningful for Eval but not for Code? Maybe the trick is that Code's implicit time-dependence seeps through? The feedback equation really is about s and t being streams.. So let's try to write a semantics for that in Eval. Entry: r (Sig m t) ? Date: Mon Aug 17 17:43:47 EDT 2015 That would be it. Sig m (r t) -> r (Sig m t) Hmm... Entry: Running in circles Date: Mon Aug 17 17:51:41 EDT 2015 I'm stuck. There is one very important thing I am just not seeing. The monad contains the time behavior. If this is the case, then every thing inside an 'm' has time behavior associated to it. feedback :: s -> (s -> m (s, t)) -> m t If the monad contains time behavior, then s -> m (s, t) means something like: given an initial state s, a sequence of s, t can be constructed. So the monad IS a sequence. If this is so, why is add :: r t -> r t -> m (r t) The result is not a sequence. So looking from feedback, m is a sequence. Looking from add, m is only sharing. Makes no sense. Entry: Comonads? Date: Mon Aug 17 18:13:50 EDT 2015 Sig m t -> m t looks more like extract :: w t -> t extend :: (w a -> b) -> w a -> w b Entry: Joining state Date: Mon Aug 17 18:47:13 EDT 2015 The trouble I had really was to write () and (,) state join operations. Maybe these should just be shifted to Feedback? Entry: RSignal.hs Date: Mon Aug 17 22:52:29 EDT 2015 {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, TupleSections #-} module RSignal(Signal(..)) where -- Alternative version tied to representations. import Control.Applicative import Control.Monad import Data data Signal l m r t = forall s. (Unfold l m r s) => Signal { sigInit :: r s, sigUpdate :: r s -> m (r s, r t) } class MRepr m r => Unfold l m r s where unfold :: r s -> (r s -> m (r s, r t)) -> m (r (l t)) -- Here, (Signal l m r) is Applicative only if r is applicative, which -- it is not in the most general cases (e.g. phantom types). Still it -- is necessary to lift operations over Signals, so define generalized -- versions. pureS :: Unfold l m r a => m (r a) -> Signal l m r a pureS v = Signal rvoid $ \_ -> liftM (rvoid,) v mapS :: (r a -> m (r b)) -> Signal l m r a -> Signal l m r b mapS f (Signal s u) = Signal s u' where u' s = do (s', a) <- u s b <- f a return $ (s', b) -- Applicative needs a lot of boiler plate as it all needs to be -- handled inside the representation, requiring a higher order -- language. -- appS :: Signal l m r (a -> b) -> Signal l m r a -> Signal l m r b -- appS (Signal f0 f) (Signal a0 a) = Signal (pair (f0, a0)) b where instance MRepr m r => Unfold l m r () where unfold = undefined Entry: Int -> m t Date: Mon Aug 17 23:01:28 EDT 2015 What about this: s -> (s -> m (s, t)) -> (Int -> m t) Making the result a function leaves many things open. The Eval semantics would be clear. The Code semantics could feed in a dummy index. The important thing is that :: Int -> t is a meta-object that can be transformed further. A code generator, not code. Essentially it is the representation that fills this in however it needs. The question is then which one of these return types: Int -> m t m (Int -> t) Latter is more difficult to handle for instance of (,). Former seems like the right thing for now. Entry: If (Int -> m t) works, [m t] or m [t] should work as well. Date: Tue Aug 18 09:26:13 EDT 2015 The point is that: - The equation should produce a sequence of some sort, to give it the proper semantics. - The typeof the sequence should be such that the representation can still do things it needs. - The practical problems came from writing the instance of (,) It should also work as m [t], but is there a reason to try? Int -> mt is more abstract and it works now.. Entry: Normal forms Date: Tue Aug 18 09:58:35 EDT 2015 In Lib.hs it is useful to work with: - curried functions - Haskell tuples For compilation is is easier to work with: - uncurried functions - Represented tuples These are all isomorphic, so normal forms should be easy to implement. Entry: Struct Date: Tue Aug 18 11:04:19 EDT 2015 This is actually not working because there is no terminator for leaf nodes. -- Data structures can be converted between target language -- representation and embedding in Haskell (i.e. meta-level). class MRepr m r => Struct m r a b where unpack :: r a -> b pack :: b -> r a instance MRepr m r => Struct m r () () where unpack _ = () pack _ = nil instance (Struct m r a (r a), Struct m r b (r b)) => Struct m r (a, b) (r a, r b) where pack (a, b) = cons (pack a) (pack b) unpack ab = (unpack a, unpack b) where (a, b) = uncons ab In the end it would probably be a good idea to add a cleaner representation... For now it seems the notational overhead is too high. Entry: Unfold Date: Tue Aug 18 11:40:50 EDT 2015 Basically, this is a two step process. What I want is Comp (Code (Int -> t)) What I get is Int -> Comp (Code t) Let's abstract it properly, move the plumbing into compUnfold. The current, incorrectly typed version looks like: compSignal :: Flatten t => Signal Comp t -> State -> Term compSignal = compSC . compUnfold compUnfold (Signal i u) = unfold i u $ undefined instance MakeVar (Code t) => Unfold Comp (Code t) where unfold init update = \_ -> do si <- makeVar codeState Prev si init (so, o) <- update si codeState Next si so return o EDIT: Solved by adding an Unfold constructor in Term, which indicates the context is inside a time-unfold, where state bindings are valid (LetS, UpdateS) and a time index is defined for input arrays (makeSignalVar). Entry: Next Date: Tue Aug 18 21:14:24 EDT 2015 So this seems doable. Maybe time to compile to LLVM? http://www.stephendiehl.com/llvm/ Entry: Feldspar fusion trick Date: Wed Aug 19 00:22:46 EDT 2015 data Vector a = Indexed (Data Length) (Data Ix -> a) map f (Indexed l ixf) = Indexed l (f . ixf) A good idea of feldspar is to stick to C-like semantics: for, while, if. Something I noticed in RAI is the frequent use of (Int -> t) maps, i.e. arrays of generated objects. For loops are handy for this. Instead of implementing Fold, it might be better to have indexable vectors and Feldspar's for. Actually, non-linear indexing is quite essential. Good points: - vector representation / fusion (keep indexing!) - embracing for / while In the references, an interesting language is SequenceL[2], which has automatic lifting (in the sense of Conal Eliott's beautiful differentiation?). See normalize-transpose[2]. [1] http://www.cse.chalmers.se/~ms/MemoCode.pdf [2] https://en.wikipedia.org/wiki/SequenceL Entry: accelerate Date: Wed Aug 19 01:18:07 EDT 2015 https://github.com/Gabriel439/post-rfc/blob/master/sotu.md http://hackage.haskell.org/package/accelerate Entry: Curried primitives Date: Wed Aug 19 11:11:08 EDT 2015 Having trouble defining recursion relation for compiling curried functions. This is due to need for makeVar which is (m (r t)), so need to assume monad. instance (MakeVar i, Flatten i, Flatten o) => Compile (i -> Comp o) where compile f = compile $ makeVar >>= codeFun >>= f Maybe this can be solved with a join trick? instance (MakeVar i, Flatten i, Flatten o) => Compile (Comp i -> Comp o) where It could work with overlapping instances. EDIT: still nothing. Could do lifted functions easily. Maybe that's the way to go? Entry: curried Comp function induction Date: Wed Aug 19 15:41:37 EDT 2015 The induction steps are (t -> m t) -> (t -> t -> m t) (t -> t -> m t) -> (t -> t -> t -> m t) ... where the t can be different but are kept same here for clarity. problem is that we can't generate any variables outside of the monad. There doesn't seem to be a generic way around this apart from lifting: m t -> m t -> m t It's also not that important... Entry: While loop Date: Thu Aug 20 11:03:58 EDT 2015 While loop with accumulator init. info "while" $ compTest (while (\x -> eq x x) (\x -> add x x) zero :: Comp CI) -- while: r0 = 0, while r1 = eq[r0,r0] out r1 r2 = add[r0,r0] out r2 out r0 Together with array indexing, this means fold can be removed as a primitive. Seems to work, but missing is vector representation. Entry: Code vector representation Date: Thu Aug 20 12:56:12 EDT 2015 Basically: (Int, Int -> Comp (Code t)) This doesn't fit in a Term, or does it? It would create a mutual dependency. A solution would be to hide it in a dictionary in the monad, and use variables. Let's move Term.hs into Code.hs The fundamental conflict arises from things that produce vectors: the "value" needs to be accessible. So either they need to be kept out of Let expressions, or the state should have a dictionary to be able to reference. The latter seems clunky, so let's put it in Term first. It's not in Term. It's Code itself that should have an array type. Entry: Abstract Vectors Date: Thu Aug 20 16:23:56 EDT 2015 That was blind hacking, just following the types without global insight.. But it seems to work, at least until vectors will be outputs. Entry: Vector output Date: Thu Aug 20 18:27:29 EDT 2015 For now it's enough to fold vectors before exit. Multi-pass currently isn't possible, as vectors need to be memory-backed. Solving the return problem and memory-backing seems to be the same thing. Milti-pass is essentially running siso-like operations on a vector, but with the possibility of recovery the end state. Compilation monad can take care of temporary space. Entry: ReturnVec Date: Fri Aug 21 01:17:18 EDT 2015 To return a vector, wrap it in a RetVec constructor, record length and instantiate dereference. It might be best to turn this into imperative code, setting vector elements. The same can then be used for intermediate vectors. Entry: Vector representation Date: Fri Aug 21 09:40:21 EDT 2015 The r t r (v t) thing seems to make overlapping instances a necessity - at least in Code.hs I do not see a way around it: Cote t vs. Code (CVec t) Entry: sys vs <*> Date: Sun Aug 23 10:33:50 EDT 2015 (Signal f0 f) <*> (Signal a0 a) = Signal (f0, a0) fa where fa (sf, sa) = do (sf', f') <- f sf (sa', a') <- a sa return ((sf', sa'), f' a') sys p0 p (Signal i0 i) = Signal o0 o where o0 = (i0, p0) o (si, su) = do (si', i') <- i si (su', o') <- p su i' return $ ((si', su'), o') for Applicative: s -> m (s, i -> m o) for sys: s i -> m (s, o) Not the same.. In any case, these are the key equations, realizing: - there is an Applicative instance and, - it is enough to have operators shared implication: s -> m (s, i -> m o) lift tuple to (i ->), m s -> m (i -> m (s, o)) s i -> m (s, o) lift (i ->) to m s -> m (i -> m (s, o)) Here are some proofs of type equivalences. p4 is especially surprising to me. -- Constructive proofs of normal forms -- Applicative form to normal form. p1 :: Monad m => (s -> m (s, i -> m o)) -> s -> m (i -> m (s, o)) p1 f s = return (\i -> do (s', f') <- f s o <- f' i return (s', o)) -- Update equation form to normal form p2 :: Monad m => (s -> i -> m (s, o)) -> s -> m (i -> m (s, o)) p2 f s = return (\i -> f s i) -- Update equation inside monad. p3 :: Monad m => (s -> m (i -> m (s, o))) -> m (s -> i -> m (s, o)) p3 f = return (\s i -> do f' <- f s f' i) -- Lift inputs out again? p4 :: Monad m => (m (s -> i -> m (s, o))) -> s -> i -> m (s, o) p4 mf s i = do f <- mf f s i It seems it is always possible to "undo" a wrapped or a lifted Kleisli arrow: unlift1 :: Monad m => m (a -> m b) -> a -> m b unlift1 mf a = do f <- mf; f a unlift2 :: Monad m => (m a -> m b) -> a -> m b unlift2 f = f . return With this in mind, can Signal -> Signal maps be converted back to systems? p5 :: Monad m => ((s -> m (s, i)) -> s -> m(s, o)) -> s -> i -> m (s o) That doesn't seem to be straightforward. Is this strictly more general? Nope, it should work something like this: p5 f s i = (f (\() -> return ((), i))) s But this needs the initial state to have a generic input s (here replaced with unit ()). So this works as well, but needs Signal, and will produce an existential type as well. So strangely, all these representations are as good as equivalent. Strange. Maybe the misunderstanding comes from Signal not being an infinite sequence, but a parameterized generator of such. Essentially, a Signal is a Kleisli arrow, which has many lifted forms that can be transformed back to a -> m b. So is this relevant for mapping Signal -> Signal to something else? Can't get (s->i->m(s,o)) because of the existential type. Is it possible to do this: unsys :: (Signal m i -> Signal m o) -> Signal m (i -> m o) It's possible to construct this: s -> i -> m (s, o) But can that be converted to this? s -> m (s, i -> m o) It doesn't look like this is possible because s can't be moved outside of (i->). Entry: Next? Date: Sun Aug 23 21:26:04 EDT 2015 - instantiate vectors (solves vector output + intermediates). - subsampling - folding vector maps Entry: Loop fusion for accumulating maps Date: Sun Aug 23 21:29:16 EDT 2015 Vector representation can now accomodate loop fusion for map. It would be interesting to allow loop fusion for accumulating maps. How to generalize arrays to support this? s -> (s -> i -> m (s, o)) -> (Int -> i) -> (Int -> o) Can't, because they are no longer random access. This needs a separate data type. As long as output state is not needed, this can be built on top of Signal. Composition is then composition of Signals. For essential multipass it doesn't matter anyway. Solve later... EDIT: See also HATD code: (lazy) sequences as folds. Entry: Sequences as folds Date: Sat Aug 29 23:13:29 CEST 2015 Argument is the same as for (Int->): allow loop folding. Doesn't seem too useful here.. Entry: Functions of signals Date: Sun Aug 30 00:12:17 CEST 2015 What does it actually mean? (s->m(s,a)) -> (s->m(s,b)) -> (s->m(s,c)) Give two state machines, a new state machine can be constructed. The latter machine operates by executing a step in the two input machines, performing some internal computation, and producing an output step and state update. The state update is (necessarily) composed of the input states and possibly some internal state private to the internal computation. The main question remains: why are signal processors not Kleisli arrows (from instantaneous values to signals)? There seems to be someting interesting in creating a linear composition law, where kleisli composition would be linear convolution of impulse responses. This seems dual to the local, comonadic view (composing time-delayed filters). Does it make sense to make compositions of "non-linear" impulse responses? Entry: Block computing Date: Fri Sep 4 15:01:19 CEST 2015 Next: - vector intermediates (evaluate vectors) - sample rate reduction (for block processing) application: dynwav. should be a lot easier to express at a high level in haskell. Sample rate reduction is a state machine with a skip/process decision. Important is to allow the caller of the stream function to have its block segmentation coincide with the subsampling rate. To implement, the decision to update should be abstract. To build this it's probably best to start with internally tracking a subsampling clock, and then generalizing this to an input. Use lifting to convert a processor to a subsampled one. Entry: Haskell vs. Scheme Date: Tue Feb 16 11:20:04 EST 2016 I'd love to do more with this, but I'm getting more aware of time limitations. What is needed to make this practical? Actual sounds. I want to take it to the level of LLVM. Entry: Recap Date: Thu Jul 21 09:03:04 EDT 2016 It's been most of a year since I worked on this. What was the point, what is there in my mind now before looking at it in detail? - Applicative Functors are important. Why? Likely because composition of stream operators is functional, even if the stream operators themselves are not. - Types are still hard. - A lot of inconsistencies that could have been swept under the rug doing this typeless, will not be able to be expressed. - I do like the positive side of this: types force you to get your abstractions right. Leaks will be very clear, or won't be expressible. Re-reading now, backwards. Ha. Vector intermediates. Basically, scratch pads. That's a big one. Why is this such a big deal? Is there a class of algorithms I'm just not able to express? Entry: Equivalences Date: Sat Jul 23 14:46:39 EDT 2016 This[1] is interesting. My intuitions about monadic wrapping was wrong. Essentially, function arguments can always be bubbled up. Something interesting is there, or at least the bad intuition is telling. Elaborate? [1] entry://20150823-103350 Entry: Recap: time and space Date: Sat Mar 18 10:05:51 EDT 2017 The main idea is that these are different in a fundamental way. The directionality of time is going to be an essential part of the implementation of an event/stream processing machine. On the level of abstraction, some things might be lifted, e.g. to work with Applicative, but the difference between being able to go forward AND backward, compared to only going in one direction, will always be there in some form or another. Entry: The basic ideas, and the basic problem Date: Wed Apr 12 00:16:11 EDT 2017 1. Represent streams by their update functions. There are two ways of looking at this. The (generalized) arrow view which takes as central object the stream processor: (s,a) -> (s, b), and the (generalized) applicative functor s -> (s,a) It seems both are equivalent in this case. ( See conversion functions that act as proofs. ) 2. The "generalized" bit refers to this only being Applicative or Arrow under some kind of existential projection that hides the state accumulation in the two natural compositions: ser: ((s,a) -> (s,b)) -> ((s',b) -> (s',c)) -> ((s,s'),a) -> ((s,s'),c) par: ((s,a) -> (s,b)) -> ((s',c) -> (s',d)) -> ((s,s'),(a,c)) -> ((s,s'),(b,d)) 3. Use the tagless interpreter phantom type trick to allow for inner and outer representations of the code (Haskell and e.g. generated C code). Where I got stuck last time, is in finding a good way of looking at this hiding operation. E.g. how to thing of the above as just function composition (a -> b) -> (b -> c) -> (a -> c) And do all the things one wants to do in functional pogramming, while retaining the ability to use the full types with explicit state, as those are needed for code generation and to make the tagless embedding work. Essentially, I want to replace the "full theory" of Haskell, replacing function composition by something that is similar, but simpler (e.g. it cannot support recursion). What this tagging actually does is creating an order relation. It is no longer possible to create loops, because the types would blow up. Other than that, there doesn't seem to be any limitation. So are these things arrows? No. Because the composition of two of these, is not of the same parameterized type. This seems to be truly something different. This is all about hiding those types, which is what "OO" would do: to hide the internal state. The solution to this is likely to learn a bit more about existential types. In fact, the solution uses existential types that comply to a type class interface to perform the compilation. Think about this some more. Entry: The question Date: Wed Apr 12 00:40:30 EDT 2017 Is it possible to 1. start with objects that have the following composition rule: ((s,a) -> (s,b)) -> ((s',b) -> (s',c)) -> ((s,s'),a) -> ((s,s'),c) 2. abstract them to (a -> b) -> (b -> c) -> (a -> c) 3. perform all kinds of FP combination mumbo-jumbo on them 4. take an a->b result, and turn it back into (s,a) -> (s,b) The answer is no, if you throw away the information, such as by collapsing the open form (s, s->(s,a)) to the closed form [a]. But is it possible to do this in a way that the information is never throw away? It is likely possible to represent these as Arrow or Applicative inside some kind of existential type https://en.wikibooks.org/wiki/Haskell/Existentially_quantified_types Existential types, or 'existentials' for short, are a way of 'squashing' a group of types into one, single type. So suppose that the arrow 'a' is such a squashed type, that can produce a code output type 'c', which we are interested in. From here on, only the Applicative viewpoint is taken as it is easier to write down (values instead of functions). The atomic value is the "open" signal (s,s->(s,x)) We would like to think of this as an applicative a x We're interested in two representations: - a collapsed Haskell infinite list [a] - an existential type that embeds the compiler inside the abstraction "a x", together with a map (a x) -> c, where c is the output code representation, e.g. a C or LLVM program. THE QUESTION: What is this existential type? For the applicative view, I believe it is this: data Code a = forall s. Compile s a => Code (s->(s,a)) And I believe last time I ran into trouble trying to deduce things like this: Compile s a, Compile s' b => Compile (s,s') (a,b) I found two definitions. Without and with representation tags. Which one is the proper one? Maybe it was possible to put the representation tag inside the types for the first one? data Signal m o = forall s. (Unfold m s) => Signal { sigInit :: s, sigUpdate :: s -> m (s, o) } data Signal m r o = forall s. (Feedback m r s) => Signal { sigInit :: r s, sigUpdate :: r s -> m (r s, r o) } EDIT: It appears the former is enough. It was possible to separate representation and Signal type. Entry: Representations and monadic "inner structure". Date: Wed Apr 12 01:32:49 EDT 2017 Instead of (s, s->(s,a)), the actual type of the bare open loop code is: (s, s->m(s,a)) The monad wrapping is necessary to be able to represent things like eager evaluation. And then some more, when also the representation is taken into account we get the code embedded as a Haskell function: (r s, r s -> m (r s, r a)) and the representation of the code: r (s, s -> m (s, a)) Still a bit confusing. Looks like going over Test.hs would be the next thing to do.. Entry: Logic Date: Wed Apr 12 10:19:11 EDT 2017 What starts to sink in, is that types and functions really are logic statements and proofs, and that it helps to think of them in this abstracted way, just to also harnest intuition about implication to reason about type signatures. When signatures get complex, it becomes sometimes hard to keep thinking in "element space", but thinking about logic variables and constraints then seems to make more sense. Entry: Cleanup Date: Wed Apr 12 10:28:21 EDT 2017 Code.hs:5:14: warning: -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS To get this back up and running: apt-get install cabal-install cabal update cabal install cabal-install cd siso cabal config cabal build cabal repl To run in emacs, use haskell-program-name I'm adding a start script to the directory to make this simpler. EDIT: this is now part of emacs/dev.el: (defun my-siso () (interactive) (let ((haskell-program-name "/home/tom/darcs/meta/siso/ghci.sh")) (run-haskell))) Here's what's in Test.hs: - Basic eval and compile to pseudocode: *Main> evalTest_I ramp [1,2,3,4,5] *Main> compTest_I ramp unfold state r0 : 0 r1 = add[r0,1] r0 <- r1 out r1 - Composition of signals and systems, with systems as signal -> signal maps (that was surprising). accu :: (Ring m r t, Unfold m (r t)) => Signal m (r t) -> Signal m (r t) ramp :: (Ring m r t, Unfold m (r t)) => Signal m (r t) *Main> compTest_I $ accu ramp unfold state r0 : 0 state r1 : 0 r2 = add[r0,1] r3 = add[r2,r1] r1 <- r3 r0 <- r2 out r3 *Main> compTest_I $ accu $ accu ramp unfold state r0 : 0 state r1 : 0 state r2 : 0 r3 = add[r0,1] r4 = add[r3,r1] r5 = add[r4,r2] r2 <- r5 r1 <- r4 r0 <- r3 out r5 Together with input/output grouping, this appears to be all that is needed for a basic system. Entry: Next Date: Wed Apr 12 13:31:08 EDT 2017 From previous notes: - instantiate vectors (solves vector output + intermediates). - folding vector maps - vector intermediates (evaluate vectors) - sample rate reduction (for block processing) However it might be more interesting to make a C or LLVM output to make this all a little more real. Entry: Producing code output Date: Wed Apr 12 13:39:59 EDT 2017 Currently, the output type is Term. What would be an LLVM term? http://www.stephendiehl.com/llvm/ It seems best to use the data representation: - llvm-general-pure is a pure Haskell representation of the LLVM IR. - llvm-general is the FFI bindings to LLVM required for constructing the C representation of the LLVM IR and performing optimization and compilation. EDIT: Following the tutorial, I really need to focus first on generating the LLVM IR, to separate it from the infrastructure built in the tutorial -- it's not clear on just skimming. See imports here: https://github.com/sdiehl/kaleidoscope/blob/master/src/chapter3/Emit.hs This is what I'm looking for: https://github.com/sdiehl/llvm-tutorial-standalone A minimal LLVM builder. Basically the same code as the Haskell Kaleidoscope tutorial uses but without going through a frontend AST. Entry: llvm-general-pure Date: Wed Apr 12 16:43:31 EDT 2017 https://hackage.haskell.org/package/llvm-general-pure Yeah that puts me in the middle of a compilation problem. Apparently there is an issue with template-haskell and ghc 8.0 in combination with llvm-general-pure https://github.com/bscarlet/llvm-general/issues/171 As of Nov 16, 2016 there is no fix on hackage. Last release on hackage is Thu Feb 11 00:14:31 UTC 2016 Maybe best to work around it using the explained procedure: $ git clone -b llvm-3.8 https://github.com/bscarlet/llvm-general.git $ cabal install llvm-general/llvm-general-pure $ cabal install llvm-general/llvm-general Entry: llvm-tutorial-standalone Date: Thu Apr 13 09:34:28 EDT 2017 https://github.com/sdiehl/llvm-tutorial-standalone Entry: Low-hanging fruit? Date: Sun Apr 16 09:57:05 EDT 2017 LLVM bits are not straightforward, at least not in my current frame of mind. Is there anything that makes sense to do that is more incremental?