DEMO   ENGLISH   CONFIG (1.0)
  ROOTCAT   ROOT.  "changed to ROOT from S"
  FILES common.templates.lfg  .
  LEXENTRIES   (DEMO ENGLISH) (MORPH ENGLISH).
  TEMPLATES (DEMO ENGLISH) (STANDARD COMMON).  "added common ParGram templates"
  RULES   (DEMO ENGLISH) (MORPH ENGLISH).
  MORPHOLOGY (DEMO ENGLISH).
  GOVERNABLERELATIONS    SUBJ OBJ OBJ2 COMP XCOMP OBL OBL-?+.
  SEMANTICFUNCTIONS    ADJUNCT  TOPIC FOCUS POSS STANDARD.
  NONDISTRIBUTIVES    NUM PERS COORD-FORM.
  EPSILON   e.
  OPTIMALITYORDER NOGOOD  PPadj +PPattach +sg-imp.
  GENOPTIMALITYORDER GenBadPunct NOGOOD +Punct.

----

DEMO ENGLISH MORPHOLOGY (1.0)

TOKENIZE:
P!basic-parse-tok.fst G!default-gen-tokenizer.fst

ANALYZE:
english.infl.patch.full.fst

----

DEMO   ENGLISH   RULES (1.0)

ROOT --> "can have other things here as well, imperatives, etc." 
	  { S | Simp}. 

  Simp --> e: (^ SUBJ PRED) = 'pro'
	       (^ SUBJ PERS) = 2; 
 	  VP
 	  EXCL.  "obligatory exclamation mark"

   S --> NP: (^ SUBJ)=!
	     (! CASE)=nom;
 	 VP: (^ TNS-ASP TENSE); "require that sentences have tense"
 	 (PERIOD: @(OT-MARK Punct)).  "prefer for generation" 


   VP --> (AUX) "auxiliary introduced for passive" 
 	  V: ^=!;   "head of VP"
 	  (NP: (^ OBJ)=! "direct object"
	       (! CASE)=acc)
 	  (NP: (^ OBJ2) = !) "secondary object"
 	  PP*: { ! $ (^ ADJUNCT) "PPs can be all types of adjuncts"
		 (! PTYPE) =c sem "only semantic PPs here"
		 @(OT-MARK PPadj) "disprefer adjunct PPs" 
	       | (^ OBL) = ! "or a a general oblique"
	       };
 	  (PP: (^ OBL-TO) = ! "special obl for ditransitives"
	       "example of a constraining equation: require a value with =c"
	       (! PFORM) =c to)
 	  (PP: (^ OBL-AG) = ! "oblique agent of passive" 
	       "example of a constraining equation: require a value with =c"
	       (! PFORM) =c by ). 

   NP --> "either a full NP or a PRON"
	  { (D) "optional determiner"
 	    AP*: ! $ (^ ADJUNCT); "introducing adjectives in sets"
 	    N "head of NP"
 	    PP*: ! $ (^ ADJUNCT) "PPs modifying NPs" 
		 (! PTYPE) =c sem "have to be semantic" 
		 @(OT-MARK PPattach) "prefer PPs attached to NPs"
 	  | PRON}. 
 

   AP --> ADV*: ! $ (^ ADJUNCT);
 	  A
 	  (COMMA).						

   PP --> { P: ^ = ! "head of PP"
	       (! PTYPE) =c sem; "semantic type, Adjunct"
 	    NP: (^ OBJ) = !
		(! CASE) = acc
 	  | P: ^ = ! "head of PP" 
	       (! PTYPE) =c nosem; "non-semantic type, OBL"
 	    NP
 	  }. 



  METARULEMACRO(_CAT _BASECAT _RHS) = "applies to all rules in the grammar"

    { "just use the rule as stated"
      "don't do anything to it; ALWAYS include this option"

      _RHS

     |"if it is an NP or an N, pass it to the NP
      coordination rule"
      "COM{EX RULE NP: the girl and the boy}"

      e: _CAT $c { NP N };
      @(NPCOORD _CAT)

     |"if it is any other category, pass it to
      the same category coordination rule"
      "COM{EX RULE S: the girl sleeps and walks.}"
      "COM{EX RULE PP: with the girl and in the park}"

      e: _CAT ~$ { NP N };
      @(SCCOORD _CAT)

     |"allow bracketing around any category"
      "COM{EX RULE S: [the girl] sleeps.}"
      "COM{EX RULE S: boys baked [the bananas in the cake].}"

      LB: @(OT-MARK GenBadPunct); "preceding quote mark"
                                  "disprefer in generation"
      _CAT: @PUSHUP; "this pushes the quotes to the top
                      to avoid vacuous ambiguity for things like:
                      COM{EX RULES NP: [cakes])"
      RB "following quote mark"}.

