Permalink
Browse files

Another rejig of pattern represetation

  • Loading branch information...
1 parent 67a24f7 commit de476a17c45694ccd7c4658111115117f7684700 @yaxu committed Sep 5, 2012
Showing with 119 additions and 389 deletions.
  1. +8 −8 Parse.hs
  2. +0 −61 Pat.hs
  3. +107 −316 Pattern.hs
  4. +4 −4 Stream.hs
View
@@ -83,10 +83,10 @@ pRhythm f = do spaces
pSequence f
pSequence :: Parser (Pattern a) -> GenParser Char () (Pattern a)
-pSequence f = do x <-pReps
+pSequence f = do --x <-pReps
ps <- many $ pPart f
- let p = Arc (cat ps) 0 1 x
- return $ p
+ --let p = Arc (cat ps) 0 1 x
+ return $ cat ps
pPart :: Parser (Pattern a) -> Parser (Pattern a)
pPart f = do part <- parens (pSequence f) <|> f <|> pPoly f
@@ -102,23 +102,23 @@ pString = many1 (letter <|> oneOf "0123456789" <|> char '/') <?> "string"
pVocable :: Parser (Pattern String)
pVocable = do v <- pString
- return $ Atom v
+ return $ atom v
pDouble :: Parser (Pattern Double)
pDouble = do nf <- intOrFloat <?> "float"
let f = either fromIntegral id nf
- return $ Atom f
+ return $ atom f
pBool :: Parser (Pattern Bool)
pBool = do oneOf "t1"
- return $ Atom True
+ return $ atom True
<|>
do oneOf "f0"
- return $ Atom False
+ return $ atom False
pInt :: Parser (Pattern Int)
pInt = do i <- natural <?> "integer"
- return $ Atom (fromIntegral i)
+ return $ atom (fromIntegral i)
pRatio :: Parser (Rational)
pRatio = do n <- natural <?> "numerator"
View
61 Pat.hs
@@ -1,61 +0,0 @@
-module Pat where
-
-import Control.Applicative
-import Data.Fixed
-import Data.List
-import Data.Maybe
-import Data.Ratio
-import Debug.Trace
-
-type T = (Rational, Rational)
-type Event a = (T, a)
-
-data Seq a = Seq {events :: [Event a]}
-
-data Pat a = Pat {arc :: T -> Seq a}
- | Sig {at :: Rational -> Seq a}
-
-instance Functor Seq where
- fmap f = Seq . mapSnds f . events
-
-instance Functor Pat where
- fmap f (Pat a) = Pat $ fmap f . a
- fmap f (Sig a) = Sig $ fmap f . a
-
-instance Applicative Seq where
- pure x = Seq [((0,1), x)]
- (Seq fs) <*> (Seq xs) = Seq xs'
- where xs' = concatMap (\f -> map (\(t, x) -> (t, (snd f) x)) $ filter (startsIn f) xs) fs
-
-startsIn :: Event a -> Event b -> Bool
-startsIn (t, _) (t', _) = (fst t') >= (fst t) && (fst t' <= (fst t + snd t))
-
-instance Applicative Pat where
- pure x = rep x
- (Pat fs) <*> (Pat xs) = Pat $ \t -> fs t <*> xs t
- (Sig fs) <*> (Sig xs) = Sig $ \i -> fs i <*> xs i
- (Pat fs) <*> (Sig xs) = Pat $ s
- where s t = Seq $ concatMap (\(t', f) -> mapSnds f (events $ xs $ fst t')) (events $ fs t)
- (Sig fs) <*> (Pat xs) = Sig $ s
- where s i = Seq $ concatMap (\(t', f) -> mapSnds f (events $ xs $ t') ) (events $ fs i)
-
-rep :: a -> Pat a
-rep x = Pat $ \(s, d) -> Seq (map (\n -> ((fromIntegral n, 1), x)) [(ceiling s) .. (ceiling $ s+d) - 1])
-
--- instance Applicative Pat where
--- pure x = rep x
--- fs <*> xs = Pat $ \t -> (arc fs) t <*> (arc xs) t
-
-
-
--- mapFst :: (a -> b) -> (a, c) -> (b, c)
--- mapFst f (x,y) = (f x,y)
-
--- mapFsts :: (a -> b) -> [(a, c)] -> [(b, c)]
--- mapFsts = map . mapFst
-
-mapSnd :: (a -> b) -> (c, a) -> (c, b)
-mapSnd f (x,y) = (x,f y)
-
-mapSnds :: (a -> b) -> [(c, a)] -> [(c, b)]
-mapSnds = fmap . mapSnd
Oops, something went wrong.

0 comments on commit de476a1

Please sign in to comment.