Commit ab2de986 authored by Gilles Coremans's avatar Gilles Coremans
Browse files

Fix Comble.hs line-endings

parent 2fd86920
{-# LANGUAGE GADTs, KindSignatures, NPlusKPatterns #-}
module Comble where
import qualified Data.Array as A
import Control.Applicative
type Card = Integer
data Comble :: * -> * where
Empty :: Comble e
Pure :: e -> Comble e
Alt :: Comble e -> Comble e -> Card -> Comble e
App :: Comble (arg -> e) -> Comble arg -> Card -> Comble e
card :: Comble e -> Card
card Empty = 0
card (Pure _) = 1
card (Alt _ _ n) = n
card (App _ _ n) = n
instance Functor Comble where
fmap f x = pure f <*> x
instance Applicative Comble where
pure x = Pure x
f <*> x = App f x (card f * card x)
instance Alternative Comble where
empty = Empty
t <|> u = Alt t u (card t + card u)
infixl 9 !
(!) :: Comble e -> Integer -> e
Pure x ! 0 = x
Alt t u _ ! k = if k < m then t ! k else u ! (k - m)
where m = card t
App t u _ ! k = (t ! (k `div` n)) (u ! (k `mod` n))
where n = card u
toList :: Comble e -> [e]
toList c = go c [] where
go Empty acc = acc
go (Pure x) acc = x : acc
go (Alt t u _) acc = go t (go u acc)
go (App (Pure fun) arg _) acc = fmap fun (toList arg) ++ acc
go (App fun arg _) acc = ((toList fun) <*> (toList arg)) ++ acc
data Tree elem = Leaf | Node (Tree elem) elem (Tree elem) deriving Show
treesOfSize :: (Alternative effect) => Integer -> effect (Tree ())
treesOfSize n = memoGo n where
table = tabulate go (0,n)
memoGo m = table A.! m where
go 0
= pure Leaf
go (s+1)
= asum [ pure Node <*> memoGo s1 <*> pure () <*> memoGo s2
| (s1, s2) <- split2 s]
split2 :: (Integral int) => int -> [(int, int)]
split2 n = [(a, n - a) | a <- [0 .. n]]
asum :: (Alternative effect) => [effect val] -> effect val
asum = foldr (<|>) empty
tabulate :: (A.Ix i) => (i -> e) -> (i,i) -> A.Array i e
tabulate f (l,u) =
A.listArray (l,u) (map f (A.range (l,u)))
data LC = Var Integer | Lam LC | Apply LC LC deriving Show
termsOfSize :: Alternative effect => Integer -> effect LC
termsOfSize n = memoGo (n,0) where
table = tabulate go ((0,0),(n,n))
memoGo p = table A.! p
go (0,m) = asum [pure (Var v) | v <- [0..m-1]]
go (s+1,m) =
asum [pure (Var v) | v <- [0..m-1]]
<|> (Lam <$> go (s,m+1))
<|> asum [ pure Apply <*> go (s1,m) <*> go (s2, m) | (s1, s2) <- split2 s]
{-# LANGUAGE GADTs, KindSignatures, NPlusKPatterns #-}
module Comble where
import qualified Data.Array as A
import Control.Applicative
type Card = Integer
data Comble :: * -> * where
Empty :: Comble e
Pure :: e -> Comble e
Alt :: Comble e -> Comble e -> Card -> Comble e
App :: Comble (arg -> e) -> Comble arg -> Card -> Comble e
card :: Comble e -> Card
card Empty = 0
card (Pure _) = 1
card (Alt _ _ n) = n
card (App _ _ n) = n
instance Functor Comble where
fmap f x = pure f <*> x
instance Applicative Comble where
pure x = Pure x
f <*> x = App f x (card f * card x)
instance Alternative Comble where
empty = Empty
t <|> u = Alt t u (card t + card u)
infixl 9 !
(!) :: Comble e -> Integer -> e
Pure x ! 0 = x
Alt t u _ ! k = if k < m then t ! k else u ! (k - m)
where m = card t
App t u _ ! k = (t ! (k `div` n)) (u ! (k `mod` n))
where n = card u
toList :: Comble e -> [e]
toList c = go c [] where
go Empty acc = acc
go (Pure x) acc = x : acc
go (Alt t u _) acc = go t (go u acc)
go (App (Pure fun) arg _) acc = (fun <$> (toList arg)) ++ acc
go (App fun arg _) acc = ((toList fun) <*> (toList arg)) ++ acc
data Tree elem = Leaf | Node (Tree elem) elem (Tree elem) deriving Show
treesOfSize :: (Alternative effect) => Integer -> effect (Tree ())
treesOfSize n = memoGo n where
table = tabulate go (0,n)
memoGo m = table A.! m where
go 0
= pure Leaf
go (s+1)
= asum [ pure Node <*> memoGo s1 <*> pure () <*> memoGo s2
| (s1, s2) <- split2 s]
split2 :: (Integral int) => int -> [(int, int)]
split2 n = [(a, n - a) | a <- [0 .. n]]
asum :: (Alternative effect) => [effect val] -> effect val
asum = foldr (<|>) empty
tabulate :: (A.Ix i) => (i -> e) -> (i,i) -> A.Array i e
tabulate f (l,u) =
A.listArray (l,u) (map f (A.range (l,u)))
data LC = Var Integer | Lam LC | Apply LC LC deriving Show
termsOfSize :: Alternative effect => Integer -> effect LC
termsOfSize n = memoGo (n,0) where
table = tabulate go ((0,0),(n,n))
memoGo p = table A.! p
go (0,m) = asum [pure (Var v) | v <- [0..m-1]]
go (s+1,m) =
asum [pure (Var v) | v <- [0..m-1]]
<|> (Lam <$> go (s,m+1))
<|> asum [ pure Apply <*> go (s1,m) <*> go (s2, m) | (s1, s2) <- split2 s]
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment