Regenerate source GF parser from GF.cf. Now, when GF/Source/Makefile is used, no hand-hacking is needed.

src/GF/Compile/GetGrammar.hs

@@ -15,7 +15,6 @@
 module GF.Compile.GetGrammar where
 
 import GF.Data.Operations
-import qualified GF.Source.ErrM as E
 
 import GF.Infra.UseIO
 import GF.Infra.Modules

src/GF/Compile/ReadFiles.hs

@@ -103,13 +103,29 @@ getAllFiles opts ps env file = do
       imps <- if st == CSEnv
                 then return (maybe [] snd mb_envmod)
                 else do s <- ioeIO $ BS.readFile file
-                        (mname,imps) <- ioeErr ((liftM importsOfModule . pModHeader . myLexer) s)
+                        (mname,imps) <- ioeErr ((liftM (importsOfModule . modHeaderToModDef) . pModHeader . myLexer) s)
                         ioeErr $ testErr  (mname == name)
                                           ("module name" +++ mname +++ "differs from file name" +++ name)
                         return imps
 
       return (name,st,t,imps,dropFileName file)
 
+-- FIXME: this is pretty ugly, it's just to get around the difference
+-- between ModHeader as returned when parsing just the module header 
+-- when looking for imports, and ModDef, which includes the whole module.
+modHeaderToModDef :: ModHeader -> ModDef
+modHeaderToModDef (MModule2 x y z) = MModule x y (modHeaderBodyToModBody z)
+  where
+    modHeaderBodyToModBody :: ModHeaderBody -> ModBody
+    modHeaderBodyToModBody b = case b of
+                                 MBody2 x y -> MBody x y []
+                                 MNoBody2 x -> MNoBody x
+                                 MWith2 x y -> MWith x y
+                                 MWithBody2 x y z -> MWithBody x y z []
+                                 MWithE2 x y z -> MWithE x y z
+                                 MWithEBody2 x y z w -> MWithEBody x y z w []
+                                 MReuse2 x -> MReuse x
+                                 MUnion2 x -> MUnion x
 
 isGFO :: FilePath -> Bool
 isGFO = (== ".gfo") . takeExtensions

src/GF/Source/AbsGF.hs

@@ -27,6 +27,21 @@ data Transfer =
  | TransferOut Open
   deriving (Eq,Ord,Show)
 
+data ModHeader =
+   MModule2 ComplMod ModType ModHeaderBody
+  deriving (Eq,Ord,Show)
+
+data ModHeaderBody =
+   MBody2 Extend Opens
+ | MNoBody2 [Included]
+ | MWith2 Included [Open]
+ | MWithBody2 Included [Open] Opens
+ | MWithE2 [Included] Included [Open]
+ | MWithEBody2 [Included] Included [Open] Opens
+ | MReuse2 PIdent
+ | MUnion2 [Included]
+  deriving (Eq,Ord,Show)
+
 data ModType =
    MTAbstract PIdent
  | MTResource PIdent

src/GF/Source/ErrM.hs

@@ -1,26 +0,0 @@
--- BNF Converter: Error Monad
--- Copyright (C) 2004  Author:  Aarne Ranta
-
--- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
-module GF.Source.ErrM where
-
--- the Error monad: like Maybe type with error msgs
-
-import Control.Monad (MonadPlus(..), liftM)
-
-data Err a = Ok a | Bad String
-  deriving (Read, Show, Eq, Ord)
-
-instance Monad Err where
-  return      = Ok
-  fail        = Bad
-  Ok a  >>= f = f a
-  Bad s >>= f = Bad s
-
-instance Functor Err where
-  fmap = liftM
-
-instance MonadPlus Err where
-  mzero = Bad "Err.mzero"
-  mplus (Bad _) y = y
-  mplus x       _ = x

src/GF/Source/LexGF.hs

@@ -147,7 +147,7 @@ alexGetChar (p, _, s) =
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (p, c, s) = c
 
