src/HOL/Tools/Function/scnp_reconstruct.ML
changeset 32950 5d5e123443b3
parent 32149 ef59550a55d3
child 32952 aeb1e44fbc19
equal deleted inserted replaced
32949:aa6c470a962a 32950:5d5e123443b3
    37 
    37 
    38 structure ScnpReconstruct : SCNP_RECONSTRUCT =
    38 structure ScnpReconstruct : SCNP_RECONSTRUCT =
    39 struct
    39 struct
    40 
    40 
    41 val PROFILE = FundefCommon.PROFILE
    41 val PROFILE = FundefCommon.PROFILE
    42 fun TRACE x = if ! FundefCommon.profile then Output.tracing x else ()
    42 fun TRACE x = if ! FundefCommon.profile then tracing x else ()
    43 
    43 
    44 open ScnpSolve
    44 open ScnpSolve
    45 
    45 
    46 val natT = HOLogic.natT
    46 val natT = HOLogic.natT
    47 val nat_pairT = HOLogic.mk_prodT (natT, natT)
    47 val nat_pairT = HOLogic.mk_prodT (natT, natT)
   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)