src/Tools/isac/Specify/cas-command.sml
author Walther Neuper <walther.neuper@jku.at>
Wed, 03 Jun 2020 13:57:22 +0200
changeset 60018 70a98f2b5754
parent 59982 56654afad89f
child 60097 0aa54181d7c9
permissions -rw-r--r--
unify Pre_Conds.check, partially
walther@59894
     1
(* Title:  Interpret/lucas-interpreter.sml
walther@59894
     2
   Author: Walther Neuper 2019
walther@59894
     3
   (c) due to copyright terms
walther@59894
     4
*)
walther@59894
     5
walther@59894
     6
signature COMPUTER_ALGEBRA_SYSTEM_COMMAND =
walther@59894
     7
sig
walther@59982
     8
  type T = CAS_Def.T
walther@59982
     9
  val input : term -> (Ctree.ctree * Specification.T) option
walther@59982
    10
  val is_from: TermC.as_string -> Formalise.T -> bool
walther@59894
    11
walther@59894
    12
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
walther@59982
    13
  (*NONE*)
walther@59894
    14
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
walther@59982
    15
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
walther@59982
    16
  val input_: References.T -> (term * term list) list ->
walther@59982
    17
    Problem.id * I_Model.T * Method.id * I_Model.T * Pre_Conds.T * Proof.context
walther@59982
    18
walther@59982
    19
  val dtss2itm_: Model_Pattern.T -> term * term list ->
walther@59982
    20
    int list * bool * string * I_Model.feedback (*I_Model.single'*)
walther@59982
    21
  val flattup2: 'a * ('b * 'c * 'd * 'e) -> 'a * 'b * 'c * 'd * 'e
walther@59894
    22
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
walther@59894
    23
end
walther@59894
    24
walther@59894
    25
(**)
walther@59894
    26
structure CAS_Cmd(**): COMPUTER_ALGEBRA_SYSTEM_COMMAND(**) =
walther@59894
    27
struct
walther@59894
    28
(**)
walther@59894
    29
walther@59896
    30
type T = CAS_Def.T;
walther@59896
    31
walther@59982
    32
fun dtss2itm_ ppc (d, ts) =
walther@59982
    33
  let
walther@59982
    34
    val (f, (d, id)) = the (find_first ((curry op= d) o 
walther@59982
    35
  		(#1: (term * term) -> term) o
walther@59982
    36
  		(#2: Model_Pattern.single -> (term * term))) ppc)
walther@59982
    37
  in
walther@59982
    38
    ([1], true, f, I_Model.Cor ((d, ts), (id, ts)))
walther@59982
    39
  end
walther@59982
    40
walther@59982
    41
fun flattup2 (a, (b ,c, d, e)) = (a, b, c, d, e)
walther@59982
    42
walther@59982
    43
fun is_from (hdf : TermC.as_string) ((fmz_, spec) : Formalise.T) =
walther@59982
    44
  hdf <> "" andalso fmz_ = [] andalso spec = References.empty
walther@59982
    45
walther@59982
    46
fun input_ ((dI, pI, mI): References.T) dtss = (*WN110515 reconsider thy..ctxt*)
walther@59982
    47
  let
walther@59982
    48
    val thy = ThyC.get_theory dI
walther@59982
    49
	  val {ppc, ...} = Problem.from_store pI
walther@59982
    50
	  val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
walther@59982
    51
	  val its = O_Model.add_id its_
walther@59982
    52
	  val pits = map flattup2 its
walther@59982
    53
	  val (pI, mI) =
walther@59982
    54
      if mI <> ["no_met"]
walther@59982
    55
      then (pI, mI)
walther@59982
    56
		  else
walther@59982
    57
        case Refine.problem thy pI pits of
walther@59982
    58
			    SOME (pI,_) => (pI, (hd o #met o Problem.from_store) pI)
walther@59982
    59
			  | NONE => (pI, (hd o #met o Problem.from_store) pI)
walther@59982
    60
	  val {ppc, pre, prls, ...} = Method.from_store mI
walther@59982
    61
	  val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
walther@59982
    62
	  val its = O_Model.add_id its_
walther@59982
    63
	  val mits = map flattup2 its
walther@60018
    64
	  val (_, pre) = Pre_Conds.check prls pre mits 0
walther@59982
    65
    val ctxt = Proof_Context.init_global thy
walther@59982
    66
  in (pI, pits, mI, mits, pre, ctxt) end;
walther@59982
    67
walther@59982
    68
(* check if the input term is a CAScmd and return a ctree with a _complete_ calchead *)
walther@59982
    69
fun input hdt =
walther@59982
    70
  let
walther@59982
    71
    val (h, argl) = strip_comb hdt
walther@59982
    72
  in
walther@59982
    73
    case assoc_cas (ThyC.get_theory "Isac_Knowledge") h of
walther@59982
    74
      NONE => NONE
walther@59982
    75
    | SOME (spec as (dI,_,_), argl2dtss) =>
walther@59982
    76
	      let
walther@59982
    77
          val dtss = argl2dtss argl
walther@59982
    78
	        val (pI, pits, mI, mits, pre, ctxt) = input_ spec dtss
walther@59982
    79
	        val spec = (dI, pI, mI)
walther@59982
    80
	        val (pt,_) = Ctree.cappend_problem Ctree.e_ctree [] (Istate_Def.empty, ContextC.empty)
walther@59982
    81
		        ([], References.empty) ([], References.empty, hdt, ctxt)
walther@59982
    82
	        val pt = Ctree.update_spec pt [] spec
walther@59982
    83
	        val pt = Ctree.update_pbl pt [] pits
walther@59982
    84
	        val pt = Ctree.update_met pt [] mits
walther@59982
    85
	      in
walther@59982
    86
	        SOME (pt, (true, Pos.Met, hdt, mits, pre, spec) : Specification.T)
walther@59982
    87
	      end
walther@59982
    88
  end
walther@59894
    89
walther@59894
    90
(**)end(**)