~ubuntu-branches/ubuntu/utopic/haskell-uulib/utopic

« back to all changes in this revision

Viewing changes to src/UU/Parsing/Perms.hs

Committer: Bazaar Package Importer
Author(s): Arjan Oosting
Date: 2006-11-18 16:24:30 UTC
Revision ID: james.westby@ubuntu.com-20061118162430-24ddyj27kj0uk17v

Tags: upstream-0.9.2

Import upstream version 0.9.2

files added:

LICENSE-LGPL

Makefile.in

README

Setup.hs

VERSION

configure

configure.in

src/UU

src/UU/DData

src/UU/DData/IntBag.hs

src/UU/DData/IntMap.hs

src/UU/DData/IntSet.hs

src/UU/DData/Map.hs

src/UU/DData/MultiSet.hs

src/UU/DData/Queue.hs

src/UU/DData/Scc.hs

src/UU/DData/Seq.hs

src/UU/DData/Set.hs

src/UU/PPrint.hs

src/UU/Parsing

src/UU/Parsing.hs

src/UU/Parsing/CharParser.hs

src/UU/Parsing/Derived.hs

src/UU/Parsing/Interface.hs

src/UU/Parsing/Machine.hs

src/UU/Parsing/MachineInterface.hs

src/UU/Parsing/Merge.hs

src/UU/Parsing/Offside.hs

src/UU/Parsing/Perms.hs

src/UU/Parsing/StateParser.hs

src/UU/Pretty

src/UU/Pretty.hs

src/UU/Pretty/Basic.hs

src/UU/Pretty/Ext.hs

src/UU/Scanner

src/UU/Scanner.hs

src/UU/Scanner/GenToken.hs

src/UU/Scanner/GenTokenOrd.hs

src/UU/Scanner/GenTokenParser.hs

src/UU/Scanner/GenTokenSymbol.hs

src/UU/Scanner/Position.hs

src/UU/Scanner/Scanner.hs

src/UU/Scanner/Token.hs

src/UU/Scanner/TokenParser.hs

src/UU/Scanner/TokenShow.hs

src/UU/Util

src/UU/Util/BinaryTrees.hs

src/UU/Util/PermTree.hs

src/UU/Util/Utils.hs

uulib.cabal

uulib.cabal.in

Show diffs side-by-side

added added

removed removed

src/UU/Parsing/Perms.hs

module UU.Parsing.Perms(Perms(), pPerms, pPermsSep, succeedPerms, (~*~), (~$~)) where

import UU.Parsing

import Maybe

-- =======================================================================================

-- ===== PERMUTATIONS ================================================================

-- =======================================================================================

newtype Perms p a = Perms (Maybe (p a), [Br p a])

data Br p a = forall b. Br (Perms p (b -> a)) (p b)

instance IsParser p s => Functor (Perms p) where

fmap f (Perms (mb, bs)) = Perms (fmap (f<$>) mb, map (fmap f) bs)

instance IsParser p s => Functor (Br p) where

fmap f (Br perm p) = Br (fmap (f.) perm) p

(~*~) :: IsParser p s => Perms p (a -> b) -> p a -> Perms p b

perms ~*~ p = perms `add` (getzerop p, getonep p)

(~$~) :: IsParser p s => (a -> b) -> p a -> Perms p b

f ~$~ p = succeedPerms f ~*~ p

succeedPerms :: IsParser p s => a -> Perms p a

succeedPerms x = Perms (Just (pLow x), [])

add :: IsParser p s => Perms p (a -> b) -> (Maybe (p a),Maybe (p a)) -> Perms p b

add b2a@(Perms (eb2a, nb2a)) bp@(eb, nb)

= let changing :: IsParser p s => (a -> b) -> Perms p a -> Perms p b

f `changing` Perms (ep, np) = Perms (fmap (f <$>) ep, [Br ((f.) `changing` pp) p | Br pp p <- np])

in Perms

( do { f <- eb2a

; x <- eb

; return (f <*> x)

}

, (case nb of

Nothing -> id

Just pb -> (Br b2a pb:)

)[ Br ((flip `changing` c) `add` bp) d | Br c d <- nb2a]

)

pPerms :: IsParser p s => Perms p a -> p a

pPerms (Perms (empty,nonempty))

= foldl (<|>) (fromMaybe pFail empty) [ (flip ($)) <$> p <*> pPerms pp

| Br pp p <- nonempty

]

pPermsSep :: IsParser p s => p x -> Perms p a -> p a

pPermsSep (sep :: p z) perm = p2p (pSucceed ()) perm

where p2p :: IsParser p s => p x -> Perms p a -> p a

p2p fsep (Perms (mbempty, nonempties)) =

let empty = fromMaybe pFail mbempty

pars (Br t p) = flip ($) <$ fsep <*> p <*> p2p sep t

in foldr (<|>) empty (map pars nonempties)

p2p_sep = p2p sep

b'\\ No newline at end of file'

Older »