"Coordination rules"

NPCOORD(_CAT) = "coordination of nominals"
   "COM{EX RULE NP: girls and boys}"
   "This differs from SCCOORD in that the conjunction provides NUM pl to
   the resulting coordinated f-structure and the person features are
   resolved for the noun phrase."

   _CAT: @IN-SET  "first nominal"
         @NP-CONJUNCT; "calls person resolution template"

   CONJnp: @PUSHUP; "conjunction"
           "PUSHUP avoids vacuous ambiguity in constructions like:
            COM{EX RULES NP: girls and boys}"

   _CAT: @IN-SET "second nominal"
         @NP-CONJUNCT.

SCCOORD(_CAT) = "coordination of non-nominals"
  "COM{EX RULES PP: with girls and with boys}"
  "COM{EX RULES S: girls sleep and boys sleep.}"
  "no features other than a COORD-FORM are provided to the coordinated
  f-structure."

   _CAT: @IN-SET; "first constituent"
   (COMMA: @(OT-MARK GenBadPunct)) "optional comma; 
                                    disprefered in generation"
                       "COM{EX RULES S: girls sleep, and boys sleep.}"

   CONJ: @PUSHUP; "conjunction"
         "PUSHUP avoids vacuous ambiguity in constructions like:
         COM{EX RULES S: boys walk and sleep.}" 

   _CAT: @IN-SET "second constituent".


----
DEMO   ENGLISH   TEMPLATES (1.0)

 NP-CONJUNCT = "provides person resolution features for nominal
                 coordination" 
  
      { "if either conjunct is 1st person; the whole NP is"
        "EX: the boys and me}"
        (! PERS)=c 1
        (^ PERS)=1
       |"if a conjunct is 2nd person and the NP is not
        already 1st person, make it 2nd person"
        (! PERS)=c 2
        { (^ PERS)=c 1 "one conjunct was 1st person"
                       "EX: you and I}"
         |(^ PERS)=2 } "else assign 2nd person"
                       "EX: you and the boys}"
       |"otherwise, the NP is 3rd person"
        "EX: the boys and her}"
        (^ PERS)=3}.


 OT-MARK(_mark) = "assigns an OT mark, from common templates"
       _mark $ o::*.

   PASS(FRAME) = { FRAME "no passive, just give back subcat frame"
	          (^ PASSIVE) = - "no passive"
	  | FRAME "passive"
	    (^ PASSIVE) = + "mark as such"
	    (^ PARTICIPLE) =c past "make sure to have a past participle"
	    (^ OBJ)-->(^ SUBJ) "obj goes to subj"
	    { (^ SUBJ)-->(^ OBL-AG) "either make subj obl-ag"
	    | (^ SUBJ)--> NULL "or delete"
	    }
	  }. 

DAT-SHIFT(SCHEMATA) = { SCHEMATA 
	                 | SCHEMATA 
	                   (^ OBJ)-->(^ OBJ2)
	                   (^ OBL-TO)-->(^ OBJ)}.

DITRANS(P) = @(PASS @(DAT-SHIFT (^ PRED)='P<(^ SUBJ) (^ OBJ) (^ OBL-TO)>')).


 "transitives can passivize"

   TRANS(P) = @(PASS (^ PRED)='P<(^ SUBJ) (^ OBJ)>').

   INTRANS(P) = (^ PRED) = 'P<(^SUBJ)>'.

   INTRANS-OBL(P) = (^ PRED) = 'P<(^SUBJ)(^OBL)>'.
             


   OPT-TRANS(P) = { (^ PRED) = 'P<(^SUBJ)(^OBJ)>'   "P is a variable"
	          | (^ PRED) = 'P<(^SUBJ)>' }.  "this template takes one argument:  P"
	  
   TENSE(T) = (^ TENSE) = T.  "the more general case"

   CASE(C) = (^ CASE) = C.   

   MOOD(M) = (^ MOOD) = M.

   VPRES = @(TENSE pres) 
	   @(MOOD indicative). 

   VPAST = @(TENSE past) 
	  @(MOOD indicative). 

   VPROG = (^ ASPECT PROG) = +.

   PRED(P) = (^ PRED) = 'P'. 

   PASTP = (^ PARTICIPLE) = past. 

   BARE-AGR = { (^ SUBJ NUM) = pl "either it is plural"
	  | (^ SUBJ PERS) ~= 3 "or singular and not 3rd person"
	    (^ SUBJ NUM) = sg
	    @(OT-MARK sg-imp) "prefer a singular imperative"
	  }.

   S-AGR = (^ SUBJ PERS) = 3  "for verbs in -s"
	   (^ SUBJ NUM) = sg. 

 COUNT-NOUN(P N) = @(PRED P)
	             (^ NUM) = N
	             (^ PERS) = 3
	             (^ NTYPE) = count. 

