This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- | |
Structurally guaranteed to satisfy the following rules: | |
\* Forward does not depend on backwards. | |
\* Does not send or ack under reset. | |
\* Keeps driving the same value until acked. | |
\* Only acks if there is an input. | |
-} | |
mkCircuit :: | |
forall dom sl someOutput noOutput a b. | |
(HiddenClockResetEnable dom, NFDataX sl, NFDataX someOutput, NFDataX noOutput) => |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
process :: (MonadLogger m, MonadState State m) => Event -> m () | |
process = \case | |
PuckEvent puck -> when (puck ^. #battery < 30) $ logWarnN "Puck battery low" | |
SquareEvent square -> when (square ^. #battery < 30) $ logWarnN "Square battery low" | |
WaterLeakEvent leak -> do | |
when (leak ^. #battery < 30) $ logWarnN "Leak detector battery low" | |
let newState = if leak ^. #water_leak then Wet else Dry | |
oldState <- (#leakState . #wetness) <<.= newState | |
when (oldState /= newState || newState == Wet) $ logWarnN $ "Basement leak detector: " <> pack (show newState) | |
HallEffectEvent location event -> do |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
benchmarking splits1 | |
time 5.094 ms (4.943 ms .. 5.271 ms) | |
0.991 R² (0.984 R² .. 0.997 R²) | |
mean 4.744 ms (4.646 ms .. 4.863 ms) | |
std dev 343.1 μs (275.7 μs .. 454.0 μs) | |
variance introduced by outliers: 46% (moderately inflated) | |
benchmarking splits2 | |
time 12.37 ms (12.09 ms .. 12.64 ms) | |
0.996 R² (0.993 R² .. 0.998 R²) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Criterion.Main | |
import Data.List as L (inits, tails) | |
import qualified Data.Vector as V | |
import qualified Data.Vector.Generic as VG | |
import qualified Data.Vector.Unboxed as VU | |
splits1, splits2, splits3 :: [a] -> [([a],[a])] | |
splits1 xs = zip (L.inits xs) (L.tails xs) | |
splits2 [] = [([],[])] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE KindSignatures, DataKinds, GADTs, FlexibleInstances, FlexibleContexts #-} | |
main = return () | |
-- Problem: I want to (de)serialize a GADT with multiple constructors. | |
-- Any given type will only have a single valid constructor, so there should be no need to serialize a tag. | |
-- However, it is difficult to convince GHC that for all `n`, `Foo n` is deserializable. | |
-- This is presumably because the instances for `n ~ Z` and `n ~ S m` are in separate places and GHC | |
-- doesn't have logic in place to realized that that covers all possibilities. | |
-- However, I can't figure out a good way to combine the two instances so GHC is happy. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE BangPatterns #-} | |
import System.Environment (getArgs) | |
add :: Int -> Int -> Int | |
add start stop = go (start `mod` 3) (start `mod` 5) 0 start | |
where | |
go !a !b !acc !i | |
| i == stop = acc | |
| otherwise = go a' b' acc' (i+1) | |
where |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Data.Map.Strict as Map | |
import Data.Vector as Vec | |
-- The recursive step | |
rec :: (Int -> [[Int]]) -> Int -> [[Int]] | |
rec rec n = do | |
this <- [1..n] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import qualified Control.Lens as L | |
import qualified Control.Lens.Prism as LP | |
import Data.Semigroup ((<>)) | |
foo :: (b1 -> t) -> (b2 -> t) -> (s -> Either t a1) -> (s -> Either t a2) -> ((Either b1 b2 -> t), (s -> Either t (Either a1 a2))) | |
foo inj1 inj2 proj1 proj2 = (either inj1 inj2, \s -> (Left <$> proj1 s) <> (Right <$> proj2 s)) | |
foo' :: L.Prism s t a1 b1 -> L.Prism s t a2 b2 -> L.Prism s t (Either a1 a2) (Either b1 b2) | |
foo' p j = uncurry LP.prism $ LP.withPrism p (\inj1 proj1 -> L.withPrism j (\inj2 proj2 -> foo inj1 inj2 proj1 proj2)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
> import Control.Monad.Morph | |
> import Control.Monad.Except | |
> let wrap f = hoist (withExceptT f) | |
> :t wrap | |
wrap | |
:: (MFunctor t, Monad m) => | |
(e -> e') -> t (ExceptT e m) b -> t (ExceptT e' m) b | |
> let wrap = hoist . withExceptT | |
<interactive>:5:12: error: |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ScopedTypeVariables #-} | |
module ADTStorable where | |
import Foreign.Storable | |
import Foreign.Ptr | |
import Data.Word (Word8) | |
instance forall a . Storable a => Storable (Maybe a) where |
NewerOlder