annotate ppc/parser.mly @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
mike@0 1 /* ppc/parser.mly */
mike@0 2 /* Copyright (c) 2017 J. M. Spivey */
mike@0 3
mike@0 4 %{
mike@0 5 open Keiko
mike@0 6 open Dict
mike@0 7 open Tree
mike@0 8 %}
mike@0 9
mike@0 10 %token <Dict.ident> IDENT
mike@0 11 %token <Keiko.op> MULOP ADDOP RELOP
mike@0 12 %token <int> NUMBER
mike@0 13 %token <char> CHAR
mike@0 14 %token <Keiko.symbol * int> STRING
mike@0 15
mike@0 16 /* punctuation */
mike@0 17 %token SEMI DOT COLON LPAR RPAR COMMA SUB BUS
mike@0 18 %token EQUAL MINUS ASSIGN VBAR ARROW
mike@0 19 %token BADTOK IMPOSSIBLE
mike@0 20
mike@0 21 /* keywords */
mike@0 22 %token ARRAY BEGIN CONST DO ELSE END IF OF
mike@0 23 %token PROC RECORD RETURN THEN TO TYPE
mike@0 24 %token VAR WHILE NOT POINTER NIL
mike@0 25 %token REPEAT UNTIL FOR ELSIF CASE
mike@0 26
mike@0 27 /* operator priorities */
mike@0 28 %left RELOP EQUAL
mike@0 29 %left ADDOP MINUS
mike@0 30 %left MULOP
mike@0 31 %nonassoc NOT UMINUS
mike@0 32
mike@0 33 %type <Tree.program> program
mike@0 34 %start program
mike@0 35
mike@0 36 %{
mike@0 37 let const n t = makeExpr (Constant (n, t))
mike@0 38 %}
mike@0 39
mike@0 40 %%
mike@0 41
mike@0 42 program :
mike@0 43 block DOT { Prog ($1, ref []) } ;
mike@0 44
mike@0 45 block :
mike@0 46 decl_list BEGIN stmts END { makeBlock ($1, $3) } ;
mike@0 47
mike@0 48 decl_list :
mike@0 49 /* empty */ { [] }
mike@0 50 | decl decl_list { $1 @ $2 } ;
mike@0 51
mike@0 52 decl :
mike@0 53 CONST const_decls { $2 }
mike@0 54 | VAR var_decls { $2 }
mike@0 55 | proc_decl { [$1] }
mike@0 56 | TYPE type_decls { [TypeDecl $2] } ;
mike@0 57
mike@0 58 const_decls :
mike@0 59 const_decl { [$1] }
mike@0 60 | const_decl const_decls { $1 :: $2 } ;
mike@0 61
mike@0 62 const_decl :
mike@0 63 IDENT EQUAL expr SEMI { ConstDecl ($1, $3) } ;
mike@0 64
mike@0 65 type_decls :
mike@0 66 type_decl { [$1] }
mike@0 67 | type_decl type_decls { $1 :: $2 } ;
mike@0 68
mike@0 69 type_decl :
mike@0 70 IDENT EQUAL typexpr SEMI { ($1, $3) } ;
mike@0 71
mike@0 72 var_decls :
mike@0 73 var_decl { [$1] }
mike@0 74 | var_decl var_decls { $1 :: $2 } ;
mike@0 75
mike@0 76 var_decl :
mike@0 77 ident_list COLON typexpr SEMI { VarDecl (VarDef, $1, $3) } ;
mike@0 78
mike@0 79 proc_decl :
mike@0 80 proc_heading SEMI block SEMI { ProcDecl ($1, $3) } ;
mike@0 81
mike@0 82 proc_heading :
mike@0 83 PROC name params return_type { Heading ($2, $3, $4) } ;
mike@0 84
mike@0 85 params :
mike@0 86 LPAR RPAR { [] }
mike@0 87 | LPAR formal_decls RPAR { $2 } ;
mike@0 88
mike@0 89 formal_decls :
mike@0 90 formal_decl { [$1] }
mike@0 91 | formal_decl SEMI formal_decls { $1 :: $3 } ;
mike@0 92
mike@0 93 formal_decl :
mike@0 94 ident_list COLON typexpr { VarDecl (CParamDef, $1, $3) }
mike@0 95 | VAR ident_list COLON typexpr { VarDecl (VParamDef, $2, $4) }
mike@0 96 | proc_heading { PParamDecl $1 } ;
mike@0 97
mike@0 98 return_type :
mike@0 99 /* empty */ { None }
mike@0 100 | COLON typexpr { Some $2 } ;
mike@0 101
mike@0 102 stmts :
mike@0 103 stmt_list { match $1 with [x] -> x
mike@0 104 | xs -> makeStmt (Seq $1, 0) } ;
mike@0 105
mike@0 106 stmt_list :
mike@0 107 stmt { [$1] }
mike@0 108 | stmt SEMI stmt_list { $1 :: $3 } ;
mike@0 109
mike@0 110 stmt :
mike@0 111 line stmt1 { makeStmt ($2, $1) }
mike@0 112 | /* A trick to force the right line number */
mike@0 113 IMPOSSIBLE { failwith "impossible" } ;
mike@0 114
mike@0 115 line :
mike@0 116 /* empty */ { !Lexer.lineno } ;
mike@0 117
mike@0 118 stmt1 :
mike@0 119 /* empty */ { Skip }
mike@0 120 | variable ASSIGN expr { Assign ($1, $3) }
mike@0 121 | name actuals { ProcCall ($1, $2) }
mike@0 122 | RETURN expr_opt { Return $2 }
mike@0 123 | IF expr THEN stmts elses END { IfStmt ($2, $4, $5) }
mike@0 124 | WHILE expr DO stmts END { WhileStmt ($2, $4) }
mike@0 125 | REPEAT stmts UNTIL expr { RepeatStmt ($2, $4) }
mike@0 126 | FOR name ASSIGN expr TO expr DO stmts END
mike@0 127 { let v = makeExpr (Variable $2) in
mike@0 128 ForStmt (v, $4, $6, $8) }
mike@0 129 | CASE expr OF arms else_part END { CaseStmt ($2, $4, $5) } ;
mike@0 130
mike@0 131 elses :
mike@0 132 /* empty */ { makeStmt (Skip, 0) }
mike@0 133 | ELSE stmts { $2 }
mike@0 134 | ELSIF line expr THEN stmts elses { makeStmt (IfStmt ($3, $5, $6), $2) } ;
mike@0 135
mike@0 136 arms :
mike@0 137 arm { [$1] }
mike@0 138 | arm VBAR arms { $1 :: $3 } ;
mike@0 139
mike@0 140 arm :
mike@0 141 expr COLON stmts { ($1, $3) };
mike@0 142
mike@0 143 else_part :
mike@0 144 /* empty */ { makeStmt (Skip, 0) }
mike@0 145 | ELSE stmts { $2 } ;
mike@0 146
mike@0 147 ident_list :
mike@0 148 IDENT { [$1] }
mike@0 149 | IDENT COMMA ident_list { $1 :: $3 } ;
mike@0 150
mike@0 151 expr_opt :
mike@0 152 /* empty */ { None }
mike@0 153 | expr { Some $1 } ;
mike@0 154
mike@0 155 expr :
mike@0 156 variable { $1 }
mike@0 157 | NUMBER { const $1 integer }
mike@0 158 | STRING { let (lab, len) = $1 in
mike@0 159 makeExpr (String (lab, len)) }
mike@0 160 | CHAR { const (int_of_char $1) character }
mike@0 161 | NIL { makeExpr Nil }
mike@0 162 | name actuals { makeExpr (FuncCall ($1, $2)) }
mike@0 163 | NOT expr { makeExpr (Monop (Not, $2)) }
mike@0 164 | MINUS expr %prec UMINUS { makeExpr (Monop (Uminus, $2)) }
mike@0 165 | expr MULOP expr { makeExpr (Binop ($2, $1, $3)) }
mike@0 166 | expr ADDOP expr { makeExpr (Binop ($2, $1, $3)) }
mike@0 167 | expr MINUS expr { makeExpr (Binop (Minus, $1, $3)) }
mike@0 168 | expr RELOP expr { makeExpr (Binop ($2, $1, $3)) }
mike@0 169 | expr EQUAL expr { makeExpr (Binop (Eq, $1, $3)) }
mike@0 170 | LPAR expr RPAR { $2 } ;
mike@0 171
mike@0 172 actuals :
mike@0 173 LPAR RPAR { [] }
mike@0 174 | LPAR expr_list RPAR { $2 } ;
mike@0 175
mike@0 176 expr_list :
mike@0 177 expr { [$1] }
mike@0 178 | expr COMMA expr_list { $1 :: $3 } ;
mike@0 179
mike@0 180 variable :
mike@0 181 name { makeExpr (Variable $1) }
mike@0 182 | variable SUB expr BUS { makeExpr (Sub ($1, $3)) }
mike@0 183 | variable DOT name { makeExpr (Select ($1, $3)) }
mike@0 184 | variable ARROW { makeExpr (Deref $1) } ;
mike@0 185
mike@0 186 typexpr :
mike@0 187 name { TypeName $1 }
mike@0 188 | ARRAY expr OF typexpr { Array ($2, $4) }
mike@0 189 | RECORD fields END { Record $2 }
mike@0 190 | POINTER TO typexpr { Pointer $3 } ;
mike@0 191
mike@0 192 fields :
mike@0 193 field_decl opt_semi { [$1] }
mike@0 194 | field_decl SEMI fields { $1 :: $3 } ;
mike@0 195
mike@0 196 field_decl :
mike@0 197 ident_list COLON typexpr { VarDecl (FieldDef, $1, $3) } ;
mike@0 198
mike@0 199 opt_semi :
mike@0 200 SEMI { () }
mike@0 201 | /* empty */ { () } ;
mike@0 202
mike@0 203 name :
mike@0 204 IDENT { makeName ($1, !Lexer.lineno) } ;