mikros/rust
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Modified parser to handle alt type andadded a few tests

Browse Source 
ast.ml - modified arm types for easier polymorphism
       - fixed a bug in fmt_type_arm
dead.ml - modified arm types for easier polymorphism
common.ml - added 'either'
          - added some useful auxiliary functions
item.ml - modified arm code to be more polymorphic and handle both alt-tag and alt-type, also fixed the problematic case in bad-alt.rs
Makefile - added XFAIL for new alt-type test
bad-alt.rs - added test for invalid alt syntax
alt-type-simple.rs - added simple test for alt type
This commit is contained in:
Or Brostovski 2010-08-21 02:41:43 +03:00
parent 4467d7683d
commit 0830b5bf24
7 changed files with 166 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Makefile
View File

@ -362,6 +362,7 @@ self: $(CFG_COMPILER)
# of inter-task shutdown races introduced with notification proxies.
TASK_XFAILS := test/run-pass/acyclic-unwind.rs \
test/run-pass/alt-type-simple.rs \
test/run-pass/basic.rs \
test/run-pass/clone-with-exterior.rs \
test/run-pass/comm.rs \

9
src/boot/fe/ast.ml
View File

@ -322,7 +322,7 @@ and pat =
and tag_arm' = pat * block
and tag_arm = tag_arm' identified
and type_arm' = ident * slot * block
and type_arm' = (ident * slot) * block
and type_arm = type_arm' identified
and port_arm' = port_case * block
@ -1305,8 +1305,11 @@ and fmt_tag_arm (ff:Format.formatter) (tag_arm:tag_arm) : unit =
fmt_arm ff (fun ff -> fmt_pat ff pat) block;
and fmt_type_arm (ff:Format.formatter) (type_arm:type_arm) : unit =
let (_, slot, block) = type_arm.node in
fmt_arm ff (fun ff -> fmt_slot ff slot) block;
let ((ident, slot), block) = type_arm.node in
let fmt_type_arm_case (ff:Format.formatter) =
fmt_slot ff slot; fmt ff " "; fmt_ident ff ident
in
fmt_arm ff fmt_type_arm_case block;
and fmt_port_arm (ff:Format.formatter) (port_arm:port_arm) : unit =
let (port_case, block) = port_arm.node in

172
src/boot/fe/item.ml
View File

