GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-29 12:48:54 -06:00
Code Issues Packages Projects Releases Wiki Activity

optimization flags and improver eng

Browse Source
This commit is contained in:
aarne
2005-02-05 09:52:04 +00:00
parent 977a7b6865
commit 2429599b50
15 changed files with 307 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
lib/resource/abstract/Rules.gf
View File

@@ -212,8 +212,6 @@ fun
ExistCN : CN -> Cl ; -- "there is a bar" ExistCN : CN -> Cl ; -- "there is a bar"
ExistNumCN : Num -> CN -> Cl ; -- "there are (86) bars" ExistNumCN : Num -> CN -> Cl ; -- "there are (86) bars"
--- The type signatures of these ones should be changed from VP to VPI. OneNP : NP ; -- "one (walks)"
OneVP : VP -> Cl ; -- "one walks"
} ; } ;

5
lib/resource/english/BasicEng.gf
View File

@@ -1,8 +1,11 @@
--# -path=.:../abstract:../../prelude --# -path=.:../abstract:../../prelude
--# -val
concrete BasicEng of Basic = CategoriesEng ** open NewParadigmsEng in { concrete BasicEng of Basic = CategoriesEng ** open NewParadigmsEng in {
flags startcat=Phr ; lexer=textlit ; parser=chart ; unlexer=text ; flags
startcat=Phr ; lexer=textlit ; unlexer=text ;
optimize=all ;
lin lin
airplane_N = regN "airplane" ; airplane_N = regN "airplane" ;

97
lib/resource/english/ClauseEng.gf
View File

@@ -1,64 +1,65 @@
--# -path=.:../abstract:../../prelude --# -path=.:../abstract:../../prelude
--# -opt
concrete ClauseEng of Clause = CategoriesEng ** concrete ClauseEng of Clause = CategoriesEng **
open Prelude, SyntaxEng in { open Prelude, SyntaxEng in {
lin flags optimize=all ;
SPredV np v = predVerbGroupClause np (predVerb v) ;
SPredPassV np v = predVerbGroupClause np (passVerb v) ;
SPredV2 np v x = predVerbGroupClause np (complTransVerb v x) ;
SPredReflV2 np v = predVerbGroupClause np (reflTransVerb v) ;
SPredVS np v x = predVerbGroupClause np (complSentVerb v x) ;
SPredVV np v x = predVerbGroupClause np (complVerbVerb v x) ;
SPredVQ np v x = predVerbGroupClause np (complQuestVerb v x) ;
SPredVA np v x = predVerbGroupClause np (complAdjVerb v x) ;
SPredV2A np v x y = predVerbGroupClause np (complDitransAdjVerb v x y) ;
SPredSubjV2V np v x y = predVerbGroupClause np (complDitransVerbVerb
False v x y) ;
SPredObjV2V np v x y = predVerbGroupClause np (complDitransVerbVerb
True v x y) ;
SPredV2S np v x y = predVerbGroupClause np (complDitransSentVerb v x y) ;
SPredV2Q np v x y = predVerbGroupClause np (complDitransQuestVerb v x y) ;
SPredAP np v = predBeGroup np (\\_ => v.s ! AAdj) ; lin
-- SPredAP np v = predVerbGroupClause np (predAdjective v) ; SPredV np v = predVerbClause np v (complVerb v) ;
SPredSuperl np a = predVerbGroupClause np (predAdjective (superlAdjPhrase a)) ; SPredPassV np v = predBeGroup np (passVerb v) ;
SPredCN np v = predVerbGroupClause np (predCommNoun v) ; SPredV2 np v x = predVerbClause np v (complTransVerb v x) ;
SPredNP np v = predVerbGroupClause np (predNounPhrase v) ; SPredReflV2 np v = predVerbClause np v (reflTransVerb v) ;
SPredPP np v = predVerbGroupClause np (predAdverb v) ; SPredVS np v x = predVerbClause np v (complSentVerb v x) ;
SPredAV np v x = predVerbGroupClause np (complVerbAdj v x) ; SPredVV np v x = predVerbClause np v (complVerbVerb v x) ;
SPredObjA2V np v x y = predVerbGroupClause np (complVerbAdj2 True v x y) ; SPredVQ np v x = predVerbClause np v (complQuestVerb v x) ;
SPredVA np v x = predVerbClause np v (complAdjVerb v x) ;
SPredV2A np v x y = predVerbClause np v (complDitransAdjVerb v x y) ;
SPredSubjV2V np v x y = predVerbClause np v (complDitransVerbVerb False v x y) ;
SPredObjV2V np v x y = predVerbClause np v (complDitransVerbVerb True v x y) ;
SPredV2S np v x y = predVerbClause np v (complDitransSentVerb v x y) ;
SPredV2Q np v x y = predVerbClause np v (complDitransQuestVerb v x y) ;
SPredAP np v = predBeGroup np (complAdjective v) ;
SPredSuperl np a = predBeGroup np (complAdjective (superlAdjPhrase a)) ;
SPredCN np v = predBeGroup np (complCommNoun v) ;
SPredNP np v = predBeGroup np (complNounPhrase v) ;
SPredPP np v = predBeGroup np (complAdverb v) ;
SPredAV np v x = predBeGroup np (complVerbAdj v x) ;
SPredObjA2V np v x y = predBeGroup np (complVerbAdj2 True v x y) ;
SPredProgVP = progressiveClause ; SPredProgVP = progressiveClause ;
QPredV np v = intVerbPhrase np (predVerb v) ; QPredV np v = intVerbClause np v (complVerb v) ;
QPredPassV np v = intVerbPhrase np (passVerb v) ; QPredPassV np v = predBeGroupQ np (passVerb v) ;
QPredV2 np v x = intVerbPhrase np (complTransVerb v x) ; QPredV2 np v x = intVerbClause np v (complTransVerb v x) ;
QPredReflV2 np v = intVerbPhrase np (reflTransVerb v) ; QPredReflV2 np v = intVerbClause np v (reflTransVerb v) ;
QPredVS np v x = intVerbPhrase np (complSentVerb v x) ; QPredVS np v x = intVerbClause np v (complSentVerb v x) ;
QPredVV np v x = intVerbPhrase np (complVerbVerb v x) ; QPredVV np v x = intVerbClause np v (complVerbVerb v x) ;
QPredVQ np v x = intVerbPhrase np (complQuestVerb v x) ; QPredVQ np v x = intVerbClause np v (complQuestVerb v x) ;
QPredVA np v x = intVerbPhrase np (complAdjVerb v x) ; QPredVA np v x = intVerbClause np v (complAdjVerb v x) ;
QPredV2A np v x y = intVerbPhrase np (complDitransAdjVerb v x y) ; QPredV2A np v x y = intVerbClause np v (complDitransAdjVerb v x y) ;
QPredSubjV2V np v x y = intVerbPhrase np (complDitransVerbVerb QPredSubjV2V np v x y = intVerbClause np v (complDitransVerbVerb
False v x y) ; False v x y) ;
QPredObjV2V np v x y = intVerbPhrase np (complDitransVerbVerb QPredObjV2V np v x y = intVerbClause np v (complDitransVerbVerb
True v x y) ; True v x y) ;
QPredV2S np v x y = intVerbPhrase np (complDitransSentVerb v x y) ; QPredV2S np v x y = intVerbClause np v (complDitransSentVerb v x y) ;
QPredV2Q np v x y = intVerbPhrase np (complDitransQuestVerb v x y) ; QPredV2Q np v x y = intVerbClause np v (complDitransQuestVerb v x y) ;
QPredAP np v = intVerbPhrase np (predAdjective v) ; QPredAP np v = predBeGroupQ np (complAdjective v) ;
QPredSuperl np a = intVerbPhrase np (predAdjective (superlAdjPhrase a)) ; QPredSuperl np a = predBeGroupQ np (complAdjective (superlAdjPhrase a)) ;
QPredCN np v = intVerbPhrase np (predCommNoun v) ; QPredCN np v = predBeGroupQ np (complCommNoun v) ;
QPredNP np v = intVerbPhrase np (predNounPhrase v) ; QPredNP np v = predBeGroupQ np (complNounPhrase v) ;
QPredPP np v = intVerbPhrase np (predAdverb v) ; QPredPP np v = predBeGroupQ np (complAdverb v) ;
QPredAV np v x = intVerbPhrase np (complVerbAdj v x) ; QPredAV np v x = predBeGroupQ np (complVerbAdj v x) ;
QPredObjA2V np v x y = intVerbPhrase np (complVerbAdj2 True v x y) ; QPredObjA2V np v x y = predBeGroupQ np (complVerbAdj2 True v x y) ;
IPredV a v = predVerbGroupI True a (predVerb v) ; IPredV a v = predVerbI True a v (complVerb v) ;
IPredV2 a v x = predVerbGroupI True a (complTransVerb v x) ; IPredV2 a v x = predVerbI True a v (complTransVerb v x) ;
---- SPredAP np v = predBeGroup np (\\_ => v.s ! AAdj) ;
IPredAP a v = predVerbGroupI True a (predAdjective v) ; IPredAP a v = predBeGroupI True a (complAdjective v) ;
{- {-
-- Use VPs -- Use VPs

11
lib/resource/english/RulesEng.gf
View File

@@ -69,7 +69,7 @@ lin
-- verbs and verb prases -- verbs and verb prases
PredAS = predAdjSent ; PredAS = predAdjSent ;
PredV0 rain = predVerbGroupClause (pronNounPhrase pronIt) (predVerb rain) ; PredV0 rain = predVerbClause (pronNounPhrase pronIt) rain (complVerb rain) ;
-- Partial saturation. -- Partial saturation.
@@ -186,16 +186,17 @@ lin
----------------------- -----------------------
-- special constructions -- special constructions
OneVP = predVerbGroupClause (nameNounPhrase (nameReg "one" human)) ; OneNP = nameNounPhrase (nameReg "one" human) ;
---- ThereNP = thereIs ;
ExistCN A = predVerbGroupClause ExistCN A = predVerbClause
(nameNounPhrase (nameReg "there" Neutr)) (nameNounPhrase (nameReg "there" Neutr))
(mkTransVerbDir verbBe)
(complTransVerb (mkTransVerbDir verbBe) (complTransVerb (mkTransVerbDir verbBe)
(indefNounPhrase singular A)) ; (indefNounPhrase singular A)) ;
ExistNumCN nu A = ExistNumCN nu A =
predVerbGroupClause predVerbClause
(nameNounPhrasePl (nameReg "there" Neutr)) (nameNounPhrasePl (nameReg "there" Neutr))
(mkTransVerbDir verbBe)
(complTransVerb (mkTransVerbDir verbBe) (complTransVerb (mkTransVerbDir verbBe)
(indefNounPhraseNum plural nu A)) ; (indefNounPhraseNum plural nu A)) ;

236
lib/resource/english/SyntaxEng.gf
View File

@@ -327,8 +327,8 @@ oper
SForm = SForm =
VFinite Tense Anteriority VFinite Tense Anteriority
| VInfinit Anteriority --- | VInfinit Anteriority
| VPresPart --- | VPresPart
; ;
-- This is how the syntactic verb phrase forms are realized as -- This is how the syntactic verb phrase forms are realized as
@@ -336,6 +336,7 @@ oper
oper oper
{- --vg
verbSForm : Bool -> Verb -> Bool -> SForm -> Agr -> {fin,inf : Str} = verbSForm : Bool -> Verb -> Bool -> SForm -> Agr -> {fin,inf : Str} =
\isAux,verb,b,sf,agr -> \isAux,verb,b,sf,agr ->
let let
@@ -380,6 +381,7 @@ oper
VInfinit Anter => parts neg (have ++ liked) ; VInfinit Anter => parts neg (have ++ liked) ;
VPresPart => parts neg liking VPresPart => parts neg liking
} ; } ;
-}
auxHave : Bool -> Tense -> Agr -> Str = \b,t,a -> auxHave : Bool -> Tense -> Agr -> Str = \b,t,a ->
let has = let has =
@@ -422,6 +424,7 @@ oper
negAux : Bool -> Str -> Str = \b,is -> if_then_Str b is (is + "n't") ; negAux : Bool -> Str -> Str = \b,is -> if_then_Str b is (is + "n't") ;
{- --vg
useVerbGen : Bool -> Verb -> (Agr => Str) -> VerbGroup = \isAux,verb,arg -> useVerbGen : Bool -> Verb -> (Agr => Str) -> VerbGroup = \isAux,verb,arg ->
let let
go = verbSForm isAux verb go = verbSForm isAux verb
@@ -436,6 +439,7 @@ oper
beGroup : (Agr => Str) -> VerbGroup = beGroup : (Agr => Str) -> VerbGroup =
useVerbAux (verbBe ** {s1 = []}) ; useVerbAux (verbBe ** {s1 = []}) ;
--vg -}
---- TODO: the contracted forms. ---- TODO: the contracted forms.
@@ -466,45 +470,49 @@ oper
-- All negative verb phrase behave as auxiliary ones in questions. -- All negative verb phrase behave as auxiliary ones in questions.
predVerbGroup : Bool -> Anteriority -> VerbGroup -> VerbPhrase = \b,ant,vg -> { predVerbI : Bool -> {s : Str ; a : Anteriority} -> Verb -> Complement -> VerbPhrase =
s = table { \b,ant,verb,comp ->
VIInfinit => \\a => vg.s2 ! b ! VInfinit ant ! a ; -- s1 is just neg for inf let
VIPresPart => \\a => vg.s2 ! b ! VPresPart ! a ans = ant.s ; --- just to avoid ? in parsing
inf = case ant.a of {
Simul => verb.s ! InfImp ;
Anter => "have" ++ verb.s ! PPart
}
in
{s = table {
VIInfinit => \\a => ans ++ inf ++ verb.s1 ++ comp ! a ;
VIPresPart => \\a => ans ++ verb.s ! PresPart ++ comp ! a
} ; } ;
s1 = if_then_Str b [] "not" s1 = if_then_Str b [] "not"
} ; } ;
predVerbGroupI : Bool -> {s : Str ; a : Anteriority} -> VerbGroup -> VerbPhrase =
\b,ant,vg ->
let vp = predVerbGroup b ant.a vg in
{s = \\f,a => ant.s ++ vp.s ! f ! a ;
s1 = vp.s1
} ;
-- A simple verb can be made into a verb phrase with an empty complement. -- A simple verb can be made into a verb phrase with an empty complement.
-- There are two versions, depending on if we want to negate the verb. -- There are two versions, depending on if we want to negate the verb.
-- N.B. negation is *not* a function applicable to a verb phrase, since -- N.B. negation is *not* a function applicable to a verb phrase, since
-- double negations with "don't" are not grammatical. -- double negations with "don't" are not grammatical.
predVerb : Verb -> VerbGroup = \walk -> complVerb : Verb -> Complement = \walk ->
useVerb walk (\\_ => []) ; \\_ => walk.s1 ;
mkComp : Verb -> Complement -> Complement = \verb,comp ->
\\a => verb.s1 ++ comp ! a ;
-- Verb phrases can also be formed from adjectives ("is old"), -- Verb phrases can also be formed from adjectives ("is old"),
-- common nouns ("is a man"), and noun phrases ("ist John"). -- common nouns ("is a man"), and noun phrases ("ist John").
-- The third rule is overgenerating: "is every man" has to be ruled out -- The third rule is overgenerating: "is every man" has to be ruled out
-- on semantic grounds. -- on semantic grounds.
predAdjective : Adjective -> VerbGroup = \old -> complAdjective : Adjective -> Complement = \old ->
beGroup (\\_ => old.s ! AAdj) ; (\\_ => old.s ! AAdj) ;
predCommNoun : CommNoun -> VerbGroup = \man -> complCommNoun : CommNoun -> Complement = \man ->
beGroup (\\a => indefNoun (fromAgr a).n man) ; (\\a => indefNoun (fromAgr a).n man) ;
predNounPhrase : NounPhrase -> VerbGroup = \john -> complNounPhrase : NounPhrase -> Complement = \john ->
beGroup (\\_ => john.s ! NomP) ; (\\_ => john.s ! NomP) ;
predAdverb : PrepPhrase -> VerbGroup = \elsewhere -> complAdverb : PrepPhrase -> Complement = \elsewhere ->
beGroup (\\_ => elsewhere.s) ; (\\_ => elsewhere.s) ;
{- --- compiles to 25k lines gfr 3/2/2005 {- --- compiles to 25k lines gfr 3/2/2005
predAdjSent : Adjective -> Sentence -> Clause = \bra,hansover -> predAdjSent : Adjective -> Sentence -> Clause = \bra,hansover ->
@@ -517,7 +525,21 @@ oper
predAdjSent : Adjective -> Sentence -> Clause = \bra,hansover -> predAdjSent : Adjective -> Sentence -> Clause = \bra,hansover ->
predBeGroup (pronNounPhrase pronIt) (\\n => bra.s ! AAdj ++ "that" ++ hansover.s) ; predBeGroup (pronNounPhrase pronIt) (\\n => bra.s ! AAdj ++ "that" ++ hansover.s) ;
predBeGroup : NounPhrase -> (Agr => Str) -> Clause = \itt,goo -> Complement = Agr => Str ;
predBeGroupI : Bool -> {s : Str ; a : Anteriority} -> Complement -> VerbPhrase =
\b,ant,vg ->
{s = table {
VIInfinit => \\a => ant.s ++ case ant.a of {
Simul => "be" ++ vg ! a ;
Anter => "have" ++ "been" ++ vg ! a
} ;
VIPresPart => \\a => "being" ++ vg ! a
} ;
s1 = if_then_Str b [] "not" ;
} ;
predBeGroup : NounPhrase -> Complement -> Clause = \itt,goo ->
let let
it = itt.s ! NomP ; it = itt.s ! NomP ;
good = goo ! itt.a ; good = goo ! itt.a ;
@@ -551,10 +573,11 @@ oper
VFinite t Anter => case o of { VFinite t Anter => case o of {
Dir => it ++ has b t ++ beengood t ; Dir => it ++ has b t ++ beengood t ;
Inv => has b t ++ it ++ beengood t Inv => has b t ++ it ++ beengood t
} ; }
VInfinit Simul => it ++ begood Future ; --- ;
VInfinit Anter => it ++ beengood Future ; --- VInfinit Simul => it ++ begood Future ;
VPresPart => it ++ "being" ++ good --- VInfinit Anter => it ++ beengood Future ;
--- VPresPart => it ++ "being" ++ good
} }
} ; } ;
@@ -578,8 +601,8 @@ oper
-- ("I switch on the radio" / "I switch the radio on"). -- ("I switch on the radio" / "I switch the radio on").
---- TODO: do this again. ---- TODO: do this again.
complTransVerb : TransVerb -> NounPhrase -> VerbGroup = \switch,radio -> complTransVerb : TransVerb -> NounPhrase -> Complement = \switch,radio ->
useVerb switch (\\_ => switch.s3 ++ radio.s ! AccP) ; mkComp switch (\\_ => switch.s3 ++ radio.s ! AccP) ;
-- Verbs that take direct object and a particle: -- Verbs that take direct object and a particle:
@@ -601,14 +624,14 @@ oper
-- Therefore, the function can also be used for "he is swum", etc. -- Therefore, the function can also be used for "he is swum", etc.
-- The syntax is the same as for adjectival predication. -- The syntax is the same as for adjectival predication.
passVerb : Verb -> VerbGroup = \love -> passVerb : Verb -> Complement = \love ->
predAdjective (adj2adjPhrase (regAdjective (love.s ! PPart))) ; complAdjective (adj2adjPhrase (regAdjective (love.s ! PPart))) ;
-- Transitive verbs can also be used reflexively. -- Transitive verbs can also be used reflexively.
-- But to formalize this we must make verb phrases depend on a person parameter. -- But to formalize this we must make verb phrases depend on a person parameter.
reflTransVerb : TransVerb -> VerbGroup = \love -> reflTransVerb : TransVerb -> Complement = \love ->
useVerb love (\\a => love.s1 ++ love.s3 ++ reflPron a) ; ---- mkComp love (\\a => love.s1 ++ love.s3 ++ reflPron a) ; ----
-- Transitive verbs can be used elliptically as verbs. The semantics -- Transitive verbs can be used elliptically as verbs. The semantics
-- is left to applications. The definition is trivial, due to record -- is left to applications. The definition is trivial, due to record
@@ -634,14 +657,14 @@ oper
} ; } ;
complDitransAdjVerb : complDitransAdjVerb :
TransVerb -> NounPhrase -> AdjPhrase -> VerbGroup = \gor,dig,sur -> TransVerb -> NounPhrase -> AdjPhrase -> Complement = \gor,dig,sur ->
useVerb mkComp
gor gor
(\\_ => gor.s1 ++ gor.s3 ++ dig.s ! AccP ++ sur.s ! AAdj) ; (\\_ => gor.s1 ++ gor.s3 ++ dig.s ! AccP ++ sur.s ! AAdj) ;
complAdjVerb : complAdjVerb :
Verb -> AdjPhrase -> VerbGroup = \seut,sur -> Verb -> AdjPhrase -> Complement = \seut,sur ->
useVerb mkComp
seut seut
(\\n => sur.s ! AAdj ++ seut.s1) ; (\\n => sur.s ! AAdj ++ seut.s1) ;
@@ -716,8 +739,6 @@ oper
APl P3 => "themselves" APl P3 => "themselves"
} ; } ;
progressiveVerbPhrase : VerbPhrase -> VerbGroup = \vp ->
beGroup (vp.s ! VIPresPart) ;
progressiveClause : NounPhrase -> VerbPhrase -> Clause = \np,vp -> progressiveClause : NounPhrase -> VerbPhrase -> Clause = \np,vp ->
predBeGroup np (vp.s ! VIPresPart) ; predBeGroup np (vp.s ! VIPresPart) ;
@@ -734,6 +755,64 @@ oper
---- compiles to 4k lines gfr. also relSlash, relVerbPhrase are bad ---- compiles to 4k lines gfr. also relSlash, relVerbPhrase are bad
oper oper
Verbal = VForm => Agr => Str ;
-- This applies to non-auxiliaries.
predVerbClause : NounPhrase -> Verb -> Complement -> Clause = \np,verb,comp ->
let
it = np.s ! NomP ;
agr = np.a ;
itgoes : Order -> Str -> Str -> Str = \o,x,y -> case o of {
Dir => it ++ x ++ y ;
Inv => x ++ it ++ y
} ;
goes : Tense -> Str = \t -> verb.s ! case <t,agr> of {
<Present,ASgP1> => Indic P1 ;
<Present,ASgP3 _> => Indic P3 ;
<Present,_> => Indic P2 ;
<Past,ASgP1> => Pastt Pl ;
<Past,ASgP3 _> => Pastt Sg ;
_ => Pastt Pl --- Future doesn't matter
} ;
off = comp ! agr ;
go = verb.s ! InfImp ++ off ;
gone = verb.s ! PPart ++ off ;
going = verb.s ! PresPart ++ off ;
have = "have" ;
has : Bool -> Tense -> Str = \b,t -> auxHave b t agr ;
does : Bool -> Tense -> Str = \b,t -> auxTense b t agr
in
{s = \\o,b,sf =>
let
neg = if_then_Str b [] "not" ;
in
case sf of {
VFinite Present Simul => case b of {
True => case o of {
Dir => it ++ goes Present ++ off ;
Inv => does b Present ++ it ++ go
} ;
False => itgoes o (does b Present) go
} ;
VFinite Past Simul => case b of {
True => case o of {
Dir => it ++ goes Past ++ off ;
Inv => does b Past ++ it ++ go
} ;
False => itgoes o (does b Past) go
} ;
VFinite t Simul => itgoes o (does b t) go ;
VFinite Present Anter => itgoes o (has b Present) gone ;
VFinite Past Anter => itgoes o (has b Past) gone ;
VFinite t Anter => itgoes o (does b t) (have ++ gone)
--- ;
--- VInfinit Simul => it ++ neg ++ go ;
--- VInfinit Anter => it ++ neg ++ (have ++ gone) ;
--- VPresPart => it ++ neg ++ going
}
} ;
{- --vg
predVerbGroupClause : NounPhrase -> VerbGroup -> Clause = predVerbGroupClause : NounPhrase -> VerbGroup -> Clause =
\yo,dosleep -> { \yo,dosleep -> {
s = \\o,b,c => s = \\o,b,c =>
@@ -755,7 +834,7 @@ oper
} }
} }
} ; } ;
-- vg -}
--3 Sentence-complement verbs --3 Sentence-complement verbs
-- --
@@ -766,20 +845,20 @@ oper
-- To generate "says that John walks" / "doesn't say that John walks": -- To generate "says that John walks" / "doesn't say that John walks":
---- TODO: the alternative without "that" ---- TODO: the alternative without "that"
complSentVerb : SentenceVerb -> Sentence -> VerbGroup = \say,johnruns -> complSentVerb : SentenceVerb -> Sentence -> Complement = \say,johnruns ->
useVerb say (\\_ => "that" ++ johnruns.s) ; mkComp say (\\_ => "that" ++ johnruns.s) ;
complQuestVerb : SentenceVerb -> QuestionSent -> VerbGroup = \se,omduler -> complQuestVerb : SentenceVerb -> QuestionSent -> Complement = \se,omduler ->
useVerb se (\\_ => se.s1 ++ omduler.s ! IndirQ) ; mkComp se (\\_ => se.s1 ++ omduler.s ! IndirQ) ;
complDitransSentVerb : TransVerb -> NounPhrase -> Sentence -> VerbGroup = complDitransSentVerb : TransVerb -> NounPhrase -> Sentence -> Complement =
\sa,honom,duler -> \sa,honom,duler ->
useVerb sa mkComp sa
(\\_ => sa.s1 ++ sa.s3 ++ honom.s ! AccP ++ "that" ++ duler.s) ; (\\_ => sa.s1 ++ sa.s3 ++ honom.s ! AccP ++ "that" ++ duler.s) ;
complDitransQuestVerb : TransVerb -> NounPhrase -> QuestionSent -> VerbGroup = complDitransQuestVerb : TransVerb -> NounPhrase -> QuestionSent -> Complement =
\sa,honom,omduler -> \sa,honom,omduler ->
useVerb sa mkComp sa
(\\_ => sa.s1 ++ sa.s3 ++ honom.s ! AccP ++ omduler.s ! IndirQ) ; (\\_ => sa.s1 ++ sa.s3 ++ honom.s ! AccP ++ omduler.s ! IndirQ) ;
@@ -799,16 +878,16 @@ oper
-- The contraction of "not" is not provided, since it would require changing -- The contraction of "not" is not provided, since it would require changing
-- the verb parameter type. -- the verb parameter type.
complVerbVerb : VerbVerb -> VerbPhrase -> VerbGroup = \try,run -> complVerbVerb : VerbVerb -> VerbPhrase -> Complement = \try,run ->
let let
taux = try.isAux ; taux = try.isAux ;
to = if_then_Str taux [] "to" ; to = if_then_Str taux [] "to" ;
torun : Agr => Str = torun : Agr => Str =
\\a => run.s1 ++ to ++ run.s ! VIInfinit ! a \\a => run.s1 ++ to ++ run.s ! VIInfinit ! a
in in
if_then_else VerbGroup taux ---- if_then_else VerbGroup taux
(useVerb try torun) ---- (useVerbAux try torun)
(useVerbAux try torun) ; (mkComp try torun) ;
-- The three most important example auxiliaries. -- The three most important example auxiliaries.
@@ -834,9 +913,9 @@ oper
DitransVerbVerb = TransVerb ** {s4 : Str} ; DitransVerbVerb = TransVerb ** {s4 : Str} ;
complDitransVerbVerb : complDitransVerbVerb :
Bool -> DitransVerbVerb -> NounPhrase -> VerbPhrase -> VerbGroup = Bool -> DitransVerbVerb -> NounPhrase -> VerbPhrase -> Complement =
\obj,be,dig,simma -> \obj,be,dig,simma ->
useVerb be mkComp be
(\\a => be.s1 ++ be.s3 ++ dig.s ! AccP ++ be.s3 ++ be.s4 ++ (\\a => be.s1 ++ be.s3 ++ dig.s ! AccP ++ be.s3 ++ be.s4 ++
simma.s1 ++ -- negation simma.s1 ++ -- negation
if_then_Str obj if_then_Str obj
@@ -851,17 +930,15 @@ oper
s3 = hitta.s3 s3 = hitta.s3
} ; } ;
complVerbAdj : Adjective -> VerbPhrase -> VerbGroup = \grei, simma -> complVerbAdj : Adjective -> VerbPhrase -> Complement = \grei, simma ->
beGroup
(\\a => (\\a =>
grei.s ! AAdj ++ simma.s1 ++ grei.s ! AAdj ++ simma.s1 ++
"to" ++ "to" ++
simma.s ! VIInfinit ! a) ; simma.s ! VIInfinit ! a) ;
complVerbAdj2 : complVerbAdj2 :
Bool -> AdjCompl -> NounPhrase -> VerbPhrase -> VerbGroup = Bool -> AdjCompl -> NounPhrase -> VerbPhrase -> Complement =
\obj,grei,dig,simma -> \obj,grei,dig,simma ->
beGroup
(\\a => (\\a =>
grei.s ! AAdj ++ grei.s ! AAdj ++
grei.s2 ++ dig.s ! AccP ++ grei.s2 ++ dig.s ! AccP ++
@@ -892,10 +969,10 @@ oper
slashTransVerbCl : NounPhrase -> TransVerb -> ClauseSlashNounPhrase = slashTransVerbCl : NounPhrase -> TransVerb -> ClauseSlashNounPhrase =
\you,lookat -> \you,lookat ->
let youlookat = (predVerbClause you lookat (complVerb lookat)).s in
{s = table { {s = table {
DirQ => \\b,f => (questVerbPhrase you (predVerb DirQ => youlookat ! Inv ;
lookat)).s ! b ! f ! DirQ ; IndirQ => youlookat ! Dir
IndirQ => (predVerbGroupClause you (predVerb lookat)).s ! Dir
} ; } ;
s2 = lookat.s3 s2 = lookat.s3
} ; } ;
@@ -927,11 +1004,11 @@ oper
RelClause : Type = {s : Bool => SForm => Agr => Str} ; RelClause : Type = {s : Bool => SForm => Agr => Str} ;
RelSentence : Type = {s : Agr => Str} ; RelSentence : Type = {s : Agr => Str} ;
------ relg
relVerbPhrase : RelPron -> VerbGroup -> RelClause = \who,walks -> relVerbPhrase : RelPron -> VerbGroup -> RelClause = \who,walks ->
{s = \\b,sf,a => {s = \\b,sf,a => []
let wa = fromAgr a in ---- let wa = fromAgr a in
(predVerbGroupClause (relNounPhrase who wa.g wa.n) walks).s ! Dir ---- (predVerbGroupClause (relNounPhrase who wa.g wa.n) walks).s ! Dir ! b ! sf
! b ! sf
} ; } ;
--- TODO: full tense variation in relative clauses. --- TODO: full tense variation in relative clauses.
@@ -1056,7 +1133,7 @@ oper
IndirQ => cl.s ! Dir ! b ! c IndirQ => cl.s ! Dir ! b ! c
} }
} ; } ;
{- --vg
questVerbPhrase : NounPhrase -> VerbGroup -> Question = questVerbPhrase : NounPhrase -> VerbGroup -> Question =
questVerbPhrase' False ; questVerbPhrase' False ;
@@ -1080,19 +1157,38 @@ oper
(predVerbGroupClause John walk).s ! Dir ! b ! cl (predVerbGroupClause John walk).s ! Dir ! b ! cl
} }
} ; } ;
-- vg -}
--3 Wh-questions --3 Wh-questions
-- --
-- Wh-questions are of two kinds: ones that are like $NP - VP$ sentences, -- Wh-questions are of two kinds: ones that are like $NP - VP$ sentences,
-- others that are line $S/NP - NP$ sentences. -- others that are line $S/NP - NP$ sentences.
intNounPhrase : IntPron -> NounPhrase = \who ->
{s = who.s ; a = toAgr who.n P3 who.g} ;
predBeGroupQ : IntPron -> Complement -> Question = \who,old ->
let whoisold = predBeGroup (intNounPhrase who) old
in
{s = \\b,sf,_ => whoisold.s ! Dir ! b ! sf} ;
{- --vg
intVerbPhrase : IntPron -> VerbGroup -> Question = \who,walk -> intVerbPhrase : IntPron -> VerbGroup -> Question = \who,walk ->
let let
who : NounPhrase = {s = who.s ; a = toAgr who.n P3 who.g} ; who : NounPhrase = {s = who.s ; a = toAgr who.n P3 who.g} ;
whowalks : Clause = predVerbGroupClause who walk whowalks : Clause = predVerbGroupClause who walk
in in
{s = \\b,sf,_ => whowalks.s ! Dir ! b ! sf} ; {s = \\b,sf,_ => whowalks.s ! Dir ! b ! sf} ;
--vg -}
intVerbClause : IntPron -> Verb -> Complement -> Question = \who,walk,here ->
let
who : NounPhrase = {s = who.s ; a = toAgr who.n P3 who.g} ;
whowalks : Clause = predVerbClause who walk here
in
{s = \\b,sf,_ => whowalks.s ! Dir ! b ! sf} ;
intSlash : IntPron -> ClauseSlashNounPhrase -> Question = \who,yousee -> intSlash : IntPron -> ClauseSlashNounPhrase -> Question = \who,yousee ->
{s = \\b,cl,q => {s = \\b,cl,q =>
let let

3
lib/resource/scandinavian/RulesScand.gf
View File

@@ -99,7 +99,6 @@ lin
-- --
SlashV2 = slashTransVerb ; SlashV2 = slashTransVerb ;
OneVP = predVerbGroupClause npMan ;
IdRP = identRelPron ; IdRP = identRelPron ;
FunRP = funRelPron ; FunRP = funRelPron ;
@@ -172,7 +171,7 @@ lin
----------------------- -----------------------
-- special constructions -- special constructions
OneVP = predVerbGroupClause npMan ; OneNP = npMan ;
ExistCN A = predVerbGroupClause npDet ExistCN A = predVerbGroupClause npDet
(complTransVerb (mkDirectVerb (deponentVerb verbFinnas)) (complTransVerb (mkDirectVerb (deponentVerb verbFinnas))

19
src/GF/Canon/Share.hs
View File

@@ -9,10 +9,10 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Optimizations on GFC code: sharing, parametrization, value sets.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Share (shareModule, OptSpec, basicOpt, fullOpt, valOpt) where module Share (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
import AbsGFC import AbsGFC
import Ident import Ident
@@ -28,9 +28,10 @@ import qualified Modules as M
type OptSpec = [Integer] --- type OptSpec = [Integer] ---
doOptFactor opt = elem 2 opt doOptFactor opt = elem 2 opt
doOptValues opt = elem 3 opt doOptValues opt = elem 3 opt
basicOpt = [] shareOpt = []
fullOpt = [2] paramOpt = [2]
valOpt = [3] valOpt = [3]
allOpt = [2,3]
shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo) shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo)
shareModule opt (i,m) = case m of shareModule opt (i,m) = case m of
@@ -38,13 +39,14 @@ shareModule opt (i,m) = case m of
(i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js))) (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
_ -> (i,m) _ -> (i,m)
shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOpt opt t) m) shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt t) m)
shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOpt opt t) m) shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt t) m)
shareInfo _ i = i shareInfo _ i = i
-- the function putting together optimizations -- the function putting together optimizations
shareOpt :: OptSpec -> Term -> Term shareOptim :: OptSpec -> Term -> Term
shareOpt opt shareOptim opt
| doOptFactor opt && doOptValues opt = values . factor 0
| doOptFactor opt = share . factor 0 | doOptFactor opt = share . factor 0
| doOptValues opt = values | doOptValues opt = values
| otherwise = share | otherwise = share
@@ -133,5 +135,6 @@ replace old new trm = case trm of
values :: Term -> Term values :: Term -> Term
values t = case t of values t = case t of
T ty [c] -> T ty [Cas p (values t) | Cas p t <- [c]] -- preserve parametrization
T ty cs -> V ty [values t | Cas _ t <- cs] -- assumes proper order T ty cs -> V ty [values t | Cas _ t <- cs] -- assumes proper order
_ -> C.composSafeOp values t _ -> C.composSafeOp values t

