make "sqrt" work by proper use of HOLogic.dest_number and its resulting type;
authorwenzelm
Tue, 17 Aug 2021 21:57:40 +0200
changeset 6038143e4d63c93df
parent 60380 ab55837e42c4
child 60382 3e3480647439
make "sqrt" work by proper use of HOLogic.dest_number and its resulting type;
src/Tools/isac/Knowledge/Root.thy
test/Tools/isac/ProgLang/evaluate.sml
     1.1 --- a/src/Tools/isac/Knowledge/Root.thy	Tue Aug 17 21:48:38 2021 +0200
     1.2 +++ b/src/Tools/isac/Knowledge/Root.thy	Tue Aug 17 21:57:40 2021 +0200
     1.3 @@ -44,37 +44,38 @@
     1.4  ML \<open>
     1.5  (*-------------------------functions---------------------*)
     1.6  (*evaluation square-root over the integers*)
     1.7 -fun eval_sqrt (_ : string) (_ : string) (t as (Const (op0, _) $ arg)) _(*thy*) = 
     1.8 -    (case arg of 
     1.9 -  	  (Const (\<^const_name>\<open>numeral\<close>, T) $ num) =>
    1.10 -        let val ni = HOLogic.dest_numeral num
    1.11 -        in
    1.12 -    	    if ni < 0 then NONE
    1.13 -    	    else
    1.14 -    		    let val fact = Eval.squfact ni;
    1.15 -    		    in
    1.16 +fun eval_sqrt (_ : string) (_ : string) t (_: theory) = 
    1.17 +  (case t of
    1.18 +    Const (op0, _) $ num =>
    1.19 +      (case try HOLogic.dest_number num of
    1.20 +        SOME (T, ni)=>
    1.21 +          if ni < 0 then NONE
    1.22 +          else
    1.23 +            let val fact = Eval.squfact ni;
    1.24 +            in
    1.25                if fact * fact = ni 
    1.26 -    		      then
    1.27 +              then
    1.28                  SOME ("#sqrt #" ^ string_of_int ni ^ " = #"
    1.29 -    			          ^ string_of_int (if ni = 0 then 0 else ni div fact),
    1.30 -    			        HOLogic.Trueprop $ TermC.mk_equality (t, TermC.term_of_num T fact))
    1.31 -    		      else if fact = 1 then NONE
    1.32 -      		    else
    1.33 +                    ^ string_of_int (if ni = 0 then 0 else ni div fact),
    1.34 +                  HOLogic.Trueprop $ TermC.mk_equality (t, TermC.term_of_num T fact))
    1.35 +              else if fact = 1 then NONE
    1.36 +              else
    1.37                  SOME ("#sqrt #" ^ string_of_int ni ^ " = sqrt (#"
    1.38 -      		          ^ string_of_int fact ^ " * #" ^ string_of_int fact ^ " * #"
    1.39 -      		          ^ string_of_int (ni div (fact * fact)) ^ ")",
    1.40 -      		        HOLogic.Trueprop $ TermC.mk_equality 
    1.41 +                    ^ string_of_int fact ^ " * #" ^ string_of_int fact ^ " * #"
    1.42 +                    ^ string_of_int (ni div (fact * fact)) ^ ")",
    1.43 +                  HOLogic.Trueprop $ TermC.mk_equality 
    1.44                      (t, (TermC.mk_factroot op0 T fact (ni div (fact*fact)))))
    1.45 -    	      end
    1.46 -  	    end
    1.47 -    | _ => NONE)
    1.48 -  | eval_sqrt _ _ _ _ = NONE;
    1.49 +            end
    1.50 +        | NONE => NONE)
    1.51 +  | _ => NONE);
    1.52 +
    1.53  (*val (thmid, op_, t as Const(op0,t0) $ arg) = ("", "", str2term "sqrt 0");
    1.54  > eval_sqrt thmid op_ t thy;
    1.55  > val Free (n1,t1) = arg; 
    1.56  > val SOME ni = int_of_str n1;
    1.57  *)
    1.58  \<close>
    1.59 +
    1.60  calculation SQRT (sqrt) = \<open>eval_sqrt "#sqrt_"\<close>
    1.61      (*different types for 'sqrt 4' --- 'Calculate SQRT'*)
    1.62  ML \<open>
     2.1 --- a/test/Tools/isac/ProgLang/evaluate.sml	Tue Aug 17 21:48:38 2021 +0200
     2.2 +++ b/test/Tools/isac/ProgLang/evaluate.sml	Tue Aug 17 21:57:40 2021 +0200
     2.3 @@ -459,12 +459,8 @@
     2.4  "----------- fun adhoc_thm \<longrightarrow> exception TYPE --------------------------------------------------";
     2.5  "----------- fun adhoc_thm \<longrightarrow> exception TYPE --------------------------------------------------";
     2.6  val t = TermC.str2term "sqrt 4";
     2.7 +Eval.adhoc_thm (ThyC.get_theory "Isac_Knowledge") ("NthRoot.sqrt", eval_sqrt "#sqrt_") t;
     2.8  
     2.9 -(* error-from-Skip_Proof.make_thm: inherited errors are marked TOODOO.1 in test/*
    2.10 - exception TYPE raised (line 169 of "consts.ML"): Illegal type
    2.11 -   for constant "HOL.eq" :: real \<Rightarrow> (num \<Rightarrow> real) \<Rightarrow> bool (**)
    2.12 -      Eval.adhoc_thm (ThyC.get_theory "Isac_Knowledge") ("NthRoot.sqrt", eval_sqrt "#sqrt_") t
    2.13 -( **)
    2.14  "~~~~~ fun adhoc_thm , args:"; val (thy, (op_, eval_fn), ct) =
    2.15    ((ThyC.get_theory "Isac_Knowledge"),
    2.16      ("NthRoot.sqrt", eval_sqrt "#sqrt_": string -> term -> theory -> (string * term) option), t);