Skip to content

Instantly share code, notes, and snippets.

View ChallengeTransform.hs
{-# language GADTs, ScopedTypeVariables, DeriveTraversable #-}
module ChallengeTransform where
import Data.Typeable
import Data.Proxy
import Data.Coerce
data Scheme a where
Res :: Typeable a => !(Proxy a) -> Scheme a
Arg :: Typeable a => !(Proxy a) -> Scheme b -> Scheme (a -> b)
@treeowl
treeowl / Bftr.hs
Last active Mar 16, 2020
Breadth-first binary tree creation
View Bftr.hs
-- | This module defines a function that produces a complete binary tree
-- from a breadth-first list of its (internal) node labels. It is an
-- optimized version of an implementation by Will Ness that avoids
-- any "impossible" cases. See
--
-- https://stackoverflow.com/a/60561480/1477667
module Bftr (Tree (..), bft, list, deftest) where
import Data.Function (fix)
import Data.Monoid (Endo (..))
View ZipRev.hs
zipRev :: [a] -> [b] -> [(a,b)]
zipRev xs ys = fr where
(fr, allbs) = go [] allbs xs ys
go acc ~(b':bs') (a:as) (b:bs) = ((a,b') : res, bss)
where
(res, bss) = go (b:acc) bs' as bs
go acc _ _ _ = ([], acc)
@treeowl
treeowl / SingMap.hs
Last active Dec 19, 2018
Singleton maps
View SingMap.hs
{-# language TypeInType, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators,
GADTs, UndecidableInstances, NoStarIsType, TemplateHaskell, InstanceSigs,
TypeSynonymInstances, FlexibleInstances, BangPatterns #-}
module SingMap (module SingMap, module P, module F) where
import GHC.TypeLits hiding (type (<=))
import Data.Type.Bool
import Data.Type.Equality
import Data.Singletons
import Data.Traversable
@treeowl
treeowl / BasicNat.hs
Last active Jun 30, 2019
Fast total sorting of arbitrary Traversable containers
View BasicNat.hs
{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, GADTs,
ScopedTypeVariables, TypeOperators #-}
-- | Type-level natural numbers and singletons, with proofs of
-- a few basic properties.
module BasicNat (
-- | Type-level natural numbers
Nat (..)
, type (+)
View gist:73a5464a8345d5716208a70ab1e4c5a9
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wall -fwarn-incomplete-uni-patterns #-}
module AS2 where
View Ix.hs
ix :: Applicative f => Int -> (a -> f a) -> Seq a -> f (Seq a)
ix i@(I# i') f (Seq xs)
| 0 <= i && i < size xs = Seq <$> ixTreeE (\_ (Elem a) -> Elem <$> f a) i' xs
| otherwise = pure (Seq xs)
unInt :: Int -> Int#
unInt (I# n) = n
ixTreeE :: Applicative f
=> (Int# -> Elem a -> f (Elem a)) -> Int# -> FingerTree (Elem a) -> f (FingerTree (Elem a))
View LazyMonadicQueue.hs
{-# LANGUAGE DeriveFunctor, BangPatterns #-}
module Queues.LazyMonadic where
import Data.Word
import Control.Applicative
import Control.Monad
data Result e a = Result
{ rval :: a
, rlen :: Word
, rremains :: [e]
@treeowl
treeowl / Magmas
Created May 8, 2015
Free magmas and semigroups
View Magmas
-- Construction of the free magma over an arbitrary type.
module Magma
import Set
%default total
%access public
infixl 6 <++>
class Set c => Magma c where
@treeowl
treeowl / freemagma
Last active Aug 29, 2015
Binary leaf trees are free magmas
View freemagma
module Set
%default total
infixl 4 ~=
class Set c where
(~=) : (x,y:c) -> Type
rfl : {x:c} -> x ~= x
symm : {x,y:c} -> x ~= y -> y ~= x