aboutsummaryrefslogtreecommitdiffhomepage
path: root/theories/Init/SpecifSyntax.v
blob: e48ba77f62fa2350a2d84adda63db31c85e30c8a (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
120
121
122
123
124
125
126
127

(* $Id$ *)

Require Export LogicSyntax.
Require Export Specif.

(* Parsing of things in Specif.v *)

Grammar constr constr1 :=
  sig [ "{" lconstr($lc) ":" lconstr($c1) "|" lconstr($c2) "}" ]
       -> [ (sig $c1 [$lc : $c1]$c2) ]

| sig2 [ "{" lconstr($lc) ":" lconstr($c1)
           "|" lconstr($c2) "&" lconstr($c3) "}" ]
       -> [ (sig2 $c1 [$lc : $c1]$c2 [$lc : $c1]$c3) ]

| sigS [ "{" lconstr($lc) ":" lconstr($c1) "&" lconstr($c2) "}" ]
       -> [ (sigS $c1 [$lc : $c1]$c2) ]

| sigS2 [ "{" lconstr($lc) ":" lconstr($c1)
             "&" lconstr($c2) "&" lconstr($c3) "}" ]
       -> [ (sigS2 $c1 [$lc : $c1]$c2 [$lc : $c1]$c3) ].

Grammar constr constr1: ast :=
  squash [ "{" lconstr($lc) "}" ] -> [(SQUASH $lc)].

Grammar constr lassoc_constr4 :=
  squash_sum
  [ lassoc_constr4($c1) "+" lassoc_constr4($c2) ] ->
      case [$c2] of
        (SQUASH $T2) ->
            case [$c1] of
              (SQUASH $T1) -> [ (sumbool $T1 $T2) ] (* {T1}+{T2} *)
            | $_           -> [ (sumor $c1 $T2) ]   (* c1+{T2} *)
            esac
      | $_           -> [ (sum $c1 $c2) ]           (* c1+c2 *)
      esac.

(* Pretty-printing of things in Specif.v *)

Syntax constr
  (* Default pretty-printing rules *)
  level 10:
    sig_var
      [<<(ABSTR_B_NB $c1 $c2)>>] -> [ [<hov 0> "sig " $c1:L [1 1] $c2:L ] ]
  | sig2_var
      [<<(Sig2_ABSTR_B_NB $c1 $c2)>>] -> [ [<hov 0> "sig2 " $c1:L [1 1] $c2:L ] ]
  | sigS_var
      [<<(SigS_ABSTR_B_NB $c1 $c2)>>] -> [ [<hov 0> "sigS " $c1:L [1 1] $c2:L ] ]
  | sigS2_var [<<(SigS2_ABSTR_B_NB $c1 $c2 $c3)>>]
      -> [ [<hov 0> "sigS2 " $c1:L [1 1] $c2:L [1 1] $c3:L] ]
  ;

  level 1:
(* Pretty-printing of [sig] *)
    sig  [ (sig $c1 $c2) ] -> [ (ABSTR_B_NB  $c1 $c2):E ]
  | sig_nb [ << (ABSTR_B_NB $c1 (LAMBDALIST $c1 [<>]$c2)) >> ]
      -> [ [<hov 0> "{_:" $c1:E " |" [1 3] $c2:E "}" ] ]
  | sigma_b [ << (ABSTR_B_NB $c1 (LAMBDALIST $c1 [$id]$c2)) >> ]
      -> [ [<hov 0> "{" $id ":" $c1:E " |" [1 3] $c2:E "}" ] ]

(* Pretty-printing of [sig2] *)
  | sig2 [ (sig2 $c1 $c2 $c3) ] -> [ (Sig2_ABSTR_B_NB  $c1 $c2 $c3):E ]
  | sig2_b_b
      [ << (Sig2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [$id]$c2)
                            (LAMBDALIST $c1 [$id]$c3)) >> ]
       -> [ [<hov 0> "{"$id":"$c1:E"|" [1 3]$c2:E [1 3]"& "$c3:E "}" ] ]
  | sig2_nb_b
      [ << (Sig2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [<>]$c2)
                            (LAMBDALIST  $c1 [$id]$c3)) >> ]
       -> [ [<hov 0> "{"$id":"$c1:E"|" [1 3]$c2:E [1 3]"& "$c3:E "}" ] ]
  | sig2_b_nb
      [ << (Sig2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [$id]$c2)
                            (LAMBDALIST $c1 [<>]$c3)) >> ]
       -> [ [<hov 0> "{"$id":"$c1:E"|" [1 3]$c2:E [1 3]"& "$c3:E "}" ] ]
  | sig2_nb_nb
      [ << (Sig2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [<>]$c2)
                            (LAMBDALIST $c1 [<>]$c3)) >> ]
       -> [ [<hov 0> "{_:"$c1:E "|" [1 3] $c2:E [1 3]"& " $c3:E "}" ] ]

