hmx-sets.opp.exp 4.82 KB
Newer Older
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
File "hmx-sets.mly", line 69, characters 7-10:
Warning: the token TRY is unused.
File "hmx-sets.mly", line 72, characters 7-11:
Warning: the token WITH is unused.
%{

open Sets.Hm
open Sets.Primitives

let sequence e1 e2 =
  App(Lambda("-", e2), e1)

let sequence arg body =
  sequence (PrimApp(PrimEnsureUnit, [arg])) body

(* A pattern is either a variable or the unit constant. A wildcard pattern is viewed as a variable "-", which cannot
   be named inside expressions, because the lexer will not view it as an identifier. *)

type pattern =
  | PVariable of string
  | PUnit

let rec make_fun patterns expr =
  match patterns with
  | [] ->
      expr
  | (PVariable x) :: patterns ->
      Lambda (x, make_fun patterns expr)
  | PUnit :: patterns ->
      Lambda ("-", sequence (Var "-") (make_fun patterns expr))

let rec make_let (pattern, body) =
  match pattern with
  | PVariable x ->
      x, body
  | PUnit ->
      "-", PrimApp (PrimEnsureUnit, [body])

let rec make_set = function
  | [] ->
      PrimApp (PrimSetEmpty, [])
  | label :: rest ->
      PrimApp (PrimSetExtend label, [make_set rest])

%}
%start phrase
%token WITH
%token UNIT
%token UNDERSCORE
%token TRY
%token TILDE
%token SETMINUS
%token SEMISEMI
%token SEMI
%token RPAREN
%token RBRACE
%token QUESTION
%token PLUS
%token NORMAL
%token MATCH
%token LPAREN
%token LET
%token LBRACE
%token IN
%token <string> IDENT
%token FUN
%token EXC
%token EQUAL
%token DOT
%token CHOOSE
%token ARROW

%type <Sets.Hm.phrase> phrase
%%

phrase:
77 78 79 80
| _1 = expression _2 = SEMISEMI
    {                                                                ( "_", _1 )}
| _1 = LET _2 = pattern _3 = pattern_list _4 = EQUAL _5 = expression _6 = SEMISEMI
    {                                                                ( make_let (_2, make_fun _3 _5) )}
81 82

expression:
83 84 85 86 87 88 89
| _1 = expression2
    {                            ( _1 )}
| _1 = FUN _2 = pattern_list _3 = ARROW _4 = expression
    {                                         ( make_fun _2 _4 )}
| _1 = LET _2 = pattern _3 = pattern_list _4 = EQUAL _5 = expression _6 = IN _7 = expression
    {                                                                ( let name, body = make_let (_2, make_fun _3 _5) in
                                                                  Let (name, body, _7) )}
90 91

expression2:
92 93 94 95
| _1 = expression1
    {                      ( _1 )}
| _1 = expression1 _2 = SEMI _3 = expression
    {                                    ( sequence _1 _3 )}
96 97

expression1:
98 99 100 101 102 103
| _1 = expression0
    {                             ( _1 )}
| _1 = expression1 _2 = expression0
    {                                                ( App (_1, _2) )}
| _1 = CHOOSE _2 = expression0 _3 = expression0
    {                                                                ( PrimApp (PrimChoice, [_2;_3]) )}
104 105

expression0:
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
| _1 = IDENT
    {                        ( Var _1 )}
| _1 = UNIT
    {                      ( PrimApp (PrimUnit, []) )}
| _1 = NORMAL
    {                                                                ( PrimApp (PrimNormal, []) )}
| _1 = EXC
    {                                                                ( PrimApp (PrimExc, []) )}
| _1 = MATCH
    {                                                                ( PrimApp (PrimMatch, []) )}
| _1 = LPAREN _2 = expression _3 = RPAREN
    {                                              ( _2 )}
| _1 = LBRACE _2 = label_list _3 = RBRACE
    {                                               ( make_set _2 )}
| _1 = expression0 _2 = PLUS _3 = IDENT
    {                                                                ( PrimApp (PrimSetExtend _3, [_1]) )}
| _1 = expression0 _2 = DOT _3 = IDENT
    {                                             ( PrimApp (PrimSetMemberAssert _3, [_1]) )}
| _1 = expression0 _2 = SETMINUS _3 = IDENT
    {                                                                ( PrimApp (PrimSetRestrict _3, [_1]) )}
| _1 = expression0 _2 = QUESTION _3 = IDENT
    {                                                                ( PrimApp (PrimSetMemberTest _3, [_1]) )}
| _1 = expression0 _2 = TILDE _3 = IDENT
    {                                                                ( PrimApp (PrimSetModify _3, [_1]) )}
130 131 132

label_list:
| 
133 134 135 136 137
    {                              ( [] )}
| _1 = IDENT
    {                             ( [_1] )}
| _1 = IDENT _2 = SEMI _3 = label_list
    {                                                   ( _1 :: _3 )}
138 139 140

pattern_list:
| 
141 142 143
    {                              ( [] )}
| _1 = pattern _2 = pattern_list
    {                                                     ( _1 :: _2 )}
144 145

pattern:
146 147 148 149 150 151
| _1 = IDENT
    {                                                                ( PVariable _1 )}
| _1 = UNDERSCORE
    {                                                                ( PVariable "-" )}
| _1 = UNIT
    {                                                                ( PUnit )}
152 153 154 155 156

%%