@ -225,69 +225,117 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
| ALT ->
bump ps;
begin
let rec parse_pat ps =
match peek ps with
TYPE -> [| |]
| LPAREN ->
let (stmts, lval) = bracketed LPAREN RPAREN parse_lval ps in
let rec parse_pat ps =
match peek ps with
IDENT _ ->
let apos = lexpos ps in
let name = Pexp.parse_name ps in
let bpos = lexpos ps in
if peek ps != LPAREN then
begin
match name with
Ast.NAME_base (Ast.BASE_ident ident) ->
let slot =
{ Ast.slot_mode = Ast.MODE_local;
Ast.slot_ty = None }
in
Ast.PAT_slot
((span ps apos bpos slot), ident)
|_ -> raise (unexpected ps)
end
else
let lv = name_to_lval apos bpos name in
Ast.PAT_tag (lv, paren_comma_list parse_pat ps)
| LIT_INT _
| LIT_UINT _
| LIT_CHAR _
| LIT_BOOL _ ->
Ast.PAT_lit (Pexp.parse_lit ps)
| UNDERSCORE -> bump ps; Ast.PAT_wild
| tok -> raise (Parse_err (ps,
"Expected pattern but found '" ^
(string_of_tok tok) ^ "'"))
in
let rec parse_arms ps =
match peek ps with
CASE ->
bump ps;
let pat = bracketed LPAREN RPAREN parse_pat ps in
let block = parse_block ps in
let arm = (pat, block) in
(span ps apos (lexpos ps) arm)::(parse_arms ps)
| _ -> []
in
let parse_alt_block ps =
let arms = ctxt "alt tag arms" parse_arms ps in
spans ps stmts apos begin
Ast.STMT_alt_tag {
Ast.alt_tag_lval = lval;
Ast.alt_tag_arms = Array.of_list arms
}
end
in
bracketed LBRACE RBRACE parse_alt_block ps
| _ -> [| |]
end
IDENT _ ->
let apos = lexpos ps in
let name = Pexp.parse_name ps in
let bpos = lexpos ps in
if peek ps != LPAREN then
begin
match name with
Ast.NAME_base (Ast.BASE_ident ident) ->
let slot =
{ Ast.slot_mode = Ast.MODE_local;
Ast.slot_ty = None }
in
Left
(Ast.PAT_slot ((span ps apos bpos slot),
ident))
|_ -> raise (unexpected ps)
end
else
let lv = name_to_lval apos bpos name in
let parse_pat ps = either_get_left (parse_pat ps) in
Left
(Ast.PAT_tag (lv, paren_comma_list parse_pat ps))
| LIT_INT _
| LIT_UINT _
| LIT_CHAR _
| LIT_BOOL _ ->
Left (Ast.PAT_lit (Pexp.parse_lit ps))
| UNDERSCORE -> bump ps; Left (Ast.PAT_wild)
| tok -> raise (Parse_err (ps,
"Expected pattern but found '" ^
(string_of_tok tok) ^ "'"))
in
let rec parse_arms ps parse_case =
match peek ps with
CASE ->
bump ps;
let case = parse_case ps in
let blk = parse_block ps in
let combine_and_span case =
(span ps apos (lexpos ps) (case, blk)) in
let is_default = either_has_right case in
if is_default then
let arm = combine_and_span (either_get_right case) in
([], Some arm)
else
let rec_result = parse_arms ps parse_case in
let arm = combine_and_span (either_get_left case) in
(arm::(fst rec_result), (snd rec_result))
| _ -> ([], None)
in
let parse_alt_block ps str parse_case make_stmt =
let br_parse_case = bracketed LPAREN RPAREN parse_case in
let arms = (ctxt (String.concat " " ["alt"; str; "arms"])
(fun ps -> parse_arms ps br_parse_case) ps) in
make_stmt (fst arms) (snd arms)
in
let which_alt = match peek ps with
TYPE -> "type" | LPAREN -> "tag" | _ -> raise (unexpected ps)
in
let (stmts, lval) = if which_alt = "type" then bump ps;
bracketed LPAREN RPAREN parse_lval ps
in
let make_alt_tag_stmt val_arms dflt_arm =
assert (not (bool_of_option dflt_arm));
spans ps stmts apos begin
Ast.STMT_alt_tag {
Ast.alt_tag_lval = lval;
Ast.alt_tag_arms = Array.of_list val_arms;
}
end
in
let make_alt_type_stmt val_arms dflt_arm =
spans ps stmts apos begin
Ast.STMT_alt_type {
Ast.alt_type_lval = lval;
Ast.alt_type_arms = Array.of_list val_arms;
Ast.alt_type_else = option_map (fun x -> snd x.node) dflt_arm;
}
end
in
let parse_slot_and_ident ps =
match peek ps with
UNDERSCORE -> Right ()
| _ -> Left (pair_rev (Pexp.parse_slot_and_ident false ps))
in
let parse_alt_tag_block ps =
parse_alt_block ps
"tag"
parse_pat
make_alt_tag_stmt
in
let parse_alt_type_block ps =
parse_alt_block ps
"type"
parse_slot_and_ident
make_alt_type_stmt
in
let parse_alt_block2 ps =
match which_alt with
"type" -> parse_alt_type_block ps
| "tag" -> parse_alt_tag_block ps
| _ -> assert false
in
bracketed LBRACE RBRACE parse_alt_block2 ps
| IF ->
let final_else = ref None in
let rec parse_stmt_if _ =

2
src/boot/me/dead.ml
View File

@ -70,7 +70,7 @@ let dead_code_visitor
| Ast.STMT_alt_type { Ast.alt_type_arms = arms;
Ast.alt_type_else = alt_type_else } ->
let arm_ids = Array.map (fun { node = (_, _, block) } ->
let arm_ids = Array.map (fun { node = ((_, _), block) } ->
block.id) arms in
let else_ids =
begin

31
src/boot/util/common.ml
View File

@ -3,6 +3,8 @@
* types shared across all phases of the compiler.
*)
type ('a, 'b) either = Left of 'a | Right of 'b
type filename = string
type pos = (filename * int * int)
type span = {lo: pos; hi: pos}
@ -343,6 +345,11 @@ let rec list_drop n ls =
;;
(*
* Auxiliary pair functions.
*)
let pair_rev (x,y) = (y,x)
(*
* Auxiliary option functions.
*)
@ -357,11 +364,35 @@ let may f x =
Some x' -> f x'
| None -> ()
let option_map f x =
match x with
Some x' -> Some (f x')
| None -> None
let option_get x =
match x with
Some x -> x
| None -> raise Not_found
(*
* Auxiliary either functions.
*)
let either_has_left x =
match x with
Left _ -> true
| Right _ -> false
let either_has_right x = not (either_has_left x)
let either_get_left x =
match x with
Left x -> x
| Right _ -> raise Not_found
let either_get_right x =
match x with
Right x -> x
| Left _ -> raise Not_found
(*
* Auxiliary stack functions.
*)

6
src/test/compile-fail/bad-alt.rs Normal file
View File

@ -0,0 +1,6 @@
// error-pattern: Unexpected token 'x'
fn main() {
let int x = 5;
alt x;
}

11
src/test/run-pass/alt-type-simple.rs Normal file
View File

@ -0,0 +1,11 @@
fn altsimple(any x) {
alt type (f) {
case (int i) { print("int"); }
case (str s) { print("str"); }
}
}
fn main() {
altsimple(5);
altsimple("asdfasdfsDF");
}