fix-parser-simple 15320.1 → 15320.2

raw patch · 2 files changed

+12/−11 lines, 2 files

Files

• Parser/Fix/Simple.hs +11/−10
• fix-parser-simple.cabal +1/−1

@@ -16,20 +16,21 @@ -- | Fixity/Associativity data Fixity = Prefix | InfixLeft | InfixRight | InfixNull | Postfix deriving Eq; -data TokenType = -- | Plain, i.e. operand-                 TokenPlain-               | TokenLParenth-               | TokenRParenth+data TokenType p = -- | Plain, i.e. operand+                   TokenPlain+                 | TokenLParenth+                 | TokenRParenth                  -- | Operator, with fixity and precedence-               | TokenOper Fixity Integer-  deriving Eq;+                 | TokenOper Fixity p;  -- | Shunt and Fold-parsefix :: (t -> a, t -> a -> a, t -> a -> a -> a) -> (t -> TokenType) -> [t] -> a;+parsefix :: Ord p =>+            (t -> a, t -> a -> a, t -> a -> a -> a) -> (t -> TokenType p) -> [t] -> a; parsefix apply = liftM2 (.) (foldfix apply) shunt;  -- | Fold expression in postfix form-foldfix :: (t -> a, t -> a -> a, t -> a -> a -> a) -> (t -> TokenType) -> [t] -> a;+foldfix :: Ord p =>+           (t -> a, t -> a -> a, t -> a -> a -> a) -> (t -> TokenType p) -> [t] -> a; foldfix (apply0, apply1, apply2) lookup_t =   let {     foldfix' stack = flip list (list const (error "Empty Stack!") stack) $ \ t ->@@ -56,7 +57,7 @@     Precedence at start is zero -} -- Dijkstra's algorithm-shunt :: (t -> TokenType) -> [t] -> [t];+shunt :: Ord p => (t -> TokenType p) -> [t] -> [t]; shunt lookup_t = (.) (execWriter . flip runStateT []) $ (.) (>> (get >>= tell)) $   (mapM_ $ \ t ->    case lookup_t t of {@@ -71,5 +72,5 @@                        | Postfix == fix1 -> tell [t]                        | Prefix  == fix1 -> modify (t:);      TokenLParenth -> modify (t:);-     TokenRParenth -> get >>* break ((== TokenLParenth) . lookup_t) >>= tell *=* list (const put) (put $ error "Mismatched Parentheses") >>* uncurry mappend;+     TokenRParenth -> get >>* break (\ t -> case lookup_t t of { TokenLParenth -> True; _ -> False; }) >>= tell *=* list (const put) (put $ error "Mismatched Parentheses") >>* uncurry mappend;    });

@@ -1,5 +1,5 @@ Name:fix-parser-simple-Version:15320.1+Version:15320.2 Description:Simple fix-expression parser License:LGPL License-File:license.txt