Haskell hacking Entry: Gnuplot Date: Sun Jul 22 09:09:41 EDT 2012 import Graphics.Gnuplot.Simple plotList [] [(1, 1), (2, 2), (3, 3)] [1] http://stackoverflow.com/questions/9022978/haskell-plotting-library-similiar-to-matlab Entry: OpenGL: GLFW Date: Sat Oct 27 10:15:16 EDT 2012 I'm not too happy with GLUT. Let's try GLFW What about GLEW? Entry: Monads & Gonads Date: Sun Feb 17 16:50:17 CET 2013 "The monadic curse is that once someone learns what monads are and how to use them, they loose the ability to explain it to other people." "Ajax is a monad." I have to look at it again, but the basic idea is that ajax apparently is pure functional, where an operation on an object returns a new object, as opposed to a mutated object. [1] http://www.youtube.com/watch?v=b0EF0VTs9Dc [2] http://importantshock.wordpress.com/2009/01/18/jquery-is-a-monad/ Entry: So what is a monad? Date: Sun Feb 17 19:22:28 CET 2013 Focusing on the "do" notation, a way of looking at Monads is that the "do" notation allows (almost?) any language based around the concept of assigning values to names be embedded in a pure functional language. Essentially, the monad is an interpreter for a language. Doesn't help, I know.. But was a big aha for me. The reason why "do" is so weird is because it represents "the default syntax" of many programming languages. It makes much more sense to think of "composition of Kleisli arrows", i.e. how do you chain a -> M b with b -> M c. This composition makes "sequencing" completely abstract, and "sequencing" is really nothing more than "interpreting the instructions of a program". Entry: FLUNK highlights Date: Mon Mar 25 13:22:21 EDT 2013 Some highlights from the FLUNK[1] FB group. Detroit Lambda Lounge [2], GLFPC a conference on FP[5]. K'zoo Code and Kegs [3], The Bureau[4]. Michael's talk on MSP430 [6]. Charles' presentation on Pd? [1] http://www.facebook.com/groups/131823756886983/ [2] http://www.detroitlambdalounge.com/ [3] http://www.codeandkegs.com/ [4] http://jointhebureau.com/ [5] https://groups.google.com/forum/?fromgroups#!forum/glfpc [6] https://docs.google.com/presentation/d/1XKzCQZACO7KtdQlp1dIsViObaj20fbwP5bqisuUmiyQ/edit#slide=id.p Entry: Haskell killer libraries Date: Mon Aug 12 10:03:34 EDT 2013 [1] http://www.reddit.com/r/haskell/comments/1k3fq7/what_are_some_killer_libraries_and_frameworks/cbldpgy Entry: Commutation Date: Fri Jan 10 01:13:36 EST 2014 Maybe it's time for a longer article to get a better grip at the phenomenon of commutation of type constructors. Is there any interesting general concept to understand? Something categorical? The basic structure pops up in representations of the lambda calculus, where the representation type R and the function type (->) commute. app : R (a -> b) -> R a -> R b lam : (R a -> R b) -> R (a -> b) or R ((->) a b) <-> (->) (R a) (R b) Here (->) is binary which makes it a bit awkward, so let's look at the double unary case: A (B x) -> B (A x) and its inverse An example, also from language embedding is representation of data structures. Here the representation R is opaque, and the data structure S is concrete, i.e. can be deconstructed in Haskell code. unpack: R (S x) -> S (R x) pack: S (R x) -> R (S x) Here "unpack" takes an opaque reprsentation of a data structure and turns it into a Haskell data structure composed of (smaller) represented objects, while "pack" is the inverse. Both examples are the same if we partially apply (->) as (-> a) and thus look only at the return type. This is useful in abstracting compilation hacks for a DSL. It allows special-case representation for certain classes of data structures, while keeping a simple model in Haskell. ( Example: delay lines as feedback systems ) What are the characteristics? Inverses exists, so these are all 1-1 maps. Maybe inverses need not be 1-1? Really, it only mentions types. This might also work for embeddings into larger spaces with canonical representations (projection -> bijection -> injection) So it seems to really be about representation. What is representation? Turning hard-to-handle mess into neat spaces through focus on transformation of type constructors. Aiming at representation / compilation, another example is the representation of the "map" operator. map : R (a -> b) -> R [ a ] -> R [ b ] This misses [ R a ] -> [ R b ] Why? The latter is a _concrete_ implementation of map in terms of real lists, so it needs "pack" and "unpack". It seems that this is a good example of where abstraction helps: "map" can be represented abstractly as long as the data structure is never unpacked. Entry: QuickCheck / FFI Date: Mon Dec 22 17:21:28 EST 2014 I started writing code using the haskell FFI for trying out quickcheck. But where did I put it? armdev/quickcheck Entry: Curried instances Date: Sun Jul 19 20:29:12 EDT 2015 Here's something I found weird when I first saw it, and now picking up Haskell again after a long pause, I have trouble articulating. So re-learn why (->) has an applicative instance. Applicative instances are of kind * -> *, while function application is of kind * -> * -> * corresponding to types: a -> b or (->) a b It is possible to "curry" or "partially apply" instances (I don't know the proper term), e.g. as in: Applicative ((->) a) Entry: This shit is hard Date: Mon Jul 20 01:06:15 EDT 2015 It took one day to go from: "Yeah, let's pick up this type shit again" to "Man this is a maze!". So why is it hard? It's very abstract to a point where I have not found a way to make the building blocks concrete. Entry: Transposition Date: Tue Jul 21 22:50:09 EDT 2015 A lot of this high-level compilation code is specifying how to transpose / commute operators. Maybe the next 10x in code productivity is about inferring these commutations? Entry: Applicative Functor Date: Mon Jul 27 01:55:37 EDT 2015 What is a good analogy for an AF? F: lift a unary operation over something. AF: lift a multi-ary operation over something. Entry: duplicate instance declarations Date: Fri Jul 31 00:58:54 EDT 2015 A very important point! [1] The instance R a => A a says that every type "a" is an instance of "A"; if an instance for A is needed, the compiler says "OK, I know how to make one of those. But I now add a new constraint, R a." It does *not* say: pick one of these structurally identical things based on the constraints you can satisfy. That's a lot more involved than structural induction, which is the approach Haskell uses to pick instances. [1] https://mail.haskell.org/pipermail/haskell-cafe/2008-October/049773.html Entry: Arrow = Category + Applicative? Date: Sun Aug 2 23:43:45 EDT 2015 [1] https://cdsmith.wordpress.com/2011/07/30/arrow-category-applicative-part-i/ Entry: Idioms are oblivious, arrows are meticulous, monads are promiscuous Date: Wed Aug 5 21:42:36 EDT 2015 [1] http://homepages.inf.ed.ac.uk/wadler/papers/arrows-and-idioms/arrows-and-idioms.pdf Entry: Free monads Date: Thu Aug 6 23:18:52 EDT 2015 https://www.fpcomplete.com/user/dolio/many-roads-to-free-monads Entry: Monad transformers Date: Fri Aug 7 00:49:18 EDT 2015 http://blog.ezyang.com/2013/09/if-youre-using-lift-youre-doing-it-wrong-probably/ Entry: Haskell + Erlang Date: Sun Aug 9 23:45:57 EDT 2015 http://stackoverflow.com/questions/1397653/mixing-erlang-and-haskell Entry: Conditional join? Date: Fri Aug 14 17:39:49 EDT 2015 For monad m, is there a way to write a class that has these two instances: maybeJoin :: m (m t) -> m t maybeJoin :: m t -> m t I can't get this to work because the second pattern also matches the first one, and also other type unification issues I don't understand. This arises in a DSL with operations like: add :: t -> t -> m t Where I would like to use nested expressions as well by defining "evaluation order" on functions with signatures: t -> m t -> m t m t -> t -> m t m t -> m t -> m t I want it to pick the right one automatically. It's easy to define the last one add' a b = join $ liftM2 f a b And then insert return whenever needed. Maybe look for "join $ liftM2" which seems to be an indicator of this kind of problem popping up elsewhere.. Alternatively, use m t -> m t -> m t for everything, but replace bind with: a <= ... expanding to: a' <- ... let a = return a' This way it is guaranteed that the monadic operation has executed, e.g. if a is used multiple times, the computation that produced a' only ran once. ... >>= $ \x -> ... >>= $ \y -> return ... Could change that to >>>= where (>>>=) :: Monad m => m a -> (m a -> m b) -> m b m >>>= f = m >>= (f . return) Entry: Reactive GUI Date: Sat Aug 15 09:19:11 EDT 2015 http://stackoverflow.com/questions/2672791/is-functional-gui-programming-possible http://hackage.haskell.org/package/reactive-banana https://wiki.haskell.org/Reactive-banana Entry: Avoiding Cabal Hell Date: Tue Aug 18 22:08:33 EDT 2015 On debian: apt-get remove haskell-platform apt-get autoremove apt-get install ghc cabal-install globally: cabal update cabal install cabal-install per project: cabal sandbox init cabal configure cabal install --only-dependencies http://softwaresimply.blogspot.com/2014/07/haskell-best-practices-for-avoiding.html Entry: forall Date: Thu Aug 20 09:11:55 EDT 2015 foo :: (forall a. a -> a) -> (Char,Bool) bar :: forall a. ((a -> a) -> (Char, Bool)) Some good explanations in [1]. For the above, the a->a in foo has to be polymorphic: type is instantiated at the implementation site. In bar, a->a can be any (concrete) function mapping some type a to a. [1] https://stackoverflow.com/questions/3071136/what-does-the-forall-keyword-in-haskell-ghc-do Entry: Streams and corecursion Date: Fri Aug 21 14:45:03 EDT 2015 Recursion: break down Corecursion: build up Example[1]: factorial as (the termination of) an infinite stream. [1] https://en.wikipedia.org/wiki/Corecursion Entry: Kleisli arrow Date: Sun Aug 23 10:26:54 EDT 2015 Monad m => a -> m b Monad m => a -> b -> m c Monad m => (a,b) -> m c First is a Kleisli arrow. What about second? Since it's isomorphic to the third, it could be considered as. Entry: Monads and bad intuitions Date: Sun Aug 23 16:44:47 EDT 2015 I had the false impression that it is not possible to lift anything out of a monad type constructor, but it *is* possible to lift (i->) back out, i.e. turn a lifted Kleisli arrow back into normal form: 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 The reason is that as long as there is one layer of wrapping, it's always possible to +1 or -1 with return and join. Entry: CPS Monad revisited Date: Sun Aug 23 19:52:08 EDT 2015 By construction: A continuation resembles a function in that it takes an argument, but does not return (e.g. it returns bottom). k = r -> b r: result type of function in CPS form. will be passed to the continuation. b: bottom (or for terminating embeddings, any other Haskell term) A CPS computation is then a function that takes a continuation and produces the embedding type of the computation. c = k -> b = (r -> b) -> b c is Monadic in its r parameter, with return :: r -> ((r -> b) -> b) return r = \k -> k r bind :: ((r -> b) -> b) -> (r -> ((r' -> b) -> b)) -> ((r' -> b) -> b) bind c f = \k -> c (\r -> f r k) ------------- k' With return trivially invoking k, bind means: - create a new CPS computation from c and k, by: - first running c with continuation k', which - takes the value computed by c and, - uses it to unlock a new CPS computation from f - which is then executed by passing it the final continuation k Note that 'bind' and 'return' mimick variable binding and value return in a functional language. b is an effect of the embedding. When running a CPS computation, a value of type b will be produced. b is irrelevant for the CPS Monad composition. However, in a CPS computation, b is likely constrained by other operations that modify continuations directly. Entry: Turn left folds into right folds (corecursion) Date: Tue Aug 25 12:46:33 CEST 2015 Basically, left folds don't work well in a lazy language because they build a tower of thunks[1]. Right folds are easy, and they can operate on infinite streams as well. [1] http://stackoverflow.com/questions/8235797/is-foldl-ever-preferable-to-its-strict-cousin-foldl Entry: Testing C code with Haskell Date: Tue Aug 25 19:59:50 CEST 2015 https://wiki.haskell.org/FFI_Introduction http://blog.ezyang.com/2010/06/setting-up-cabal-the-ffi-and-c2hs/ Entry: moodler Date: Thu Aug 27 13:04:36 CEST 2015 https://github.com/dpiponi/Moodler Entry: reading Haskell Date: Thu Aug 27 18:27:12 CEST 2015 Or writing readable Haskell? Don't worry about wrapping and lifting: this is what the type checker is for. If you have a generalized operation, just name it similar to the closest library function. e.g.: head' ((t:_,_)) = t tail' ((_:ts,x)) = (ts, x) Then, when reading, one can focus on the meaning modulo the wrapping/lifting. Entry: _not_ using reader monad Date: Sun Aug 30 21:18:57 CEST 2015 Explicit reader is sometimes more clear. data Trie a b = Node [(a, Trie a b)] | Leaf b deriving (Eq, Show) foldrPairs f i a = runReader (fld i a) [] where fld i (Leaf a) = do ts <- ask return $ f (ts, a) i fld i (Node []) = return i fld i (Node ((t,a):r)) = do i' <- fld i (Node r) local (++[t]) (fld i' a) foldrPairs f i a = fld [] i a where fld ts i (Leaf a) = f (ts, a) i fld _ i (Node []) = i fld ts i (Node ((t,a):r)) = fld (t:ts) (fld ts i $ Node r) a or foldrPairs f i a = fld [] i a where fld ts i (Leaf a) = f (ts, a) i fld ts i (Node ((t,a):r)) = i'' where i' = fld ts i $ Node r -- inner i'' = fld (ts++[t]) i' a -- outer fld _ i (Node []) = i or using foldr foldrPairs f i a = fld [] i a where fld ts i (Leaf a) = f (ts, a) i fld ts i (Node tas) = foldr f' i tas where f' (t,a) i = fld (ts++[t]) i a Entry: a -> b -> m c Date: Thu Sep 3 13:40:07 CEST 2015 Is a -> b -> m c a Kleisli arrow? One would think, because it is isomorphic to (a,b) -> m c. Another way to look at this, replacing ordinary function type by Kleisli arrows: (a -> m (b -> m c)) Is this isomorphic also? EDIT: The answer is yes: tx :: Monad m => (a -> m (b -> m c)) -> (a -> b -> m c) tx f a b = do; f' <- f a; f' b The basic idea is that as long as the output is monadic, anything monadic in the input can always be "pulled out". And doubly wrapped outputs can always be flattened to singly wrapped, but singly wrapped outputs are the endpoint. In general, the conclusion is that inputs are not important. They are just parameters that influence the output. Sounds trivial, but is actually quite an important guiding principle. Entry: Testing C against reference Haskell implementation Date: Fri Sep 11 19:51:39 CEST 2015 https://sligt.wordpress.com/2010/05/28/testing-c-using-quickcheck/ Entry: What I wish I knew... Date: Sun Sep 13 00:23:02 CEST 2015 http://dev.stephendiehl.com/hask/ Entry: Sandboxes Date: Sat Jan 2 14:16:19 CET 2016 [master] tom@tp:~/git/cauterize$ cabal sandbox init [master] tom@tp:~/git/cauterize$ cabal install --only-dependencies http://coldwa.st/e/blog/2013-08-20-Cabal-sandbox.html Entry: Lenses Date: Sun Jan 10 23:03:12 CET 2016 The name lens goes back to Benjamin Pierce’s work on bidirectional programming. The notion of a lens in this package corresponds to his notion of a “very well-behaved lens”. Q: How does this package relate to “Bananas, Lenses, Envelopes and Barbed Wire?” A: It doesn’t. https://github.com/ekmett/lens/wiki/FAQ Entry: DSL time Date: Fri Aug 12 17:47:13 EDT 2016 So I'm done with not having a good state machine implementation language. Time to build one from scratch as a haskell DSL. This should map to C and sequential logic for HDL synthesis. Rationale: in my work I only need two kinds of systems: a generic "control computer", which can be any high level language (Haskell, Scheme, Erlang, ...) and some leaf hardware that has severe resource and timing constraints, and needs a C or HDL lower layer. Would be a good opportinity to try out free monads. Entry: stack Date: Sat Sep 10 14:28:10 EDT 2016 https://www.fpcomplete.com/blog/2015/06/why-is-stack-not-cabal Entry: FRP Date: Tue Sep 13 01:03:51 EDT 2016 https://begriffs.com/posts/2016-07-27-tikhon-on-frp.html http://wiki.haskell.org/Reactive-banana https://wiki.haskell.org/Threepenny-gui take-home point: behaviors and events are dual Entry: HalVM Date: Sat Dec 10 00:26:48 EST 2016 http://uhsure.com/halvm3.html Entry: typeclasses Date: Fri Dec 23 20:43:25 EST 2016 https://www.youtube.com/watch?v=hIZxTQP1ifo - add behaviour to data types (mixins?) Entry: types vs. tests Date: Tue Dec 27 12:42:52 EST 2016 Translations and communication: usually types are sufficient for this, as the functionality is mostly implemented by composing obvious sub-solutions into an obvious solution, where the complexity is just in getting it not to do undefined things. Algorithms: types are not sufficient, as algorithic steps usually contain "cleverness" in a way that can not be expressed easily through type systems. Custom properties are often at play that cannot be expressed in the implementation language. In that case there are a couple of options: - manual proofs - a model in a different language with more checkable/provable properties - property based testing - manual testing Entry: Functional programming and Imperative Multiprocessing Date: Mon Mar 6 12:50:12 EST 2017 Imperative is _necessary_ when communication is involved. I would like to find out how to do Erlang-style multiprocessing in Haskell. If I find out how to do that, I'll switch to Haskell for future work. https://wiki.haskell.org/Concurrency Entry: Switch to stack? Date: Wed Apr 12 10:37:50 EDT 2017 It's been a couple of years. Maybe time to switch default setup to current state of the art? Before I was using ghci, cabal-install from Debian packages, then used "cabal install cabal-install" to upgrade cabal. Regarding ghci, is it possible to have tab completion in emacs? Had trouble installing llvm-generic-pure, not sure why. Removed the sandbox, then reinstalled it following "cabal help sandbox". Entry: Installing stack Date: Thu Apr 13 14:47:01 EDT 2017 cabal install stack stack new https://docs.haskellstack.org/en/stable/GUIDE/ Entry: Standardize on haskell build system Date: Fri Jun 2 08:41:52 EDT 2017 It's starting to fall apart.. Entry: installing haskell on debian Date: Sat Jun 10 15:05:17 EDT 2017 This shit keeps breaking.. tom@zoo:~$ cabal install cabal-install cabal: failed to parse output of 'ghc-pkg dump' I need a sure shot way of building xmonad. Maybe best to not install any debian packages except from haskell-stack? # apt-get install haskell-stack $ stack setup $ stack install xmonad-contrib But that is not enough to also have it do the recompile. https://github.com/commercialhaskell/stack/issues/710 I don't understand how I've fixed it again this time, by uninstalling xmonad debian package, then reinstalling again. Entry: Getting re-aquianted with Haskell build tools Date: Sun Nov 5 07:52:33 EST 2017 First stop: CCC. I'd like to build a language that can compile to composable cooperative state machines. Incredible... The first thing I do is a git pull, and it causes a stack build failure on one of the examples. Not easy to fix with just commenting out things, so I am going to leave this for later. Not getting into yak shaving. What is possible is to make a monadic language for the state machines without relying on the syntax. Entry: Free Theorem / Free Monad Date: Sun Nov 5 14:18:48 EST 2017 The idea of "free". https://stackoverflow.com/questions/12421085/good-introduction-to-free-theorems http://homepages.inf.ed.ac.uk/wadler/topics/parametricity.html https://underscore.io/blog/posts/2015/04/14/free-monads-are-simple.html http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html Entry: Free Monad Date: Sat Nov 18 01:12:59 EST 2017 The free monad is all possible nestings derived from a functor. I.e. the fixed point of a functor. Compare to lists -- but I did not find this very clarifying. data List a = Nil | Cons a (List a) The definition of a Free is similar: data Free f a = Pure a | Roll (f (Free f a)) E.g Pure a Roll $ f $ Pure a Roll $ f $ Roll $ f Pure a This contains all nested versions of the functor. E.g. with a product functor such as pair: f a = {a, a} and leaving out the tags Pure and Roll, the actual structure is: a {a,a} {{a,a},{a,a}} ... "Technically, it is only a tree if your base functor is a product functor. When you have a sum functor as the base functor it more closely resembles a stack machine." The Free Monad (data structure) is to the Monad (class) like the List (data structure) to the Monoid (class): It is the trivial implementation, where you can decide afterwards how the content will be combined. -> That rings like the other explanation: instead of combing computations, it just keeps nesting. -> Or: You want to use the machinery of a monad for composition, but want to determine later on what the meaning of the functions will be. Then foldFree takes return and join. This is an interpreter. "Stacking instead of reduction." https://stackoverflow.com/questions/13352205/what-are-free-monads http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html Entry: Product functor vs. sum functor Date: Sat Nov 18 01:47:32 EST 2017 Interesting how sums keep appearing as "the other". When thinking about data types, I envision mostly products (structs), but sums are just as important (unions). Also in ada. At the type level, the "or" looks "algebraic", while at the proof / function level this requires case analysis. Producs seem that much simpler to express. Where does the asymmetry come from, if these are really dual? Entry: Contemporary Haskell Date: Tue Nov 28 22:13:06 EST 2017 Things to learn: - Free anything - Lenses - Monad stacks and associativity - Parser combinators (parsec, attoparsec, happy) - knot tying - strictness ! - extensions to be aware of? - concurrency: STM, MVar, channels, par, MapReduce Possible applications: - snarfing parsers for databases (e.g. logs) - testers, specifiers for other programs http://book.realworldhaskell.org/read/monad-transformers.html http://book.realworldhaskell.org/read/using-parsec.html https://stackoverflow.com/questions/19208231/attoparsec-or-parsec-in-haskell http://book.realworldhaskell.org/read/concurrent-and-multicore-programming.html Entry: Monad stacks Date: Sat Dec 2 11:38:10 EST 2017 See "Hiding our work" http://book.realworldhaskell.org/read/monad-transformers.html Using the GeneralizedNewtypeDeriving language pragma, it is possible to create a newtype that has all the component monad operations. This addresses the main concern I had: that "liftM" operations were always needed. Entry: parsec Date: Sat Dec 2 20:00:18 EST 2017 <|> is not commutative Below, in the definition of 'atom', the two combinators cannot be swapped. file = endBy line (char '\n') line = sepBy atom (char ',') atom = quoted <|> plain quoted = do char '"'; a <- many $ noneOf "\","; char '"'; return a plain = many $ noneOf ",\n\"" parseCSV :: String -> Either ParseError [[String]] parseCSV input = parse file "(unknown)" input This: https://kunigami.blog/2014/01/21/an-introduction-to-the-parsec-library/ Says to use the 'try' combinator "which will make a parser to not consume its input if it fails to match". Wait... it might just be many1 Entry: Cross compiling haskell Date: Sat Dec 2 20:37:34 EST 2017 I'd like to create a "service node" for offloading tasks from an Erlang system. This needs only a single static binary. What I want is something that can handle different Erlang RPC calls in parallel. It doesn't really have to be a node which needs some extra protocol overhead. A port process is already good enough. Start here: https://medium.com/@zw3rk/a-haskell-cross-compiler-for-raspberry-pi-ddd9d41ced94 From here: https://www.reddit.com/r/haskell/comments/2uszbi/haskell_does_it_support_cross_compilation/ "GHC doesn't cross-compile user programs" But it is possible to cross-compile GCC and compile it on the target. This mentiones a frankenstein's cross-compiler: https://haskellembedded.github.io/posts/2015-12-15-arm.html So it's not without caveats. Maybe simpler to set up a qemu lxc. More recent docs: https://ghc.haskell.org/trac/ghc/wiki/Building/CrossCompiling Entry: lxc + qemu armhf vm with ghc Date: Sun Dec 3 19:53:12 EST 2017 Let's try a static hello world program. Compiles but doesn't run properly; likely needs libs still. So basically, GHC needs a different C library, or the C library needs to go on the target. Let's try to build a cross-ghc. It needs gold. Does buildroot support gold? --enable-gold in buildroot's binutils options Got it this far: compiler/main/ErrUtils.hs:63:27: Module `GHC.Conc' does not export `getAllocationCounter' Probably best to compile haskell with the same version, and use a more recent one. git checkout ghc-8.0 git submodule update --init stuck here: checking for arm-linux-gcc option to accept ISO C99... unsupported configure: error: C99-compatible compiler needed tried 8.2 and 8.4 fucking mess Looking at config.log: configure:6274: checking for arm-linux-gcc option to accept ISO C99 configure:6423: arm-linux-gcc -std=gnu99 -c -g -O2 conftest.c >&5 conftest.c:67:9: error: unknown type name 'wchar_t' const wchar_t *name; I did see somewhere a variable to enable this. Toolchain -> Enable WCHAR support BR2_TOOLCHAIN_BUILDROOT_WCHAR=y BR2_USE_WCHAR=y Ok it gets past this, but then runs into trouble here: checking for ld bug 16177... affected configure: error: Your linker is affected by binutils #16177, which critically breaks linkage of GHC objects. Please either upgrade binutils or supply a different linker with the LD environment variable. Going from 2.26.1 to 2.27 Not clear if that will fix it. Nope won't fix it. The configure script checks the bug's effect, not the version. Latest version is 2.29.1 Let's see which is the latest version in buildroot. 2.29.1 is available in current head Was at: commit 54242226f034c1245d379df5f98cefcc13553437 Author: Guo Ren Date: Thu Mar 23 18:46:14 2017 +0800 Switching to: commit cbb50827f6334dab4c4a4922a2a5ae37380d812b Author: Bernd Kuhls Date: Sun Dec 3 20:41:40 2017 +0100 2.29.1 still has the problem I guess there is no way around this until it gets fixed. https://ghc.haskell.org/trac/ghc/ticket/4210 Unfortunately, things are still broken with BFD ld due to ld bug 16177 (​https://sourceware.org/bugzilla/show_bug.cgi?id=16177) wherein ld inexplicably generates R_ARM_COPY relocations where a standard R_ARM_ABS32 relocation would do just fine (as gold does). Sadly, despite the bug being reported two months ago, there has been no activity from the ld side. For now I suspect we'll just have to advise users to use gold on ARM. How to use gold? "...supply a different linker with the LD environment variable" Trying this: #!/bin/sh # apt-get install ghc happy alex # cd $(dirname $0)/ghc PATH=~/exo/br/target/bbb/host/usr/bin:$PATH export PATH cat <mk/build.mk HADDOCK_DOCS=NO EOF export LD=arm-linux-ld.gold ./configure --target=arm-linux && make -j24 "make -j24" gave problems trying just make Nope.. I tried a lot of permutations but all of them fail some way or other. There has to be some tutorial on how to compile this, and what versions to use. This mentions a couple of patches and a different libffi version: https://medium.com/@zw3rk/a-haskell-cross-compiler-for-raspberry-pi-ddd9d41ced94 Entry: Giving up Date: Mon Dec 4 19:26:06 EST 2017 I do not know how to do this. Since it was only supposed to be a weekend quick hack, it is time to re-evaluate if it is really necessary to proceed. What I want to do is mostly to solve some of the practical problems I've been carrying around that have to do with parsing. PCs are fine for that. For ARM, maybe try to build rust first? Entry: Parsec <|> is predictive Date: Mon Dec 4 19:53:57 EST 2017 "For reasons of speed, the (<|>) combinator is predictive; it will only try its second alternative if the first parser hasn't consumed any input." "The preferred solution to this problem is to left-factor the grammar by merging common prefixes." http://legacy.cs.uu.nl/daan/download/parsec/parsec.html Entry: Rank2Types and value-level instances Date: Fri Dec 8 21:34:06 EST 2017 http://www.haskellforall.com/2012/05/scrap-your-type-classes.html Might help for some of the problems I ran into before -- a lot of overlapping instances and "gedoe". Read it again to really understand it. Entry: Monadic languages vs CCC Date: Sun Dec 10 17:09:05 EST 2017 Here's a problem to test: For my DSP language, one of the things that really got to me there not being a default evaluation order that would give a canonical "binding chain" when evaluating expressions. It's a serious pain to lift everything to monadic values. CCC might solve that, since it makes it possible to introduce strictness and evaluation order, then map that on an arbitrary monadic interpreter/compiler. Entry: Haskell, DSP and DSLs Date: Mon Dec 11 00:55:38 EST 2017 Again... Ingredients: - CCCs for embedding of monadic languages - Monadic base language -> LLVM - Time: Sequences as state machines + Applicative abstraction - Space? Entry: Monadic langauges and expressions Date: Mon Dec 11 01:18:53 EST 2017 Basically, if mul :: t -> t -> m t Is one of the operations, it's not possible to do z <- (a mul b) mul c It needs something like do z0 <- a mul b z <- z0 mul c Which is annoying Entry: concat Date: Mon Dec 11 01:28:54 EST 2017 have: 64e6c15c3599d2fc326f9450906e8dbfed39fd58 simplified/generalized choose updated: 051ad5218f0e3bcfd398fd310774877e8679ce27 Merge branch 'master' of github.com:conal/concat e20b75609ccee4fc5c2656f396bf2a9abe67b39f curry/uncurry; min/max It builds Entry: Erlang overlay Date: Wed Dec 13 15:28:36 EST 2017 What I want is a way to use Haskell syntax and types to create a monadic language overlay to write Erlang "algorithmic" code. I.e. write something that looks like Erlang syntactically, but is fully statically typed. For this I don't really need CCC. What I need is something that translates Erlang syntax to Haskell for type annotation. Entry: circular programming Date: Fri Dec 15 23:07:34 EST 2017 https://ocharles.org.uk/blog/posts/2014-12-09-recursive-do.html Entry: concat Date: Sat Dec 16 10:32:33 EST 2017 I'll need to do some more Haskell before I can start reading Conal's code. Maybe work on the DSP language directly, assuming that all monadic abstractions will later be abstracted behind CCC. Entry: No haskell debian packages for panda Date: Tue Feb 13 11:29:52 CET 2018 Only use stack from main distro: # curl -sSL https://get.haskellstack.org/ | sh Needs to run as root once to install Debian dependencies. After that, run "stack install shake" etc.. as user. tom@kanda:~$ stack install shake tom@kanda:~$ stack install --resolver lts-6.2 Agda Entry: Compile to anything Date: Tue Feb 20 15:22:25 CET 2018 Create a language that can compile to: - bash - erlang What I need is a shell scripting language that can easily do parallel operations, such as logging into multiple servers and handling sync and node-down etc.. Entry: Trying to get back into Haskell through Shake Date: Wed Feb 21 11:40:05 CET 2018 Some syntax I don't undertand: shakeOptions{shakeFiles="_build"} https://stackoverflow.com/questions/11591170/which-is-the-use-of-curly-braces-in-haskell This is record type deconstruction. Entry: Stack Date: Wed Feb 21 13:07:04 CET 2018 It seems best to always install it from latest source. # curl -sSL https://get.haskellstack.org/ | sh https://stackoverflow.com/questions/30913145/what-is-the-difference-between-cabal-and-stack Entry: Erlang node protocol Date: Wed Feb 28 16:56:27 CET 2018 I want an Erlang node written in Haskell. There is code for this... Let's look. erlang-0.2.2 in Hackage: https://hackage.haskell.org/package/erlang-0.2.2/docs/Foreign-Erlang.html https://github.com/poor-a/erlang-ffi some derivative - dont use? https://github.com/joedevivo/erlang-haskell-interface another one: https://hackage.haskell.org/package/hinterface EDIT: Note that this still needs a manual conversion between a generic erlang data type, and any Haskell type structure. Basically, the Haskell part will be its own thing, unless the Erlang type declarations can be mapped directly. That would be the big win: types for quickcheck. Entry: Rep and structure commutation Date: Sat Mar 3 09:33:14 CET 2018 Why is that so hard? Maybe because it is actually significant? E.g. in Haskell, representation (constructor wrapping) is trivial, but in target lang it is far from. Typical intuition mismatch: commutation does not mean that in concrete applications, things will look very similar: only some structure remains. Entry: Erlang vs. Haskell BT client Date: Sun Mar 4 11:30:46 CET 2018 Link? hs: + STM: channels fit better in a typed language + types, refactoring easy - space leaks require attention. erl: + write app s.t. it can restart easy. then only fix bugs that hit frequenly enough. for b.t. client this was easy to do. - no types, refactoring hard Entry: Erlang harness Date: Sun Mar 4 11:33:10 CET 2018 Should be an overlay for Erlang code: types specified in Erlang to be translated to Haskell automatically. TODO: extend routines used for expect tests. EDIT: - special handling for singleton products - no maps - sum types need data definitions Seems to work. Other way: is there a haskell library to represent type syntax? Likely yes, but might be overkill. EDIT: This allows type-directed programming. 1. Define types in Erlang. Use proper ADTs by: - creating type aliases for all products - create sums by using unions only at top level 2. Import types in Haskell, and write functions that implement the types. 3. Use abstract evaluation to produce Erlang code. EDIT: sum types 146> hs:x("-type t(A) :: left(A) | right(A)."). <<"data T(a) = Left (Left(a)) | Right (Right(a))">> constructor---- ----alias Note that to do this without monads in the type descriptions, the CCC loophole is needed! This could translate the types to a monadic type. EDIT: Move most of this to Haskell. Dump syntax as Erlang binary -- just use the Erlang parser. Then import in Haskell and reify the types there. Entry: Strict ML embedding Date: Sun Mar 4 14:09:27 CET 2018 1. Create an ML-like language into Haskell using the tagless final representation? 2. Create a mapping from pure Haskell to this strict dialect using CCC. Entry: CCC pattern matching Date: Sun Mar 4 15:11:23 CET 2018 How does this implement pattern matching? For code similar to GW, this is pretty much all there is: data structures to decouple modules, with data moving all over the place. A pattern match is a mating of a set of costructors and a set of cases. Compare to app / lam? app :: r a -> r (a -> b) -> r b lam :: (r a -> r b) -> r (a -> b) Now suppose a is a sum type. It is never explicitly represented as a sum type in the meta language: all types are always wrapped. I did this for sum types (tuples) before. Just try Either with some concrete base types. Suppose we're interested in this function f_w :: r (Either Int Float -> Bool) f_i :: (r (Either Int Float)) -> (r Bool) The point of hiding this behind r, is that the representation is completely opaque. I.e. the "target compiler" needs to have a special case to implement deconstruction. In that sense, sums and products are indistinguishable. Again. r (a -> b) Opaque representation of function. Here a->b is just an index. (r a) -> (r b) Actual function mapping one rep to another. What do app and lam create? A way to use native function abstraction, application to create representations of functions. The point is to create reps of funcs. Specialized to Ether: the point is to create a rep of e.g Erlang function: fun({left, X}) -> inc(X); ({right,Y}} -> dec(Y). From a Haskell meta-language function: \e -> case e of Left x -> app r_inc x Right y -> app r_dec y Types: r (Either A B -> C) Either (r A) (r B) -> r C For every target language type, there needs to be an operation that lifts it out like this. Sums or products really do not matter. In this case, a specialized "appEither" is needed appEither :: r (Either A B) -> r (Either A B -> C) -> r C but what about (Either (r A) (r B) -> r C) -> r (Either A B -> C) I'm confusing two things: - function abstraction / application - type construction / deconstruction These are very similar, but they need to be implemented in a way that they can be mixed. A case statement takes two representations of functions, one for each case: caseEither :: r (Either A B) -> r (A -> C) -> r (B -> C) -> r (Either A B -> C) So, the solution is to implement "case" explicitly for each sum type. Pattern matching is a _syntactic_ overlay for case, and should not be modeled in the representation. The counterpart is explicit constructor functions EitherL :: r A -> r (Either A B) EitherR :: r B -> r (Either A B) Main point, per datatype: - a case function - constructors However, generic 2-ary sum and product are enough to structurally mimick any possible ADT. So "ML" is: - app/lam - cons/uncons (products) - either/uneither (sums) Starting to recall how this was explained in the final tagless lit. Entry: Toy languages Date: Sun Mar 4 16:27:17 CET 2018 - app/lam + cons/uncons + either/uneither - extend to monadic forms to embed side effects Entry: SimpleML to Typed Erlang? Date: Sun Mar 4 16:38:11 CET 2018 To embed this in Haskell, it is simplest to stick to diadic sums and products. However, that will lead to very ugly Erlang data types. How to solve? - Somehow generate the type classes to include more types? - Create conversion functions to translate between "public" and "private" representations Entry: Type checker + abstract evaluator Date: Sun Mar 4 16:51:00 CET 2018 Steps: - write code + (optional) type annotation in Erlang - translate code from Erlang parse tree to embedded language in Haskell - type check - (optional) do abstract evaluation This will solve the main problem: Erlang code that passes the type check will not have type errors. Disadvantage: embedding is likely to be rough, so the Erlang code that passes this will be a subset. It will not work for multi-processing code. But it might still be possible to create Erlang abstractions that can be represented in haskell. Entry: Erlang pids vs. Haskell channels Date: Sun Mar 4 16:54:48 CET 2018 How to emulate channels in Erlang? A simple way is to prefix all messages for a particular channel and implement channel read as a blocking receive. Entry: Alternatives Date: Sun Mar 4 16:59:40 CET 2018 A better way to represent sums is to use {Tag,_}. This is needed anyway to be able to match at run time. Entry: Lenses Date: Sat Mar 24 11:08:15 EDT 2018 https://github.com/ekmett/lens/wiki/FAQ The name lens goes back to Benjamin Pierce’s work on bidirectional programming. The notion of a lens in this package corresponds to his notion of a “very well-behaved lens”. So it is related to Pierce's bidirectional programming. Interesting. Maybe interesting to implement the "editable database view" this way. Entry: Traverse tree with context summary Date: Sun May 6 16:48:41 EDT 2018 A common operation, but how to build it out of common components? What about Traversable and Foldable? https://wiki.haskell.org/Foldable_and_Traversable Entry: I need a PRU emulator Date: Mon May 21 11:05:55 EDT 2018 Will need to write some "threaded" PRU code, but I want to make sure I have a little framework where I can evaluate the code before actually running it on the machine. Debugging is minimal. This coincides with some staapl idea to do the same for the PIC. I need some general approach. Implement it as a monad, but the monad should be programmable. I have two main tricks: - "tagless final" - free monads to separate code and data structure EDIT: The meaning of a program is a function that produces an infinite timing diagram. So the meaning of an instruction is to modify the value of a signal at a particular time. The program counter is just another signal. Now, specify the assembly language as a class that is parameterized by a monad that satisfies certain constraints. Entry: Evaluation order Date: Mon May 21 12:05:12 EDT 2018 the typical thing that happens is to want to map a -> b -> m c to m a -> m b -> m c What is missing there is evaluation order, so that is handled by. EDIT: I've been here before, and it is not a good idea. It can trigger multiple evaluations for side-effecting behaviors such as label generation. So let's not do this by default. Entry: loops/recursion and tagless-final Date: Mon May 21 16:20:56 EDT 2018 All examples I've seen are non-recursive. Using Haskell's built-in recursion doesn't seem to be a good idea. It's ok for code, but for data it creates infinite data structures. So what to do. Add a y combinator to the language? I'm looking into this for assembly lanugage. This should be possible as long as there are no arbitrary jumps, i.e. all jump destinations are expicitly named locations. That way the type class implementing the language can use either the provided jump labels, or link the code. Entry: State monad vs. state update functions Date: Wed May 23 09:02:42 EDT 2018 I'm implementing a partial emulator for Sitara PRU. Instead of using explicit state update functions s->s, I'm using a state monad :: m (). Because of (), this seems not necessary. However, it is still useful because intermediate computations used to implement the instructions can still return values inside the monad, such as e.g. a register lookup function :: m Int. Entry: Free Monad Date: Sun May 27 08:33:02 EDT 2018 Sometimes, a one-line explanation does it all. http://hackage.haskell.org/package/free-5.0.2/docs/Control-Monad-Free.html Monads provide substitution (fmap) and renormalization (join): m >>= f = join (fmap f m) A free Monad is one that does no work during the normalization step beyond simply grafting the two monadic values together. Entry: Type-directed programming Date: Sun May 27 11:05:20 EDT 2018 Write down types, create an incomplete implementation using base cases, then fill in more general cases, then abstract points keeping it working. Finally, a general standard type class structure emerges, so then rewrite it to use that interfaces. This will then point to other generalizations. Entry: filterMap ? Date: Sun May 27 11:16:47 EDT 2018 Is there an operation that filters and return Just the filtered elements? See mapMaybe, catMaybes I need the same for a Map: Map.map folled by Map's catMaybes variant? traverseMaybeWithKey mapMaybe Entry: Conversions Date: Sun May 27 11:30:49 EDT 2018 It's great to have something that can perform automatic conversions of data representations. E.g. foldr on Map A B or List (A,B) would be the same code. Then the latter can be used when order is important, and the first when uniqueness is important. Entry: Free in SeqNet.hs Date: Sun May 27 15:44:19 EDT 2018 I'm using Free to create an expression data type from a flat term Functor. type Exp n = Free Term n I constructed some code using the types directly: -- Inline node based on predicate. inlineP :: (n -> Bool) -> (n -> Term n) -> n -> Exp n inlineP p ref = inl where inl n = case (p n) of True -> Free $ fmap inl $ ref n False -> Pure n Then couldn't figure it out how to write it using the free operators. After reading some docs and looking at type signatures, liftF looked like what I needed: inlineP p ref = inl where inl n = case (p n) of True -> liftF (ref n) >>= inl False -> return n liftF :: Term n -> Free Term n liftF :: Term n -> Exp n It converts between the "basic structure" and the "nested structure". Basically, what liftF does is to make a functor value (which might have multiple n), look like a single monadic value n, which can then be bound to an f a -> m b to be applied. Essentially, the Free monad abstracts fmap as bind. I'll need to use this some more before it clicks. Entry: Applicative Functor Date: Sun May 27 17:50:11 EDT 2018 An applicative functor is just a multi-argument functor: fmap :: (a -> b) -> f a -> f b liftA2 :: (a -> b -> c) -> f a -> f b -> f c Why is this considered a side effect? https://wiki.haskell.org/Typeclassopedia#Applicative Maybe the somplicity of liftA2 is a bit misleading. The additional operations are. (<*>) :: f (a -> b) -> f a -> f b which combines two contexts into one, and pure :: a -> f a which creates a sort of default context. These make f into something more than just a container. Read that page again. Lots of interesting pointers. Entry: compose and 2-argument function? Date: Sun May 27 18:33:31 EDT 2018 How to pipe the output of a 2 argument function through a second one? a -> b -> c and c -> d (c -> d) -> (a -> (b -> c)) -> (a -> (b -> d)) (c -> d) -> f c -> f d so it is fmap and the functor is F(t) = (a -> (b -> t)) but i can't get to i that way. It's Kmett's dot dot dot... *Main> :t (.) (.) :: (b -> c) -> (a -> b) -> a -> c *Main> :t (.) . (.) (.) . (.) :: (b -> c) -> (a1 -> a -> b) -> a1 -> a -> c *Main> :t (.) . (.) . (.) (.) . (.) . (.) :: (b -> c) -> (a2 -> a1 -> a -> b) -> a2 -> a1 -> a -> c reg'' :: Seq m r => SType -> (r S -> m (r S)) -> m (r S) reg'' = ((.).(.)) (fmap fst) reg' Ok, I get it. The sequence applies f to the result of 1,2,3,.. argument function (.) f g1 ((.).(.) f g2 ((.).(.).(.)) f g3 The first one is just functiona application. The other ones immedately look quite ugly, but if application is written as above it is clear there is a sequence. https://stackoverflow.com/questions/17585649/composing-function-composition-how-does-work That mentions composing fmap gets you deeper into layers of functors. That makes sense. Then (.) is ifmap for ((->) r), which brings the same point as above. So (.).(.) is fmap.fmap Entry: Template haskell vs. Makefile Date: Sun May 27 22:19:15 EDT 2018 For embedded DSL it really doesn't matter. Compiler will always run on large system. Entry: sequence List,Monad genaralizes to traverse Functor,Traversable Date: Mon May 28 12:13:14 EDT 2018 https://stackoverflow.com/questions/17562345/generalizing-sequence-for-all-functors Slightly different interface but enough to do replace sequence,fmap with traverse,return. What I ran into was this: traverse :: (a -> f b) -> t a -> f (t b) generic (a -> m b) -> f a -> m (f b) specialized to mapping monadic function over a functor The specific version for Monad and List is traverse ' :: Monad m => (a -> m b) -> [a] -> m [b] traverse' f l = sequence $ map f l EDIT: actually, there is: sequence :: (Traversable t, Monad m) => t (m a) -> m (t a) http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html#v:sequence sequence $ fmap _ _ == traverse _ _ I keep using the former... Seems more readable and also since there is no 2-arg traverse version? E.g. sequence $ liftA2 _ _ _ Entry: Metalevel Functors -> Targetlevel lists Date: Mon May 28 13:57:06 EDT 2018 A problem I've run into quite a bit is the "commutation" between representation and containers. Awkward, and often not necessary. Typically, the target only needs a single container that captures the flattened out structure of a metalevel functor. In C, this could be a flat C struct. Entry: "transposing" (,) and Functor? Date: Mon May 28 16:27:20 EDT 2018 f (a, b) -> (f a, f b)? Yeah not really a problem. Entry: Composing functors Date: Mon May 28 16:30:49 EDT 2018 I find a need to see Functor [t] as a functor of t. Is there a standard way? https://stackoverflow.com/questions/19774564/what-does-it-mean-to-compose-two-functors Entry: Typechecker fights Date: Tue May 29 16:29:24 EDT 2018 What does this actually accomplish? Making sure you get the wrapping/unwrapping right such that behaviors tagged onto specific types can do their thing. I find there to be a big gap sometimes between the intuitive "oh, I can string this and that together", and getting all the type packing/unpacking right. I guess that's what the type checker is for, to fill in those tedious details. Entry: (_ a) Date: Tue May 29 19:51:58 EDT 2018 To find out the type of a function. Entry: Free monad Date: Tue May 29 20:04:01 EDT 2018 I keep getting stuck on things. How to turn f a -> m a ? liftF :: f a -> m a Entry: Structure preserving applicatives? (Zippable?) Date: Wed May 30 13:21:40 EDT 2018 Is there a way to constrain an applicative such that it is structure-preserving, in the same way that fmap has to be? E.g. List has a very annoying cross product Applicative. ZipList is the way around that. How to say I want it to be the same shape? What is actually the constraint I'm making? Maybe the more important question: Why am I using an applicative functor in a way that this matters? Edit: actually, in this case ('next' in Seq.hs), the only use can be replaced by toList + zip. In fixMem I still need to use liftA2. But if it is in a monad, maybe application helps? I don't understand why this is so hard to resolve. Why can't a functor have a size and a canonical list representation? https://stackoverflow.com/questions/31143239/zippable-class-for-haskell Representable functor http://hackage.haskell.org/package/adjunctions-4.2.1/docs/Data-Functor-Rep.html#v:liftR2 https://en.wikipedia.org/wiki/Representable_functor I don't quite understand it. ZipList is not an instance? Maybe look at what ZipList is an instance of? Maybe it is Alternative? Which is a Monoid only if the containee is a monoid right? List is also Alternative, so not what I'm looking for. So basically, this is a little to dense.. For now I don't need a solution. Errors against non-zipping applicatives will be caught at runtime. So ZipList is actually "dirty" because (liftA2 f) is not total. EDOT: Actually ziplists do truncate, so it is total. The solution is probably to use Rep? Entry: Apply Date: Wed May 30 16:41:56 EDT 2018 Or Apply? http://hackage.haskell.org/package/semigroupoids-5.0.0.1/docs/Data-Functor-Apply.html#t:Apply Which has ZipList but not List? Yes it was Apply liftA2 becomes liftF2 Also see WrappedApplicative How does that work? Because that's essentially what I've been chasing. Nope, this still has []. *Main> liftF2 (+) [1,2] [3,4] [4,5,5,6] Damn. Let's just put liftA2 back. There's no need to create the dependency. Entry: Representable? Naperian? Date: Wed May 30 17:39:13 EDT 2018 https://stackoverflow.com/questions/46489376/which-haskell-functors-are-equivalent-to-the-reader-functor there is only one shape. For later. But it does seem that is it. ZipList is not in it because it doesn't have fixed shape. Also: http://hackage.haskell.org/package/base-4.11.1.0/docs/GHC-Generics.html#t:Rep Entry: Zippable Functors Date: Wed May 30 20:58:35 EDT 2018 http://hackage.haskell.org/package/keys-3.0.4/docs/Data-Key.html#t:Indexable Entry: Hidden state Date: Wed May 30 21:18:57 EDT 2018 Time to revisit: I want to define composition for stateful computations Which is an applicative functor, except for the extra state. Can this be hidden? Yes is the answer. And I did this before as ~/meta/dspm/Sys.hs: data Sys stx m i o = forall s. (CSSM stx m s i o) => Sys (SSM m s i o) class CSSM stx m s i o where ssmCompile :: SSM m s i o -> stx So you can make this work as long as you define an interface. Above, the interface is "can be compiled to some syntax datatype". Which is really the only thing we want to do with "open" code. It's time to fish out that library, clean it up and put it on github. I did rewrite that whole thing as an Applicative and Arrow. Something like this: data Sig stx m o = forall s. (CSig stx m s o) => Sig (s, s -> m (s, o)) class CSig stx m s o where compileSig :: (i -> CSig stx m s o) -> stx Where is the last version of that code? ~/git/siso Signal.hs 4265 Haskell ~/git/siso/src/Signal.hs RSignal.hs 1778 Haskell ~/git/siso/src/RSignal.hs I believe there are issues with the latter one. Entry: Free fold Date: Thu May 31 13:23:12 EDT 2018 Free seems to be genuinely useful, but I'm having a hard time getting used to the interface. I want to monadically iterate over the leaf nodes, but each time we're going one level deeper I want to inspect that node and take some monadic action before continuing descend. Proably liftF and retract? Simplified: I want to look at each Free Functor node. iterM :: (Monad m, Functor f) => (f (m a) -> m a) -> Free f a -> m a I don't get it. Simpler example. Ok this can be used for creating bindings, where a instance is replaced by a reference that can be incorporated in another node. What I need is the other way around: for each leaf node, I want to accumulate its contents. I.e. I want to look at the tag of the list first. That's possible. Ok, that's it. Entry: Tree to Path Date: Thu May 31 20:24:22 EDT 2018 There must be a simpler way to do this. Entry: Free again Date: Fri Jun 1 08:37:51 EDT 2018 Monadic processing of a tree - Either wrap the monad and work with (>>=) - Use IterM The former is more direct. The latter uses f (m a) -> m a at each instance of the functor, to reduce the functor to a single value. The values are wrapped in a monad to allow threading the side effect through the iteration. I'm surpristed though there is no f (m a) -> m (), to be able to run the iteration for side-effect only. It's not easy to build one unless the monad is wrapped in maybe. Actually it makes no sense: the input at each level must be the output from another level. What I'm trying to do is to create a "path builder" into a nested s-expression, where the "directory name" used for stringing the path together is just a node. In general, this might not work. What is a "pathable tree"? Keyed functor? Actually keyed doesn't pick out an element. It's an f->f map. But it can probably used as some building block. Entry: More Free Date: Sat Jun 2 09:18:44 EDT 2018 hoistFree :: Functor g => (forall a. f a -> g a) -> Free f b -> Free g b Lift a natural transformation from f to g into a natural transformation from FreeT f to FreeT g. foldFree :: Monad m => (forall x. f x -> m x) -> Free f a -> m a The very definition of a free monad is that given a natural transformation you get a monad homomorphism. Entry: Tagged s-expressions Date: Sat Jun 2 09:44:13 EDT 2018 Let's recap: - Use of Free monad allows focus on the Functor, using combinators for iteration. - Parsec makes parsing straightforward to produce the Free data structure. Currently still using explict recursion, but probably possible to avoid using unfold. - Functor with tag node, allows construction of paths and monadic iteration of paths in a Reader environment. - List all paths matchin a certain parent path The remaining problem is that paths are not unique in this specific case. How to make them unique? Maybe uniqueness is not necessary if I can just "overwrite" the last unique structure. E.g. create something similar to a stack trace. [Net,Atom "SPI0_SCLK"] [Net,Joined] [Net,Joined,PortRef] [Net,Joined,PortRef,Atom "A23"] [Net,Joined,PortRef,InstanceRef] [Net,Joined,PortRef,InstanceRef,Atom "U8"] [Net,Joined,PortRef,InstanceRef] [Net,Joined,PortRef] [Net,Joined,PortRef] [Net,Joined,PortRef,Atom "&16"] [Net,Joined,PortRef,InstanceRef] [Net,Joined,PortRef,InstanceRef,Atom "U9"] [Net,Joined,PortRef,InstanceRef] [Net,Joined,PortRef] E.g. at [Net,Joined,PortRef,Atom "A23"], the last [Net,Atom "SPI0_SCLK"] node should be available. Really this is just a structural problem. Essentially, the information should be right there in the path, but instead we need to go up, then down a bit. It seems hacky to do it like that. Better to make paths unique so they can be used as keys. Ok, generalize: - Keep a state monad to make keys unique. - The output is the map of paths to values, or the set of paths. Is it necessary to preserve order? It doesn't seem so. The result is a relation. So this is a generic tree -> relation(s) transformation. Entry: Free and iterM Date: Sat Jun 2 11:28:07 EDT 2018 It seems that in many cases it's just easier to use >>= to recurse manually. What I want is m (a) -> f (m a) I guess this needs combinations of retact and lift to convert between the monad (tree) and the node (which possibly contains subtrees). What I want is to be able to do two different things based on whether something is a Pure or a Free node. Basic tree handling. How to do this? Entry: Using retract Date: Sat Jun 2 12:14:57 EDT 2018 I don't understand what retract does: retract :: Monad f => Free f a -> f a How can it convert a tree into a node? *Main> retract $ Free [Pure 1, Free [Pure 2]] [1,2] So it uses the concatenation operation of [] here. Which means it uses at least applicative. Ok, obvious: it uses the Monad constraint on f to perform the functor flattening. So if I want to flatten an s-expression into a path relation, I just need to define a monad for it and then use retract? How to create a monad for Node t [t] What about this. Use hoistFree to map the tree onto some monad, then use the monad to retract? No this is all getting too complicated. I have a tree. This is a monadic value (of leaf nodes). I can tack stuff onto the free monad which provides context. Now, how to iterate? Basically, how to unpack one level of the monad? Bind already does the recursive map. It seems that these two monads need to be kept separate, such that once can be used to wrap values inside the functor. How is bind defined for free? That is the key really. instance (Functor f) => Monad (Free f) where return = Pure (Pure x) >>= f = f x (Free xs) >>= f = Free $ fmap (>>= f) xs Basically, I want a different bind. One where fmap introduces context Maybe iter is the way to go anway. EDIT: So for EDIF, I'm just making an explicit iteration. The data structure is not specific enough to do this with iterM without some serious workarounds inside the iterated function. Entry: Finite trees as relations Date: Sat Jun 2 13:52:26 EDT 2018 Figure out the constraints to make this generic. What does a tree have to look like so it can be turned into a relation? Is this ORM? Probably not. ORM probably provides indirection. The generic transformation is from a tree structure that is _finite_ into a relation. But: infinite trees can be made finite by introducing node references. So this seems quite generic. As long as nodes ca be tagged with a name. Entry: Bottom scraper as illustration of operating on tree coordinates Date: Sun Jun 3 13:13:16 EDT 2018 The main idea is that it is possible to describe a tree as a map form coordinates to values. This exposes operations on the coordinates that hare otherwise hard to express on the tree. It is a special case of the general principle of transforming to an isomorphic representation to make certain operations trivial. A useful trick, but coordinate code can be hard to read. Also: it is not a good idea if the tree structure contains symbolic names to be used as indexing tags. E.g. in EDIF.hs this was used assuming low-level structure could be dependend upon. Code is now changed to use symbolic referencing. The idea is though that when s-expression structure is rigid, it is possible to use coordinates and local context: 1) Convert tree to path->val map, with "zipper" paths 2) Find nodes by filtering on the deep end of the path, returning path 3) Fetch other information by transforming those paths. This allows ignoring most of the top level boiler plate. Entry: Existential types for siso? Date: Mon Jun 4 23:59:27 EDT 2018 Is this actually necessary? In current experiments, the fixed type output syntax could be hidden inside the representation monad. I must have reached that conclusion last time.. It no longer contains the existential type. EDIT: My notes are too messy. There are still existential types to be able to work with explicit state. But it doesn't really seem to be necessary as long as the "fix" operator is part of the language in some form. This allows state to be tucked away into the implementation of the monad. All the other applicative stuff seems really not so interesting when there is only the time dimension. It just moves between update equation vs. infinite sequence view. For Signal.hs, it might be useful when time and space dimensions can be combined. Here's the tradeoff: - fix is external: state accumulation is handled by representing tuples and functions in the language. - fix is internal: all state is hidden inside the implementation I see no real reason for handling state explicitly. It is supposed to be hidden from view, and is much more straightforward to handle internally. So don't mix them yet. Play wit the simpler version on PRU and Seq. Add some C and maybe some space loops to arrive at RAI? Entry: (Int,Maybe Int) -> Maybe (Int, Int) Date: Tue Jun 5 18:17:40 EDT 2018 Just an example, but something I found hard to express when getting tired. (Int,Maybe Int) -> Maybe (Int, Int) Generalized: (a, f b) -> f (a, b) Entry: Tagless-Final and representations Date: Tue Jun 5 20:56:12 EDT 2018 For a * -> * type f, the represention might have f (r t) <-> r (f t) Which moves between the concrete metalevel construct on the lhs, and the abstract construct on the right. Specifying transformations like that is essentially what the design of the embedded language entails. For languages that do not have lambda/apply, it appears to be sufficient to define some first order control structures. I wonder if I can write Bachus' functional forms for the state machine languages. https://en.wikipedia.org/wiki/Function-level_programming Practically, I want a RAI-style loop, with the ability to have intermediate vectors. How to formalize? http://scienceblogs.com/goodmath/2007/03/20/backuss-idea-of-functional-pro-1/ Yeah maybe not really... It's mostly about being able to bind intermediate arrays, to be able to do multipass algorithms, which is not something RAI can do for some reason. An essential part here is to have arrays as units of representation, and with that the representations of higher order functions that operate on them. Not so much an issue for the PRU and Seq code, as there is no "vector level" to work with. Everything needs to be flattend. But still it might be possible to use a staapl-style approach, where higher order things can be passed around freely at the meta-level, but get instantiated. E.g. a there would be a way to represent a lambda abstraction, but no way to leave it as a value in the code. It has to be applied. How to express that? Entry: The essence of staapl Date: Tue Jun 5 21:21:10 EDT 2018 Allow metalevel values to be passed around freely, and instantiated in target code. This is trival to do in Haskell. Where a target program is :: m (), but any metalevel version of target code can be carried around. To generalize this to assembly: there should be a combinator that replaces a labda expression (e.g. a -> m b), with a function call by compiling that function somewhere and carrying around the label. Still for the PRU this would require register allocation. How hard is it to implement a stack? I could do a forth for bookkeeping. Entry: Too abstract Date: Tue Jun 5 21:26:59 EDT 2018 When working on practical things, I do start finding ways to reuse more of the Haskell ecosystem. However, the theorizing about metalanguages seems to not go very far. Entry: double monadic values Date: Sat Jun 9 20:10:30 EDT 2018 I had always thought that these were _equivalent_ to singles, because join can always flatten. But obviously, they are not. Entry: Contravariant functor Date: Sat Jun 16 22:38:31 EDT 2018 From http://hackage.haskell.org/package/contravariant-1.4.1/docs/Data-Functor-Contravariant.html It's clear in the definition of an example contramap :: ( a -> b ) -> ( b -> Bool ) -> ( a -> Bool ) contramap f b = b . f It is obviously the same when Bool is generalized to t. Contrast this with an example of a covariant functor: map :: ( a -> b ) -> ( Bool -> a ) -> ( Bool -> b ) map f a = f . a So one way to look at it is to see whether it transforms the output or the input of something. The a profunctor bundles the two cases in one. E.g. both input and output are transformed. To make this more clear, use i and o type parameters to draw the analogy with input and output: dimap :: (o -> o') -> (i' -> i) -> p i o -> p i' o' Or separately: lmap :: (i' -> i) -> p i o -> p i' o -- imap rmap :: (o -> o') -> p i o -> p i o' -- omap So (->) is a profunctor, as are Arrow instances. https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/profunctors http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html https://ocharles.org.uk/blog/guest-posts/2013-12-22-24-days-of-hackage-profunctors.html https://www.reddit.com/r/haskell/comments/5vdj40/what_is_a_profunctor_anyway/ The latter mentions that Profunctors are more restricted than pipelines, in that they just express how their ends can be adapted. I.e. there is no composition mechanism such as for e.g. Arrow. The whole hierarchy of constraints involves Profunctor, Category, Strong, Choice, Arrow, and others. http://hackage.haskell.org/package/profunctors-5.2.2/docs/Data-Profunctor-Strong.html http://hackage.haskell.org/package/profunctors-5.2.2/docs/Data-Profunctor-Choice.html https://www.reddit.com/r/haskell/comments/5vdj40/what_is_a_profunctor_anyway/ Contravariant itself may seem a bit surprising at first. The usual idea is that if f is contravariant, then its type argument only appears in a negative position. What does that mean? That it appears on the left side of an odd number of function arrows. For instance: a -- positive position a -> Bool -- negative position (a -> Bool) -> Bool -- positive position ((a -> Bool) -> Bool) -> Bool -- negative position a -> Bool -> Bool = a -> (Bool -> Bool) -- negative position Entry: Natural transformations Date: Sat Jun 16 23:42:54 EDT 2018 http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html This has an interesting remark about natural transformations: If F and G are functors, and h is a natural transformation h:F=>G, then we have that h . fmap f = fmap f . h If we think of F and G as containers, then this rule says that a natural transformation relates the structures of the containers, not the contents. Entry: Sources and sinks Date: Sun Jun 17 00:13:12 EDT 2018 So functors are are sources, producing output. Contravariant functors are sinks, taking input. Entry: "fix" and Arrow Date: Sun Jun 17 01:04:01 EDT 2018 class Arrow a => ArrowLoop a The loop operator expresses computations in which an output value is fed back as input, although the computation occurs only once. It underlies the rec value recursion construct in arrow notation. loop should satisfy the following laws: a (b, d) (c, d) -> a b c So my "fix" operator in Seq is loop. Is that useful? Maybe it isn't, because I can't really fix pure functions. There is always a delay. I've been here before.. Why would I use arrows instead of just tucking things away in a monad? https://www.reddit.com/r/haskell/comments/4fkkzo/when_does_one_consider_using_arrows/ https://wiki.haskell.org/Yampa http://mstksg.github.io/auto/ Entry: Auto, feedback Date: Sun Jun 17 01:28:43 EDT 2018 https://github.com/mstksg/auto/blob/master/README.md So it's layed out as a cyclic graph. Where is the delay element? Probably in sumFromD. Entry: When is Arrow appropriate? Date: Sun Jun 17 02:32:42 EDT 2018 https://www.reddit.com/r/haskell/comments/4fkkzo/when_does_one_consider_using_arrows/ Come up with some other examples? A function and its inverse? data InvFun a b = InvFun (a->b) (b->a) https://hackage.haskell.org/package/invertible Not an arrow, because "arr" doesn't have an implementation. Kmett: Arrow is primarily used when one has failed to discover Applicative. One of the primary motivations for them was to find a way to model Swiestra and Duponcheel's parser for LL(1) grammars... which actually makes a much better Applicative than an Arrow. The main usecase I have for importing Control.Arrow these days is when I want to call (&&&), not to define instances. EDIT 7/21: Kmett: class (Strong p, Category p) => Arrow p instance (Strong p, Category p) => Arrow p See 7/21 Entry: Why is Applicative so powerful? Date: Sun Jun 17 03:22:22 EDT 2018 https://en.wikipedia.org/wiki/Applicative_functor ... they allow sequencing of functorial computations (unlike plain functors) but without deciding on which computation to perform on the basis of the result of a previous computation (unlike monads) Example of an Applicative that is not a Monad? https://stackoverflow.com/questions/7220436/good-examples-of-not-a-functor-functor-applicative-monad ... a type constructor that's Applicative but not a Monad, a very common example would be ZipList. https://www.xanthir.com/b4fM0 Entry: Time for CT again.. Date: Sun Jun 17 04:22:31 EDT 2018 https://bartoszmilewski.com/2014/10/28/category-theory-for-programmers-the-preface/ Entry: Stacking state monads Date: Mon Jun 18 10:16:18 EDT 2018 EDIT: Seems to be a bad idea because it doesn't mix with automatic lifting. I'm picking a different approach in the practical issue that removes the need for this. Entry: Refactoring Date: Tue Jun 19 12:36:14 EDT 2018 So this is true: refactoring is made a whole lot easier with strong static types. The "wrapping" is there to add the proper semantics to the actual representation, leaving it possible to think only in vague isomorphisms, which is really how human abstraction seems to work anyway. We really do see the essence of structure, and gloss over the implementation details. The great thing about this is that I can actually do this kind of work when I'm tired and cannot deal with details very well. Still the big intuitive picture is usually accessible. Entry: Dynamic typing Date: Tue Jun 19 16:07:43 EDT 2018 I have a map from Int to some existential type. I know that two separate references have the same type if the integer is the same, so how to coerce? https://stackoverflow.com/questions/29684482/can-i-coerce-an-existentially-quantified-argument-in-a-type-constructor http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Typeable.html http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Dynamic.html Or just use unsafeCoerce? Yeah maybe not. Dynamic seems to be the way to go. Entry: scripting Date: Fri Jun 22 21:47:50 EDT 2018 For ad hoc batch processing IO code. - read input files - set up some equations - write output files how to do this when the input is large and unstructured? Just just one block and mix the code. Entry: Filtermap? Date: Sat Jun 23 10:22:41 EDT 2018 I've been looking for this before. traverseMaybeWithKey mapMaybe catMaybes Entry: Phantom types Date: Sat Jun 23 11:01:45 EDT 2018 I'm doing some work cross-referencing tables, and I would like to type-tag them such that lookup functions are typed. They are organized in a way that some tables do not have proper types. E.g. a table can contain both (a,b) and (a,c). How to tackle this? Best to make some kind of split at import time. More specifically, I have a schematics netlist file: (netname, [(component_name, pin_name)]) Basically, each component should have its own type, and each pin name should have one type per component. EDIT: Something like this: -- Main phantom String type newtype Tag t = Tag String instance Show (Tag t) where show (Tag s) = s -- Void tags for the phantom type data Tag_osd335_sm data Tag_am335x_signal data Tag_firmware gw4_octavo_csv :: IO [(Tag Tag_osd335_sm, Tag Tag_am335x_signal, Tag Tag_firmware)] gw4_octavo_csv = do table <- readCSVFile "gw4_octavo.csv" let table' = checkTable table return $ map (\[o,s,f] -> (Tag o, Tag s, Tag f)) table' EDIT: The above is straightforward. The real problem is in "level mixing" for distinguishing between variants. There are some generic patterns in Pins.hs EDIT: It really helps to have local type signatures such as: dt_offset :: T T_am335x_zcz -> T T_dt_offset dt_offset = (flip lookup') (map (\(_,pin,offset,_) -> (pin,offset)) bbb_pins) The implementation in this case is not so interesting: it does what it needs to do to make it work, given the ad-hoc way the information is organized. So yes, doing it like this is a good idea, with remarks - Use phantom types and void tags. This is easy enough to use and provides the necessary typing with a little extra notation noise. - Actual data types are only needed when sums are involved. Implementing sums is where most of the work is (products are easy, sums are hard). - Implementing full sum types is probably too much work, so allow for a "misc" alternative that captures the information, but doesn't encode it at the type level. This allows to gradually refine. - Use type annotations for all the converter functions. That is the information needed to understand the program. Entry: Lenses Date: Sun Jun 24 21:01:28 EDT 2018 What I'm interested in is the perspective "editable views". The Kmett lenses seem different though. More general. Yeah too complicated for now.. Entry: Products are easy, sums are hard Date: Mon Jun 25 17:30:18 EDT 2018 Another one: apparently in intuitionstic logic, it is not possible to implement one connective in terms of the other. However it is possible to have a single (ugly) one. https://en.wikipedia.org/wiki/Intuitionistic_logic#Non-interdefinability_of_operators Entry: Web interface Date: Wed Jun 27 08:07:26 EDT 2018 So basically, I have a way to write web applications in Erlang, but it is still quite cumbersome. The price of "reactivity" is high. The alternative is to use full page reloads and form submits. Or, write a model in Haskell, and compile it down to an Erlang representation of the same thing? How about this for a hack: - Create a haskell node that can call into Erlang - Have erlang load file, parse it, push it into Haskell - Let Haskell map the syntax onto code This way it might be possible to write in a subset of Erlang that can be typed and tested with Haskell overlay. Entry: Tree and Forest Date: Wed Jun 27 18:22:00 EDT 2018 I never ran into those terms before. data Tree a = Tree a (Forest a) data Forest a = [Tree a] Also called "rose trees". https://en.wikipedia.org/wiki/Rose_tree Entry: Haskell && top-down design Date: Thu Jun 28 12:26:10 EDT 2018 I find myself using more of a top-down approach when doing type-directed work. Write down the specification as types, then refine those into possible "lemmas". What often happens when descending into the implementation is that top level APIs get changed to some isomorphic representation that is easier to use. Incorrect assumptions get corrected: dependencies get added or removed. I really like this way of working. Entry: Recap Date: Thu Jun 28 13:08:44 EDT 2018 Last couple of weeks were very interesting and insightful. But also exhausting. This stuff is hard to come by. A night of sleep does seem to help in that regard. Just as working incrementally. I think it is time to push this much further. The next practical hurdle is to write tests. I've been doing this in Erlang, but it costs too much time to debug the tests themselves. Erlang is a very good _operational_ framework. But it does suffer from the problem that all dynamic languages suffer from: it is hard to refactor and evolve. Tests help, but the tests themselves have the same problem: the tests would appear to need tests! Let's cut that short and use a more formal representation of tests. Entry: Haskell test server Date: Thu Jun 28 14:33:19 EDT 2018 To make a Haskell test server, it is likely not necessary to do this at the node level. There is already an Erlang instance running. The Haskell component can just run as a Port. This allows to keep the Haskell I/O part minimal. http://hackage.haskell.org/package/hinterface-0.5.0.2/docs/Foreign-Erlang-Term.html Entry: HalVM Date: Thu Jun 28 14:44:03 EDT 2018 https://galois.com/project/halvm/ Maybe time to revisit? Yet another time sink, likely. I just think it's cool. Don't really need it. Entry: Monads are weird, yes. Date: Thu Jun 28 16:35:07 EDT 2018 So yes, Monads are weird. But they are really just about representing sequential programming in an implicit context as function composition, making the context explicit but still mostly hidden syntactically (if do notation is used). Once this structure is internalized, all the sequential programming you've learned in the past can just be readily reused. But, it really is its own thing. That is an important point. Entry: Free monads as a way to compose effects Date: Fri Jun 29 01:39:22 EDT 2018 https://ocharles.org.uk/blog/posts/2016-01-26-transformers-free-monads-mtl-laws.html Use composition of functors used in a Free monad to encode the effect. The extensible-effects library then provides some machinery However, inefficient. Then something about laws I don't follow. Entry: Map a b / Set (a,b) Date: Fri Jun 29 10:06:03 EDT 2018 Note that these are not the same. The latter is a relation and does not impose the constraint that the a values are unique. Entry: Netlist aliases Date: Fri Jun 29 11:48:08 EDT 2018 EDIT: This is a detour. See next posts: the core idea is that a netlist is a partition (set of disjoint sets), and that a net name is just one of the elements of a subset. Not realizing this yielded a lot of confusion. Getting into mathy territory. I'm having problem expressing joins of nets when names are involved. How to name the union? One approach is to compute the union of the names as the new name, i.e. switch from NetName to (Set NetName) as names of nets. It is tempting to then define: newtype NetName' = NetName' (Set NetName) instance Eq NetName' where (NetName' a) == (NetName' b) = not $ Set.null $ Set.intersection a b But this is not transitive. E.g. E.g. given elements {1,2}, {2,3}, {3,4}, it is clear that {1,2} == {2,3} and {2,3} == {3,4}, but {1,2} /= {3,4} To make this work, a transitive closure is needed, which I don't see how to define explicitly. It does seem possible though to use this transitive closure implicitly when operating on a map-like structure that uses (Set NetName) as keys, but doesn't rely on the Haskell Eq and Ord classes. With this implicit implementation as a map, it is likely possible to distill equality relative to the contents of the map. Weird... What happens when searching for "set-indexed map" ? Trying to implement this I run into inconsistencies.. Maybe it doesn't make sense? Particularly, lookup has a weird meaning. Given a map: {1,2} => {a} (3,4} => {b} What is lookup {1,3} ? The only sane thing here is to have it be {a,b}, but in the lookup itself there is already a join happening. Sets are way stranger than I thought! The net shorting function falls right out. Entry: Nets as just sets again? Date: Fri Jun 29 18:29:47 EDT 2018 So what about getting rid of net names, and using representatives instead? Which would be pins. Nets are sets of pins. The shorting operation shorts pins, resulting in the corresponding nets to be shorted. Maybe I'm just looking at this in the wrong way. Lift out the "partition" operation. Ok, done. Much simpler. So if this works (netlist is a partition), then we really can get rid of netnames and just work with pinnames. The netname can then be a "pin" of the schematic. Ok, that was quite the detour. Summary: - key concept is "partition" - a strict order can produce representatives Entry: Map and Eq,Ord Date: Fri Jun 29 22:57:27 EDT 2018 Is it ok to use (Map (Set k) v) ? This is a partition mapped to v. I guess. It is only operations such as insert that are not well-defined on partitions. Entry: Naming types Date: Sun Jul 1 20:58:12 EDT 2018 Internally, it is ok to use type aliases. Names are only necessary for class instances (the name refers to behavior), and to provide a clean API in case of a library. But even then it doesn't really matter. Entry: reader Comonad is curried reader Monad? Date: Mon Jul 2 22:19:14 EDT 2018 (a, e) -> b We used currying to turn them into Kleisli arrows: a -> (e -> b) https://bartoszmilewski.com/2017/01/02/comonads/ Entry: Rank n types Date: Fri Jul 6 12:18:22 EDT 2018 Maybe the point of rank-2 is to pass a polymorphic think to a function, such that it can instantiate it in multiple ways to different types? Then rank-N is the higher order function generalization of that. Entry: FRP Date: Sat Jul 7 13:49:16 EDT 2018 https://www.quora.com/How-is-state-represented-in-FRP-Can-you-have-something-like-the-state-monad-in-FP/answer/Conal-Elliott "The shift from sample-then-compose to compose-then-sample is very important, because sampling discards information." Entry: Functor composition Date: Sat Jul 7 16:55:11 EDT 2018 Took me a while to figure out how to approach this, but it's really simple when you focus on the types. Functor compositions tend to pop up in ad-hoc places. It is important to realize that it is not necessary to use the Data.Functor.Compose wrapper. It is often simpler and clearer to only define a specialized mapping function. E.g. mapBindings :: (a -> b) -> [(a, Term (Op a))] -> [(b, Term (Op b))] mapBindings f l = map f' l where f' (name, term) = (f name, (fmap . fmap) f term) I still find the implementation hard to read, but the type is really clear, so the approach is to write that first, then compose fmap and any specialized mapping functions as needed. Entry: Type directed programming Date: Sat Jul 7 17:08:15 EDT 2018 Sometimes writing down the type gets you out of the rut of thinking in strict programming terms. It happens quite a lot that there is a lazy way to do something that would not have come up in a strict, imperative mind set. The type-directed approach says: forget about how exactly this behaves at run time.. is it possible? Is there a path? Entry: liftA2 for Monad Date: Sun Jul 8 09:06:07 EDT 2018 One of those weird confusions. Obviously, because Applicative => Monad, there is an implementation of liftA2 for every Monad instance. So what is the order of evaluation? liftA2 first executes the effect of the partial application, to then use <*> to apply the monadic curried function to the second argument. liftA2 f a b = f <$> a <*> b Entry: A template haskell lisp Date: Sun Jul 8 11:48:14 EDT 2018 So I've arrived at the need for: - loading a file - parsing it as an s-expression - mapping it to monadic syntax I think I understand the last two steps, but how to get the string into template haskell context? http://hackage.haskell.org/package/file-embed Entry: quickcheck state machine Date: Mon Jul 9 21:04:33 EDT 2018 https://github.com/advancedtelematic/quickcheck-state-machine#readme Entry: yoneda, lenses Date: Sun Jul 15 08:35:59 EDT 2018 https://arxiv.org/abs/1807.01948 http://www.cs.ox.ac.uk/jeremy.gibbons/publications/proyo.pdf Entry: template haskell sexp Date: Sun Jul 15 10:23:14 EDT 2018 What I want: integrate TH in the build, such that a file in any syntax is translated to TH. EDIT: I've got the basic skeleton working for "(+ 1 2)": read file, parse as s-expression, and convert to haskell syntax. Also performs currying. The rest is too much at this time. Still needs ANF. Entry: yoneda, profunctors, lenses Date: Sun Jul 15 19:47:37 EDT 2018 There is nothing more to the ‘semantics’ of an entity than syntactic references to other entities. http://www.cs.ox.ac.uk/jeremy.gibbons/publications/proyo.pdf Also why it is so hard to learn a new mathematical concept, without seeing how it is used! There is a lot in this paper. Maybe a good one to explore a bit deeper? Entry: Rank N types Date: Mon Jul 16 14:11:21 EDT 2018 I think it had already clicked for me as I recently needed multiple instantiations of the same function type in setting that made perfect practical sense, but here is some more explanation: https://stackoverflow.com/questions/12031878/what-is-the-purpose-of-rank2types ... while you can write a function that takes different types of arguments without this extension, you can't write a function that uses its argument as different types in the same invocation. It is about being able to instantiate the type multiple times. The comment about System F is insightful. Entry: Refactor-oriented programming Date: Tue Jul 17 22:32:33 EDT 2018 Once the basic structure is there, it is often easy to zoom in and change just one thing. The idea that you can just write down a program in one go is a misconception that keeps lingering. Programming is incremental debunking of bad theories. Entry: DataKinds Date: Thu Jul 19 23:06:22 EDT 2018 Normal: untyped functional programming at the type level. With data kinds, the kind level gets a form of types. https://stackoverflow.com/questions/20558648/what-is-the-datakinds-extension-of-haskell So I understand that this is useful in combination with phantom types. What about type families? Entry: Local copies of modules Date: Fri Jul 20 15:33:26 EDT 2018 One important thing to figure out is how to build a local copy of a module. Currently I've been just using links. Looks like I'm going to have to so something to erlang-ffi: {error,<0.35.0>, {<0.160.0>, "** ~w: Connection attempt ~s node ~w ~s since it cannot handle ~p.**~n", ['gw@10.1.3.107',"from",'haskell@kanda.zoo',"rejected", ["UTF8_ATOMS"]]}} Try to do this with cabal2nix tom@panda:~/humanetics/gw_src/meta$ cabal2nix cabal2nix Missing: URI Usage: cabal2nix [--version] [--sha256 HASH] [--maintainer MAINTAINER] [--no-haddock] [--no-check] [--jailbreak] [--revision ARG] [--no-hyperlink-source] [--enable-library-profiling] [--enable-executable-profiling] [--enable-profiling] [--extra-arguments ARG] [--hackage-db PATH] [--shell] [-f|--flag ARG] [--compiler ARG] [--system ARG] [--subpath PATH] URI Recognized URI schemes: cabal://pkgname-pkgversion download the specified package from Hackage cabal://pkgname download latest version of this package from Hackage file:///local/path load the Cabal file from the local disk /local/path abbreviated version of file URI download the source from the specified repository If the URI refers to a cabal file, information for building the package will be retrieved from that file, but hackage will be used as a source for the derivation. Otherwise, the supplied URI will be used to as the source for the derivation and the information is taken from the cabal file at the root of the downloaded source. https://github.com/Gabriel439/haskell-nix EDIT: Something strange in gw_src/meta... only until I edited the .cabal file and removed the library did it compile properly. Entry: Arrow is Strong Category? Date: Sat Jul 21 20:23:18 EDT 2018 http://hackage.haskell.org/package/profunctors-5.3/docs/Data-Profunctor-Strong.html Strong: first' :: p a b -> p (a, c) (b, c) second' :: p a b -> p (c, a) (c, b) Profunctor: dimap :: (a -> b) -> (c -> d) -> p b c -> p a d So Strong is the ability to funnel through some extra information, and Profunctor allows the transform the beginning and end of the Category arrows. https://www.reddit.com/r/haskell/comments/4fkkzo/when_does_one_consider_using_arrows/ Kmett: class (Strong p, Category p) => Arrow p instance (Strong p, Category p) => Arrow p So prove that. Or be lazy and google it: https://www.eyrie.org/~zednenem/2017/07/twist "the monoid and the strength must also be compatible" So what do I want out of this? In rtl.txt there is the strong suspicion that the reason for Seq to be a monad is _only_ because of the metaprogramming functionality. The underlying combinatorial language definitely has a fixed computational structure. Now, I know that there is the Applicative subset, but that does not seem to be enough. It does not capture sharing (circuit fanout). Arrows do it, but Arrows are awkward to use. Strong Profunctor should be enough according to the above. Does that actually help? Let's define instances. EDIT: Not necessary. Kleisli already has all the instances. So what does this buy? Arrows are Strong Monads: http://www-kb.is.s.u-tokyo.ac.jp/~asada/papers/arrStrMnd.pdf https://stackoverflow.com/questions/38169453/whats-the-relationship-between-profunctors-and-arrows Entry: Binary Kleisli Arrow? Date: Sat Jul 21 21:46:32 EDT 2018 I'm still trying to make sense of this, so is this nonsense? Basically, Categories and monoids are linked through the Hom-set https://bartoszmilewski.com/2014/12/05/categories-great-and-small/ https://en.wikipedia.org/wiki/Hom_functor So a monoid is represented such that monoidal composition is function comosition. For monads this is the similar, but the composition is Kleisli composition. So "binary kleisli" makes sense only as Kleisli composition. So what is a -> b -> m c ? It's really just (a, b) -> m c So I guess the questions becomes, "how do you get to m (a,b)" ? A way to construct a program from linear Kleisli arrow composition, is to use tuple-shuffling operators. Note that monads can do something much more powerful, e.g. ANF: how binding works in do notation. But is that just equivalent to tuple chaining? Entry: Tuple shuffling Date: Sat Jul 21 22:02:05 EDT 2018 Getting deep into misunderstood abstractions. What is the relation between: - do-notation / ANF - tuple-shuffling + linear Kleisli conmposition In the former, there is a local context of names available that gives a bit of a spaceous feel, while simply composing individual Kleisli arrows, and pushing this local context through typles feels very awkward. But are these equivalent? I'm thinking they must be. But why does ANF seem so much more powerful? I.e. it seems as if linear tuple-shuffling cannot change the structure of composition, but ANF clearly can: just use "if" to pick two different monadic values. Why is this so hard to understand? Why does my intuition have these gaps? Maybe time, once and for all, to clear this up. Early on when working on Staapl and just reading about Haskell without actually understanding, I thought monads were the same as the state monad. Now I come to a similar, but different situation, where I'm thinking that tuple-shuffling is the same as ANF form. So a question is: can you implement "if" with tuple shuffling? What would it's type look like? if' :: (Bool, m a, m a) -> m a Which is just the uncurried version of regular if. But note that (m a) is a monadic value, not a Kleisli arrow. Does that matter? Probably not. Again, why am I so confused about this? It is an old one... The answer should be straightforward if it is meaningful. Is there a type error in the idea? Maybe rephrase. Why is it at all possible to have this context? How can a Kleisli arrow "down the chain" see the lexical context that was also available to previous compositions? Obviously, it works. Why do I find it so strange? Often when these things happen, it is about asking the wrong, meaningless question. An appropriate question in this context is: can do notation / bind chaining be written in terms of kleisli composition? \ma mb -> do a <- ma b <- mb return $ a + b \ma mb -> ma >>= (\a -> mb >>= (\b -> return $ a + b)) So again, it's completely obvious that this is possible (algebraically). Why do function abstraction and (>>=) interact in such an un-intuitive way? Simpler, with a unary function \ma -> ma >>= (\a -> return $ a + 1) Maybe just a bit too much wine to do these kinds of things... I've noticed in the past weeks getting more intense about Haskell work that I've gotten stuck on intuitions that are just plain wrong, while sleeping on it made it absolutely clear what was going on without getting into the generated "intuitive madness". Entry: Continuation monad: the mother of all monads Date: Sat Jul 21 22:17:33 EDT 2018 http://blog.sigfpe.com/2008/12/mother-of-all-monads.html "Suppose someone stole all the monads but one, which monad would you want it to be?" Ha! This is that paper with the famous quote: "I often find I learn more computer science by trying to decode random isolated sentences than from reading entire papers." Anyway, not for now. I'll get back into this when making the ANF transformer. Entry: Applicative do Date: Sat Jul 21 22:47:24 EDT 2018 http://haskell.1045720.n5.nabble.com/Applicative-do-td3141527.html Entry: Partially applied type synonyms Date: Sun Jul 22 09:44:18 EDT 2018 https://stackoverflow.com/questions/4922560/why-doesnt-typesynonyminstances-allow-partially-applied-type-synonyms-to-be-use So in general it doesn't work. Entry: What is so special about Strong? Date: Tue Jul 24 17:25:40 EDT 2018 Category: composition, identity Profunctor: pre/post composition with function Strong: "side channel" Entry: unboxed mutable arrays without IO? Date: Wed Jul 25 21:36:08 EDT 2018 http://nochair.net/posts/2015/01-24-arrays-in-haskell.html Entry: Deriving Generic, serialize Date: Thu Jul 26 20:12:56 EDT 2018 http://hackage.haskell.org/package/cereal-0.5.5.0/docs/Data-Serialize.html Entry: Arrow, Applicative Date: Sat Jul 28 14:59:27 EDT 2018 https://stackoverflow.com/questions/24668313/arrows-are-exactly-equivalent-to-applicative-functors "In practice, an occasional >>= between applicatives gives this full monadic power whilst keeping the nice pure-feel syntax of Applicative. – AndrewC Jul 10 '14" Exactly what I ran into with SeqApp.hs Also in that page: Applicative can only combine outputs. It's not possible to take the output of one computation and use it to influence another. Entry: Sharing Date: Sat Jul 28 20:11:12 EDT 2018 Is there any way to express sharing without using Monad? Doesn't look like it. Sharing really is bind. Entry: arrays, ST Date: Thu Aug 2 14:09:32 EDT 2018 I want fast mutable arrays. ST vs IO, and the 'U' unboxed version. First, what is ST? http://hackage.haskell.org/package/base-4.11.1.0/docs/Control-Monad-ST.html Basically, IO for "inner loops". http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.144.2237&rep=rep1&type=pdf EDIT: This is quite cool. I ran into this before, but could not quite appreciate the importance. This means there is as good as no reason to go out of Haskell, besides platform size (i.e. Haskell is big). Not simple though. Rank-2 types. I get the basic idea, but do not see exactly how to make sure that two instances of s are the same. Entry: runST and rank-2 inference Date: Thu Aug 2 20:32:30 EDT 2018 This doesn't infer properly: runST' f = runST f The reason is that 'f' is not inferred as rank-2. An explicit signature fixes it: runST' :: (forall s. ST s a) -> a Ok I got this far: -- Derive the correct form by adding stuff to runST. seqRun' :: ([Int] -> forall s. ST s [Int]) -> [[Int]] -> [[Int]] seqRun' f i = [runST $ f (head i)] OK... the error I run into is this: seqRun' :: ((m,r,[Int]) -> forall s. ST s (m, r, [Int]), (m, r)) -> [[Int]] -> [[Int]] SeqPrim.hs:93:12: error: • Illegal polymorphic type: forall s. ST s (m, r, [Int]) GHC doesn't yet support impredicative polymorphism • In the type signature: seqRun' :: ((m, r, [Int]) -> forall s. ST s (m, r, [Int]), (m, r)) -> [[Int]] -> [[Int]] If I curry this, it's ok: seqRun' :: ((m,r,[Int]) -> forall s. ST s (m, r, [Int])) -> (m, r) -> [[Int]] -> [[Int]] So I was driven into some other corner of the type system. Why are these not equivalent? This is quite hard to work around. Entry: More rank-2 madness Date: Fri Aug 3 16:40:33 EDT 2018 These fucking error messages! test-qc-SeqLib.hs:191:12: error: • Couldn't match expected type ‘SeqPrim.Mem s’ with actual type ‘a0’ because type variable ‘s’ would escape its scope This (rigid, skolem) type variable is bound by a type expected by the context: (a0, Int, (Int, Int, Int), [Int]) -> GHC.ST.ST s (Int, (Int, Int, Int), [Int]) at test-qc-SeqLib.hs:191:12-39 • In the first argument of ‘seqMemUpdate’, namely ‘r12’ In a stmt of a 'do' block: r13' <- seqMemUpdate r12 (r3, r6, r5, r7) In the expression: do { r1 <- seqSLICE (seqInt 1) r0 (seqInt 0); r3 <- seqSLICE (seqInt 1) r2 (seqInt 0); r5 <- seqSLICE (seqInt 8) r4 (seqInt 0); r8 <- seqADD (seqInt 4) r6 (seqInt 1); .... } • Relevant bindings include r12 :: a0 (bound at test-qc-SeqLib.hs:191:12) EDIT: Solved it by turning tuples into lists so the type parameter was accessible. In retrospect, it was fairly obvious. Still, it is hard to find exactly where the error is originating. Entry: skolem Date: Tue Aug 7 00:49:32 EDT 2018 A Skolem variable (or perhaps better Skolem constant) represents an unknown fixed type during type inference. As such, a Skolem constant does match itself, as well as a (unification) variable, but it won't match any concrete type. Skolem constants indeed arise from existential bindings, usually. They're quite different from normal unification variables that arise from universal bindings and match any concrete type. – kosmikus Oct 4 '12 at 9:00 https://stackoverflow.com/questions/12719435/what-are-skolems Entry: abstraction Date: Thu Aug 9 08:49:47 EDT 2018 One of the really cool things in Haskell is that you don't need to think of abstraction up-front: write a flat routine, then bundle things up in a second pass. Entry: quickcheck reports Date: Thu Aug 9 12:20:08 EDT 2018 Is there a way to print a report when a test fails? Entry: fixed length vectors Date: Sat Aug 11 15:49:32 EDT 2018 https://blog.jle.im/entry/fixed-length-vector-types-in-haskell.html Entry: Tagless final and macro processing Date: Sat Aug 11 18:16:42 EDT 2018 The really cool thing about tagless-final is that there is no explicit handling of object language, other than as functions. From the (meta-)programmer's perspective, they feel like the same thing. Obviously, there is a distinction at some point, where the object language is being interpreted (or compiled), but it is not in the programmer's way. This is what I wanted to accomplish with Staapl, but it required the creation of a new language as metalanguage (cat). Tagless-final avoids that. Entry: Monadic form for expression languages Date: Sun Aug 12 21:41:40 EDT 2018 This is really annoying. I've tried several things and I can't seem to find something I like. Basically, it looks bad and requires thinking for simple things like multi-argument applications. What I've started doing: - reuse names and use update notation : v <- v `op` arg - use >>= and =<< - use lift functions Entry: Periodicity detection Date: Tue Aug 14 19:12:31 EDT 2018 [(2,0),(120,1),(1680,0),(120,1),(1680,0),(120,1),(1680,0),(120,1),(1680,0),(120,1),(678,0)] [(1,0),(1,1),(119,0),(1,1),(119,0),(1,1),(119,0),(1,1),(119,0),(1,1),(18,0)] [(2,0),(1,1),(1799,0),(1,1),(1799,0),(1,1),(1799,0),(1,1),(1799,0),(1,1),(797,0)] Problem is preamble and postable. How to get rid of them? With a large enough sample, taking a histogram should make it easy to find the a good range. Is there a way to do this without a lot of decisions? Entry: Convert betweeen STUArray and UArray Date: Wed Aug 15 08:43:52 EDT 2018 Figure this out. I have a loop that operates on arrays, and I'd like to "chunk" it such that it can be used lazily. Entry: Instance of Foldable that is not Functor Date: Sun Aug 19 00:43:21 EDT 2018 Given DAG, iterate over a dependency set of a node. EDIT: Took some time to write it out, but eventually deleted it in favor of using Data.Graph representation (reachable). Also, Foldable wasn't possible due to Ord constraint imposed by Map implementation. Entry: Data.Graph Date: Sun Aug 19 11:13:25 EDT 2018 The answer to the question "How to work with directed graphs in Haskell. Don't graphs need mutation or awkward infinite data structions?" is to use the adjacency list representation from Data.Graph. Entry: Monads are metaprograms, and they are not Date: Thu Aug 23 12:45:32 EDT 2018 I.e. there is no staging in the sense of passing through several compilation steps. Evaluation is just function application, and there is no need to build inerpreter/compiler towers. Towers are just function composition. Lazyness makes this all work transparently. But.. if this is the case, then doing this in a strict language is just another layer of lambdas. So the laziness itself doesn't really do anything. The important bit is the function abstraction, and for the particular problem, also the polymorphism wrt. the particular monad. Can I just do this in Scheme? Entry: hackage: how to find an empty package slot? Date: Sun Aug 26 13:53:08 EDT 2018 E.g. I would like Language/Seq I don't know how to do this, so just stick to this and fix it later if there is a problem. Entry: nix/haskell build problems, Show1 Date: Mon Aug 27 14:52:39 EDT 2018 Things I didn't have problems with before suddenly are problematic. What I miss is a good way to pin versions. How to resolve this? I clearly don't know what I'm doing, so I wonder what is the quickest way to just get it up and running again. EDIT: Look at the build error itself and try to find out where it is coming from. Maybe I just need a break. Fuck this shit. EDIT: Yeah a lot of things broke at once with very obscure error messages. Ultimately, the solution was to downgrade to ghc 8.2.2 from the nixos-18.03 channel. This does not have the Show1 issue. To implement Show1 manually, figure out what it is actually supposed to do. Documentation isn't very clear. I.e. what is the Int parameter for? https://mail.haskell.org/pipermail/libraries/2016-January/026536.html Entry: Monad transformers Date: Sat Sep 1 09:20:21 EDT 2018 EDIT: See bottom. This is all a misunderstanding. How to create a monad transformer? E.g. instead of using one of the standard ones directly, what about abstracting away an effect and wrapping it only as part of a stack? https://blog.jakuba.net/2014/07/22/building-monad-transformers-part-1.html Trying to abstract the assembler as a monad transformer. -- Assembler. data Asm i m t = Asm [i] (m t) -- deriving (Functor, Applicative) instance Functor m => Functor (Asm i m) where fmap f (Asm is mv) = Asm is $ fmap f mv instance Applicative m => Applicative (Asm i m) where pure v = Asm [] $ pure v (Asm is mf) <*> (Asm is' mv) = undefined instance Monad m => Monad (Asm i m) where (Asm is' mv) >>= f = undefined Stuck at <*>. I don't understand how is and is' are supposed to be combined. This is essentially a writer monad, so it seems that it should just be concatenation. I see that algebraically, but not intuitively. I think I can't do this in a day of mental fog. Yeah brain is just not starting up today.. EDIT: Tried again, I just can't juggle it. It seems the value is inside the inner monad, and somehow i need to get it out. Some knot-tying intuition missing? Monads do not compose in general. So it is to be expected that some trickery goes into the implementation of bind of a monad transformer. "Each Monad Transformer exists because monads do not compose in general." http://data.tmorris.net/talks/monad-transformers/8de95b5b9d29c395a68cc8940ca03faad204e474/monad-transformers.pdf Maybe what I'm trying to do is to create a generic way of composing? this just has wrappers? https://github.com/haskell/mtl/blob/master/Control/Monad/Writer/Class.hs Let's have a look at the WriterT source. https://hub.darcs.net/ross/transformers https://hub.darcs.net/ross/transformers/browse/Control/Monad/Trans/Writer/Lazy.hs So... the implementation is not what I expected: it uses runWriterT internally. So indeed: each monad transformer has some kind of trick. instance (Monoid w, Monad m) => Monad (WriterT w m) where #if !(MIN_VERSION_base(4,8,0)) return a = writer (a, mempty) {-# INLINE return #-} #endif m >>= k = WriterT $ do ~(a, w) <- runWriterT m ~(b, w') <- runWriterT (k a) return (b, w `mappend` w') {-# INLINE (>>=) #-} fail msg = WriterT $ fail msg {-# INLINE fail #-} And... my definition is wrong! newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } The monoid value is inside the monad. Entry: Monad transformers Date: Sat Sep 1 10:50:02 EDT 2018 So here's what I want to know. Composing the standard monad transformers is easy as long as you need only one of each. How to use multiple instances? This seems like a reasonable request, but there is no simple way to do this. The idea I had is to create new transformers, and compose monads out of those. So, is the solution to use 'lift' instead? http://blog.ezyang.com/2013/09/if-youre-using-lift-youre-doing-it-wrong-probably/ Interesting points, but what I'm looking for is some practical advice. I’ve settled on a development style that uses monad transformers to derive problem-specific monads, but wraps them in a newtype to hide their generic structure. Each newtype’d monad is accompanied by meaningfully named wrappers around ‘ask’, ‘get’, ‘set’, etc., lifted as necessary. Only these wrappers deal with the monad stack. This way, monad transformers remove the work of writing boilerplate monad implementations, but they don’t eliminate the need to write an interface, and I’m fine with that. E.g. when there are multiple state components, an interface needs to be written anyway. So maybe best to do it in terms of 'lift', as opposed to packing/unpacking tuples. Entry: pipes Date: Mon Sep 3 12:18:12 EDT 2018 What I have: - a Verilog Procedural Interface (VPI) module parameterized by environment variables to find input and output pipes on the file system. What I want: - A haskell wrapper to create the pipes, run the application, read/write the pipes and expose the whole thing as an [[Int]] -> [[Int]] function. - A binary protocol. To keep things simple, add some simplifications: - uint32_t - known vector size - optionally "flush" after write to allow "tight" emulation Eventually, this is supposed to go fast. Should I use IPC instead of pipes? Maybe it is too soon, so stick with the simplest. Entry: C code Date: Tue Sep 4 16:57:57 EDT 2018 What's the simplest way to compile C code and load it through FFI? Entry: Haskell as a metalanguage Date: Tue Sep 4 16:59:13 EDT 2018 The main point is "reification as a function". Basically, no restriction on composition when testing and generating code. Entry: Strict stream processing Date: Wed Sep 12 11:56:51 EDT 2018 I have a file in, file out stream processor operating on lines, but I can't figure out how to add strictness to keep sane memory usage. If I understand correctly: this needs to be done at the pulling end. EDIT: Adding random bang patterns and nothing helps. Getting frustrated. I don't know where to start looking. I'm thinking that the problem might be in "show" and "++". Likely this needs lazy byte streams. Why else would there be a need for such an abstraction? Strings and (++) are not ok because all the (++) thunks need to be unpacked before the first line can be read. The lesson seems to be: monoids are not good for infinite streams. I've run into this before, e.g. the writer monad. Googling "monoid space leak": https://blog.infinitenegativeutility.com/2016/7/writer-monads-and-space-leaks https://ro-che.info/articles/2017-01-10-nested-loop-space-leak Entry: LLVM and haskell Date: Sun Sep 16 16:32:54 EDT 2018 cd /home/tom/cache/llvm-pru/tablegen && runghc Main.hs pats /home/tom/cache/llvm-pru/third/llvm/lib/Target/PRU/generated/patterns.td /bin/sh: 1: runghc: not found Entry: Templating Date: Thu Jan 3 20:07:50 CET 2019 I'm running into more cases where generated files have a lot of boilerplate, so are easier to generate as files in the target language. The addition of parameterization would be nice. http://hackage.haskell.org/package/shakespeare https://www.yesodweb.com/book/shakespearean-templates EDIT: Not for me. Dedicated to web formats. Entry: Monadic form is annoying Date: Tue Jan 29 11:23:57 EST 2019 I want a pre-processor. Simplest seems s-expr. EDIT: Why not see if this has been done before? Entry: Monads are too cumbersome for pure languages Date: Mon Mar 11 09:31:40 EDT 2019 The main problem is that in order to capture sharing information, it is necessaary to use a monadic form. That, however, is very cumbersome for languages that are mainly in expression form. As of now I've seen only a couple of ways to work around this: - Use a different syntax (template haskell or explicit compilation) - Compiling to categories (similar, but at the lambda<->ccc level) - Some hack that violates referential transparency The simplicity of just sticking to Haskell is an advantage, but it makes the language ugly at the lower levels. Maybe just get used to it? Specifically for and & or in the HDL: maybe there is a way to do just that? E.g. use some kind of list representation. E.g: a = ~b | c | d a <- or [ not b, c, d ] When using list, they all need the same types. It can be done using tuples though, and using only binary tuples, implementing a class for 3 instances: (a, a) (a, m a) (m a, a) (m a, m b) a <- or (not b, or (c, d)) This is pretty much equivalent to just having 2-ary functions, and there I ran into ambiguities that required a lot of type annotation. There doesn't seem to be a way out. Another way is to have a sub-language for just the logic: app $ Or [Not [Or [a,b,c]]] But then this would need to be extended for every function. How to make this workm where each operation is a uniary or a binary. x or [x not [x or [a,b,c]]] I think that would work. Same using an infix or $$ [not $$ [or $$ [a,b,c]]] Forget about the unary for now. The binary form isn't that hard to express. Nope... doesn't work! Forget about this... There is no solution apart from creating a data structure representing the sub-language, and compiling it explicitly. Get used to monadic notation. Entry: Sequential notation again Date: Tue Apr 2 11:11:41 EDT 2019 Summarize, again: - stick to monadic representation. there is no good alternative - solve the "flatness" by producing n-ary primitives, and get used to using traverse / sequence. Entry: ghcid Date: Sat Apr 6 16:16:03 EDT 2019 https://www.parsonsmatt.org/2018/05/19/ghcid_for_the_win.html https://github.com/ndmitchell/ghcid https://www.reddit.com/r/haskell/comments/8kn1x7/ghcid_for_the_win/ Entry: Ad hoc collections Date: Mon Apr 8 08:14:45 EDT 2019 I've not run into this a whole lot yet. Maybe up to now, everything I did had a lot of intrinsic structure, where all the arbitraryness was at the data end, not the type end. Maybe it is best to keep it like that? Anwyay, I need a struct with many members, and a simple way to extend it. A dictionary seems to be the proper abstraction for this, but there is also record syntax. So how to represent a dictionary in Haskell? EDIT: Just use data or newtype, and use ad-hoc bundling in pairs. That provides enough type brittleness to organize things. Pairs, because instantiation is somewhat arbitrary, so it's ok to just use arbitrary "pass through types" instead of using an environment monad. Entry: ghcid multiple modules Date: Mon Apr 8 11:23:53 EDT 2019 Is this just about "switching focus"? I.e. organize work in such a way that you can stay inside one module? EDIT: It should work with multiple targets. Maybe fix all this first, because the work is all arbitrary details and would benefit greatly from immediate feedback. EDIT: Something is not right in how this starts up. EDIT: Call ghci directly inside of nix env, not through cabal. Entry: Monadfail Date: Wed Apr 10 10:31:00 EDT 2019 Language/Seq/Term.hs:263:3: error: • No instance for (Control.Monad.Fail.MonadFail M) Something changed in GHC. I believe it is just adding a class at some point. https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.6 "GHC now enables the MonadFailDesugaring extension by default." How to turn it back off? {-# LANGUAGE NoMonadFailDesugaring #-} Entry: Show1 Date: Wed Apr 10 10:50:35 EDT 2019 Language/Seq/NetList.hs:247:57: error: • Could not deduce (Show1 TypedForm) arising from the first field of ‘TypedExpr’ (type ‘TypedExpr' n’) from the context: Show n bound by the deriving clause for ‘Show (TypedExpr n)’ at Language/Seq/NetList.hs:247:57-60 Possible fix: use a standalone 'deriving instance' declaration, so you can specify the instance context yourself • When deriving the instance for (Show (TypedExpr n)) | 247 | newtype TypedExpr n = TypedExpr (TypedExpr' n) deriving Show | ^^^^ I've just made it compile. Probably broken now... EDIT: This is due to an upgrade from 8.2 to 8.6. I have to upgrade, so figure out why this breaks. First, find out what Show1 really is: https://hackage.haskell.org/package/transformers-0.4.3.0/docs/Data-Functor-Classes.html "Liftings of the Prelude classes Eq, Ord, Read and Show to unary type constructors." EDIT: I really don't want to get into this now. To much of a switch. EDIT: Maybe I have to? It is an automatically derived instance that then is not properly automatically derived? I don't understand this mess. EDIT: There are some weird interactions between GeneralizedNewtypeDeriving and DeriveAnyClass. I think I've solved it by using just GeneralizedNewtypeDeriving and not DeriveAnyClass, and implenting (Show1 TypedExpr) manually. Maybe this is what DerivingStrategies fixes? I really don't want to know. Entry: cabal2nix guidelines Date: Wed Apr 10 13:43:56 EDT 2019 0. Running "cabal" inside the nix environment will refer to the cabal outside the environment. This is very confusing at first. What cabal2nix does is provide an environment in which ghc and ghci see the base module set so they can compile the .hs modules inside the package. 1. Keep packages small. Split things up in a core library, side libraries, tools and test binaries. nix is very slow, and you will get stuck in a loop at some point where there is an error right at the end and you have to sit through a full build for the next iteration. 2. Use cabal2nix to create a separate setup where only the base modules are provided, but all the modules that you're working on are loaded in interpreted mode. I.e. just link them into the isolated directory used for the ghcid config. Entry: I need code navigation Date: Thu Apr 11 09:30:39 EDT 2019 haskell-mode uses ghci for this. It seems that I'm going to need to extend ghcid to support a couple of things. Entry: Lifting in monadic algebraic languages. Date: Sat Apr 20 16:29:43 EDT 2019 Given functor, what would this need? -- Why are there no generic patterns for this? c1 f (C ar ai) = do cr <- f ar ; ci <- f ai ; return $ C cr ci c2 f (C ar ai) (C br bi) = do cr <- f ar br ; ci <- f ai bi ; return $ C cr ci Basically, the monad is there because of practical reasons (e.g. strict language), not because of mathematical constraints on the semantics. This is really unfortunate, but is an artefact of Haskell embeddings. So if the monad were not there, this could be fmap and zip. The second one _adds_ information: the order of operations. A lot would be solved by implementing some kind of to/from list operation. Is there a generic way to express that? Foldable -> toList but fromlist is not generic. Traversable and Zip. Entry: Why does Zip not have more standing? Date: Sat Apr 20 16:35:35 EDT 2019 It is ubiquitous in numerical applications, but I've not seen it in many other places. Entry: Constraining ranges Date: Wed May 8 08:04:02 EDT 2019 I have a function (i->s) -> (i'->s), where i is an integer in 0..n, and i' is in 0..n+1 How to express that in a type? Probably type families? Droppig the s, i.e. i->i' becomes something like i -> S i, where S is the successor type. https://en.wikipedia.org/wiki/Type_family https://wiki.haskell.org/GHC/Type_families EDIT: Type families are type-indexed types. I want value-indexed types. Datakinds? https://stackoverflow.com/questions/20558648/what-is-the-datakinds-extension-of-haskell https://www.parsonsmatt.org/2017/04/26/basic_type_level_programming_in_haskell.html Entry: Type level programming Date: Thu May 9 14:54:39 EDT 2019 I need to start from ground up, now that I sort of know what I want. The first thing to do is to wrap Seq to have fixed size vectors. Let's start here: https://www.parsonsmatt.org/2017/04/26/basic_type_level_programming_in_haskell.html Notes: - Data Kinds are there to restrict kinds, e.g. avoid Succ :: * -> *, which would allow e.g. Succ Bool, allowing Succ :: Nat -> Nat - GADTs allow to create parametric structures, where parameters can have constraints (e.g. be only one of a finite set of tupes). - The combination of these two allows creation of type-level vectors - Type Families then provide a mechanism to organize parameterized types. - Then there's some notes about how this is hard to use Read that a bit more, then graduate to this: https://www.schoolofhaskell.com/user/konn/prove-your-haskell-for-great-safety/dependent-types-in-haskell Entry: ghcid Date: Sat May 11 09:25:59 EDT 2019 After looking at the code I noticed that it supports json output. Entry: folds Date: Thu May 16 09:01:56 EDT 2019 Haskell's Foldable is about how data structures relate to lists and the associated linear folding. This is different from the generalized fold that replaces all the constructors of a data type. The structure-preserving iteration pattern in Haskell is called traverse. Entry: exposing functor structure Date: Thu May 16 09:27:12 EDT 2019 A pattern that tends to happen a lot when exploring how to represent something: 1. Start with an ad-hoc data type 2. Write a generalized fold for it 3. Factor it out such that the Functor structure is exposed, i.e. separate structure from content. This then yields Foldabale and Traversable. Entry: CS410 McBride lectures Date: Thu May 16 15:13:49 EDT 2019 Available on Youtube. https://github.com/pigworker/CS410-17 Entry: Annotating functors Date: Fri May 17 09:56:58 EDT 2019 Is this a general pattern / idiom? 1. Often is is terribly convenient to shoe-horn a data structure into Functor, Foldable, Traversable interfaces. However, this abstracts away context information. 2. To work around this, provide a custom iteration that does nothing but adding a context record to each element inside the Functor that "inverts" all the references to the outside world, from the perspective of that element. I.e. F a -> F (Ctx, a). Basically, Ctx is some kind of zipper-like structure. Entry: web Date: Sat May 18 17:33:58 EDT 2019 https://www.reddit.com/r/haskell/comments/9vsaax/current_best_webframework_to_choose_in_haskell/ https://haskell-miso.org/ http://hackage.haskell.org/package/servant Entry: automatic deriving is a mess Date: Tue May 21 08:13:50 EDT 2019 I'm just cargo-culting this for now. It works with these, which is the only thing I'm interested in. {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} Entry: Making ideas precise Date: Tue May 21 09:25:06 EDT 2019 Boils down to how to nest data structures. Each level of nesting can then be tagged by some semantics, determined by what operations can work on the wrapper. Entry: Overriding print stdout Date: Mon Sep 9 12:37:29 IST 2019 How to redirect stdout? Maybe the realy problem is not to hard-code it in the first place. EDIT: Use this logfile = "/home/tom/exo/ghcid/output.log" withLogfile m = do h <- openFile logfile AppendMode stdout_dup <- hDuplicate stdout stderr_dup <- hDuplicate stderr hDuplicateTo h stdout hDuplicateTo h stderr m hClose h hDuplicateTo stdout_dup stdout hDuplicateTo stderr_dup stderr return () Entry: Lenses Date: Sat Nov 23 09:59:53 EST 2019 So now I have a pretty good intuitive idea about lenses (a map between edits that preserves model identity after appidentity ofmodels after application of edits) Why is the Haskell definition different? Entry: A long standing problem: link pure stream view and stateful implementation Date: Mon Feb 3 09:11:45 EST 2020 I have something that behaves as a pure function: a causal stream processor. Output streams _only_ depend on input streams. However to implement this in a way that can be reified as state machines, I am forced to use a monadic representation: say: accumulate_v :: v -> m v Where v is the value type. This is a stateful operation that computes the instantaneous output value as the sum of the the current input value and the hidden internal state. The monad is necessary to implement the state, but can also be used to hide a compiler that would e.g. be used to produce C or Verilog output. What I really want to do is to create functions like: accumulate_s :: s -> s That operate abstractly on the stream type in a way that exposes their purity, but then can be mapped back to implementation using comp :: (s -> s) -> (v -> m v) Is this possible? The only thing I've found up to now is Conal's CCC approach that essentially redefines evaluation at a very deep level and doesn't seem possible without a plugin. Is there another way? EDIT: I went down this path before, and then part of the solution was existential types, but it still did not solve the sharing problem. It seems that strictness (an effect!) is baked into this problem in a very deep way. So let's stick to this conclusion for now: there is no way to do this other than using CCC. Here's a possible lead: http://www.philipzucker.com/approximating-compiling-categories-using-typelevel-haskell-take-2/ Next step? - Go over Conal's presentation again - Check Oleg's embedding: http://okmij.org/ftp/Haskell/de-typechecker.lhs For now, just stick with monadic primitives. It's just inconvenient, not a show stopper. Entry: Revisit the unsafe interface Date: Wed Feb 5 07:27:25 EST 2020 Look up the Haskell Logic DSL that did this. I believe the reason the "unsafe" part is not unsafe is that there is that functional semantics. NO. Get Conal's plugin to work. Entry: Post to haskell cafe Date: Wed Feb 5 07:37:03 EST 2020 Is there currently a consensus on what is the best way to embed a pure dataflow language while keeping control over value sharing? I have a stream processing language that has a monadic interface (a -> b -> m c) to track variable sharing so it can compile down to C or Verilog, but I would like to create an expression interface layer on top (s a -> s b -> s c) that still allows me to recover the underlying monad representation to implement sharing. I got used to writing in monadic form but I really can't sell this to EEs... Other than a TH or syntax frontend, unsafe tricks, or Conal's compiling to categories which requires a plugin (I believe), is there another way? Entry: Sharing through content addressable store Date: Wed Feb 5 08:05:50 EST 2020 In a pure representation of a dataflow language with sharing, the trick is to merge context. I've solved this before also doing common subexpression elimination. Is it possible to represent a context in such a way that it is easy to merge? Can this use some form of hashing? Follow up (see mailing list thread) - applicative do? - recent ghc also have source plugins? - check how ivory/tower edsl libraries do their embedding - try clash - try MaybePure - RebindableSyntax - Edward Kmett's AD package does observable sharing - https://hackage.haskell.org/package/sbv http://www.ittc.ku.edu/~andygill/papers/reifyGraph.pdf https://hackage.haskell.org/package/data-reify - https://www.researchgate.net/profile/David_Sands3/publication/225679607_Observable_Sharing_for_Functional_Circuit_Description/links/0a85e530b7beb39a9c000000.pdf Entry: Ivory: safe embedded C Date: Wed Feb 5 09:35:52 EST 2020 https://ivorylang.org/ https://github.com/galoisinc/Ivory Ivory is an embedded domain specific language (EDSL) which aims to provide a systems-level programming language that removes some common pitfalls of programming in C, without sacrificing expressivity. Ok great I don't need to make a C frontend! Entry: Tower Date: Wed Feb 5 09:39:46 EST 2020 Tower is a concurrency framework for the Ivory Language. https://github.com/galoisinc/tower Entry: Clash Date: Wed Feb 5 11:18:48 EST 2020 Carter Shonwald: Try using clash, its its own thing, and overanalysis might be more challenging than just trying it out Fair point. But I really want multiple targets, and something that I understand completely, so I'm not going to do this. See rtl.txt Tracking this down, Christiaan Baaij's thesis has some information about this in Appendix C: https://essay.utwente.nl/59482/1/scriptie_C_Baaij.pdf But the problem there is recovering loops. I do not have loops: all register close operations are explicit. The relevant paper is: [9] Koen Claessen and David Sands. Observable sharing for functional circuit description. In Asian Computing Science Conference, pages 62–73. Springer Verlag, 1999. https://archive.alvb.in/msc/thesis/reading/observable-sharing-circuits.pdf http://www.cse.chalmers.se/~koen/ Entry: Lisp-style pattern matcher Date: Sun Feb 9 19:14:51 EST 2020 I've been using s-expressions (SE) for many things. They are terribly convenient since the parser is almost trivial. I'm mapping SE to (Free [String]). What I miss, is straightforward structural matching. The Free/Pure constructors are clumsy to use for direct matching, but it might be possible to define some fold-style matchers. EDIT: yea not now The underlying problem is that the s-expression space is very large, and I want to match a very specific subset. So maybe it's best to use the Either monad. Or... use the path represenation. That is much easier to match. Entry: ghcid ending in a service Date: Wed Feb 12 06:08:41 EST 2020 It seems best to turn it around completely: let's start ghcid ONLY as a service. Don't worry about the output being written to some file. Let the Erlang side query tests. EDIT: Something works, but still there are things I don't understand about restarting. Maybe it is useful to spend the time to get the ghcide code up? Entry: linear algebra Date: Thu Feb 13 08:49:41 EST 2020 https://hackage.haskell.org/package/linear Kmett of course.. Maybe have a look at the dependencies? Entry: redefine classes on top of kleisli arrows Date: Fri Feb 14 17:05:31 EST 2020 So instead of using functions, use kleisli arrows to define the usual type class structure. Does that make any sense? Does it reduce to something that exists? Start with map: normal: (a -> b) -> f a -> f b new: (a -> m b) -> f a -> m (f b) That is traverse, where m can be just an applicative, and the functor f needs to be traversable. I.e. it needs to have a natural sequential order. How does applicative generalize? E.g. for the special case 2-op: normal: (a -> b -> c) -> f a -> f b -> f c new: (a -> b -> m c) -> f a -> f b -> m (f c) Which is traverse2 Entry: Effects Date: Sun Feb 16 13:24:48 EST 2020 In general terms, there is a single monad that is implemented by communication with a handler. In essence this is two "processes", one is the abstract computation, the other is the implementation of the effects. Is this correct enough? Looking around for a good introduction video I found this: freer-effects: https://www.youtube.com/watch?v=gUPuWHAt6SA - we don't have time for building monad stacks - monads transformers "sort of" compose, but still a hack - get out og Eff by singleton monad, or pure for empty - induction to implement - MTL: scaffolding goes away at compile time neat https://reasonablypolymorphic.com/ https://hackage.haskell.org/package/freer-effects http://okmij.org/ftp/Haskell/extensible/more.pdf http://okmij.org/ftp/Haskell/zseq.pdf http://okmij.org/ftp/Haskell/extensible/exteff.pdf Entry: check out compiling to categories Date: Sun Feb 23 20:29:50 EST 2020 I have 3 use cases already: - dataflow systems - reactive web pages - electronic circuits Entry: DerivingVia Date: Mon Mar 30 12:07:30 EDT 2020 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0120-deriving-via.rst Entry: matrix library Date: Fri Jun 5 22:51:50 EDT 2020 https://hackage.haskell.org/package/hmatrix http://dis.um.es/~alberto/hmatrix/hmatrix.html Entry: exo integration Date: Wed Jul 1 17:13:20 EDT 2020 Just a brief note: ghci is integrated in exo for fast Haskell code reload, with a BERT RPC interface to properly integrate in redo scheduler. Works quite well. Entry: Threading Date: Fri Jul 3 15:15:36 EDT 2020 https://stackoverflow.com/questions/5847642/haskell-lightweight-threads-overhead-and-use-on-multicores Entry: FFI Date: Sun Jul 5 12:40:04 EDT 2020 I went for this a couple of times. Search for FFI backwards. https://stackoverflow.com/questions/6740850/call-c-functions-from-haskell-at-runtime Two things to realize: - The ffi requires libraries to be linked into the binary, or into ghci - Otherwise, use dlopen? I'm starting to think that it might be simpler to generate test code, than to try to marshall data. Or to focus on protocols, and to run protocol tests + internal state asserts.