[Gtk2hs-commit] gtk2hs/tools/c2hs/base/syntax Lexers.hs,1.1.1.1,1.2 Parsers.hs,1.1.1.1,1.2

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/c2hs/base/syntax
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15642/base/syntax

Modified Files:
	Lexers.hs Parsers.hs 
Log Message:
add Axel's --precomp patches with a binary serialisation framework derived from
the one used in ghc. This required makeing Position a proper data type.
Also converted to using Data.FiniteMap rather than the CTK FiniteMaps module.


Index: Parsers.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/c2hs/base/syntax/Parsers.hs,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- Parsers.hs	13 Nov 2004 16:42:50 -0000	1.1.1.1
+++ Parsers.hs	13 Nov 2004 17:26:51 -0000	1.2
@@ -83,7 +83,7 @@
 import List       (sort)
 
 import Common     (Position, Pos (posOf), nopos)
-import FiniteMaps (FiniteMap, unitFM, joinCombFM, mapFM, lookupFM, toListFM)
+import Data.FiniteMap (FiniteMap, unitFM, plusFM_C, mapFM, lookupFM, fmToList)
 import Errors     (interr, ErrorLvl(..), Error, makeError)
 
 infix  5 `opt`
@@ -207,7 +207,7 @@
 (Parser a (Empty x p))  <|> q                        = mergeEpsilon a  x p q
 p                       <|> (Parser a' (Empty x q))  = mergeEpsilon a' x q p
 (Parser a (Alts alts1)) <|> (Parser a' (Alts alts2)) = 
-  Parser (a `joinActions` a') $ Alts (joinCombFM (<|>) alts1' alts2')
+  Parser (a `joinActions` a') $ Alts (plusFM_C (<|>) alts1' alts2')
   where
     alts1' = mapFM (\_ p -> Left  $> p) alts1
     alts2' = mapFM (\_ p -> Right $> p) alts2
@@ -470,12 +470,12 @@
 				. sort 
 				. map show 
 				. map fst 
-				. toListFM 
+				. fmToList
 				$ alts
 
-instance Token t => Show (Parser a t r) where
-  showsPrec _ (Parser a c) = shows c
+--instance Token t => Show (Parser a t r) where
+--  showsPrec _ (Parser a c) = shows c
 
-instance Token t => Show (Cont a t r) where
-  showsPrec _ (Empty r p ) = showString "*" . shows p
-  showsPrec _ (Alts  alts) = shows alts
+--instance Token t => Show (Cont a t r) where
+--  showsPrec _ (Empty r p ) = showString "*" . shows p
+--  showsPrec _ (Alts  alts) = shows alts

Index: Lexers.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/c2hs/base/syntax/Lexers.hs,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- Lexers.hs	13 Nov 2004 16:42:50 -0000	1.1.1.1
+++ Lexers.hs	13 Nov 2004 17:26:51 -0000	1.2
@@ -137,7 +137,7 @@
 import Maybe  (fromMaybe, isNothing)
 import Array  (Ix(..), Array, array, (!), assocs, accumArray)
 
-import Common (Position, Pos (posOf), nopos, incPos, tabPos, retPos)
+import Common (Position(Position), Pos (posOf), nopos, incPos, tabPos, retPos)
 import DLists (DList, openDL, zeroDL, unitDL, snocDL, joinDL, closeDL)
 import Errors (interr, ErrorLvl(..), Error, makeError)
 
@@ -263,22 +263,22 @@
 lexaction      :: Regexp s t -> Action t -> Lexer s t
 lexaction re a  = re `lexmeta` a'
   where
-    a' lexeme pos@(fname, row, col) s = 
+    a' lexeme pos@(Position fname row col) s = 
        let col' = col + length lexeme
        in
        col' `seq` case a lexeme pos of
-		    Nothing -> (Nothing, (fname, row, col'), s, Nothing)
-		    Just t  -> (Just (Right t), (fname, row, col'), s, Nothing)
+		    Nothing -> (Nothing, (Position fname row col'), s, Nothing)
+		    Just t  -> (Just (Right t), (Position fname row col'), s, Nothing)
 
 -- Variant for actions that may returns an error (EXPORTED)
 --
 lexactionErr      :: Regexp s t -> ActionErr t -> Lexer s t
 lexactionErr re a  = re `lexmeta` a'
   where
-     a' lexeme pos@(fname, row, col) s = 
+     a' lexeme pos@(Position fname row col) s = 
        let col' = col + length lexeme
        in
-       col' `seq` (Just (a lexeme pos), (fname, row, col'), s, Nothing)
+       col' `seq` (Just (a lexeme pos), (Position fname row col'), s, Nothing)
 
 -- Close a regular expression with a meta action (EXPORTED)
 --
@@ -464,13 +464,13 @@
         -- the result triple of `lexOne' that signals a lexical error;
         -- the result state is advanced by one character for error correction
         --
-	lexErr = let (cs, pos@(fname, row, col), s) = state
+	lexErr = let (cs, pos@(Position fname row col), s) = state
 	             err = makeError ErrorErr pos
 			     ["Lexical error!", 
 			      "The character " ++ show (head cs) 
 			      ++ " does not fit here; skipping it."]
 		 in
-		 (Just (Left err), l, (tail cs, (fname, row, (col + 1)), s))
+		 (Just (Left err), l, (tail cs, (Position fname row (col + 1)), s))
 
 	-- we take an open list of characters down, where we accumulate the
 	-- lexeme; this function returns maybe a token, the next lexer to use