Permalink
Browse files

Start adding records.

  • Loading branch information...
xlq committed Sep 16, 2012
1 parent 7d7768f commit 09feca0f2c5af9da443ffe331e06023e85c3ea24
Showing with 76 additions and 3 deletions.
  1. +5 −0 lexer.mll
  2. +15 −0 parse_tree.mli
  3. +41 −3 parser.mly
  4. +1 −0 symbols.ml
  5. +1 −0 symbols.mli
  6. +13 −0 translation.ml
View
@@ -30,6 +30,10 @@ let keywords = create_hashtable 10 [
"False", FALSE;
"in", IN;
"out", OUT;
"case", CASE;
"when", WHEN;
"others", OTHERS;
"record", RECORD;
"Inspect_Type", INSPECT_TYPE;
"Static_Assert", STATIC_ASSERT;
]
@@ -60,6 +64,7 @@ rule scan = parse
| ';' { SEMICOLON }
| '.' { DOT }
| ',' { COMMA }
| '|' { MID }
| ":=" { ASSIGN }
| ".." { DOTDOT }
| "=>" { RARROW }
View
@@ -43,6 +43,21 @@ and package =
and declaration =
| Subprogram of subprogram
| Type_decl of loc * string * type_decl
and type_decl =
| Record_type_decl of record_field list
and record_field =
| Record_constraint of expr
| Record_field of loc * string * ttype
| Variant_record of loc * expr * (discrete_choice list * record_field list) list
and discrete_choice =
| Expr_choice of expr
| Range_choice of expr * expr
| Subtype_choice of ttype
| Others_choice
and ttype =
| Named_type of loc * dotted_name
View
@@ -24,13 +24,13 @@ let check_end (pos1, name1) (pos2, name2) =
/* Keywords */
%token PACKAGE PROCEDURE NULL END AND OR VAR IS IF THEN ELSE ELSIF
%token WHILE LOOP TYPE RANGE GIVEN TRUE FALSE
%token INSPECT_TYPE STATIC_ASSERT IN OUT
%token WHILE LOOP TYPE RANGE GIVEN TRUE FALSE CASE WHEN OTHERS
%token INSPECT_TYPE STATIC_ASSERT IN OUT RECORD
/* Punctuation */
%token COLON SEMICOLON DOT DOTDOT COMMA ASSIGN RARROW
%token LPAREN RPAREN LBRACKET RBRACKET LBRACE RBRACE
%token EQ NE LT LE GT GE
%token EQ NE LT LE GT GE MID
/* Other */
%token EOF
@@ -72,6 +72,7 @@ declarations:
declaration:
| subprogram { Subprogram $1 }
| TYPE IDENT IS type_decl SEMICOLON { Type_decl(rhs_start_pos 4, $2, $4) }
subprogram:
| PROCEDURE dotted_name opt_parameters IS
@@ -143,6 +144,43 @@ konstraint:
}
}
type_decl:
| NULL RECORD { Record_type_decl([]) }
| RECORD record_fields END RECORD { Record_type_decl($2) }
record_fields:
| NULL SEMICOLON { [] }
| ne_record_fields { $1 }
ne_record_fields:
| record_field { [$1] }
| record_field ne_record_fields { $1::$2 }
record_field:
| expr SEMICOLON
{ Record_constraint($1) }
| IDENT COLON ttype SEMICOLON
{ Record_field(pos(), $1, $3) }
| CASE expr IS variant_cases END CASE SEMICOLON
{ Variant_record(pos(), $2, $4) }
variant_cases:
| variant_case { [$1] }
| variant_case variant_cases { $1::$2 }
variant_case:
| WHEN discrete_choices RARROW record_fields { ($2, $4) }
discrete_choices:
| discrete_choice { [$1] }
| discrete_choice MID discrete_choices { $1::$3 }
discrete_choice:
| expr { Expr_choice($1) }
| expr DOTDOT expr { Range_choice($1,$3) }
| IN ttype { Subtype_choice($2) }
| OTHERS { Others_choice }
ne_statements:
| NULL SEMICOLON
{ Null_statement(pos ()) }
View
@@ -55,6 +55,7 @@ and symbol_info =
| Subprogram_sym of subprogram_info
| Variable_sym
| Parameter_sym of param_mode * ttype
| Record_sym
and subprogram_info = {
mutable sub_parameters : symbol list;
View
@@ -74,6 +74,7 @@ and symbol_info =
| Subprogram_sym of subprogram_info
| Variable_sym
| Parameter_sym of param_mode * ttype
| Record_sym
and subprogram_info = {
mutable sub_parameters : symbol list;
View
@@ -403,12 +403,25 @@ let translate_subprogram_body compiler state subprogram_sym sub =
Backend_c.translate compiler subprogram_sym entry_point state.st_blocks;
state.st_blocks <- []
let translate_type_declaration state scope loc name decl =
begin match find scope name with
| [] -> ()
| sym::_ ->
already_declared_error sym loc;
raise Bail_out
end;
let type_sym = new_symbol scope name (Some loc) Record_sym in
(* TODO *)
()
let translate_declarations state scope declarations =
List.iter (fun declaration ->
try
match declaration with
| Parse_tree.Subprogram(sub) ->
translate_subprogram_prototype state scope sub
| Parse_tree.Type_decl(loc, name, decl) ->
translate_type_declaration state scope loc name decl
with Bail_out -> ()
) declarations

0 comments on commit 09feca0

Please sign in to comment.