New Config With AFP components and a thin interface for monitor-checking.
This commit is contained in:
parent
36fac27d0c
commit
04cc46f9b4
14
Isa_DOF.thy
14
Isa_DOF.thy
|
@ -12,9 +12,9 @@ text\<open> Offering
|
||||||
text\<open> In this section, we develop on the basis of a management of references Isar-markups
|
text\<open> In this section, we develop on the basis of a management of references Isar-markups
|
||||||
that provide direct support in the PIDE framework. \<close>
|
that provide direct support in the PIDE framework. \<close>
|
||||||
|
|
||||||
theory Isa_DOF (* Isabelle Document Ontology Framework *)
|
theory Isa_DOF (* Isabelle Document Ontology Framework *)
|
||||||
imports Main (* Isa_MOF *)
|
imports Main
|
||||||
RegExp
|
RegExpInterface (* Interface to functional regular automata for monitoring *)
|
||||||
Assert
|
Assert
|
||||||
|
|
||||||
keywords "+=" ":="
|
keywords "+=" ":="
|
||||||
|
@ -65,9 +65,9 @@ structure DOF_core =
|
||||||
struct
|
struct
|
||||||
type docclass_struct = {params : (string * sort) list, (*currently not used *)
|
type docclass_struct = {params : (string * sort) list, (*currently not used *)
|
||||||
name : binding, thy_name : string, id : serial, (* for pide *)
|
name : binding, thy_name : string, id : serial, (* for pide *)
|
||||||
inherits_from : (typ list * string) option,
|
inherits_from : (typ list * string) option, (* imports *)
|
||||||
attribute_decl : (binding * typ * term option) list,
|
attribute_decl : (binding * typ * term option) list, (* class local *)
|
||||||
rex : term list }
|
rex : term list } (* monitoring regexps --- product semantics*)
|
||||||
|
|
||||||
|
|
||||||
type docclass_tab = docclass_struct Symtab.table
|
type docclass_tab = docclass_struct Symtab.table
|
||||||
|
@ -169,7 +169,7 @@ fun upd_monitor_tabs f {docobj_tab,docclass_tab,ISA_transformer_tab, monitor_tab
|
||||||
|
|
||||||
|
|
||||||
fun get_accepted_cids ({accepted_cids, regexp_stack }:open_monitor_info) = accepted_cids
|
fun get_accepted_cids ({accepted_cids, regexp_stack }:open_monitor_info) = accepted_cids
|
||||||
fun get_regexp_stack ({accepted_cids, regexp_stack }:open_monitor_info) = regexp_stack
|
fun get_regexp_stack ({accepted_cids, regexp_stack }:open_monitor_info) = regexp_stack
|
||||||
|
|
||||||
|
|
||||||
(* doc-class-name management: We still use the record-package for internally
|
(* doc-class-name management: We still use the record-package for internally
|
||||||
|
|
50
RegExp.thy
50
RegExp.thy
|
@ -22,7 +22,7 @@ definition rep1 :: "'a rexp \<Rightarrow> 'a rexp" ("\<lbrace>(_)\<rbrace>\<^sup
|
||||||
where "\<lbrace>A\<rbrace>\<^sup>+ \<equiv> A ~~ \<lbrace>A\<rbrace>\<^sup>*"
|
where "\<lbrace>A\<rbrace>\<^sup>+ \<equiv> A ~~ \<lbrace>A\<rbrace>\<^sup>*"
|
||||||
|
|
||||||
definition opt :: "'a rexp \<Rightarrow> 'a rexp" ("\<lbrakk>(_)\<rbrakk>")
|
definition opt :: "'a rexp \<Rightarrow> 'a rexp" ("\<lbrakk>(_)\<rbrakk>")
|
||||||
where "\<lbrakk>A\<rbrakk> \<equiv> A || Zero"
|
where "\<lbrakk>A\<rbrakk> \<equiv> A || One"
|
||||||
|
|
||||||
value "Star (Conc(Alt (Atom(CHR ''a'')) (Atom(CHR ''b''))) (Atom(CHR ''c'')))"
|
value "Star (Conc(Alt (Atom(CHR ''a'')) (Atom(CHR ''b''))) (Atom(CHR ''c'')))"
|
||||||
text{* or better equivalently: *}
|
text{* or better equivalently: *}
|
||||||
|
@ -37,12 +37,14 @@ i.e. we give a direct meaning for regular expressions in some universe of ``deno
|
||||||
|
|
||||||
This universe of denotations is in our concrete case: *}
|
This universe of denotations is in our concrete case: *}
|
||||||
|
|
||||||
|
definition enabled :: "('a,'\<sigma> set)da \<Rightarrow> '\<sigma> set \<Rightarrow> 'a list \<Rightarrow> 'a list"
|
||||||
|
where "enabled A \<sigma> = filter (\<lambda>x. next A x \<sigma> \<noteq> {}) "
|
||||||
|
|
||||||
text{* Now the denotational semantics for regular expression can be defined on a post-card: *}
|
text{* Now the denotational semantics for regular expression can be defined on a post-card: *}
|
||||||
|
|
||||||
fun L :: "'a rexp => 'a lang"
|
fun L :: "'a rexp => 'a lang"
|
||||||
where L_Emp : "L Zero = {}"
|
where L_Emp : "L Zero = {}"
|
||||||
|L_One: "L One = {[]}"
|
|L_One: "L One = {[]}"
|
||||||
|L_Atom: "L (\<lfloor>a\<rfloor>) = {[a]}"
|
|L_Atom: "L (\<lfloor>a\<rfloor>) = {[a]}"
|
||||||
|L_Un: "L (el || er) = (L el) \<union> (L er)"
|
|L_Un: "L (el || er) = (L el) \<union> (L er)"
|
||||||
|L_Conc: "L (el ~~ er) = {xs@ys | xs ys. xs \<in> L el \<and> ys \<in> L er}"
|
|L_Conc: "L (el ~~ er) = {xs@ys | xs ys. xs \<in> L el \<and> ys \<in> L er}"
|
||||||
|
@ -58,11 +60,51 @@ fun L\<^sub>s\<^sub>u\<^sub>b :: "'a::order rexp => 'a lang"
|
||||||
|L\<^sub>s\<^sub>u\<^sub>b_Conc: "L\<^sub>s\<^sub>u\<^sub>b (el ~~ er) = {xs@ys | xs ys. xs \<in> L\<^sub>s\<^sub>u\<^sub>b el \<and> ys \<in> L\<^sub>s\<^sub>u\<^sub>b er}"
|
|L\<^sub>s\<^sub>u\<^sub>b_Conc: "L\<^sub>s\<^sub>u\<^sub>b (el ~~ er) = {xs@ys | xs ys. xs \<in> L\<^sub>s\<^sub>u\<^sub>b el \<and> ys \<in> L\<^sub>s\<^sub>u\<^sub>b er}"
|
||||||
|L\<^sub>s\<^sub>u\<^sub>b_Star: "L\<^sub>s\<^sub>u\<^sub>b (Star e) = Regular_Set.star(L\<^sub>s\<^sub>u\<^sub>b e)"
|
|L\<^sub>s\<^sub>u\<^sub>b_Star: "L\<^sub>s\<^sub>u\<^sub>b (Star e) = Regular_Set.star(L\<^sub>s\<^sub>u\<^sub>b e)"
|
||||||
|
|
||||||
|
|
||||||
|
definition XX where "XX = (rexp2na example_expression)"
|
||||||
|
definition YY where "YY = na2da(rexp2na example_expression)"
|
||||||
(* reminder from execute *)
|
(* reminder from execute *)
|
||||||
value "NA.accepts (rexp2na example_expression) [0,1,1,0,0,1]"
|
value "NA.accepts (rexp2na example_expression) [0,1,1,0,0,1]"
|
||||||
|
|
||||||
value "DA.accepts (na2da (rexp2na example_expression)) [0,1,1,0,0,1]"
|
value "DA.accepts (na2da (rexp2na example_expression)) [0,1,1,0,0,1]"
|
||||||
|
|
||||||
|
definition zero where "zero = (0::nat)"
|
||||||
|
definition one where "one = (1::nat)"
|
||||||
|
|
||||||
|
typ "'a set"
|
||||||
|
|
||||||
|
|
||||||
|
export_code zero one Suc Int.nat nat_of_integer int_of_integer
|
||||||
|
Zero One Atom Plus Times Star
|
||||||
|
rexp2na na2da enabled
|
||||||
|
NA.accepts DA.accepts
|
||||||
|
|
||||||
|
example_expression
|
||||||
|
|
||||||
|
in SML
|
||||||
|
|
||||||
|
|
||||||
|
module_name RegExpChecker file "RegExpChecker.sml"
|
||||||
|
|
||||||
|
SML_file "RegExpChecker.sml"
|
||||||
|
|
||||||
|
ML\<open> open RegExpChecker;\<close>
|
||||||
|
|
||||||
|
(*
|
||||||
|
ML{* use "RegExpChecker.sml"; open RegExpChecker;
|
||||||
|
|
||||||
|
val eq_int = {equal = curry(op =) : int -> int -> bool};
|
||||||
|
val eq_bool_list = {equal = curry(op =) : bool list -> bool list -> bool};
|
||||||
|
val eq_mynat = {equal = fn x:RegExpChecker.nat => fn y => x = y}
|
||||||
|
val s = RegExpChecker.rexp2na eq_int;
|
||||||
|
val xxx = na2da eq_mynat;
|
||||||
|
val ((init), (next,fin)) = na2da eq_bool_list (RegExpChecker.rexp2na eq_mynat example_expression);
|
||||||
|
val Set X = next zero init;
|
||||||
|
val Set Y = next one init;
|
||||||
|
val Set Z = next (Suc one) init;
|
||||||
|
*}
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
no_notation Atom ("\<lfloor>_\<rfloor>")
|
no_notation Atom ("\<lfloor>_\<rfloor>")
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,339 @@
|
||||||
|
structure RegExpChecker : sig
|
||||||
|
type 'a equal
|
||||||
|
type num
|
||||||
|
type int
|
||||||
|
datatype nat = Zero_nat | Suc of nat
|
||||||
|
type 'a set
|
||||||
|
datatype 'a rexp = Zero | Onea | Atom of 'a | Plus of 'a rexp * 'a rexp |
|
||||||
|
Times of 'a rexp * 'a rexp | Star of 'a rexp
|
||||||
|
val nat : int -> nat
|
||||||
|
val accepts : 'a * (('b -> 'a -> 'a) * ('a -> bool)) -> 'b list -> bool
|
||||||
|
val acceptsa :
|
||||||
|
'a equal -> 'a * (('b -> 'a -> 'a set) * ('a -> bool)) -> 'b list -> bool
|
||||||
|
val na2da :
|
||||||
|
'a equal ->
|
||||||
|
'a * (('b -> 'a -> 'a set) * ('a -> bool)) ->
|
||||||
|
'a set * (('b -> 'a set -> 'a set) * ('a set -> bool))
|
||||||
|
val rexp2na :
|
||||||
|
'a equal ->
|
||||||
|
'a rexp ->
|
||||||
|
bool list * (('a -> bool list -> (bool list) set) * (bool list -> bool))
|
||||||
|
val one : nat
|
||||||
|
val zero : nat
|
||||||
|
val enabled :
|
||||||
|
'a set * (('b -> 'a set -> 'a set) * ('a set -> bool)) ->
|
||||||
|
'a set -> 'b list -> 'b list
|
||||||
|
val example_expression : nat rexp
|
||||||
|
val nat_of_integer : IntInf.int -> nat
|
||||||
|
val int_of_integer : IntInf.int -> int
|
||||||
|
end = struct
|
||||||
|
|
||||||
|
fun equal_boola p true = p
|
||||||
|
| equal_boola p false = not p
|
||||||
|
| equal_boola true p = p
|
||||||
|
| equal_boola false p = not p;
|
||||||
|
|
||||||
|
type 'a equal = {equal : 'a -> 'a -> bool};
|
||||||
|
val equal = #equal : 'a equal -> 'a -> 'a -> bool;
|
||||||
|
|
||||||
|
val equal_bool = {equal = equal_boola} : bool equal;
|
||||||
|
|
||||||
|
fun eq A_ a b = equal A_ a b;
|
||||||
|
|
||||||
|
fun equal_lista A_ [] (x21 :: x22) = false
|
||||||
|
| equal_lista A_ (x21 :: x22) [] = false
|
||||||
|
| equal_lista A_ (x21 :: x22) (y21 :: y22) =
|
||||||
|
eq A_ x21 y21 andalso equal_lista A_ x22 y22
|
||||||
|
| equal_lista A_ [] [] = true;
|
||||||
|
|
||||||
|
fun equal_list A_ = {equal = equal_lista A_} : ('a list) equal;
|
||||||
|
|
||||||
|
datatype num = One | Bit0 of num | Bit1 of num;
|
||||||
|
|
||||||
|
datatype int = Zero_int | Pos of num | Neg of num;
|
||||||
|
|
||||||
|
datatype nat = Zero_nat | Suc of nat;
|
||||||
|
|
||||||
|
datatype 'a set = Set of 'a list | Coset of 'a list;
|
||||||
|
|
||||||
|
datatype 'a rexp = Zero | Onea | Atom of 'a | Plus of 'a rexp * 'a rexp |
|
||||||
|
Times of 'a rexp * 'a rexp | Star of 'a rexp;
|
||||||
|
|
||||||
|
fun dup (Neg n) = Neg (Bit0 n)
|
||||||
|
| dup (Pos n) = Pos (Bit0 n)
|
||||||
|
| dup Zero_int = Zero_int;
|
||||||
|
|
||||||
|
fun plus_nat (Suc m) n = plus_nat m (Suc n)
|
||||||
|
| plus_nat Zero_nat n = n;
|
||||||
|
|
||||||
|
val one_nat : nat = Suc Zero_nat;
|
||||||
|
|
||||||
|
fun nat_of_num (Bit1 n) = let
|
||||||
|
val m = nat_of_num n;
|
||||||
|
in
|
||||||
|
Suc (plus_nat m m)
|
||||||
|
end
|
||||||
|
| nat_of_num (Bit0 n) = let
|
||||||
|
val m = nat_of_num n;
|
||||||
|
in
|
||||||
|
plus_nat m m
|
||||||
|
end
|
||||||
|
| nat_of_num One = one_nat;
|
||||||
|
|
||||||
|
fun nat (Pos k) = nat_of_num k
|
||||||
|
| nat Zero_int = Zero_nat
|
||||||
|
| nat (Neg k) = Zero_nat;
|
||||||
|
|
||||||
|
fun uminus_int (Neg m) = Pos m
|
||||||
|
| uminus_int (Pos m) = Neg m
|
||||||
|
| uminus_int Zero_int = Zero_int;
|
||||||
|
|
||||||
|
fun plus_num (Bit1 m) (Bit1 n) = Bit0 (plus_num (plus_num m n) One)
|
||||||
|
| plus_num (Bit1 m) (Bit0 n) = Bit1 (plus_num m n)
|
||||||
|
| plus_num (Bit1 m) One = Bit0 (plus_num m One)
|
||||||
|
| plus_num (Bit0 m) (Bit1 n) = Bit1 (plus_num m n)
|
||||||
|
| plus_num (Bit0 m) (Bit0 n) = Bit0 (plus_num m n)
|
||||||
|
| plus_num (Bit0 m) One = Bit1 m
|
||||||
|
| plus_num One (Bit1 n) = Bit0 (plus_num n One)
|
||||||
|
| plus_num One (Bit0 n) = Bit1 n
|
||||||
|
| plus_num One One = Bit0 One;
|
||||||
|
|
||||||
|
val one_int : int = Pos One;
|
||||||
|
|
||||||
|
fun bitM One = One
|
||||||
|
| bitM (Bit0 n) = Bit1 (bitM n)
|
||||||
|
| bitM (Bit1 n) = Bit1 (Bit0 n);
|
||||||
|
|
||||||
|
fun sub (Bit0 m) (Bit1 n) = minus_int (dup (sub m n)) one_int
|
||||||
|
| sub (Bit1 m) (Bit0 n) = plus_int (dup (sub m n)) one_int
|
||||||
|
| sub (Bit1 m) (Bit1 n) = dup (sub m n)
|
||||||
|
| sub (Bit0 m) (Bit0 n) = dup (sub m n)
|
||||||
|
| sub One (Bit1 n) = Neg (Bit0 n)
|
||||||
|
| sub One (Bit0 n) = Neg (bitM n)
|
||||||
|
| sub (Bit1 m) One = Pos (Bit0 m)
|
||||||
|
| sub (Bit0 m) One = Pos (bitM m)
|
||||||
|
| sub One One = Zero_int
|
||||||
|
and plus_int (Neg m) (Neg n) = Neg (plus_num m n)
|
||||||
|
| plus_int (Neg m) (Pos n) = sub n m
|
||||||
|
| plus_int (Pos m) (Neg n) = sub m n
|
||||||
|
| plus_int (Pos m) (Pos n) = Pos (plus_num m n)
|
||||||
|
| plus_int Zero_int l = l
|
||||||
|
| plus_int k Zero_int = k
|
||||||
|
and minus_int (Neg m) (Neg n) = sub n m
|
||||||
|
| minus_int (Neg m) (Pos n) = Neg (plus_num m n)
|
||||||
|
| minus_int (Pos m) (Neg n) = Pos (plus_num m n)
|
||||||
|
| minus_int (Pos m) (Pos n) = sub m n
|
||||||
|
| minus_int Zero_int l = uminus_int l
|
||||||
|
| minus_int k Zero_int = k;
|
||||||
|
|
||||||
|
fun list_ex p [] = false
|
||||||
|
| list_ex p (x :: xs) = p x orelse list_ex p xs;
|
||||||
|
|
||||||
|
fun bex (Set xs) p = list_ex p xs;
|
||||||
|
|
||||||
|
fun snd (x1, x2) = x2;
|
||||||
|
|
||||||
|
fun fst (x1, x2) = x1;
|
||||||
|
|
||||||
|
fun next a = fst (snd a);
|
||||||
|
|
||||||
|
fun foldl f a [] = a
|
||||||
|
| foldl f a (x :: xs) = foldl f (f a x) xs;
|
||||||
|
|
||||||
|
fun foldl2 f xs a = foldl (fn aa => fn b => f b aa) a xs;
|
||||||
|
|
||||||
|
fun delta a = foldl2 (next a);
|
||||||
|
|
||||||
|
fun filter p [] = []
|
||||||
|
| filter p (x :: xs) = (if p x then x :: filter p xs else filter p xs);
|
||||||
|
|
||||||
|
fun membera A_ [] y = false
|
||||||
|
| membera A_ (x :: xs) y = eq A_ x y orelse membera A_ xs y;
|
||||||
|
|
||||||
|
fun member A_ x (Coset xs) = not (membera A_ xs x)
|
||||||
|
| member A_ x (Set xs) = membera A_ xs x;
|
||||||
|
|
||||||
|
fun removeAll A_ x [] = []
|
||||||
|
| removeAll A_ x (y :: xs) =
|
||||||
|
(if eq A_ x y then removeAll A_ x xs else y :: removeAll A_ x xs);
|
||||||
|
|
||||||
|
fun inserta A_ x xs = (if membera A_ xs x then xs else x :: xs);
|
||||||
|
|
||||||
|
fun insert A_ x (Coset xs) = Coset (removeAll A_ x xs)
|
||||||
|
| insert A_ x (Set xs) = Set (inserta A_ x xs);
|
||||||
|
|
||||||
|
fun fold f (x :: xs) s = fold f xs (f x s)
|
||||||
|
| fold f [] s = s;
|
||||||
|
|
||||||
|
fun sup_set A_ (Coset xs) a = Coset (filter (fn x => not (member A_ x a)) xs)
|
||||||
|
| sup_set A_ (Set xs) a = fold (insert A_) xs a;
|
||||||
|
|
||||||
|
val bot_set : 'a set = Set [];
|
||||||
|
|
||||||
|
fun sup_seta A_ (Set xs) = fold (sup_set A_) xs bot_set;
|
||||||
|
|
||||||
|
fun map f [] = []
|
||||||
|
| map f (x21 :: x22) = f x21 :: map f x22;
|
||||||
|
|
||||||
|
fun image f (Set xs) = Set (map f xs);
|
||||||
|
|
||||||
|
fun deltaa A_ a [] p = insert A_ p bot_set
|
||||||
|
| deltaa A_ aa (a :: w) p =
|
||||||
|
sup_seta A_ (image (deltaa A_ aa w) (next aa a p));
|
||||||
|
|
||||||
|
fun null [] = true
|
||||||
|
| null (x :: xs) = false;
|
||||||
|
|
||||||
|
fun start a = fst a;
|
||||||
|
|
||||||
|
fun fin a = snd (snd a);
|
||||||
|
|
||||||
|
fun accepts a = (fn w => fin a (delta a w (start a)));
|
||||||
|
|
||||||
|
fun acceptsa A_ a w = bex (deltaa A_ a w (start a)) (fin a);
|
||||||
|
|
||||||
|
fun or x =
|
||||||
|
(fn (ql, (dl, fl)) => fn (qr, (dr, fr)) =>
|
||||||
|
([], ((fn a => fn b =>
|
||||||
|
(case b
|
||||||
|
of [] =>
|
||||||
|
sup_set (equal_list equal_bool)
|
||||||
|
(image (fn aa => true :: aa) (dl a ql))
|
||||||
|
(image (fn aa => false :: aa) (dr a qr))
|
||||||
|
| true :: s => image (fn aa => true :: aa) (dl a s)
|
||||||
|
| false :: s => image (fn aa => false :: aa) (dr a s))),
|
||||||
|
(fn a =>
|
||||||
|
(case a of [] => fl ql orelse fr qr | true :: s => fl s
|
||||||
|
| false :: s => fr s)))))
|
||||||
|
x;
|
||||||
|
|
||||||
|
fun is_empty (Set xs) = null xs;
|
||||||
|
|
||||||
|
fun na2da A_ a =
|
||||||
|
(insert A_ (start a) bot_set,
|
||||||
|
((fn aa => fn q => sup_seta A_ (image (next a aa) q)),
|
||||||
|
(fn q => bex q (fin a))));
|
||||||
|
|
||||||
|
fun atom A_ a =
|
||||||
|
([true],
|
||||||
|
((fn b => fn s =>
|
||||||
|
(if equal_lista equal_bool s [true] andalso eq A_ b a
|
||||||
|
then insert (equal_list equal_bool) [false] bot_set else bot_set)),
|
||||||
|
(fn s => equal_lista equal_bool s [false])));
|
||||||
|
|
||||||
|
fun conc x =
|
||||||
|
(fn (ql, (dl, fl)) => fn (qr, (dr, fr)) =>
|
||||||
|
(true :: ql,
|
||||||
|
((fn a => fn b =>
|
||||||
|
(case b of [] => bot_set
|
||||||
|
| true :: s =>
|
||||||
|
sup_set (equal_list equal_bool)
|
||||||
|
(image (fn aa => true :: aa) (dl a s))
|
||||||
|
(if fl s then image (fn aa => false :: aa) (dr a qr)
|
||||||
|
else bot_set)
|
||||||
|
| false :: s => image (fn aa => false :: aa) (dr a s))),
|
||||||
|
(fn a =>
|
||||||
|
(case a of [] => false
|
||||||
|
| left :: s =>
|
||||||
|
left andalso (fl s andalso fr qr) orelse
|
||||||
|
not left andalso fr s)))))
|
||||||
|
x;
|
||||||
|
|
||||||
|
fun plus x =
|
||||||
|
(fn (q, (d, f)) =>
|
||||||
|
(q, ((fn a => fn s =>
|
||||||
|
sup_set (equal_list equal_bool) (d a s)
|
||||||
|
(if f s then d a q else bot_set)),
|
||||||
|
f)))
|
||||||
|
x;
|
||||||
|
|
||||||
|
val epsilon :
|
||||||
|
bool list * (('a -> bool list -> (bool list) set) * (bool list -> bool))
|
||||||
|
= ([], ((fn _ => fn _ => bot_set), null));
|
||||||
|
|
||||||
|
fun star a = or epsilon (plus a);
|
||||||
|
|
||||||
|
fun rexp2na A_ Zero = ([], ((fn _ => fn _ => bot_set), (fn _ => false)))
|
||||||
|
| rexp2na A_ Onea = epsilon
|
||||||
|
| rexp2na A_ (Atom a) = atom A_ a
|
||||||
|
| rexp2na A_ (Plus (r, s)) = or (rexp2na A_ r) (rexp2na A_ s)
|
||||||
|
| rexp2na A_ (Times (r, s)) = conc (rexp2na A_ r) (rexp2na A_ s)
|
||||||
|
| rexp2na A_ (Star r) = star (rexp2na A_ r);
|
||||||
|
|
||||||
|
fun apsnd f (x, y) = (x, f y);
|
||||||
|
|
||||||
|
val one : nat = one_nat;
|
||||||
|
|
||||||
|
val zero : nat = Zero_nat;
|
||||||
|
|
||||||
|
fun enabled a sigma = filter (fn x => not (is_empty (next a x sigma)));
|
||||||
|
|
||||||
|
val example_expression : nat rexp =
|
||||||
|
let
|
||||||
|
val r0 = Atom Zero_nat;
|
||||||
|
val r1 = Atom one_nat;
|
||||||
|
in
|
||||||
|
Times (Star (Plus (Times (r1, r1), r0)), Star (Plus (Times (r0, r0), r1)))
|
||||||
|
end;
|
||||||
|
|
||||||
|
fun sgn_integer k =
|
||||||
|
(if ((k : IntInf.int) = (0 : IntInf.int)) then (0 : IntInf.int)
|
||||||
|
else (if IntInf.< (k, (0 : IntInf.int)) then (~1 : IntInf.int)
|
||||||
|
else (1 : IntInf.int)));
|
||||||
|
|
||||||
|
fun divmod_integer k l =
|
||||||
|
(if ((k : IntInf.int) = (0 : IntInf.int))
|
||||||
|
then ((0 : IntInf.int), (0 : IntInf.int))
|
||||||
|
else (if ((l : IntInf.int) = (0 : IntInf.int)) then ((0 : IntInf.int), k)
|
||||||
|
else (apsnd o (fn a => fn b => IntInf.* (a, b)) o sgn_integer) l
|
||||||
|
(if (((sgn_integer k) : IntInf.int) = (sgn_integer l))
|
||||||
|
then IntInf.divMod (IntInf.abs k, IntInf.abs l)
|
||||||
|
else let
|
||||||
|
val (r, s) =
|
||||||
|
IntInf.divMod (IntInf.abs k, IntInf.abs l);
|
||||||
|
in
|
||||||
|
(if ((s : IntInf.int) = (0 : IntInf.int))
|
||||||
|
then (IntInf.~ r, (0 : IntInf.int))
|
||||||
|
else (IntInf.- (IntInf.~ r, (1 : IntInf.int)),
|
||||||
|
IntInf.- (IntInf.abs l, s)))
|
||||||
|
end)));
|
||||||
|
|
||||||
|
fun nat_of_integer k =
|
||||||
|
(if IntInf.<= (k, (0 : IntInf.int)) then Zero_nat
|
||||||
|
else let
|
||||||
|
val (l, j) = divmod_integer k (2 : IntInf.int);
|
||||||
|
val la = nat_of_integer l;
|
||||||
|
val lb = plus_nat la la;
|
||||||
|
in
|
||||||
|
(if ((j : IntInf.int) = (0 : IntInf.int)) then lb
|
||||||
|
else plus_nat lb one_nat)
|
||||||
|
end);
|
||||||
|
|
||||||
|
fun times_num (Bit1 m) (Bit1 n) =
|
||||||
|
Bit1 (plus_num (plus_num m n) (Bit0 (times_num m n)))
|
||||||
|
| times_num (Bit1 m) (Bit0 n) = Bit0 (times_num (Bit1 m) n)
|
||||||
|
| times_num (Bit0 m) (Bit1 n) = Bit0 (times_num m (Bit1 n))
|
||||||
|
| times_num (Bit0 m) (Bit0 n) = Bit0 (Bit0 (times_num m n))
|
||||||
|
| times_num One n = n
|
||||||
|
| times_num m One = m;
|
||||||
|
|
||||||
|
fun times_int (Neg m) (Neg n) = Pos (times_num m n)
|
||||||
|
| times_int (Neg m) (Pos n) = Neg (times_num m n)
|
||||||
|
| times_int (Pos m) (Neg n) = Neg (times_num m n)
|
||||||
|
| times_int (Pos m) (Pos n) = Pos (times_num m n)
|
||||||
|
| times_int Zero_int l = Zero_int
|
||||||
|
| times_int k Zero_int = Zero_int;
|
||||||
|
|
||||||
|
fun int_of_integer k =
|
||||||
|
(if IntInf.< (k, (0 : IntInf.int))
|
||||||
|
then uminus_int (int_of_integer (IntInf.~ k))
|
||||||
|
else (if ((k : IntInf.int) = (0 : IntInf.int)) then Zero_int
|
||||||
|
else let
|
||||||
|
val (l, j) = divmod_integer k (2 : IntInf.int);
|
||||||
|
val la = times_int (Pos (Bit0 One)) (int_of_integer l);
|
||||||
|
in
|
||||||
|
(if ((j : IntInf.int) = (0 : IntInf.int)) then la
|
||||||
|
else plus_int la one_int)
|
||||||
|
end));
|
||||||
|
|
||||||
|
end; (*struct RegExpChecker*)
|
|
@ -0,0 +1,113 @@
|
||||||
|
theory RegExpInterface
|
||||||
|
imports "Functional-Automata.Execute"
|
||||||
|
begin
|
||||||
|
|
||||||
|
term Atom
|
||||||
|
value "Star (Times(Plus (Atom(CHR ''a'')) (Atom(CHR ''b''))) (Atom(CHR ''c'')))"
|
||||||
|
|
||||||
|
notation Star ("\<lbrace>(_)\<rbrace>\<^sup>*" [0]100)
|
||||||
|
notation Plus (infixr "||" 55)
|
||||||
|
notation Times (infixr "~~" 60)
|
||||||
|
notation Atom ("\<lfloor>_\<rfloor>" 65)
|
||||||
|
|
||||||
|
(*
|
||||||
|
datatype 'a rexp = Empty ("<>")
|
||||||
|
| Atom 'a ("\<lfloor>_\<rfloor>" 65)
|
||||||
|
| Alt "('a rexp)" "('a rexp)" (infixr "||" 55)
|
||||||
|
| Conc "('a rexp)" "('a rexp)" (infixr "~~" 60)
|
||||||
|
| Star "('a rexp)" ("\<lbrace>(_)\<rbrace>\<^sup>*" [0]100)
|
||||||
|
*)
|
||||||
|
|
||||||
|
definition rep1 :: "'a rexp \<Rightarrow> 'a rexp" ("\<lbrace>(_)\<rbrace>\<^sup>+")
|
||||||
|
where "\<lbrace>A\<rbrace>\<^sup>+ \<equiv> A ~~ \<lbrace>A\<rbrace>\<^sup>*"
|
||||||
|
|
||||||
|
definition opt :: "'a rexp \<Rightarrow> 'a rexp" ("\<lbrakk>(_)\<rbrakk>")
|
||||||
|
where "\<lbrakk>A\<rbrakk> \<equiv> A || One"
|
||||||
|
|
||||||
|
value "Star (Conc(Alt (Atom(CHR ''a'')) (Atom(CHR ''b''))) (Atom(CHR ''c'')))"
|
||||||
|
text{* or better equivalently: *}
|
||||||
|
value "\<lbrace>(\<lfloor>CHR ''a''\<rfloor> || \<lfloor>CHR ''b''\<rfloor>) ~~ \<lfloor>CHR ''c''\<rfloor>\<rbrace>\<^sup>*"
|
||||||
|
|
||||||
|
section{* Definition of a semantic function: the ``language'' of the regular expression *}
|
||||||
|
text\<open> This is just a reminder - already defined in @{theory Regular_Exp} as @{term lang}.\<close>
|
||||||
|
|
||||||
|
text{* In the following, we give a semantics for our regular expressions, which so far have
|
||||||
|
just been a term language (i.e. abstract syntax). The semantics is a ``denotational semantics'',
|
||||||
|
i.e. we give a direct meaning for regular expressions in some universe of ``denotations''.
|
||||||
|
|
||||||
|
This universe of denotations is in our concrete case: *}
|
||||||
|
|
||||||
|
definition enabled :: "('a,'\<sigma> set)da \<Rightarrow> '\<sigma> set \<Rightarrow> 'a list \<Rightarrow> 'a list"
|
||||||
|
where "enabled A \<sigma> = filter (\<lambda>x. next A x \<sigma> \<noteq> {}) "
|
||||||
|
|
||||||
|
text{* Now the denotational semantics for regular expression can be defined on a post-card: *}
|
||||||
|
|
||||||
|
fun L :: "'a rexp => 'a lang"
|
||||||
|
where L_Emp : "L Zero = {}"
|
||||||
|
|L_One: "L One = {[]}"
|
||||||
|
|L_Atom: "L (\<lfloor>a\<rfloor>) = {[a]}"
|
||||||
|
|L_Un: "L (el || er) = (L el) \<union> (L er)"
|
||||||
|
|L_Conc: "L (el ~~ er) = {xs@ys | xs ys. xs \<in> L el \<and> ys \<in> L er}"
|
||||||
|
|L_Star: "L (Star e) = Regular_Set.star(L e)"
|
||||||
|
|
||||||
|
|
||||||
|
text\<open>A more useful definition is the \<close>
|
||||||
|
fun L\<^sub>s\<^sub>u\<^sub>b :: "'a::order rexp => 'a lang"
|
||||||
|
where L\<^sub>s\<^sub>u\<^sub>b_Emp: "L\<^sub>s\<^sub>u\<^sub>b Zero = {}"
|
||||||
|
|L\<^sub>s\<^sub>u\<^sub>b_One: "L\<^sub>s\<^sub>u\<^sub>b One = {[]}"
|
||||||
|
|L\<^sub>s\<^sub>u\<^sub>b_Atom: "L\<^sub>s\<^sub>u\<^sub>b (\<lfloor>a\<rfloor>) = {z . \<forall>x. x \<le> a \<and> z=[x]}"
|
||||||
|
|L\<^sub>s\<^sub>u\<^sub>b_Un: "L\<^sub>s\<^sub>u\<^sub>b (el || er) = (L\<^sub>s\<^sub>u\<^sub>b el) \<union> (L\<^sub>s\<^sub>u\<^sub>b er)"
|
||||||
|
|L\<^sub>s\<^sub>u\<^sub>b_Conc: "L\<^sub>s\<^sub>u\<^sub>b (el ~~ er) = {xs@ys | xs ys. xs \<in> L\<^sub>s\<^sub>u\<^sub>b el \<and> ys \<in> L\<^sub>s\<^sub>u\<^sub>b er}"
|
||||||
|
|L\<^sub>s\<^sub>u\<^sub>b_Star: "L\<^sub>s\<^sub>u\<^sub>b (Star e) = Regular_Set.star(L\<^sub>s\<^sub>u\<^sub>b e)"
|
||||||
|
|
||||||
|
|
||||||
|
definition XX where "XX = (rexp2na example_expression)"
|
||||||
|
definition YY where "YY = na2da(rexp2na example_expression)"
|
||||||
|
(* reminder from execute *)
|
||||||
|
value "NA.accepts (rexp2na example_expression) [0,1,1,0,0,1]"
|
||||||
|
value "DA.accepts (na2da (rexp2na example_expression)) [0,1,1,0,0,1]"
|
||||||
|
|
||||||
|
definition zero where "zero = (0::nat)"
|
||||||
|
definition one where "one = (1::nat)"
|
||||||
|
|
||||||
|
typ "'a set"
|
||||||
|
|
||||||
|
|
||||||
|
export_code zero one Suc Int.nat nat_of_integer int_of_integer
|
||||||
|
Zero One Atom Plus Times Star
|
||||||
|
rexp2na na2da enabled
|
||||||
|
NA.accepts DA.accepts
|
||||||
|
|
||||||
|
example_expression
|
||||||
|
|
||||||
|
in SML
|
||||||
|
|
||||||
|
|
||||||
|
module_name RegExpChecker file "RegExpChecker.sml"
|
||||||
|
|
||||||
|
SML_file "RegExpChecker.sml"
|
||||||
|
|
||||||
|
ML\<open>
|
||||||
|
(*use "RegExpChecker.sml";
|
||||||
|
open RegExpChecker; *)\<close>
|
||||||
|
|
||||||
|
(*
|
||||||
|
ML{* use "RegExpChecker.sml"; open RegExpChecker;
|
||||||
|
|
||||||
|
val eq_int = {equal = curry(op =) : int -> int -> bool};
|
||||||
|
val eq_bool_list = {equal = curry(op =) : bool list -> bool list -> bool};
|
||||||
|
val eq_mynat = {equal = fn x:RegExpChecker.nat => fn y => x = y}
|
||||||
|
val s = RegExpChecker.rexp2na eq_int;
|
||||||
|
val xxx = na2da eq_mynat;
|
||||||
|
val ((init), (next,fin)) = na2da eq_bool_list (RegExpChecker.rexp2na eq_mynat example_expression);
|
||||||
|
val Set X = next zero init;
|
||||||
|
val Set Y = next one init;
|
||||||
|
val Set Z = next (Suc one) init;
|
||||||
|
*}
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
no_notation Atom ("\<lfloor>_\<rfloor>")
|
||||||
|
|
||||||
|
|
||||||
|
end
|
|
@ -88,5 +88,116 @@ doc_class article =
|
||||||
|
|
||||||
gen_sty_template
|
gen_sty_template
|
||||||
|
|
||||||
|
|
||||||
|
ML\<open>
|
||||||
|
val term = @{term "(title ~~
|
||||||
|
\<lbrakk>subtitle\<rbrakk> ~~
|
||||||
|
\<lbrace>author\<rbrace>\<^sup>+ ~~
|
||||||
|
abstract ~~
|
||||||
|
introduction ~~
|
||||||
|
\<lbrace>technical || example\<rbrace>\<^sup>+ ~~
|
||||||
|
conclusion ~~
|
||||||
|
bibliography)"}
|
||||||
|
|
||||||
|
\<close>
|
||||||
|
|
||||||
|
|
||||||
|
ML\<open>
|
||||||
|
use "RegExpChecker.sml";
|
||||||
|
|
||||||
|
structure RegExpInterface : sig
|
||||||
|
type automaton
|
||||||
|
type env
|
||||||
|
val alphabet: term list -> env
|
||||||
|
val conv : term -> env -> int RegExpChecker.rexp (* for debugging *)
|
||||||
|
val rexp_term2da: term -> env -> automaton
|
||||||
|
val enabled : automaton -> env -> string list
|
||||||
|
val next : automaton -> env -> string -> automaton
|
||||||
|
val final : automaton -> bool
|
||||||
|
val accepts : automaton -> env -> string list -> bool
|
||||||
|
end
|
||||||
|
=
|
||||||
|
struct
|
||||||
|
local open RegExpChecker in
|
||||||
|
|
||||||
|
type state = bool list RegExpChecker.set
|
||||||
|
type env = string list
|
||||||
|
|
||||||
|
type automaton = state * ((Int.int -> state -> state) * (state -> bool))
|
||||||
|
|
||||||
|
val add_atom = fold_aterms (fn Const(c as(_,Type(@{type_name "rexp"},_)))=> insert (op=) c |_=>I);
|
||||||
|
fun alphabet termS = rev(map fst (fold add_atom termS []));
|
||||||
|
|
||||||
|
fun conv (Const(@{const_name "Regular_Exp.rexp.Zero"},_)) _ = Zero
|
||||||
|
|conv (Const(@{const_name "Regular_Exp.rexp.One"},_)) _ = Onea
|
||||||
|
|conv (Const(@{const_name "Regular_Exp.rexp.Times"},_) $ X $ Y) env = Times(conv X env, conv Y env)
|
||||||
|
|conv (Const(@{const_name "Regular_Exp.rexp.Plus"},_) $ X $ Y) env = Plus(conv X env, conv Y env)
|
||||||
|
|conv (Const(@{const_name "Regular_Exp.rexp.Star"},_) $ X) env = Star(conv X env)
|
||||||
|
|conv (Const(@{const_name "RegExpInterface.opt"},_) $ X) env = Plus(conv X env, Onea)
|
||||||
|
|conv (Const(@{const_name "RegExpInterface.rep1"},_) $ X) env = Times(conv X env, Star(conv X env))
|
||||||
|
|conv (Const (s, @{typ "doc_class rexp"})) env =
|
||||||
|
let val n = find_index (fn x => x = s) env
|
||||||
|
val _ = if n<0 then error"conversion error of regexp." else ()
|
||||||
|
in Atom(n) end
|
||||||
|
|conv S _ = error("conversion error of regexp:" ^ (Syntax.string_of_term (@{context})S))
|
||||||
|
|
||||||
|
val eq_int = {equal = curry(op =) : Int.int -> Int.int -> bool};
|
||||||
|
val eq_bool_list = {equal = curry(op =) : bool list -> bool list -> bool};
|
||||||
|
|
||||||
|
fun rexp_term2da term env = let val rexp = conv term env;
|
||||||
|
val nda = RegExpChecker.rexp2na eq_int rexp;
|
||||||
|
val da = RegExpChecker.na2da eq_bool_list nda;
|
||||||
|
in da end;
|
||||||
|
|
||||||
|
|
||||||
|
(* here comes the main interface of the module:
|
||||||
|
- "enabled" gives the part of the alphabet "env" for which the automatan does not
|
||||||
|
go into a final state
|
||||||
|
- next provides an automata transformation that produces an automaton that
|
||||||
|
recognizes the rest of a word after a *)
|
||||||
|
fun enabled (da as (state,(_,_))) env =
|
||||||
|
let val inds = RegExpChecker.enabled da state (0 upto (length env - 1))
|
||||||
|
in map (fn i => nth env i) inds end
|
||||||
|
|
||||||
|
fun next (current_state, (step,fin)) env a =
|
||||||
|
let val index = find_index (fn x => x = a) env
|
||||||
|
in if index < 0 then error"undefined id for monitor"
|
||||||
|
else (step index current_state,(step,fin))
|
||||||
|
end
|
||||||
|
|
||||||
|
fun final (current_state, (_,fin)) = fin current_state
|
||||||
|
|
||||||
|
fun accepts da env word = let fun index a = find_index (fn x => x = a) env
|
||||||
|
val indexL = map index word
|
||||||
|
val _ = if forall (fn x => x >= 0) indexL then ()
|
||||||
|
else error"undefined id for monitor"
|
||||||
|
in RegExpChecker.accepts da indexL end
|
||||||
|
|
||||||
|
end; (* local *)
|
||||||
|
end (* struct *)
|
||||||
|
\<close>
|
||||||
|
ML\<open>
|
||||||
|
val alpha = (RegExpInterface.alphabet [term]);
|
||||||
|
val DA as (init,(next,fin)) = RegExpInterface.rexp_term2da term (RegExpInterface.alphabet [term]) ;
|
||||||
|
RegExpChecker.accepts DA [0,2,3,4,5,6,7,8];
|
||||||
|
|
||||||
|
|
||||||
|
val S0 = init
|
||||||
|
val E1 = RegExpChecker.enabled DA S0 [0,1,2,3,4,5,6,7,8];
|
||||||
|
val S1 = next 0 init;
|
||||||
|
val E2 = RegExpChecker.enabled DA S1 [0,1,2,3,4,5,6,7,8];
|
||||||
|
val S2 = next 2 S1; (* uffz. it works. *)
|
||||||
|
val E3 = RegExpChecker.enabled DA S2 [0,1,2,3,4,5,6,7,8];
|
||||||
|
val S3 = next 3 S2; (* uffz. it works. *)
|
||||||
|
\<close>
|
||||||
|
|
||||||
|
ML\<open>
|
||||||
|
RegExpInterface.enabled DA alpha;
|
||||||
|
val DA' = RegExpInterface.next DA alpha "scholarly_paper.title";
|
||||||
|
RegExpInterface.enabled DA' alpha;
|
||||||
|
val DA'' = RegExpInterface.next DA' alpha "scholarly_paper.author";
|
||||||
|
RegExpInterface.enabled DA'' alpha;
|
||||||
|
\<close>
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue