abstract code to common function
authorWalther Neuper <wneuper@ist.tugraz.at>
Wed, 31 Jul 2019 09:46:50 +0200
changeset 59576b311a0634eca
parent 59575 beb3e6dd497d
child 59577 60d191402598
abstract code to common function
src/Tools/isac/Interpret/script.sml
src/Tools/isac/ProgLang/scrtools.sml
     1.1 --- a/src/Tools/isac/Interpret/script.sml	Fri Jul 26 16:34:41 2019 +0200
     1.2 +++ b/src/Tools/isac/Interpret/script.sml	Wed Jul 31 09:46:50 2019 +0200
     1.3 @@ -209,13 +209,10 @@
     1.4    | stac2tac_ _ _ (Const("Script.Or'_to'_List", _) $ _ ) = (Tactic.Or_to_List, Tactic.Empty_Tac_)
     1.5  
     1.6      (*compare "| associate _ (Subproblem'" ..TODO: extract common code *)
     1.7 -  | stac2tac_ pt _ (stac as Const ("Script.SubProblem", _) $
     1.8 -     (Const ("Product_Type.Pair", _) $ dI' $ (Const ("Product_Type.Pair", _) $ pI' $ mI')) $ ags') =
     1.9 +  | stac2tac_ pt _ (stac as Const ("Script.SubProblem", _) $ spec' $ ags') =
    1.10      let
    1.11 -      val dI = HOLogic.dest_string dI';
    1.12 +      val (dI, pI, mI) = LTool.dest_spec spec'
    1.13        val thy = Stool.common_subthy (Celem.assoc_thy dI, rootthy pt);
    1.14 -	    val pI = pI' |> HOLogic.dest_list |> map HOLogic.dest_string;
    1.15 -	    val mI = mI' |> HOLogic.dest_list |> map HOLogic.dest_string;
    1.16  	    val ags = TermC.isalist2list ags';
    1.17  	    val (pI, pors, mI) = 
    1.18  	      if mI = ["no_met"] 
    1.19 @@ -373,13 +370,10 @@
    1.20  
    1.21      (*compare "| stac2tac_ thy (Const ("Script.SubProblem",_)" ..TODO: extract common code *)
    1.22    | associate pt _ (Tactic.Subproblem' ((domID, pblID, _), _, _, _, _, _))
    1.23 -      (stac as Const ("Script.SubProblem", _) $ (Const ("Product_Type.Pair", _) $ 
    1.24 -        dI' $ (Const ("Product_Type.Pair", _) $ pI' $ mI')) $ ags') =
    1.25 +      (stac as Const ("Script.SubProblem", _) $ spec' $ ags') =
    1.26      let
    1.27 -      val dI = HOLogic.dest_string dI';
    1.28 +      val (dI, pI, mI) = LTool.dest_spec spec'
    1.29        val thy = Stool.common_subthy (Celem.assoc_thy dI, rootthy pt);
    1.30 -	    val pI = pI' |> HOLogic.dest_list |> map HOLogic.dest_string;
    1.31 -	    val mI = mI' |> HOLogic.dest_list |> map HOLogic.dest_string;
    1.32  	    val ags = TermC.isalist2list ags';
    1.33  	    val (pI, pors, mI) = 
    1.34  	      if mI = ["no_met"]
     2.1 --- a/src/Tools/isac/ProgLang/scrtools.sml	Fri Jul 26 16:34:41 2019 +0200
     2.2 +++ b/src/Tools/isac/ProgLang/scrtools.sml	Wed Jul 31 09:46:50 2019 +0200
     2.3 @@ -26,8 +26,9 @@
     2.4      val get_calcs: theory -> term -> (Rule.prog_calcID * (Rule.calID * Rule.eval_fn)) list
     2.5      val prep_rls: theory -> Rule.rls -> Rule.rls
     2.6      val prep_program : thm -> term
     2.7 -  val formal_args : term -> term list
     2.8 -  val body_of : term -> term
     2.9 +    val formal_args : term -> term list
    2.10 +    val body_of : term -> term
    2.11 +    val dest_spec : term -> Celem.spec
    2.12  (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
    2.13    (* NONE *)
    2.14  (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
    2.15 @@ -39,10 +40,14 @@
    2.16  ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
    2.17    end
    2.18  
    2.19 -(**)
    2.20  structure LTool(**): LANGUAGE_TOOLS(**) =
    2.21  struct
    2.22 -(**)
    2.23 +
    2.24 +fun dest_spec (Const ("Product_Type.Pair", _) $ d $ (Const ("Product_Type.Pair", _) $ p $ m)) =
    2.25 +    (d |> HOLogic.dest_string, 
    2.26 +     p |> HOLogic.dest_list |> map HOLogic.dest_string,
    2.27 +     m |> HOLogic.dest_list |> map HOLogic.dest_string) : Celem.spec
    2.28 +  | dest_spec t = raise TERM ("dest_spec: called with ", [t])
    2.29  
    2.30  fun prep_program thm = (thm
    2.31    |> Thm.prop_of