experiment with gfc input

examples/letter/Letter.gfcm

@@ -1,4 +1,10 @@
-concrete Russian of Letter = open ResRusU in {flags startcat = Letter ;flags lexer = textlit ;flags unlexer = textlit ;flags coding = utf8 ;lincat Author = {s : (ResRusU.Num => (ResRusU.Gen => Str)) ;n : ResRusU.DepNum ;g : ResRusU.DepGen }= {s = table ResRusU.Num {(ResRusU.sg)(ResRusU.pl)=> table ResRusU.Gen {(ResRusU.masc)(ResRusU.fem)=> str @ 0 }} ;n = <ResRusU.depnum>;g = <ResRusU.depgen>} ;"Author" ;
+concrete Russian of Letter = open ResRusU in {
+flags modulesize = n42 ;
+flags startcat = Letter ;
+flags lexer = textlit ;
+flags unlexer = textlit ;
+flags coding = utf8 ;
+lincat Author = {s : (ResRusU.Num => (ResRusU.Gen => Str)) ;n : ResRusU.DepNum ;g : ResRusU.DepGen }= {s = table ResRusU.Num {(ResRusU.sg)(ResRusU.pl)=> table ResRusU.Gen {(ResRusU.masc)(ResRusU.fem)=> str @ 0 }} ;n = <ResRusU.depnum>;g = <ResRusU.depgen>} ;"Author" ;
 lin BePromoted : Letter.Sentence = \ Position @ 0 -> {s = table ResRusU.DepNum {(ResRusU.depnum)(ResRusU.cnum (ResRusU.sg)) (ResRusU.cnum (ResRusU.pl)) => table ResRusU.DepGen {(ResRusU.depgen)(ResRusU.cgen (ResRusU.masc)) (ResRusU.cgen (ResRusU.fem)) => table ResRusU.Num {(ResRusU.pl)=> table ResRusU.Gen {(ResRusU.fem)=> "вы" ++ "были" ++ ("назначены" ++ Position @ 0.s ! <ResRusU.pl>! <ResRusU.fem>) ;(ResRusU.masc)=> "вы" ++ "были" ++ ("назначены" ++ Position @ 0.s ! <ResRusU.pl>! <ResRusU.masc>) } ;(ResRusU.sg)=> table ResRusU.Gen {(ResRusU.masc)=> "ты" ++ "был" ++ ("назначен" ++ Position @ 0.s ! <ResRusU.sg>! <ResRusU.masc>) ;(ResRusU.fem)=> "ты" ++ "была" ++ ("назначена" ++ Position @ 0.s ! <ResRusU.sg>! <ResRusU.fem>) }}}}} ;"(ты был)назначен Position_0" ;
 lin ColleagueHe : Letter.Recipient = \ -> {s = "коллега" ;n = <ResRusU.sg>;g = <ResRusU.masc>} ;"коллега" ;
 lin ColleagueShe : Letter.Recipient = \ -> {s = "коллега" ;n = <ResRusU.sg>;g = <ResRusU.fem>} ;"коллега" ;
@@ -41,13 +47,17 @@ lin Senior : Letter.Position = \ -> {s = table ResRusU.Num {(ResRusU.sg)=> table
 lincat Sentence = {s : (ResRusU.DepNum => (ResRusU.DepGen => (ResRusU.Num => (ResRusU.Gen => Str)))) }= {s = table ResRusU.DepNum {(ResRusU.depnum)(ResRusU.cnum (ResRusU.sg)) (ResRusU.cnum (ResRusU.pl)) => table ResRusU.DepGen {(ResRusU.depgen)(ResRusU.cgen (ResRusU.masc)) (ResRusU.cgen (ResRusU.fem)) => table ResRusU.Num {(ResRusU.sg)(ResRusU.pl)=> table ResRusU.Gen {(ResRusU.masc)(ResRusU.fem)=> str @ 0 }}}}} ;"Sentence" ;
 lin Spouse : Letter.Author = \ -> {s = table ResRusU.Num {(ResRusU.sg)=> table ResRusU.Gen {(ResRusU.fem)=> "твой" ++ "муж" ;(ResRusU.masc)=> "твоÑ<C2BE>" ++ "жена" } ;(ResRusU.pl)=> table ResRusU.Gen {(ResRusU.masc)=> "ваши" ++ "жены" ;(ResRusU.fem)=> "ваши" ++ "мужьÑ<C592>" }} ;n = <ResRusU.depnum>;g = <ResRusU.depgen>} ;"твоÑ<C2BE> жена" ;
 }
-resource ResRusU = {param DepGen = depgen | cgen ResRusU.Gen ;
+resource ResRusU = {
+flags modulesize = n5 ;
+param DepGen = depgen | cgen ResRusU.Gen ;
 param DepNum = depnum | cnum ResRusU.Num ;
 param Gen = masc | fem ;
 param Kas = nom | acc ;
 param Num = sg | pl ;
 }
-abstract Letter = {cat Author [] = ;
+abstract Letter = {
+flags modulesize = n42 ;
+cat Author [] = ;
 fun BePromoted : (h_ : Letter.Position)-> Letter.Sentence = {} ;
 fun ColleagueHe : Letter.Recipient = {} ;
 fun ColleagueShe : Letter.Recipient = {} ;
@@ -90,7 +100,12 @@ fun Senior : Letter.Position = {} ;
 cat Sentence [] = ;
 fun Spouse : Letter.Author = {} ;
 }
-concrete Finnish of Letter = open ResFin in {flags startcat = Letter ;flags lexer = textlit ;flags unlexer = textlit ;lincat Author = {s : (ResFin.Num => (ResFin.Gen => Str)) ;n : ResFin.DepNum ;g : ResFin.DepGen }= {s = table ResFin.Num {(ResFin.sg)(ResFin.pl)=> table ResFin.Gen {(ResFin.masc)(ResFin.fem)=> str @ 0 }} ;n = <ResFin.depnum>;g = <ResFin.depgen>} ;"Author" ;
+concrete Finnish of Letter = open ResFin in {
+flags modulesize = n42 ;
+flags startcat = Letter ;
+flags lexer = textlit ;
+flags unlexer = textlit ;
+lincat Author = {s : (ResFin.Num => (ResFin.Gen => Str)) ;n : ResFin.DepNum ;g : ResFin.DepGen }= {s = table ResFin.Num {(ResFin.sg)(ResFin.pl)=> table ResFin.Gen {(ResFin.masc)(ResFin.fem)=> str @ 0 }} ;n = <ResFin.depnum>;g = <ResFin.depgen>} ;"Author" ;
 lin BePromoted : Letter.Sentence = \ Position @ 0 -> {s = table ResFin.DepNum {(ResFin.depnum)(ResFin.cnum (ResFin.sg)) (ResFin.cnum (ResFin.pl)) => table ResFin.DepGen {(ResFin.depgen)(ResFin.cgen (ResFin.masc)) (ResFin.cgen (ResFin.fem)) => table ResFin.Num {(ResFin.sg)=> table ResFin.Gen {(ResFin.fem)=> "sinut" ++ "on" ++ ("ylennetty" ++ Position @ 0.s ! <ResFin.sg>! <ResFin.fem>) ;(ResFin.masc)=> "sinut" ++ "on" ++ ("ylennetty" ++ Position @ 0.s ! <ResFin.sg>! <ResFin.masc>) } ;(ResFin.pl)=> table ResFin.Gen {(ResFin.fem)=> "teidät" ++ "on" ++ ("ylennetty" ++ Position @ 0.s ! <ResFin.pl>! <ResFin.fem>) ;(ResFin.masc)=> "teidät" ++ "on" ++ ("ylennetty" ++ Position @ 0.s ! <ResFin.pl>! <ResFin.masc>) }}}}} ;"(sinut on)ylennetty Position_0" ;
 lin ColleagueHe : Letter.Recipient = \ -> {s = "kollega" ;n = <ResFin.sg>;g = <ResFin.masc>} ;"kollega" ;
 lin ColleagueShe : Letter.Recipient = \ -> {s = "kollega" ;n = <ResFin.sg>;g = <ResFin.fem>} ;"kollega" ;
@@ -133,13 +148,20 @@ lin Senior : Letter.Position = \ -> {s = table ResFin.Num {(ResFin.sg)=> table R
 lincat Sentence = {s : (ResFin.DepNum => (ResFin.DepGen => (ResFin.Num => (ResFin.Gen => Str)))) }= {s = table ResFin.DepNum {(ResFin.depnum)(ResFin.cnum (ResFin.sg)) (ResFin.cnum (ResFin.pl)) => table ResFin.DepGen {(ResFin.depgen)(ResFin.cgen (ResFin.masc)) (ResFin.cgen (ResFin.fem)) => table ResFin.Num {(ResFin.sg)(ResFin.pl)=> table ResFin.Gen {(ResFin.masc)(ResFin.fem)=> str @ 0 }}}}} ;"Sentence" ;
 lin Spouse : Letter.Author = \ -> {s = table ResFin.Num {(ResFin.pl)=> table ResFin.Gen {(ResFin.fem)=> "miehenne" ;(ResFin.masc)=> "vaimonne" } ;(ResFin.sg)=> table ResFin.Gen {(ResFin.fem)=> "miehesi" ;(ResFin.masc)=> "vaimosi" }} ;n = <ResFin.depnum>;g = <ResFin.depgen>} ;"vaimosi" ;
 }
-resource ResFin = {param DepGen = depgen | cgen ResFin.Gen ;
+resource ResFin = {
+flags modulesize = n5 ;
+param DepGen = depgen | cgen ResFin.Gen ;
 param DepNum = depnum | cnum ResFin.Num ;
 param Gen = masc | fem ;
 param Kas = nom | acc ;
 param Num = sg | pl ;
 }
-concrete Swedish of Letter = open ResSve in {flags startcat = Letter ;flags lexer = textlit ;flags unlexer = textlit ;lincat Author = {s : (ResSve.Num => (ResSve.Sex => Str)) ;n : ResSve.DepNum ;x : ResSve.Sex }= {s = table ResSve.Num {(ResSve.sg)(ResSve.pl)=> table ResSve.Sex {(ResSve.masc)(ResSve.fem)=> str @ 0 }} ;n = <ResSve.depnum>;x = <ResSve.masc>} ;"Author" ;
+concrete Swedish of Letter = open ResSve in {
+flags modulesize = n42 ;
+flags startcat = Letter ;
+flags lexer = textlit ;
+flags unlexer = textlit ;
+lincat Author = {s : (ResSve.Num => (ResSve.Sex => Str)) ;n : ResSve.DepNum ;x : ResSve.Sex }= {s = table ResSve.Num {(ResSve.sg)(ResSve.pl)=> table ResSve.Sex {(ResSve.masc)(ResSve.fem)=> str @ 0 }} ;n = <ResSve.depnum>;x = <ResSve.masc>} ;"Author" ;
 lin BePromoted : Letter.Sentence = \ Position @ 0 -> {s = table ResSve.DepNum {(ResSve.depnum)(ResSve.cnum (ResSve.sg)) (ResSve.cnum (ResSve.pl)) => table ResSve.Sex {(ResSve.masc)(ResSve.fem)=> table ResSve.Num {(ResSve.sg)=> table ResSve.Sex {(ResSve.fem)=> "du" ++ ("har" ++ "blivit" ++ ("befordrad" ++ ("till" ++ Position @ 0.s ! <ResSve.sg>! <ResSve.fem>))) ;(ResSve.masc)=> "du" ++ ("har" ++ "blivit" ++ ("befordrad" ++ ("till" ++ Position @ 0.s ! <ResSve.sg>! <ResSve.masc>))) } ;(ResSve.pl)=> table ResSve.Sex {(ResSve.fem)=> "ni" ++ ("har" ++ "blivit" ++ ("befordrade" ++ ("till" ++ Position @ 0.s ! <ResSve.pl>! <ResSve.fem>))) ;(ResSve.masc)=> "ni" ++ ("har" ++ "blivit" ++ ("befordrade" ++ ("till" ++ Position @ 0.s ! <ResSve.pl>! <ResSve.masc>))) }}}}} ;"du (har blivit)befordrad till Position_0" ;
 lin ColleagueHe : Letter.Recipient = \ -> {s = "kollega" ;n = <ResSve.sg>;x = <ResSve.masc>} ;"kollega" ;
 lin ColleagueShe : Letter.Recipient = \ -> {s = "kollega" ;n = <ResSve.sg>;x = <ResSve.fem>} ;"kollega" ;
@@ -182,13 +204,20 @@ lin Senior : Letter.Position = \ -> {s = table ResSve.Num {(ResSve.sg)(ResSve.pl
 lincat Sentence = {s : (ResSve.DepNum => (ResSve.Sex => (ResSve.Num => (ResSve.Sex => Str)))) }= {s = table ResSve.DepNum {(ResSve.depnum)(ResSve.cnum (ResSve.sg)) (ResSve.cnum (ResSve.pl)) => table ResSve.Sex {(ResSve.masc)(ResSve.fem)=> table ResSve.Num {(ResSve.sg)(ResSve.pl)=> table ResSve.Sex {(ResSve.masc)(ResSve.fem)=> str @ 0 }}}}} ;"Sentence" ;
 lin Spouse : Letter.Author = \ -> {s = table ResSve.Num {(ResSve.sg)=> table ResSve.Sex {(ResSve.masc)=> "din" ++ "hustru" ;(ResSve.fem)=> "din" ++ "man" } ;(ResSve.pl)=> table ResSve.Sex {(ResSve.masc)=> "era" ++ "hustrur" ;(ResSve.fem)=> "era" ++ "män" }} ;n = <ResSve.depnum>;x = <ResSve.masc>} ;"din hustru" ;
 }
-resource ResSve = {param DepNum = depnum | cnum ResSve.Num ;
+resource ResSve = {
+flags modulesize = n5 ;
+param DepNum = depnum | cnum ResSve.Num ;
 param Gen = en | ett ;
 param Kas = nom | acc ;
 param Num = sg | pl ;
 param Sex = masc | fem ;
 }
-concrete French of Letter = open ResFra in {flags startcat = Letter ;flags lexer = textlit ;flags unlexer = textlit ;lincat Author = {s : (ResFra.Num => (ResFra.Gen => Str)) ;n : ResFra.DepNum ;g : ResFra.DepGen }= {s = table ResFra.Num {(ResFra.sg)(ResFra.pl)=> table ResFra.Gen {(ResFra.masc)(ResFra.fem)=> str @ 0 }} ;n = <ResFra.depnum>;g = <ResFra.depgen>} ;"Author" ;
+concrete French of Letter = open ResFra in {
+flags modulesize = n42 ;
+flags startcat = Letter ;
+flags lexer = textlit ;
+flags unlexer = textlit ;
+lincat Author = {s : (ResFra.Num => (ResFra.Gen => Str)) ;n : ResFra.DepNum ;g : ResFra.DepGen }= {s = table ResFra.Num {(ResFra.sg)(ResFra.pl)=> table ResFra.Gen {(ResFra.masc)(ResFra.fem)=> str @ 0 }} ;n = <ResFra.depnum>;g = <ResFra.depgen>} ;"Author" ;
 lin BePromoted : Letter.Sentence = \ Position @ 0 -> {s = table ResFra.DepNum {(ResFra.depnum)(ResFra.cnum (ResFra.sg)) (ResFra.cnum (ResFra.pl)) => table ResFra.DepGen {(ResFra.depgen)(ResFra.cgen (ResFra.masc)) (ResFra.cgen (ResFra.fem)) => table ResFra.Num {(ResFra.pl)=> table ResFra.Gen {(ResFra.fem)=> "vous" ++ ("avez" ++ "été")++ ("promues" ++ Position @ 0.s ! <ResFra.pl>! <ResFra.fem>) ;(ResFra.masc)=> "vous" ++ ("avez" ++ "été")++ ("promus" ++ Position @ 0.s ! <ResFra.pl>! <ResFra.masc>) } ;(ResFra.sg)=> table ResFra.Gen {(ResFra.masc)=> "tu" ++ ("as" ++ "été")++ ("promu" ++ Position @ 0.s ! <ResFra.sg>! <ResFra.masc>) ;(ResFra.fem)=> "tu" ++ ("as" ++ "été")++ ("promue" ++ Position @ 0.s ! <ResFra.sg>! <ResFra.fem>) }}}}} ;"(tu as été)promu Position_0" ;
 lin ColleagueHe : Letter.Recipient = \ -> {s = "collègue" ;n = <ResFra.sg>;g = <ResFra.masc>} ;"collègue" ;
 lin ColleagueShe : Letter.Recipient = \ -> {s = "collègue" ;n = <ResFra.sg>;g = <ResFra.fem>} ;"collègue" ;
@@ -231,13 +260,20 @@ lin Senior : Letter.Position = \ -> {s = table ResFra.Num {(ResFra.sg)=> table R
 lincat Sentence = {s : (ResFra.DepNum => (ResFra.DepGen => (ResFra.Num => (ResFra.Gen => Str)))) }= {s = table ResFra.DepNum {(ResFra.depnum)(ResFra.cnum (ResFra.sg)) (ResFra.cnum (ResFra.pl)) => table ResFra.DepGen {(ResFra.depgen)(ResFra.cgen (ResFra.masc)) (ResFra.cgen (ResFra.fem)) => table ResFra.Num {(ResFra.sg)(ResFra.pl)=> table ResFra.Gen {(ResFra.masc)(ResFra.fem)=> str @ 0 }}}}} ;"Sentence" ;
 lin Spouse : Letter.Author = \ -> {s = table ResFra.Num {(ResFra.sg)=> table ResFra.Gen {(ResFra.masc)=> "ta" ++ "femme" ;(ResFra.fem)=> "ton" ++ "mari" } ;(ResFra.pl)=> table ResFra.Gen {(ResFra.masc)=> "vos" ++ "femmes" ;(ResFra.fem)=> "vos" ++ "maris" }} ;n = <ResFra.depnum>;g = <ResFra.depgen>} ;"ta femme" ;
 }
-resource ResFra = {param DepGen = depgen | cgen ResFra.Gen ;
+resource ResFra = {
+flags modulesize = n5 ;
+param DepGen = depgen | cgen ResFra.Gen ;
 param DepNum = depnum | cnum ResFra.Num ;
 param Gen = masc | fem ;
 param Kas = nom | acc ;
 param Num = sg | pl ;
 }
-concrete English of Letter = open ResEng in {flags startcat = Letter ;flags lexer = textlit ;flags unlexer = textlit ;lincat Author = {s : (ResEng.Num => (ResEng.Sex => Str)) ;n : ResEng.DepNum ;x : ResEng.Sex }= {s = table ResEng.Num {(ResEng.sg)(ResEng.pl)=> table ResEng.Sex {(ResEng.masc)(ResEng.fem)=> str @ 0 }} ;n = <ResEng.depnum>;x = <ResEng.masc>} ;"Author" ;
+concrete English of Letter = open ResEng in {
+flags modulesize = n42 ;
+flags startcat = Letter ;
+flags lexer = textlit ;
+flags unlexer = textlit ;
+lincat Author = {s : (ResEng.Num => (ResEng.Sex => Str)) ;n : ResEng.DepNum ;x : ResEng.Sex }= {s = table ResEng.Num {(ResEng.sg)(ResEng.pl)=> table ResEng.Sex {(ResEng.masc)(ResEng.fem)=> str @ 0 }} ;n = <ResEng.depnum>;x = <ResEng.masc>} ;"Author" ;
 lin BePromoted : Letter.Sentence = \ Position @ 0 -> {s = table ResEng.DepNum {(ResEng.depnum)(ResEng.cnum (ResEng.sg)) (ResEng.cnum (ResEng.pl)) => table ResEng.Sex {(ResEng.masc)(ResEng.fem)=> table ResEng.Num {(ResEng.pl)=> table ResEng.Sex {(ResEng.fem)=> "you" ++ ("have" ++ ("been" ++ ("promoted" ++ "to")))++ Position @ 0.s ! <ResEng.pl>! <ResEng.fem>;(ResEng.masc)=> "you" ++ ("have" ++ ("been" ++ ("promoted" ++ "to")))++ Position @ 0.s ! <ResEng.pl>! <ResEng.masc>} ;(ResEng.sg)=> table ResEng.Sex {(ResEng.fem)=> "you" ++ ("have" ++ ("been" ++ ("promoted" ++ "to")))++ Position @ 0.s ! <ResEng.sg>! <ResEng.fem>;(ResEng.masc)=> "you" ++ ("have" ++ ("been" ++ ("promoted" ++ "to")))++ Position @ 0.s ! <ResEng.sg>! <ResEng.masc>}}}}} ;"(you have been promoted to)Position_0" ;
 lin ColleagueHe : Letter.Recipient = \ -> {s = "colleague" ;n = <ResEng.sg>;x = <ResEng.masc>} ;"colleague" ;
 lin ColleagueShe : Letter.Recipient = \ -> {s = "colleague" ;n = <ResEng.sg>;x = <ResEng.fem>} ;"colleague" ;
@@ -280,7 +316,9 @@ lin Senior : Letter.Position = \ -> {s = table ResEng.Num {(ResEng.sg)=> table R
 lincat Sentence = {s : (ResEng.DepNum => (ResEng.Sex => (ResEng.Num => (ResEng.Sex => Str)))) }= {s = table ResEng.DepNum {(ResEng.depnum)(ResEng.cnum (ResEng.sg)) (ResEng.cnum (ResEng.pl)) => table ResEng.Sex {(ResEng.masc)(ResEng.fem)=> table ResEng.Num {(ResEng.sg)(ResEng.pl)=> table ResEng.Sex {(ResEng.masc)(ResEng.fem)=> str @ 0 }}}}} ;"Sentence" ;
 lin Spouse : Letter.Author = \ -> {s = table ResEng.Num {(ResEng.sg)=> table ResEng.Sex {(ResEng.fem)=> "your" ++ "husband" ;(ResEng.masc)=> "your" ++ "wife" } ;(ResEng.pl)=> table ResEng.Sex {(ResEng.fem)=> "your" ++ "husbands" ;(ResEng.masc)=> "your" ++ "wives" }} ;n = <ResEng.depnum>;x = <ResEng.masc>} ;"your wife" ;
 }
-resource ResEng = {param DepNum = depnum | cnum ResEng.Num ;
+resource ResEng = {
+flags modulesize = n4 ;
+param DepNum = depnum | cnum ResEng.Num ;
 param Kas = nom | acc ;
 param Num = sg | pl ;
 param Sex = masc | fem ;

src/GF/Canon/AbsGFC.hs

@@ -1,4 +1,3 @@
-
 module GF.Canon.AbsGFC where
 
 import GF.Infra.Ident --H
@@ -6,12 +5,19 @@ import GF.Infra.Ident --H
 -- Haskell module generated by the BNF converter, except --H
 
 -- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
-
 data Canon =
    MGr [Ident] Ident [Module]
  | Gr [Module]
   deriving (Eq,Ord,Show)
 
+data Line =
+   LMulti [Ident] Ident
+ | LHeader ModType Extend Open
+ | LFlag Flag
+ | LDef Def
+ | LEnd
+  deriving (Eq,Ord,Show)
+
 data Module =
    Mod ModType Extend Open [Flag] [Def]
   deriving (Eq,Ord,Show)
@@ -131,8 +137,8 @@ data Term =
 
 data Tokn =
    KS String
- | KM String
  | KP [String] [Variant]
+ | KM String
   deriving (Eq,Ord,Show)
 
 data Assign =

src/GF/Canon/GFC.cf

@@ -2,11 +2,21 @@
 
 -- Canonical GF. AR 27/4/2003
 
-entrypoints Canon ;
+entrypoints Canon, Line ;
+
+-- old approach: read in a whole grammar
 
 MGr. Canon ::= "grammar" [Ident] "of" Ident ";" [Module] ;
 Gr.  Canon ::= [Module] ;
 
+-- new approach: read line by line
+
+LMulti.  Line ::= "grammar" [Ident] "of" Ident ";" ;
+LHeader. Line ::= ModType "=" Extend Open "{" ;
+LFlag.   Line ::= Flag ";" ;
+LDef.    Line ::= Def ";" ;
+LEnd.    Line ::= "}" ;    
+
 Mod. Module ::= ModType "=" Extend Open "{" [Flag] [Def] "}" ;
 
 MTAbs.   ModType ::= "abstract" Ident ; 

src/GF/Canon/GetGFC.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:23 $ 
+-- > CVS $Date: 2005/05/27 21:05:17 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.7 $
+-- > CVS $Revision: 1.8 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -22,6 +22,10 @@ import GF.Infra.Modules
 import GF.Compile.GetGrammar (err2err) ---
 import GF.Infra.UseIO
 
+import System.IO
+import System.Directory
+import Control.Monad
+
 getCanonModule :: FilePath -> IOE CanonModule
 getCanonModule file = do
   gr <- getCanonGrammar file
@@ -32,6 +36,41 @@ getCanonModule file = do
 getCanonGrammar :: FilePath -> IOE CanonGrammar
 getCanonGrammar file = do
   s <- ioeIO $ readFileIf file
-  -- c <- ioeErr $ err2err $ pCanon $ myLexer s
   c <- ioeErr $ pCanon $ myLexer s
   return $ canon2grammar c
+
+-- the following surprisingly does not save memory so it is
+-- not in use
+
+getCanonGrammarByLine :: FilePath -> IOE CanonGrammar
+getCanonGrammarByLine file = do
+  b <- ioeIO $ doesFileExist file
+  if not b 
+    then ioeErr $ Bad $ "file" +++ file +++ "does not exist"
+    else do
+   ioeIO $ putStrLn ""
+   hand <- ioeIO $ openFile file ReadMode ---- err
+   size <- ioeIO $ hFileSize hand
+   gr <- addNextLine (size,0) 1 hand emptyMGrammar
+   ioeIO $ hClose hand
+   return $ MGrammar $ reverse $ modules gr
+
+ where
+   addNextLine (size,act) d hand gr = do
+     eof <- ioeIO $ hIsEOF hand 
+     if eof 
+       then return gr 
+       else do
+         s <- ioeIO  $ hGetLine hand
+         let act' = act + toInteger (length s)
+--         if isHash act act' then (ioeIO $ putChar '#') else return () 
+         updGrammar act' d gr $ pLine $ myLexer s
+    where     
+      updGrammar a d gr (Ok t) = case buildCanonGrammar d gr t of 
+        (gr',d') -> addNextLine (size,a) d' hand gr'
+      updGrammar _ _ gr (Bad s) = do
+        ioeIO $ putStrLn s
+        return emptyMGrammar
+
+      isHash a b = a `div` step < b `div` step
+      step = size `div` 50

src/GF/Canon/MkGFC.hs

@@ -5,15 +5,15 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:26 $ 
+-- > CVS $Date: 2005/05/27 21:05:17 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.12 $
+-- > CVS $Revision: 1.13 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
 
 module GF.Canon.MkGFC (prCanonModInfo, prCanon, prCanonMGr,
-	      canon2grammar, grammar2canon, 
+	      canon2grammar, grammar2canon, buildCanonGrammar,
 	      info2mod,
 	      trExp, rtExp, rtQIdent) where
 
@@ -40,7 +40,8 @@ prCanonMGr g = header ++++ prCanon g where
 
 canon2grammar :: Canon -> CanonGrammar
 canon2grammar (MGr _ _ modules) = canon2grammar (Gr modules) ---- ignoring the header
-canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where
+canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules
+
 mod2info m = case m of
     Mod mt e os flags defs -> 
       let defs' = buildTree $ map def2info defs
@@ -50,6 +51,7 @@ canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where
             MTCnc a x -> (a,M.MTConcrete x)
             MTTrans a x y -> (a,M.MTTransfer (M.oSimple x) (M.oSimple y))
       in (a,M.ModMod (M.Module mt' M.MSComplete flags (ee e) (oo os) defs'))
+ where
   ee (Ext m) = m
   ee _ = []
   oo (Opens ms) = map M.oSimple ms
@@ -170,3 +172,58 @@ rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c)
 rtIdent x 
   | isWildIdent x = identC "h_" --- needed in declarations
   | otherwise = identC $ prt x ---
+
+-- the following is called in GetGFC to read gfc files line
+-- by line. It does not save memory, though, and is therefore
+-- not used.
+
+buildCanonGrammar :: Int -> CanonGrammar -> Line -> (CanonGrammar,Int)
+buildCanonGrammar n gr0 line = mgr $ case line of
+-- LMulti ids id
+  LHeader mt ext op -> newModule mt ext op
+  LFlag f@(Flg (IC "modulesize") (IC n)) -> initModule f $ read $ tail n
+  LFlag flag        -> newFlag flag
+  LDef def          -> newDef $ def2info def
+  LEnd              -> cleanNames
+  _                 -> M.modules gr0
+ where
+   newModule mt ext op = mod2info (Mod mt ext op [] []) : mods
+   initModule f i = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com (f:flags) ee oo (newtree i))) : tmods
+   newFlag f = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com (f:flags) ee oo defs)) : tmods
+   newDef d = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com flags ee oo 
+          (upd (padd 8 n) d defs))) : tmods
+   cleanNames = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com (reverse flags) ee oo 
+          (mapTree (\ (IC f,t) -> (IC (drop 8 f),t)) defs))) : tmods
+
+   actm = head mods -- only used when a new mod has been created
+   mods = M.modules gr0
+   tmods = tail mods
+
+   mgr ms = (M.MGrammar ms, case line of
+     LDef _ -> n+1
+     LEnd   -> 1
+     _ -> n
+     )
+
+   -- create an initial tree with who-cares value
+   newtree (i :: Int) = sorted2tree [
+     (padd 8 k, ResPar []) | 
+     k <- [1..i]] --- padd (length (show i))
+
+   padd l k = let sk = show k in identC (replicate (l - length sk) '0' ++ sk)
+
+   upd n d@(f,t) defs = case defs of
+     NT -> BT (merg n f,t) NT NT --- should not happen
+     BT c@(a,_) left right 
+       | n < a  -> let left'  = upd n d left  in BT c left' right 
+       | n > a  -> let right' = upd n d right in BT c left right' 
+       | otherwise -> BT (merg n f,t) left right
+   merg (IC n) (IC f) = IC (n ++ f)

src/GF/Canon/PrintGFC.hs

@@ -19,7 +19,7 @@ doc = (:)
 render :: Doc -> String
 render d = rend 0 (map ($ "") $ d []) "" where
   rend i ss = case ss of
-    "NEW"    :ts -> realnew . rend i ts --H
+    "*NEW"   :ts -> realnew . rend i ts --H
     "<"      :ts -> showString "<" . rend i ts --H
     "$"      :ts -> showString "$" . rend i ts --H
     "?"      :ts -> showString "?" . rend i ts --H
@@ -99,10 +99,17 @@ instance Print Canon where
    MGr ids id modules -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";") , prt 0 modules])
    Gr modules -> prPrec i 0 (concatD [prt 0 modules])
 
+instance Print Line where
+  prt i e = case e of
+   LMulti ids id -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";") , doc (showString "*NEW")])
+   LHeader modtype extend open -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{"), doc (showString "*NEW")])
+   LFlag flag -> prPrec i 0 (concatD [prt 0 flag , doc (showString ";") , doc (showString "*NEW")])
+   LDef def -> prPrec i 0 (concatD [prt 0 def , doc (showString ";") , doc (showString "*NEW")])
+   LEnd  -> prPrec i 0 (concatD [doc (showString "}")])
 
 instance Print Module where
   prt i e = case e of
-   Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , prt 0 flags , prt 0 defs , doc (showString "}")])
+   Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0  modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , doc (showString "*NEW") , prt 0 flags , prt 0 defs , doc (showString "}")])
 
   prtList es = case es of
    [] -> (concatD [])
@@ -134,7 +141,7 @@ instance Print Flag where
 
   prtList es = case es of
    [] -> (concatD [])
-   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , doc (showString "*NEW") , prt 0 xs])
 
 instance Print Def where
   prt i e = case e of
@@ -149,7 +156,7 @@ instance Print Def where
 
   prtList es = case es of
    [] -> (concatD [])
-   x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "NEW") , prt 0 xs]) -- H
+   x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "*NEW") , prt 0 xs]) -- H
 
 instance Print ParDef where
   prt i e = case e of

src/GF/Compile/GrammarToCanon.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:38 $ 
+-- > CVS $Date: 2005/05/27 21:05:17 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.17 $
+-- > CVS $Revision: 1.18 $
 --
 -- Code generator from optimized GF source code to GFC.
 -----------------------------------------------------------------------------
@@ -69,8 +69,11 @@ redModInfo (c,info) = do
           mt = mt0 ---- if isIncompl then MTResource else mt0
 
       defss <- mapM (redInfo a) $ tree2list $ js
-      defs  <- return $ sorted2tree $ concat defss  -- sorted, but reduced
+      let defs0 = concat defss
-      return $ ModMod $ Module mt MSComplete flags e os defs
+      let lgh = length defs0
+      defs  <- return $ sorted2tree $ defs0  -- sorted, but reduced
+      let flags' = G.Flg (identC "modulesize") (identC ("n"++show lgh)) : flags
+      return $ ModMod $ Module mt MSComplete flags' e os defs
   return (c',info')
  where
    redExtOpen m = do