18
src/GF/Compile/Compile.hs
View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- The top-level compilation chain from source file to gfc/gfr.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Compile where module Compile where
@@ -276,12 +276,16 @@ generateModuleCode :: Options -> InitPath -> SourceModule -> IOE GFC.CanonModule
generateModuleCode opts path minfo@(name,info) = do generateModuleCode opts path minfo@(name,info) = do
let pname = prefixPathName path (prt name) let pname = prefixPathName path (prt name)
minfo0 <- ioeErr $ redModInfo minfo minfo0 <- ioeErr $ redModInfo minfo
let oopts = addOptions opts (iOpts (flagsModule minfo))
optim = maybe "share" id $ getOptVal oopts useOptimizer
minfo' <- return $ minfo' <- return $
if optim case optim of
then shareModule fullOpt minfo0 -- parametrization and sharing "parametrize" -> shareModule paramOpt minfo0 -- parametrization and sharing
else if values "values" -> shareModule valOpt minfo0 -- tables as courses-of-values
then shareModule valOpt minfo0 -- tables as courses-of-values "share" -> shareModule shareOpt minfo0 -- sharing of branches
else shareModule basicOpt minfo0 -- sharing only "all" -> shareModule allOpt minfo0 -- first parametrize then values
"none" -> minfo0 -- no optimization
_ -> shareModule shareOpt minfo0 -- sharing; default
-- for resource, also emit gfr -- for resource, also emit gfr
case info of case info of
@@ -305,8 +309,6 @@ generateModuleCode opts path minfo@(name,info) = do
_ -> True _ -> True
nomulti = not $ oElem makeMulti opts nomulti = not $ oElem makeMulti opts
emit = oElem emitCode opts && not (oElem notEmitCode opts) emit = oElem emitCode opts && not (oElem notEmitCode opts)
optim = oElem optimizeCanon opts
values = oElem optimizeValues opts
-- for old GF: sort into modules, write files, compile as usual -- for old GF: sort into modules, write files, compile as usual