(* Pretty-printing of [sigS] *)
  | sigS [ (sigS $c1 $c2) ] -> [(SigS_ABSTR_B_NB  $c1 $c2):E]
  | sigS_nb [ << (SigS_ABSTR_B_NB $c1 (LAMBDALIST $c1 [<>]$c2)) >> ]
       -> [ [<hov 0> "{_:" $c1:E [1 3]"& " $c2:E  "}" ] ]
  | sigS_b [ << (SigS_ABSTR_B_NB $c1 (LAMBDALIST $c1 [$id]$c2)) >> ]
       -> [ [<hov 0> "{" $id  ":" $c1:E [1 3] "& " $c2:E "}" ] ]

(* Pretty-printing of [sigS2] *)
  | sigS2 [ (sigS2 $c1 $c2 $c3) ] -> [(SigS2_ABSTR_B_NB  $c1 $c2 $c3):E]
  | sigS2_b_b
      [ << (SigS2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [$id]$c2)
                             (LAMBDALIST $c1 [$id]$c3)) >> ]
       -> [ [<hov 0> "{"$id ":" $c1:E [1 3]"& "$c2:E [1 3]"& "$c3:E "}" ] ]
  | sigS2_nb_b
      [ << (SigS2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [<>]$c2)
                             (LAMBDALIST  $c1 [$id]$c3)) >> ]
       -> [ [<hov 0> "{"$id ":" $c1:E [1 3]"& "$c2:E [1 3]"& "$c3:E "}" ] ]
  | sigS2_b_nb
      [ << (SigS2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [$id]$c2)
                              (LAMBDALIST $c1 [<>]$c3)) >> ]
       -> [ [<hov 0> "{"$id ":" $c1:E [1 3]"& "$c2:E [1 3]"& "$c3:E "}" ] ]
  | sigS2_nb_nb
      [ << (SigS2_ABSTR_B_NB $c1 (LAMBDALIST $c1 [<>]$c2)
                             (LAMBDALIST $c1 [<>]$c3)) >> ]
       -> [ [<hov 0> "{_:"$c1:E [1 3]"& "$c2:E [1 3]"& "$c3:E "}" ] ]

(* Pretty-printing of [projS1] and [projS2] *)
  | projS1_imp [ (projS1 ? ? $a) ] -> ["(ProjS1 " $a:E ")"]  
  | projS2_imp [ (projS2 ? ? $a) ] -> ["(ProjS2 " $a:E ")"]
  ;

(* Pretty-printing of [sumbool] and [sumor] *)
  level 4:
    sumbool [ (sumbool $t1 $t2) ]
       -> [ [<hov 0> "{" $t1:E "}" [0 1] "+" "{" $t2:L "}"] ]
  | sumor [ (sumor $t1 $t2) ]
       -> [ [<hov 0> $t1:E [0 1]  "+" "{" $t2:L "}"] ]
  ;

(* Pretty-printing of [except] *)
  level 1:
    Except_imp [ (except $1 $t2) ] -> [ [<hov 0> "Except " $t2 ] ]

(* Pretty-printing of [error] and [value] *)
  | Error_imp [ (error $t1) ]     -> [ [<hov 0> "Error" ] ]
  | Value_imp [ (value $t1 $t2) ] -> [ [<hov 0> "(Value " $t2 ")" ] ].