mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-13 14:59:32 -06:00
experiment with gfc input
This commit is contained in:
aarne
@@ -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 ;
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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 ;
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:21:23 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.7 $
|
||||
-- > CVS $Date: 2005/05/27 21:05:17 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > 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
|
||||
|
||||
@@ -5,15 +5,15 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:21:26 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.12 $
|
||||
-- > CVS $Date: 2005/05/27 21:05:17 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > 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,8 +40,9 @@ 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
|
||||
mod2info m = case m of
|
||||
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
|
||||
(a,mt') = case mt of
|
||||
@@ -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)
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -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
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:21:38 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.17 $
|
||||
-- > CVS $Date: 2005/05/27 21:05:17 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > 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
|
||||
return $ ModMod $ Module mt MSComplete flags e os defs
|
||||
let defs0 = concat defss
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user