src/Tools/isac/MathEngBasic/istate-def.sml
author Walther Neuper <walther.neuper@jku.at>
Sat, 04 Apr 2020 12:11:32 +0200
changeset 59850 f3cac3053e7b
parent 59846 7184a26ac7d5
child 59851 4dd533681fef
permissions -rw-r--r--
separate Rule_Set from Rule
     1 (* Title:  interpreter-state for Lucas-Interpretation
     2    Author: Walther Neuper 190724
     3    (c) due to copyright terms
     4 
     5    Minimum of code required BEFORE Interpret/ 
     6 *)
     7 signature INTERPRETER_STATE_DEFINITION =
     8 sig
     9 
    10   datatype asap = ORundef | AssOnly | AssGen;
    11   val asap2str: asap -> string 
    12   type pstate
    13   val e_pstate: pstate
    14   val pstate2str: pstate -> string
    15   val pstate2str': pstate -> string
    16 
    17   datatype T = RrlsState of Rule_Set.rrlsstate | Pstate of pstate | Uistate
    18   val empty: T
    19   val string_of: T -> string
    20   val string_of': T -> string
    21   val istates2str: T option * T option -> string
    22 
    23   val set_eval: Rule_Set.rls -> pstate -> pstate
    24   val set_act: term -> pstate -> pstate
    25   val set_env_true: Env.T -> pstate -> pstate
    26 
    27 end
    28 
    29 (**)                   
    30 structure Istate_Def(**): INTERPRETER_STATE_DEFINITION(**) =
    31 struct
    32 (**)
    33 
    34 open Celem                           
    35 
    36 datatype asap = (* arg. of scan_dn1 _only_ for distinction w.r.t. Or                 *)
    37   ORundef        (* undefined: set only by (topmost) Or                           *)
    38 | AssOnly       (* do not execute applicable Prog_Tac - there could be an associated
    39 	                 in parallel Or-branch                                         *)
    40 | AssGen;       (* no Associated(Weak) found within Or, thus continue scan
    41                    search for _applicable_ stacs, execute and generate pt        *)
    42 (*this constructions doesnt allow arbitrary nesting of Or !!!                    *)
    43 fun asap2str ORundef = "ORundef"
    44   | asap2str AssOnly = "AssOnly"
    45   | asap2str AssGen = "AssGen"
    46 
    47 type pstate =
    48   {env: Env.T,          (* environment for variables in a program *)
    49   path: TermC.path,     (* to the current location in a program   *)
    50   eval: Rule_Set.rls,       (* rule-set for evaluating a Prog_Expr    *)
    51   form_arg: term option,(* argument of a curried function         *)
    52   act_arg: term,        (* value for the curried argument         *)
    53   or: asap,             (* flag for scanning tactical "Or"      !shall be dropped *)
    54   found_accept: bool,   (* flag set after execution of a tactic !shall be dropped *)
    55   assoc: bool}          (* is the tactic associated to input ?cont.search Unsafe_Step \<rightarrow> Safe_Step*)
    56 val e_pstate =
    57   {env = [], path = [], eval = Rule_Set.e_rls, form_arg = NONE, act_arg = Rule.e_term,
    58     or = ORundef, found_accept = false, assoc = false}
    59 fun topt2str NONE = "NONE"
    60   | topt2str (SOME t) = "SOME " ^ Rule.term2str t;
    61 fun pstate2str {env, path, eval, form_arg, act_arg, or, found_accept, assoc} = (* for tests only *)
    62   "(" ^  Env.env2str env ^ ", " ^ TermC.string_of_path path ^ ", " ^ Rule_Set.id_rls eval ^ ", " ^
    63   topt2str form_arg ^ ", \n" ^ Rule.term2str act_arg ^ ", " ^ asap2str or ^ ", " ^
    64   bool2str found_accept ^ ", " ^ bool2str assoc ^ ")";
    65 fun pstate2str' {env, path, eval, form_arg, act_arg, or, found_accept, assoc} = (* for tests only *)
    66   "(" ^  Env.env2str' env ^ ", " ^ TermC.string_of_path path ^ ", " ^ Rule_Set.id_rls eval ^ ", " ^
    67   topt2str form_arg ^ ", " ^ Rule.term2str act_arg ^ ", " ^ asap2str or ^ ", " ^
    68   bool2str found_accept ^ ", " ^ bool2str assoc ^ ")";
    69 
    70 (* for handling type T see fun resume_prog, +? *)
    71 datatype T =                 (*interpreter state*)
    72 	  Uistate                       (*undefined in modspec, in '_deriv'ation*)
    73   | Pstate of pstate          (*for script interpreter*)
    74   | RrlsState of Rule_Set.rrlsstate; (*for reverse rewriting*)
    75 val empty = Pstate e_pstate;
    76 
    77 fun rta2str (r, (t, a)) = "\n(" ^ Rule_Set.rule2str r ^ ", (" ^ Rule.term2str t ^ ", " ^ Rule.terms2str a ^ "))";
    78 fun string_of Uistate = "Uistate"
    79   | string_of (Pstate pst) = 
    80     "Pstate " ^ pstate2str pst
    81   | string_of (RrlsState (t, t1, rss, rtas)) =
    82     "RrlsState (" ^ Rule.term2str t ^ ", " ^ Rule.term2str t1 ^ ", " ^
    83     (strs2str o (map (strs2str o (map Rule_Set.rule2str)))) rss ^ ", " ^
    84     (strs2str o (map rta2str)) rtas ^ ")";
    85 fun string_of' Uistate = "Uistate"
    86   | string_of' (Pstate pst) = 
    87     "Pstate " ^ pstate2str' pst
    88   | string_of' (RrlsState _) = raise ERROR "istate2str: drop RrlsState"
    89 fun istates2str (NONE, NONE) = "(#NONE, #NONE)"  (* for tests only *)
    90   | istates2str (NONE, SOME ist) = "(#NONE,\n#SOME " ^ string_of ist ^ ")"
    91   | istates2str (SOME ist, NONE) = "(#SOME " ^ string_of ist ^ ",\n #NONE)"
    92   | istates2str (SOME i1, SOME i2) = "(#SOME " ^ string_of i1 ^ ",\n #SOME " ^ string_of i2 ^ ")";
    93 
    94 
    95 fun set_eval e {env, path, form_arg, act_arg, or, found_accept, assoc, ...} =
    96   {env = env, path = path, eval = e, form_arg = form_arg, act_arg = act_arg,
    97     or = or, found_accept = found_accept, assoc = assoc}
    98 fun set_act act {env, path, eval, form_arg, or, found_accept, assoc, ...} =
    99   {env = env, path = path, eval = eval, form_arg = form_arg, act_arg = act,
   100     or = or, found_accept = found_accept, assoc = assoc}
   101 fun set_env_true env {path, eval, form_arg, act_arg, or, found_accept, ...} =
   102   {env = env, path = path, eval = eval, form_arg = form_arg, act_arg = act_arg,
   103     or = or, found_accept = found_accept, assoc = true}
   104 
   105 (**)end(**)
   106