2
src/GF/Grammar/Lookup.hs
View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Lookup in source (concrete and resource) when compiling.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Lookup where module Lookup where

7
src/GF/Infra/Modules.hs
View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Datastructures and functions for modules, common to GF and GFC.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Modules where module Modules where
@@ -91,6 +91,11 @@ addOpenQualif :: i -> i -> Module i f t -> Module i f t
addOpenQualif i j (Module mt ms fs me ops js) = addOpenQualif i j (Module mt ms fs me ops js) =
Module mt ms fs me (oQualif i j : ops) js Module mt ms fs me (oQualif i j : ops) js
flagsModule :: (i,ModInfo i f a) -> [f]
flagsModule (_,mi) = case mi of
ModMod m -> flags m
_ -> []
allFlags :: MGrammar i f a -> [f] allFlags :: MGrammar i f a -> [f]
allFlags gr = concat $ map flags $ reverse [m | (_, ModMod m) <- modules gr] allFlags gr = concat $ map flags $ reverse [m | (_, ModMod m) <- modules gr]

3
src/GF/Infra/Option.hs
View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Options and flags used in GF shell commands and files.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Option where module Option where
@@ -224,6 +224,7 @@ useAbsName = aOpt "abs"
useCncName = aOpt "cnc" useCncName = aOpt "cnc"
useResName = aOpt "res" useResName = aOpt "res"
useFile = aOpt "file" useFile = aOpt "file"
useOptimizer = aOpt "optimize"
markLin = aOpt "mark" markLin = aOpt "mark"
markOptXML = oArg "xml" markOptXML = oArg "xml"

