summaryrefslogtreecommitdiff
path: root/next-lib/src/romance/VerbRomance.gf
blob: 96992bd358528981ee053a77324a0e9a404f16f1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
incomplete concrete VerbRomance of Verb = 
  CatRomance ** open Prelude, CommonRomance, ResRomance in {

  flags optimize=all_subs ;

  lin
    UseV = predV ;

    ComplVV v vp = 
      insertComplement (\\a => prepCase v.c2.c ++ infVP vp a) (predV v) ;
    ComplVS v s  = insertExtrapos (\\b => conjThat ++ s.s ! (v.m ! b)) (predV v) ;
    ComplVQ v q  = insertExtrapos (\\_ => q.s ! QIndir) (predV v) ;
    ComplVA v ap = 
      insertComplement (\\a => ap.s ! AF a.g a.n) (predV v) ;

    SlashV2a v = mkVPSlash v.c2 (predV v) ;

    Slash2V3 v np = mkVPSlash v.c3 (insertObject v.c2 np (predV v)) ;
    Slash3V3 v np = mkVPSlash v.c2 (insertObject v.c3 np (predV v)) ;

    SlashV2V v vp = 
      mkVPSlash v.c2
       (insertComplement 
         (\\a => prepCase v.c2.c ++ infVP vp a) 
         (predV v)) ; 

    SlashV2S v s = 
      mkVPSlash v.c2
       (insertExtrapos 
         (\\b => conjThat ++ s.s ! Indic) ---- mood
         (predV v)) ; 

    SlashV2Q v q = 
      mkVPSlash v.c2
       (insertExtrapos 
         (\\_ => q.s ! QIndir)
         (predV v)) ; 

    {- ---- lincat should be fixed
    SlashV2A v ap = 

      let af = case v.c3.isDir of {
        True => AF np.a.g np.a.n ;  -- ... bleues
        _ => AF Masc Sg             -- il les peint en bleu
        }
    -}

    SlashV2A v ap = 
      let af = AF Masc Sg
      in
      mkVPSlash v.c2
        (insertComplement 
          (\\_ => v.c3.s ++ prepCase v.c3.c ++ ap.s ! af)
          (predV v)) ;

    ComplSlash vp np = insertObject vp.c2 np vp ;

    ReflVP v = case v.c2.isDir of {
      True  => insertRefl v ;
      False => insertComplement 
                 (\\a => v.c2.s ++ reflPron a.n  a.p v.c2.c) v
      } ;

    SlashVV v vp = 
      mkVPSlash vp.c2
        (insertComplement (\\a => prepCase v.c2.c ++ infVP vp a) (predV v)) ;

    SlashV2VNP v np vp = 
      mkVPSlash vp.c2
       (insertComplement 
         (\\a => prepCase v.c2.c ++ infVP vp a) 
         (insertObject v.c2 np (predV v))) ; 

    UseComp comp = insertComplement comp.s (predV copula) ;

    CompAP ap = {s = \\ag => ap.s ! AF ag.g ag.n} ;
    CompNP np = {s = \\_  => np.s ! Ton Acc} ;
    CompAdv a = {s = \\_  => a.s} ;

    AdvVP vp adv = insertAdv adv.s vp ;
    AdVVP adv vp = insertAdV adv.s vp ;

    PassV2 v = insertComplement (\\a => v.s ! VPart a.g a.n) (predV auxPassive) ;

}

{---b
    ComplV2 v np1 = insertObject v.c2 np1 (predV v) ;
    ComplV3 v np1 np2 = insertObject v.c3 np2 (insertObject v.c2 np1 (predV v)) ;

    ComplV2V v np vp = 
      insertComplement (\\a => prepCase v.c2.c ++ infVP vp a) 
        (insertObject v.c2 np (predV v)) ;
    ComplV2S v np s = 
      insertExtrapos (\\b => s.s ! Indic) ---- mood
        (insertObject v.c2 np (predV v)) ;
    ComplV2Q v np q = 
      insertExtrapos (\\_ => q.s ! QIndir)
        (insertObject v.c2 np (predV v)) ;

    ComplV2A v np ap = 
      let af = case v.c3.isDir of {
        True => AF np.a.g np.a.n ;  -- ... bleues
        _ => AF Masc Sg             -- il les peint en bleu
        }
      in
      insertComplement 
        (\\a => v.c3.s ++ prepCase v.c3.c ++ ap.s ! af)
          (insertObject v.c2 np (predV v)) ;

    ReflV2 v = case v.c2.isDir of {
      True  => predV {s = v.s ; vtyp = vRefl} ;
      False => insertComplement 
                 (\\a => v.c2.s ++ reflPron a.n  a.p v.c2.c) (predV v)
      } ;

    UseVS, UseVQ = \vv -> {s = vv.s ; c2 = complAcc ; vtyp = vv.vtyp} ;
-}