From David Shepherd, 31 Mar 89
From: David Shepherd <des%inmos.co.uk%NSS.Cs.Ucl.AC.UK@munnari.oz>
Date: Fri, 31 Mar 89 17:40:56 BST
To: info-hol%clover.ucdavis.edu@NSS.Cs.Ucl.AC.UK
Subject: Conversion package for HOL
Status: RO

Here is a file I have put together to provide better support of conversions.
It is based on my experiences of using the occam transformation system. In
that you parse in an occam program and then move your point of reference in
and out of the program constructs and can apply transformations at any point.
Using HOL I became infuriated at times that I couldn't go inside a term, apply
a rewrite/conversion at on an exact subterm. This package allows you to do this.

Any comments/improvements welcome (!) What would really be nice would be
to get this interfaced with a windowing system so your term is in one window
as automatically updates as you type terms in another window with the
relevant tactic automatically appearing somewhere else .... (this is what
the occam transformation system almost looks like now)

david shepherd
INMOS ltd
<des@inmos.co.uk>


Instructions:

To use, first "load" the term you want to convert by using

        # set_conv <term>;;

Then you can use the movement functions to move around the
subterms of the term. These are

        inrat()         - move into operator
        inran()         - move into operand
        inabs()         - move into abstraction body

        inbody()        - move into body of \ or binder
        inleft()        - move into left side of binary operator
        inright()       - move into right side of binary operator

        out()           - undo last movement

At any time you can view the current subterm that is your context by

        # show_conv();;

You apply a conversion at the current point using

        # apply <conv>;;

Finally, you can generate the theorem from all the conversions you have
done by

        # convert();;

For safety, this applies all the conversions to the original term, rather than
using the incrementally converted term modified by apply just in case anything
strange happened.

This mechanism can be interfaced into the tactics package (and other work) by
the new conversional

        dir_CONV s c t

This applies conversion c at a point in term t indicated by the director string
s. s is a string of `f`, `a` and `b` characters represent function (rator),
argument (rand) and body (abs). While using the conversion package the function

        # whereami();;

returns the director string of the current contexts.

4 rewrite conversions are also provided to do term rewrites as conversions. These
are

        rewrite_CONV
        pure_rewrite_CONV
        once_rewrite_CONV
        pure_once_rewrite_CONV

they work like the analogous _RULEs. (lower case is used as REWRITE_CONV already
exists)

Uses
====

This is useful for delicate term manipulation. I think with suitable development
this could prove a useful mechanism for integrating the unwind stuff into
the mainstream HOL tactic based work.


Example
=======

As an example here are a couple of steps out of a proof I've just done using
this. For each "expand" I did

        # set_conv (snd(top_goal))

and moved around the term. After each "apply" I did a "whereami" and filled
in the approriate dir_CONV.

expand(CONV_TAC ((dir_CONV `faabababfafaababab` AND_FORALL_CONV) THENC
                 (dir_CONV `faabababfafa` (DEPTH_CONV EXISTS_FORALL)) THENC
                 (dir_CONV `faabababfa` (AND_FORALL_CONV)) THENC
                 (dir_CONV `faabababafafaababab` (AND_FORALL_CONV)) THENC
                 (dir_CONV `faabababafafa` (DEPTH_CONV EXISTS_FORALL)) THENC
                 (dir_CONV `faabababafa` (AND_FORALL_CONV)) THENC
                 (dir_CONV `faabababa` (AND_FORALL_CONV)) THENC
                 (dir_CONV `faababab` (AND_FORALL_CONV)) THENC
                 (dir_CONV `faababababfafaababab` (UNWIND_CONV \t.(is_var o fst o dest_equiv) t)) THENC
                 (dir_CONV `faababababfafa` PRUNE) THENC
                 (dir_CONV `faababababafafaababab` (UNWIND_CONV \t.(is_var o fst o dest_equiv) t)) THENC
                 (dir_CONV `faababababafafa` PRUNE)));;

expand(CONV_TAC ((dir_CONV `fa` (DEPTH_CONV EXISTS_FORALL)) THENC
                 (dir_CONV `faabababab` (UNWIND_CONV \t.(is_var o fst o dest_equiv) t)) THENC
                 (dir_CONV `faab` PRUNE)));;

--------------------------------------------------------------
Here is a new conversion -- useful for unwinding local wires
Currently very slow --- it uses TAC_PROOF. It should be possible to avoid this
and infer the term directly. It also currently introduces "illegal" variables
such as "s3't" --- but these normally get immediately pruned.

%
   extra-unwind.ml

   david shepherd
   INMOS ltd

   more stuff for unwinding things
%

%  EXISTS_FORALL

   ? s . ! t . ....(s t)....  = ! t . ? st . ....st....

   used after unfolding to bring ! t's to outside
%

let EXISTS_FORALL t =
    let ex,t0 = dest_exists t
    in let un,t1 = dest_forall t0
    in let unty = snd(dest_var un)
    in let new = mk_var(fst(dest_var ex)^fst(dest_var un),type_of"^ex ^un")
    in let t2 = subst [new,"^ex ^un"] t1
    in let t3 = mk_forall (un,mk_exists (new,t2))
    in let t4 = mk_equiv (t,t3)
    in TAC_PROOF(([],t4),
        EQ_TAC THEN REPEAT STRIP_TAC
        THENL [ EXISTS_TAC "^ex ^un" THEN ASM_REWRITE_TAC[]
               ;EXISTS_TAC "\ ^un . @ ^new . ^t2"
                THEN BETA_TAC
                THEN POP_ASSUM (ASSUME_TAC o (GEN "t:^unty")
                                o SELECT_RULE o (SPEC "t:^unty"))
                THEN ASM_REWRITE_TAC[]
              ]);;



