diff options
| -rw-r--r-- | src/Makefile | 2 | ||||
| -rw-r--r-- | src/boot/me/type.ml | 74 | ||||
| -rw-r--r-- | src/test/compile-fail/infinite-tag-type-recursion.rs | 7 |
3 files changed, 78 insertions, 5 deletions
diff --git a/src/Makefile b/src/Makefile index ba5215ba..631798c7 100644 --- a/src/Makefile +++ b/src/Makefile @@ -419,7 +419,6 @@ TEST_XFAILS_X86 := $(TASK_XFAILS) \ test/run-fail/task-comm-14.rs \ test/compile-fail/bad-recv.rs \ test/compile-fail/bad-send.rs \ - test/compile-fail/infinite-tag-type-recursion.rs \ test/compile-fail/infinite-vec-type-recursion.rs \ test/compile-fail/writing-through-read-alias.rs @@ -591,7 +590,6 @@ TEST_XFAILS_LLVM := $(TASK_XFAILS) \ $(addprefix test/compile-fail/, \ bad-recv.rs \ bad-send.rs \ - infinite-tag-type-recursion.rs \ infinite-vec-type-recursion.rs \ rec-missing-fields.rs \ writing-through-read-alias.rs \ diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index a685b276..2b613cba 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -1024,6 +1024,75 @@ let populate_tag_graph_node (cx:Semant.ctxt) (id:Common.opaque_id) (n:int) = in Array.iter add_ty ty_tup +let stack_contains (stack:'a Stack.t) (elem:'a) : bool = + try + Stack.iter (fun elem' -> if elem = elem' then raise Exit) stack; false + with Exit -> true + +let report_infinitely_sized_tag + (id:Common.opaque_id) + (stack:Common.opaque_id Stack.t) + : unit = + let string_of_tag_id tag_id = + let ty = Ast.TY_tag { Ast.tag_id = tag_id; Ast.tag_args = [| |] } in + Ast.sprintf_ty () ty + in + let msg = Buffer.create 0 in + Buffer.add_string msg "found tag of infinite size: "; + while not (Stack.is_empty stack) do + Buffer.add_string msg (string_of_tag_id (Stack.pop stack)); + Buffer.add_string msg " <- " + done; + Buffer.add_string msg (string_of_tag_id id); + Buffer.add_string msg "; use '@' for recursive references"; + Common.err None "%s" (Buffer.contents msg) + +let check_for_tag_cycles (cx:Semant.ctxt) = + (* Find cycles in tags using Tarjan's strongly connected components + * algorithm. *) + let lowlinks = Hashtbl.create 0 in + let next_index, stack = ref 0, Stack.create () in + + let rec check_node id node = + if node.Semant.tgn_index = None then begin + let index = !next_index in + incr next_index; + node.Semant.tgn_index <- Some index; + + Stack.push id stack; + + Hashtbl.add lowlinks id max_int; + + let check_outgoing_edge id' = + let node' = Hashtbl.find cx.Semant.ctxt_tag_containment id' in + if node'.Semant.tgn_index = None then begin + check_node id' node'; + let lowlink = Hashtbl.find lowlinks id in + let lowlink' = Hashtbl.find lowlinks id' in + Hashtbl.replace lowlinks id (min lowlink lowlink') + end else if stack_contains stack id' then + let lowlink = Hashtbl.find lowlinks id in + let index' = + match node'.Semant.tgn_index with + Some index' -> index' + | None -> + Common.bug + () + "check_for_tag_cycles: node in stack without index" + in + Hashtbl.replace lowlinks id (min lowlink index') + in + + Queue.iter check_outgoing_edge node.Semant.tgn_children; + + if index == Hashtbl.find lowlinks id then + report_infinitely_sized_tag id stack; + + ignore (Stack.pop stack) + end + in + Hashtbl.iter check_node cx.Semant.ctxt_tag_containment + let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit = let path = Stack.create () in let fn_ctx_stack = Stack.create () in @@ -1139,7 +1208,10 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit = if not (Hashtbl.mem cx.Semant.ctxt_auto_deref_lval lval_id) then Hashtbl.add cx.Semant.ctxt_auto_deref_lval lval_id false in - Hashtbl.iter fill cx.Semant.ctxt_all_lvals + Hashtbl.iter fill cx.Semant.ctxt_all_lvals; + + (* Check for tag cycles. *) + check_for_tag_cycles cx in { diff --git a/src/test/compile-fail/infinite-tag-type-recursion.rs b/src/test/compile-fail/infinite-tag-type-recursion.rs index 19aea090..a3d5d62d 100644 --- a/src/test/compile-fail/infinite-tag-type-recursion.rs +++ b/src/test/compile-fail/infinite-tag-type-recursion.rs @@ -1,8 +1,11 @@ // -*- rust -*- -// error-pattern: Infinite type recursion +// error-pattern: tag of infinite size -type mlist = tag(cons(int,mlist), nil()); +tag mlist { + cons(int, mlist); + nil(); +} fn main() { auto a = cons(10, cons(11, nil())); |