7
src/GF/Shell/ShellCommands.hs
View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- The datatype of shell commands and the list of their options.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module ShellCommands where module ShellCommands where
@@ -130,6 +130,7 @@ testValidFlag st co f x = case f of
"transform" -> testInc customTermCommand "transform" -> testInc customTermCommand
"filter" -> testInc customStringCommand "filter" -> testInc customStringCommand
"length" -> testN "length" -> testN
"optimize"-> testIn $ words "parametrize values all share none"
_ -> return () _ -> return ()
where where
testInc ci = testInc ci =
@@ -148,8 +149,8 @@ testValidFlag st co f x = case f of
optionsOfCommand :: Command -> ([String],[String]) optionsOfCommand :: Command -> ([String],[String])
optionsOfCommand co = case co of optionsOfCommand co = case co of
CImport _ -> both "old v s opt val src retain nocf nocheckcirc cflexer noemit o" CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o"
"abs cnc res path" "abs cnc res path optimize"
CRemoveLanguage _ -> none CRemoveLanguage _ -> none
CEmptyState -> none CEmptyState -> none
CStripState -> none CStripState -> none

11
src/HelpFile
View File

@@ -25,7 +25,6 @@ i, import: i File
-old old: parse in GF<2.0 format (not necessary) -old old: parse in GF<2.0 format (not necessary)
-v verbose: give lots of messages -v verbose: give lots of messages
-s silent: don't give error messages -s silent: don't give error messages
-opt perform branch-sharing optimization
-src source: ignore precompiled gfc and gfr files -src source: ignore precompiled gfc and gfr files
-retain retain operations: read resource modules (needed in comm cc) -retain retain operations: read resource modules (needed in comm cc)
-nocf don't build context-free grammar (thus no parser) -nocf don't build context-free grammar (thus no parser)
@@ -38,6 +37,7 @@ i, import: i File
-cnc set the name used for concrete syntax (with -old option) -cnc set the name used for concrete syntax (with -old option)
-res set the name used for resource (with -old option) -res set the name used for resource (with -old option)
-path use the (colon-separated) search path to find modules -path use the (colon-separated) search path to find modules
-optimize select an optimization to override file-defined flags
examples: examples:
i English.gf -- ordinary import of Concrete i English.gf -- ordinary import of Concrete
i -retain german/ParadigmsGer.gf -- import of Resource to test i -retain german/ParadigmsGer.gf -- import of Resource to test
@@ -427,6 +427,15 @@ q, quit: q
-number, the maximum number of generated items in a list. -number, the maximum number of generated items in a list.
The default is unlimited. The default is unlimited.
-optimize, optimization on generated code.
The default is share.
-optimize=share share common branches in tables
-optimize=parametrize first try parametrize then do share with the rest
-optimize=values represent tables as courses-of-values
-optimize=all first try parametrize then do values with the rest
-optimize=none no optimization
-parser, Context-free parsing algorithm. The default is chart. -parser, Context-free parsing algorithm. The default is chart.
-parser=earley Earley algorithm -parser=earley Earley algorithm
-parser=chart bottom-up chart parser -parser=chart bottom-up chart parser

