exercise done. :D there is still a problem with the functional dependencies. see last line of code. - marc
Am Mittwoch, 4. Juli 2007 14:22 schrieb Conor McBride:
> {? * 10 + ?} 4 2 = 42
>
> <http://hackage.haskell.org/trac/haskell-prime/wiki/FlexiblePartialApplication>
>
> (3) Exercise for readers:
>
> implement constructors
> P v for embedding pure values v
> O for holes
> f :$ a for application, left-associative
> and an interpreting function
> emmental
> such that
> emmental (P (+) :$ (P (*) :$ O :$ P 10) :$ O) 4 2 = 42
>
> I think the question of whether to support linear abstractions other
> than of
> an argument suffix is an interesting one. The flip answer is a bad
> answer;
> lambda abstraction is a good answer, but sometimes feels too heavy
> for this
> job. I really don't have a strong opinion about whether it's worth
> supporting
> a lighter notation for the linear case, but I thought I'd at least
> try to
> inform the debate.
>
> All the best
>
> Conor
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
{-# OPTIONS -fglasgow-exts -farrows -fbang-patterns -fno-full-laziness -funbox-strict-fields -fallow-undecidable-instances #-}
{-# PACKAGE ghc-6.6 #-}
{-# LANGUAGE ExistentialQuantification #-}
module Main where
--import Control.Arrow
--import Data.Array as Array
--import Data.Array.ST as STArray
--import Data.Array.Unboxed as UArray
--import Data.Map as Map
--import Data.Set as Set
--import Data.List as List
--import Data.Queue
--import Data.Sequence as Seq
--import Data.IntSet as IntSet
--import Data.IntMap as IntMap
--import Data.Maybe
--import Data.Bits (xor)
--import Data.Word
--import Data.Int
--import Control.Monad
--import Control.Arrow
--import Control.Monad.State
--import Control.Monad.Writer
--import Data.Foldable (foldrM)
--import Control.Applicative
--import Data.Traversable
--import System.Posix
--import System.IO.Unsafe
--import Data.Graph.Inductive as Gr hiding ((><))
--import qualified Data.Graph.Inductive.Example as Example
--import Data.Graph.Inductive.Query.BFS
--import Control.Monad.ST.Strict
--import Data.STRef
--import System.Random
--import Data.Ratio
--import System.Exit
--import MonadLib
{-
implement constructors
P v for embedding pure values v
O for holes
f :$ a for application, left-associative
and an interpreting function
emmental
such that
emmental (P (+) :$ (P (*) :$ O :$ P 10) :$ O) 4 2 = 42
-}
type ONE = SUCC ZERO
type TWO = SUCC ONE
data ZERO
data NAT n => SUCC n
class NAT n where
nat :: n -> Int
instance NAT ZERO where
nat _ = 0
instance NAT n => NAT (SUCC n) where
nat _ = succ $ nat (undefined::n)
newtype HOLE a = HOLE a
class NAT n => UNHOLE n h f | n h -> f where
unhole :: n -> h -> f
instance UNHOLE ZERO (P v) v where
unhole _ (P v) = v
instance (NAT n , UNHOLE n f g) => UNHOLE (SUCC n) ((HOLE a)->f) (a->g) where
unhole _ f = unhole (undefined::n) . f . HOLE
data P v = P v
data O = O
data (:$) f a = f :$ a
infixl 8 :$
{-
class PLUS a b c | a b -> c where
instance PLUS ZERO b b where
instance (PLUS a b c) => PLUS (SUCC a) b (SUCC c) where
class COUNT a n | a -> n where
countH :: a -> n
countH _ = undefined
instance COUNT (P v) ZERO where
instance COUNT O ONE where
instance (COUNT f nf,COUNT a na,PLUS nf na nfa) => COUNT (f :$ a) (nfa) where
-}
class EmToH e n h | e -> n h where
emToH :: e -> h
instance EmToH (P v) ZERO v where
emToH (P v) = v
instance EmToH O ONE (HOLE h->h) where
emToH O (HOLE h) = h
instance (EmToH f nf f',EmToH a na a',ApplyH nf f' na a' nfa fa) => EmToH (f :$ a) nfa fa where
emToH (f :$ a) = applyH (undefined::(nf,na)) (emToH f) (emToH a)
class ApplyH nf f na a nfa fa | nf f na a -> nfa fa where
applyH :: (nf,na) -> f -> a -> fa
instance ApplyH ZERO (a->fa) ZERO a ZERO fa where
applyH _ f a = f a
instance (ApplyH ZERO f na a na fa) => ApplyH ZERO f (SUCC na) (HOLE h->a) (SUCC na) (HOLE h->fa) where
applyH _ f a h@(HOLE _) = applyH (undefined::(ZERO,na))f (a h)
instance (ApplyH nf f na a nfa fa) => ApplyH (SUCC nf) (HOLE h->f) na a (SUCC nfa) (HOLE h->fa) where
applyH _ f a h@(HOLE _) = applyH (undefined::(nf,na)) (f h) a
class UnH n f r | n f -> r where
unH :: n -> f -> r
instance UnH ZERO f f where
unH _ = id
instance (UnH n f r) => UnH (SUCC n) (HOLE h->f) (h->r) where
unH _ f h = unH (undefined::n) $ f (HOLE h)
class Emmental e f | e -> f where
emmental :: e -> f
instance (EmToH e n h, UnH n h r) => Emmental e r where
emmental = unH (undefined::n) . emToH
main :: IO ()
--main = print $ emmental (P (+) :$ (P (*) :$ O :$ P 10) :$ O) 4 2
main = print $ emmental (P ((+)::Int->Int->Int) :$ (P ((*)::Int->Int->Int) :$ O :$ P (10::Int)) :$ O) (4::Int) (2::Int)
pgpCnHKLE0z6g.pgp
Description: PGP signature
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