"template for names"

NAME(P) = @(PRED P)
	  (^ NUM) = sg
	  (^ PERS) = 3
	  (^ NTYPE) = name.

   PREP(P) = "template for most prepositions"
	  { (^ PRED) = 'P<(^OBJ)>' 
	    (^ PTYPE) = sem
	  | (^ PTYPE) = nosem
	    (^ PFORM) = P}.

"template for pronouns of all types" 

  PRON(P Z   N T) = (^ PRED) = 'P'
	  (^ NUM) = N
	  (^ PERS) = Z
	  (^ PRON-TYPE) = T
	  (^ NTYPE) = pron. 

 DEF =  (^ DEF). 

 
----

DEMO ENGLISH LEXICON (1.0)

"all names here"

John N * @(NAME John).

Mary N * @(NAME Mary).

Bill N * @(NAME Bill).

Kim N * @(NAME Kim).

"count nouns"

bed   N * @(COUNT-NOUN bed sg).

banana	  N * @(COUNT-NOUN banana sg).

bananas	  N * @(COUNT-NOUN banana pl).

bone 	  N * @(COUNT-NOUN bone sg).

bones 	  N * @(COUNT-NOUN bone pl).

homework  N * @(COUNT-NOUN homework sg).

dog 	  N *  @(COUNT-NOUN dog sg).

dogs 	  N * @(COUNT-NOUN dog pl);
	  V * @(TRANS dog) "can be noun or verb"
	      @VPRES
	      @S-AGR. 


gorilla  N *  @(COUNT-NOUN gorilla sg).

gorillas  N * @(COUNT-NOUN gorilla pl).

telescope N * @(COUNT-NOUN telescope sg).

garden 	  N *  @(COUNT-NOUN garden sg).

tree 	  N *  @(COUNT-NOUN tree sg).


"all verbs here"

hate	  V-S XLE @(TRANS %stem).  "using the morphological analyzer"

eat       V-S XLE @(OPT-TRANS %stem). 

implement V * @(TRANS see)
	      @VPRES
	      @BARE-AGR. 

saw 	  V * @(TRANS see) "optionally transitive verbs"
	      @VPAST.

ate 	  V * @(OPT-TRANS eat) "optionally transitive verbs"
	      @VPAST.

eats 	  V * @(OPT-TRANS eat)
	      @VPRES
              @S-AGR. 


drinks 	  V * @(OPT-TRANS drink)
	      @VPRES
	      @S-AGR. 

devour 	  V * @(TRANS devour) 
              "don't do this, do Lexical Rules instead"
	      "{ (^ PRED) = 'devour<(^SUBJ)(^OBJ)>' | 
		(^ PRED) = 'devour<(^OBJ)(^OBL)>' }"
	      @VPRES
	      @BARE-AGR. 

devours  V * @(TRANS devour) 
	     @VPRES
             @S-AGR.

devoured  V * @(TRANS devour) 
              { @VPAST  |  @PASTP}. 


gave 	  V * @(DITRANS give)
	      @VPAST. 

gives     V * @(DITRANS give)
	      @VPRES
	      @S-AGR.

given 	  V * @(DITRANS give)
	      { @VPAST | @PASTP}. 


appears   V * @(INTRANS appear)
	      @VPRES
	      @S-AGR.

appeared  V * @(INTRANS appear)
	      @VPAST. 

sleeps 	  V * @(INTRANS sleep)
	      @VPRES
	      @S-AGR. 

sleep 	  V * @(INTRANS sleep)
              @VPRES
              @BARE-AGR.

slept 	  V * @(INTRANS sleep)
	      @VPAST. 

