314 val ms = map (get_measures D) (0 upto np - 1) |
314 val ms = map (get_measures D) (0 upto np - 1) |
315 val tys = map (get_types D) (0 upto np - 1) |
315 val tys = map (get_types D) (0 upto np - 1) |
316 fun index xs = (1 upto length xs) ~~ xs |
316 fun index xs = (1 upto length xs) ~~ xs |
317 fun outp s t f xs = map (fn (x, y) => s ^ Int.toString x ^ t ^ f y ^ "\n") xs |
317 fun outp s t f xs = map (fn (x, y) => s ^ Int.toString x ^ t ^ f y ^ "\n") xs |
318 val ims = index (map index ms) |
318 val ims = index (map index ms) |
319 val _ = Output.tracing (concat (outp "fn #" ":\n" (concat o outp "\tmeasure #" ": " (Syntax.string_of_term ctxt)) ims)) |
319 val _ = tracing (concat (outp "fn #" ":\n" (concat o outp "\tmeasure #" ": " (Syntax.string_of_term ctxt)) ims)) |
320 fun print_call (k, c) = |
320 fun print_call (k, c) = |
321 let |
321 let |
322 val (_, p, _, q, _, _) = dest_call D c |
322 val (_, p, _, q, _, _) = dest_call D c |
323 val _ = Output.tracing ("call table for call #" ^ Int.toString k ^ ": fn " ^ |
323 val _ = tracing ("call table for call #" ^ Int.toString k ^ ": fn " ^ |
324 Int.toString (p + 1) ^ " ~> fn " ^ Int.toString (q + 1)) |
324 Int.toString (p + 1) ^ " ~> fn " ^ Int.toString (q + 1)) |
325 val caller_ms = nth ms p |
325 val caller_ms = nth ms p |
326 val callee_ms = nth ms q |
326 val callee_ms = nth ms q |
327 val entries = map (fn x => map (pair x) (callee_ms)) (caller_ms) |
327 val entries = map (fn x => map (pair x) (callee_ms)) (caller_ms) |
328 fun print_ln (i : int, l) = concat (Int.toString i :: " " :: map (enclose " " " " o print_cell o (uncurry (get_descent D c))) l) |
328 fun print_ln (i : int, l) = concat (Int.toString i :: " " :: map (enclose " " " " o print_cell o (uncurry (get_descent D c))) l) |
329 val _ = Output.tracing (concat (Int.toString (p + 1) ^ "|" ^ Int.toString (q + 1) ^ |
329 val _ = tracing (concat (Int.toString (p + 1) ^ "|" ^ Int.toString (q + 1) ^ |
330 " " :: map (enclose " " " " o Int.toString) (1 upto length callee_ms)) ^ "\n" |
330 " " :: map (enclose " " " " o Int.toString) (1 upto length callee_ms)) ^ "\n" |
331 ^ cat_lines (map print_ln ((1 upto (length entries)) ~~ entries))) |
331 ^ cat_lines (map print_ln ((1 upto (length entries)) ~~ entries))) |
332 in |
332 in |
333 true |
333 true |
334 end |
334 end |
335 fun list_call (k, c) = |
335 fun list_call (k, c) = |
336 let |
336 let |
337 val (_, p, _, q, _, _) = dest_call D c |
337 val (_, p, _, q, _, _) = dest_call D c |
338 val _ = Output.tracing ("call #" ^ (Int.toString k) ^ ": fn " ^ |
338 val _ = tracing ("call #" ^ (Int.toString k) ^ ": fn " ^ |
339 Int.toString (p + 1) ^ " ~> fn " ^ Int.toString (q + 1) ^ "\n" ^ |
339 Int.toString (p + 1) ^ " ~> fn " ^ Int.toString (q + 1) ^ "\n" ^ |
340 (Syntax.string_of_term ctxt c)) |
340 (Syntax.string_of_term ctxt c)) |
341 in true end |
341 in true end |
342 val _ = forall list_call ((1 upto length cs) ~~ cs) |
342 val _ = forall list_call ((1 upto length cs) ~~ cs) |
343 val _ = forall print_call ((1 upto length cs) ~~ cs) |
343 val _ = forall print_call ((1 upto length cs) ~~ cs) |