18
src/HelpFile.hs
View File

@@ -1,7 +1,7 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : (Module) -- Module : HelpFile
-- Maintainer : (Maintainer) -- Maintainer : Aarne Ranta
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
@@ -9,9 +9,10 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Help on shell commands. Generated from HelpFile by 'make help'.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module HelpFile where module HelpFile where
import Operations import Operations
@@ -52,7 +53,6 @@ txtHelpFile =
"\n -old old: parse in GF<2.0 format (not necessary)" ++ "\n -old old: parse in GF<2.0 format (not necessary)" ++
"\n -v verbose: give lots of messages " ++ "\n -v verbose: give lots of messages " ++
"\n -s silent: don't give error messages" ++ "\n -s silent: don't give error messages" ++
"\n -opt perform branch-sharing optimization" ++
"\n -src source: ignore precompiled gfc and gfr files" ++ "\n -src source: ignore precompiled gfc and gfr files" ++
"\n -retain retain operations: read resource modules (needed in comm cc) " ++ "\n -retain retain operations: read resource modules (needed in comm cc) " ++
"\n -nocf don't build context-free grammar (thus no parser)" ++ "\n -nocf don't build context-free grammar (thus no parser)" ++
@@ -65,6 +65,7 @@ txtHelpFile =
"\n -cnc set the name used for concrete syntax (with -old option)" ++ "\n -cnc set the name used for concrete syntax (with -old option)" ++
"\n -res set the name used for resource (with -old option)" ++ "\n -res set the name used for resource (with -old option)" ++
"\n -path use the (colon-separated) search path to find modules" ++ "\n -path use the (colon-separated) search path to find modules" ++
"\n -optimize select an optimization to override file-defined flags" ++
"\n examples:" ++ "\n examples:" ++
"\n i English.gf -- ordinary import of Concrete" ++ "\n i English.gf -- ordinary import of Concrete" ++
"\n i -retain german/ParadigmsGer.gf -- import of Resource to test" ++ "\n i -retain german/ParadigmsGer.gf -- import of Resource to test" ++
@@ -454,6 +455,15 @@ txtHelpFile =
"\n-number, the maximum number of generated items in a list. " ++ "\n-number, the maximum number of generated items in a list. " ++
"\n The default is unlimited." ++ "\n The default is unlimited." ++
"\n" ++ "\n" ++
"\n-optimize, optimization on generated code." ++
"\n The default is share." ++
"\n -optimize=share share common branches in tables" ++
"\n -optimize=parametrize first try parametrize then do share with the rest" ++
"\n -optimize=values represent tables as courses-of-values" ++
"\n -optimize=all first try parametrize then do values with the rest" ++
"\n -optimize=none no optimization" ++
"\n" ++
"\n" ++
"\n-parser, Context-free parsing algorithm. The default is chart." ++ "\n-parser, Context-free parsing algorithm. The default is chart." ++
"\n -parser=earley Earley algorithm" ++ "\n -parser=earley Earley algorithm" ++
"\n -parser=chart bottom-up chart parser" ++ "\n -parser=chart bottom-up chart parser" ++