waited 	  V * { @(INTRANS wait) | 
		@(INTRANS-OBL wait) 
		"this is the non-semantic OBL wait on a customer use"
		(^ OBL PFORM) =c on
		(^ PSEM) =c nosem }
	      @VPAST. 

"adjectives"

small	A * @(PRED small). 

smart	A * @(PRED smart). 

grey	A * @(PRED grey). 

"adverbs"

quickly   ADV * @(PRED quickly). 

very   ADV * @(PRED very). 

"prepositions"


by 	  P * @(PREP by). 

to 	  P *  @(PREP to).

on 	  P * @(PREP on). 

in 	  P * @(PREP in). 

with 	  P * @(PREP with). 


"auxiliaries"

was 	  AUX * @(TENSE past)
		{ (^ SUBJ PERS) = 1
                | (^ SUBJ PERS) = 3
                }
                (^ SUBJ NUM) = sg. 

"pronouns (not complete)"

I 	  PRON * @(PRON I 1 sg pers) 
		 @(CASE nom).

You	PRON * {@(PRON you 2 sg pers)
	       |@(PRON you 2 pl pers)}.

you	PRON * {@(PRON you 2 sg pers)
	       |@(PRON you 2 pl pers)}.

He 	  PRON * @(PRON he 3 sg pers)
		 @(CASE nom).

he 	  PRON * @(PRON he 3 sg pers)
		 @(CASE nom).

She 	  PRON * @(PRON she 3 sg pers)
		 @(CASE nom).

she 	  PRON * @(PRON she 3 sg pers)
		 @(CASE nom).

it	  PRON * @(PRON it 3 sg pers). 

We 	  PRON * @(PRON we 1 pl pers)
		 @(CASE nom).

we 	  PRON * @(PRON we 1 pl pers)
		 @(CASE nom).

They 	  PRON * @(PRON they 3 pl pers) 
		 @(CASE nom). 

they 	  PRON * @(PRON they 3 pl pers)
		 @(CASE nom). 

My	PRON * @(PRON my 1 sg poss). 

my	PRON * @(PRON my 1 sg poss).

Her	PRON * @(PRON her 3 sg poss).

her	PRON * @(PRON her 3 sg poss).

Him 	  PRON * @(PRON he 3 sg pers)
		 @(CASE acc).

him 	  PRON * @(PRON he 3 sg pers)
		 @(CASE acc).


"determiners"

the  D *  (^DEF) = +.

The  D *  (^DEF) = +.


a  D *  (^ DEF) = -   "this indefinite only marks singulars" 
        (^ NUM) = sg.

"conjunctions"


and  CONJ * @(COORD-FORM %stem);
     CONJnp * @(COORD-FORM %stem) @(NUM pl).

"and 	  CONJ * (^ COORD-FORM) = and; 
	  CONJnp * (^ COORD-FORM) = and
		   (^ NUM) = pl. "

"punctuation, now with some functional information"


. PERIOD * (^ STMT-TYPE) = declarative. 

, COMMA  * . 

!  EXCL * (^ STMT-TYPE) = exclamation. 


----

MORPH   ENGLISH   RULES (1.0)

"sample rule"

"this deals with verbs.  
The sublexcial items are the POS assigned to the various tags in morph-lex.lfg" 

   V --> V-S_BASE "verb stem, e.g. run"
 	 V-POS_BASE "suffix saying that this is a verb: +Verb"
 	 { TNS_BASE "tense suffix, e.g. +Pres" 
 	   PERS_BASE "person suffix, e.g. +3sg"
	 | ASP_BASE}.   "aspectual information"

  
   N --> N-S_BASE "noun stem"
	 N-POS_BASE
	 N-NUM_BASE. 

----
MORPH   ENGLISH   LEXICON (1.0)

"this guesses words that are unknown to your lexicon
 to be either adjectives or nouns"
-unknown  ADJ-S XLE (^ PRED) = '%stem';
	  N-S XLE (^ PRED) = '%stem'.

"lexical entries for tags coming out of the morphological analyzer" 

+Verb	V-POS XLE .

+Pres   TNS XLE @VPRES.

+3sg	PERS XLE @S-AGR.

+PastBoth TNS XLE "past tense or past particle"
		 { @VPAST | @PASTP }. 

+123SP	PERS XLE .

+Non3sg PERS XLE @BARE-AGR.


+Prog	ASP XLE @VPROG.  

+Noun   N-POS XLE . 

+Pl   N-NUM XLE (^ NUM) = pl. 

+Sg  N-NUM XLE (^ NUM) = sg. 



----