------------------------------------------------------------------
Here is the conversion package in its current form

%   conversion package.

    david shepherd
    INMOS ltd
    31mar89
    <des@inmos.co.uk>

    do similar things with conversions as with tactics

    use: "open term surgery"

    allows user to take a term and interactively move
    through its subterms applying conversion where necessary.
    Through use of director strings these conversions can be
    recorded in an ML script to reprove the theorem.
%

%   the 3 elements of the state %

letref conv_state = []:(string#conv)list;;
letref conv_term = "T";;
letref curr_term = "T";;

%   set_conv t --- sets the term for the conversion package to use to t %

let set_conv (t:term) = conv_state := [``,ALL_CONV];conv_term:=t;curr_term:=t;;


%   build up director string from a conversion state %

letrec get_director_string = fun [] . ``
                      | ((ch,_).cs) . (get_director_string cs) ^ ch;;

%   take a director string and return the appropriate conversional to
    do that movement %

let string_to_conv s =
    letrec f c = fun [] . c
               | (x.xs) . if x=`a` then f (c o RAND_CONV) xs else
                          if x=`f` then f (c o RATOR_CONV) xs else
                          if x=`b` then f (c o ABS_CONV) xs else
                          failwith `bad director string`
    in f I (explode s);;

%   extract a subterm from a given term t using director string s %

let get_term s t =
    letrec f t = fun [] . t
               | (x.xs) . if x=`a` then f (snd (dest_comb t)) xs else
                          if x=`f` then f (fst (dest_comb t)) xs else
                          if x=`b` then f (snd (dest_abs t)) xs else
                          failwith `bad director string`
    in f t (explode s);;

%   get the conversion represented by conv_state %

let get_conv conv_st =
  letrec f = fun [] . ALL_CONV
               | ((change,conv).cl) . (string_to_conv change) (conv THENC (f cl))
  in  f (rev conv_st);;

%   get the conversional to move to current term pointed to by conv_state %

let get_pos conv_st = string_to_conv(get_director_string conv_st);;

%   show the sub term which is the current context %

let show_conv () = print_term (get_term (get_director_string conv_state) curr_term); print_newline();();;

%   apply a conversion at the current context %

let apply c = let t = ((get_pos conv_state) c) curr_term
              in let (_,rhs) = dest_eq (concl t)
              in curr_term:=rhs;
              let (ch,co).cl = conv_state
              in conv_state := (ch,co THENC c).cl;
              ();;

%   apply all convertions so far to original term and return the theorem %

let convert () = (get_conv conv_state) conv_term;;

%   return director string of current context -- use to paste into ML script %

let whereami () = get_director_string conv_state;;

% dir_CONV s c applies conversion c at target indicated by s %

let dir_CONV s c = (string_to_conv s) c;;

% now some extra movement operators %

% move into operator of a function application %

let inrat () =
    let t = get_term(get_director_string conv_state) curr_term
    in if (is_comb t) then conv_state := (`f`,ALL_CONV).conv_state
                      else failwith `not an application`;
    ();;

% move into operand of a function application %

let inran () =
    let t = get_term(get_director_string conv_state) curr_term
    in if (is_comb t) then conv_state := (`a`,ALL_CONV).conv_state
                      else failwith `not an application`;
    ();;

% move into body of an abstraction %

let inabs () =
    let t = get_term(get_director_string conv_state) curr_term
    in if (is_abs t) then conv_state := (`b`,ALL_CONV).conv_state
                      else failwith `not an application`;
    ();;

% move out one level of context %

let out () = if (null (tl conv_state)) then failwith `outermost level`
             else let (ch1,co1).(ch2,co2).cl = conv_state
                  in  conv_state := (ch2,co2 THENC ((string_to_conv ch1) co1)).cl;();;

% move into body of an abstraction or binder %

let inbody() =
   let t = get_term (get_director_string conv_state) curr_term
   in   if (is_abs t) then conv_state := (`b`,ALL_CONV).conv_state
   else if ((is_binder o fst o dest_const o fst o dest_comb) t)
           then conv_state := (`ab`,ALL_CONV).conv_state
           else fail
   ? failwith `no body`;
   ();;

% move into left half of binary function application %

let inleft() =
   let t = get_term (get_director_string conv_state) curr_term
   in   if (is_comb t) & ((is_comb o fst o dest_comb) t)
           then conv_state := (`fa`,ALL_CONV).conv_state
           else failwith `not a binary function`;
   ();;

% move into right half of binary function application %

let inright() =
   let t = get_term (get_director_string conv_state) curr_term
   in   if (is_comb t) & ((is_comb o fst o dest_comb) t)
           then conv_state := (`a`,ALL_CONV).conv_state
           else failwith `not a binary function`;
   ();;


% Some conversions to all rewriting at targets %

let GEN_REWRITE_CONV rewrite_fun built_in_rewrites =
 let basic_net = mk_conv_net built_in_rewrites
 in
 \thl.
  let conv = rewrite_fun
             (REWRITES_CONV(merge_term_nets (mk_conv_net thl) basic_net))
  in
  \t. conv t;;

% names in lower case as REWRITE_CONV already defined %

let pure_rewrite_CONV      = GEN_REWRITE_CONV TOP_DEPTH_CONV []
and rewrite_CONV           = GEN_REWRITE_CONV TOP_DEPTH_CONV basic_rewrites
and pure_once_rewrite_CONV = GEN_REWRITE_CONV ONCE_DEPTH_CONV []
and once_rewrite_CONV      = GEN_REWRITE_CONV ONCE_DEPTH_CONV basic_rewrites;;