21
src/tools/MkHelpFile.hs
View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Compile HelpFile.hs from HelpFile.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Main where module Main where
@@ -20,6 +20,7 @@ main = do
writeFile "HelpFile.hs" s' writeFile "HelpFile.hs" s'
mkHsFile ss = mkHsFile ss =
helpHeader ++
"module HelpFile where\n\n" ++ "module HelpFile where\n\n" ++
"import Operations\n\n" ++ "import Operations\n\n" ++
"txtHelpFileSummary =\n" ++ "txtHelpFileSummary =\n" ++
@@ -39,3 +40,21 @@ mkOne s = " \"" ++ pref s ++ (escs s) ++ "\" ++"
escs [] = [] escs [] = []
escs (c:cs) | elem c "\"\\" = '\\':c:escs cs escs (c:cs) | elem c "\"\\" = '\\':c:escs cs
escs (c:cs) = c:escs cs escs (c:cs) = c:escs cs
helpHeader = unlines [
"----------------------------------------------------------------------",
"-- |",
"-- Module : HelpFile",
"-- Maintainer : Aarne Ranta",
"-- Stability : (stable)",
"-- Portability : (portable)",
"--",
"-- > CVS $Date $",
"-- > CVS $Author $",
"-- > CVS $Revision $",
"--",
"-- Help on shell commands. Generated from HelpFile by 'make help'.",
"-----------------------------------------------------------------------------",
"",
""
]