-alex_action_3 =  tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) 
+alex_action_3 =  tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
 alex_action_4 =  tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) 
 alex_action_5 =  tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) 
 alex_action_6 =  tok (\p s -> PT p (eitherResIdent (TV . share) s)) 

src/GF/Source/LexGF.x

@@ -24,7 +24,7 @@ $u = [\0-\255]          -- universal: any character
 "{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; 
 
 $white+ ;
-@rsyms { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
+@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
 \' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
 (\_ | $l)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
 

src/GF/Source/Makefile

@@ -1,6 +1,7 @@
 all:
 	cd ../.. && bnfc -p GF.Source -bytestrings -sharestrings GF/Source/GF.cf
 	rm ErrM.hs
+	perl -i -pe 's/%name pModHeader ModHeader/%partial pModHeader ModHeader/' ParGF.y
 	perl -i -pe 's/GF.Source.ErrM/GF.Data.ErrM/' *.hs *.x *.y
 	happy -gca ParGF.y
 	alex -g LexGF.x

src/GF/Source/ParGF.y

@@ -151,19 +151,19 @@ Transfer : '(' 'transfer' 'in' Open ')' { TransferIn $4 }
   | '(' 'transfer' 'out' Open ')' { TransferOut $4 }
 
 
-ModHeader :: { ModDef }
-ModHeader : ComplMod ModType '=' ModHeaderBody { MModule $1 $2 $4 } 
+ModHeader :: { ModHeader }
+ModHeader : ComplMod ModType '=' ModHeaderBody { MModule2 $1 $2 $4 } 
 
 
-ModHeaderBody :: { ModBody }
-ModHeaderBody : Extend Opens { MBody $1 $2 [] } 
-  | ListIncluded { MNoBody $1 }
-  | Included 'with' ListOpen { MWith $1 $3 }
-  | Included 'with' ListOpen '**' Opens { MWithBody $1 $3 $5 [] }
-  | ListIncluded '**' Included 'with' ListOpen { MWithE $1 $3 $5 }
-  | ListIncluded '**' Included 'with' ListOpen '**' Opens { MWithEBody $1 $3 $5 $7 [] }
-  | 'reuse' PIdent { MReuse $2 }
-  | 'union' ListIncluded { MUnion $2 }
+ModHeaderBody :: { ModHeaderBody }
+ModHeaderBody : Extend Opens { MBody2 $1 $2 } 
+  | ListIncluded { MNoBody2 $1 }
+  | Included 'with' ListOpen { MWith2 $1 $3 }
+  | Included 'with' ListOpen '**' Opens { MWithBody2 $1 $3 $5 }
+  | ListIncluded '**' Included 'with' ListOpen { MWithE2 $1 $3 $5 }
+  | ListIncluded '**' Included 'with' ListOpen '**' Opens { MWithEBody2 $1 $3 $5 $7 }
+  | 'reuse' PIdent { MReuse2 $2 }
+  | 'union' ListIncluded { MUnion2 $2 }
 
 
 ModType :: { ModType }

src/GF/Source/PrintGF.hs

@@ -128,6 +128,22 @@ instance Print Transfer where
    [] -> (concatD [])
    x:xs -> (concatD [prt 0 x , prt 0 xs])
 
+instance Print ModHeader where
+  prt i e = case e of
+   MModule2 complmod modtype modheaderbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modheaderbody])
+
+
+instance Print ModHeaderBody where
+  prt i e = case e of
+   MBody2 extend opens -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens])
+   MNoBody2 includeds -> prPrec i 0 (concatD [prt 0 includeds])
+   MWith2 included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
+   MWithBody2 included opens0 opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens])
+   MWithE2 includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
+   MWithEBody2 includeds included opens0 opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens])
+   MReuse2 pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
+   MUnion2 includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
+
 
 instance Print ModType where
   prt i e = case e of