Loading theory "Collections.ICF_Tools" (required by "Collections.Robdd" via "Collections.MapSpec" via "Collections.ICF_Spec_Base" via "Collections.Record_Intf") Loading theory "Collections.Partial_Equivalence_Relation" ### theory "Collections.Partial_Equivalence_Relation" ### 0.166s elapsed time, 0.400s cpu time, 0.000s GC time Loading theory "Finger-Trees.FingerTree" infix 0 ## signature ICF_TOOLS = sig val changed_conv: conv -> conv val chead_of: cterm -> cterm val chead_of_thm: thm -> cterm val define_simple: string -> term -> local_theory -> (term * thm) * local_theory val define_simple_global: string -> term -> theory -> (term * thm) * theory val define_simple_local: string -> term -> local_theory -> (term * thm) * local_theory val dest_def_eq: term -> term * term val dt_head: term -> term val dt_lhs: term -> term val dt_params: term -> term list val dt_rhs: term -> term val dthm_head: thm -> term val dthm_lhs: thm -> term val dthm_params: thm -> term list val dthm_rhs: thm -> term val gen_variant: (string -> bool) -> string -> string val import_cterm: cterm -> Proof.context -> cterm * Proof.context val inst_meta_cong: Proof.context -> cterm -> thm val map_option: ('a -> 'b) -> 'a option -> 'b option val norm_def_thm: thm -> thm val parse_cpat: cterm context_parser val rem_dup_prems: Proof.context -> thm -> thm val rename_cterm: cterm * cterm -> ((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list val renames_cterm: cterm * cterm -> bool val repeat_top_sweep_conv: (Proof.context -> conv) -> Proof.context -> conv val revert_abbrevs: string -> theory -> theory val sss_add: thm list -> Proof.context -> Proof.context val wrap_lthy_global: (local_theory -> local_theory) -> theory -> theory val wrap_lthy_local: (local_theory -> local_theory) -> local_theory -> local_theory val wrap_lthy_result_global: (local_theory -> 'a * local_theory) -> (morphism -> 'a -> 'b) -> theory -> 'b * theory val wrap_lthy_result_local: (local_theory -> 'a * local_theory) -> (morphism -> 'a -> 'b) -> local_theory -> 'b * local_theory end val ## = fn: ('a -> 'b) * ('c -> 'd) -> 'a * 'c -> 'b * 'd structure ICF_Tools: ICF_TOOLS ### theory "Collections.ICF_Tools" ### 0.175s elapsed time, 0.412s cpu time, 0.000s GC time Loading theory "Collections.Ord_Code_Preproc" (required by "Collections.Robdd" via "Collections.MapSpec" via "Collections.ICF_Spec_Base" via "Collections.Record_Intf") ### ML warning (line 27 of "~~/afp/thys/Collections/ICF/tools/Ord_Code_Preproc.thy"): ### (=) has infix status but was not preceded by op. ### ML warning (line 38 of "~~/afp/thys/Collections/ICF/tools/Ord_Code_Preproc.thy"): ### Value identifier (trace_ft) has not been referenced. ### ML warning (line 51 of "~~/afp/thys/Collections/ICF/tools/Ord_Code_Preproc.thy"): ### Value identifier (process) has not been referenced. signature ORD_CODE_PREPROC = sig val add: int * string * (theory -> thm -> thm) -> theory -> theory val get: theory -> (int * string * (theory -> thm -> thm)) list val rem: string -> theory -> theory val setup: theory -> theory val trace_enabled: bool ref end signature OC_SIMPSET = sig val get: theory -> simpset val map: (simpset -> simpset) -> theory -> theory val setup: theory -> theory end structure Ord_Code_Preproc: ORD_CODE_PREPROC functor Oc_Simpset (sig val name: string val prio: int end): OC_SIMPSET ### theory "Collections.Ord_Code_Preproc" ### 0.065s elapsed time, 0.128s cpu time, 0.000s GC time Loading theory "Collections.Locale_Code" (required by "Collections.Robdd" via "Collections.MapSpec" via "Collections.ICF_Spec_Base") locale FingerTreeStruc_loc ### ML warning (line 343 of "~~/afp/thys/Collections/ICF/tools/Locale_Code.thy"): ### Pattern is not exhaustive. signature LOCALE_CODE = sig val add_pat_eq: cterm -> thm list -> theory -> theory val close_block: theory -> theory val del_pat: cterm -> theory -> theory val get_unf_ss: theory -> simpset val lc_decl_del: term -> local_theory -> local_theory val lc_decl_eq: thm list -> local_theory -> local_theory val open_block: theory -> theory type pat_eq = cterm * thm list val setup: theory -> theory val tracing_enabled: bool ref end structure Locale_Code: LOCALE_CODE ### theory "Collections.Locale_Code" ### 0.190s elapsed time, 0.380s cpu time, 0.000s GC time Loading theory "Collections.Record_Intf" (required by "Collections.Robdd" via "Collections.MapSpec" via "Collections.ICF_Spec_Base") signature RECORD_INTF = sig val add_unf_thms: thm list -> Context.generic -> Context.generic val add_unf_thms_global: thm list -> theory -> theory val get_unf_ss: Context.generic -> simpset val get_unf_thms: Context.generic -> thm list val icf_locales_tac: Proof.context -> tactic val icf_rec_def: thm -> Context.generic -> Context.generic val icf_rec_def_attr: attribute context_parser val setup: theory -> theory end structure Record_Intf: RECORD_INTF ### theory "Collections.Record_Intf" ### 0.099s elapsed time, 0.200s cpu time, 0.000s GC time Loading theory "HOL-Library.AList" (required by "Collections.Assoc_List") consts update :: "'key \ 'val \ ('key \ 'val) list \ ('key \ 'val) list" consts update_with_aux :: "'val \ 'key \ ('val \ 'val) \ ('key \ 'val) list \ ('key \ 'val) list" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "(\p. size_list size (snd (snd p))) <*mlex*> {}" Found termination order: "(\p. size_list size (snd (snd (snd p)))) <*mlex*> {}" ### theory "HOL-Library.AList" ### 1.764s elapsed time, 3.472s cpu time, 0.424s GC time Loading theory "Binomial-Heaps.BinomialHeap" locale BinomialHeapStruc_loc ### Ignoring sort constraints in type variables(s): "'a" ### in type abbreviation "BinomialQueue_inv" Found termination order: "{}" Found termination order: "case_sum size (size_list size) <*mlex*> {}" Found termination order: "size_list size <*mlex*> {}" Found termination order: "{}" Found termination order: "case_sum size (size_list size) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> (\p. size_list size (fst p)) <*mlex*> {}" ### Missing patterns in function definition: ### getMinTree [] = undefined Found termination order: "size_list size <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" locale FingerTreeStruc_loc consts gmn :: "('e, 'a) Node \ 'a" consts gmd :: "('e, 'a) Digit \ 'a" consts gmft :: "('e, 'a) FingerTreeStruc \ 'a" Found termination order: "(\p. size (snd p)) <*mlex*> {}" locale BinomialHeap_loc consts is_leveln_digit :: "nat \ ('e, 'a) Digit \ bool" consts is_leveln_ftree :: "nat \ ('e, 'a) FingerTreeStruc \ bool" consts is_measured_node :: "('e, 'a) Node \ bool" consts is_measured_digit :: "('e, 'a) Digit \ bool" consts is_measured_ftree :: "('e, 'a) FingerTreeStruc \ bool" ### theory "Binomial-Heaps.BinomialHeap" ### 3.836s elapsed time, 7.608s cpu time, 0.776s GC time Loading theory "Binomial-Heaps.SkewBinomialHeap" consts nodeToList :: "('e, 'a) Node \ ('e \ 'a) list" consts digitToList :: "('e, 'a) Digit \ ('e \ 'a) list" consts toList :: "('e, 'a) FingerTreeStruc \ ('e \ 'a) list" locale SkewBinomialHeapStruc_loc Found termination order: "(\p. size (snd p)) <*mlex*> {}" Found termination order: "(\p. size (fst p)) <*mlex*> {}" consts toTree :: "('e \ 'a) list \ ('e, 'a) FingerTreeStruc" consts digitToTree :: "('e, 'a) Digit \ ('e, 'a) FingerTreeStruc" consts nodeToDigit :: "('e, 'a) Node \ ('e, 'a) Digit" ### Missing patterns in function definition: ### nlistToDigit [] = undefined ### \v vb va vc vd vf. ### nlistToDigit (v # vb # va # vc # vd # vf) = undefined ### Ignoring sort constraints in type variables(s): "'a" ### in type abbreviation "SkewBinomialQueue" Found termination order: "{}" consts digitToNlist :: "('e, 'a) Digit \ ('e, 'a) Node list" consts n_unwrap :: "('e, 'a) Node \ 'e \ 'a" Found termination order: "case_sum size (size_list size) <*mlex*> {}" Found termination order: "{}" Found termination order: "size <*mlex*> {}" Found termination order: "{}" Found termination order: "size <*mlex*> {}" Found termination order: "size_list size <*mlex*> {}" consts lconsNlist :: "('e, 'a) Node list \ ('e, 'a) FingerTreeStruc \ ('e, 'a) FingerTreeStruc" consts rconsNlist :: "('e, 'a) FingerTreeStruc \ ('e, 'a) Node list \ ('e, 'a) FingerTreeStruc" ### Missing patterns in function definition: ### nodes [] = undefined ### \v. nodes [v] = undefined Found termination order: "{}" Found termination order: "{}" Found termination order: "size_list size <*mlex*> {}" Found termination order: "case_sum size (size_list size) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "(\p. size (snd (snd p))) <*mlex*> {}" consts nlistToList :: "('e, 'a) Node list \ ('e \ 'a) list" Found termination order: "{}" Found termination order: "{}" Found termination order: "{}" Found termination order: "{}" ### Missing patterns in function definition: ### \a b. splitNlist a b [] = undefined Found termination order: "(\p. size_list size (snd p)) <*mlex*> (\p. size_list size (fst p)) <*mlex*> {}" ### Missing patterns in function definition: ### getMinTree [] = undefined Found termination order: "(\p. size_list size (snd (snd p))) <*mlex*> {}" Found termination order: "size_list size <*mlex*> {}" Found termination order: "(\p. size_list size (fst p)) <*mlex*> {}" Found termination order: "(\p. size (snd (snd p))) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" consts gmnl :: "('e, 'a) Node list \ 'a" Found termination order: "(\p. size (snd (snd p))) <*mlex*> {}" consts foldl_digit :: "('s \ 'e \ 'a \ 's) \ 's \ ('e, 'a) Digit \ 's" consts foldr_node :: "('e \ 'a \ 's \ 's) \ ('e, 'a) Node \ 's \ 's" locale Bootstrapped consts foldr_digit :: "('e \ 'a \ 's \ 's) \ ('e, 'a) Digit \ 's \ 's" consts foldl :: "('s \ 'e \ 'a \ 's) \ 's \ ('e, 'a) FingerTreeStruc \ 's" consts foldr :: "('e \ 'a \ 's \ 's) \ ('e, 'a) FingerTreeStruc \ 's \ 's" consts count_node :: "('e, 'a) Node \ nat" consts count_digit :: "('e, 'a) Digit \ nat" consts count :: "('e, 'a) FingerTreeStruc \ nat" locale FingerTree_loc ### theory "Finger-Trees.FingerTree" ### 12.888s elapsed time, 25.516s cpu time, 3.460s GC time Loading theory "HOL-Library.Code_Abstract_Nat" (required by "HOL-Library.Code_Target_Numeral" via "HOL-Library.Code_Target_Nat") ### theory "HOL-Library.Code_Abstract_Nat" ### 0.058s elapsed time, 0.116s cpu time, 0.000s GC time Loading theory "HOL-Library.Code_Target_Nat" (required by "HOL-Library.Code_Target_Numeral") ### Code generator: dropping subsumed code equation ### divmod_nat ?m ?n \ ### if ?n = 0 \ ?m < ?n then (0, ?m) ### else let (q, y) = divmod_nat (?m - ?n) ?n in (Suc q, y) ### Code generator: dropping subsumed code equation ### divmod (num.Bit1 ?m) (num.Bit1 ?n) \ ### if ?m < ?n then (0, numeral (num.Bit1 ?m)) ### else divmod_step (num.Bit1 ?n) ### (divmod (num.Bit1 ?m) (num.Bit0 (num.Bit1 ?n))) ### Code generator: dropping subsumed code equation ### divmod (num.Bit0 ?m) (num.Bit1 ?n) \ ### if ?m \ ?n then (0, numeral (num.Bit0 ?m)) ### else divmod_step (num.Bit1 ?n) ### (divmod (num.Bit0 ?m) (num.Bit0 (num.Bit1 ?n))) ### Code generator: dropping subsumed code equation ### divmod (num.Bit1 ?m) (num.Bit0 ?n) \ ### case divmod ?m ?n of (q, r) \ (q, 2 * r + 1) ### Code generator: dropping subsumed code equation ### divmod (num.Bit0 ?m) (num.Bit0 ?n) \ ### case divmod ?m ?n of (q, r) \ (q, 2 * r) ### Code generator: dropping subsumed code equation ### divmod num.One (num.Bit1 ?n) \ (0, Numeral1) ### Code generator: dropping subsumed code equation ### divmod num.One (num.Bit0 ?n) \ (0, Numeral1) ### Code generator: dropping subsumed code equation ### divmod (num.Bit1 ?m) num.One \ (numeral (num.Bit1 ?m), 0) ### Code generator: dropping subsumed code equation ### divmod (num.Bit0 ?m) num.One \ (numeral (num.Bit0 ?m), 0) ### Code generator: dropping subsumed code equation ### divmod num.One num.One \ (Numeral1, 0) ### Code generator: dropping subsumed code equation ### Suc ?m \ ?n \ ?m < ?n ### Code generator: dropping subsumed code equation ### 0 \ ?n \ True ### Code generator: dropping subsumed code equation ### ?m < Suc ?n \ ?m \ ?n ### Code generator: dropping subsumed code equation ### ?n < 0 \ False ### Code generator: dropping subsumed code equation ### of_nat ?n \ ### semiring_1_class.of_nat_aux (\i. i + (1::?'a)) ?n (0::?'a) ### theory "HOL-Library.Code_Target_Nat" ### 0.156s elapsed time, 0.312s cpu time, 0.000s GC time Loading theory "HOL-Library.Code_Target_Int" (required by "HOL-Library.Code_Target_Numeral") ### Code generator: dropping subsumed code equation ### 1 \ Int.Pos num.One ### Code generator: dropping subsumed code equation ### Int.Neg ?m + Int.Neg ?n \ Int.Neg (?m + ?n) ### Code generator: dropping subsumed code equation ### Int.Neg ?m + Int.Pos ?n \ Int.sub ?n ?m ### Code generator: dropping subsumed code equation ### Int.Pos ?m + Int.Neg ?n \ Int.sub ?m ?n ### Code generator: dropping subsumed code equation ### Int.Pos ?m + Int.Pos ?n \ Int.Pos (?m + ?n) ### Code generator: dropping subsumed code equation ### 0 + ?l \ ?l ### Code generator: dropping subsumed code equation ### ?k + 0 \ ?k ### Code generator: dropping subsumed code equation ### - Int.Neg ?m \ Int.Pos ?m ### Code generator: dropping subsumed code equation ### - Int.Pos ?m \ Int.Neg ?m ### Code generator: dropping subsumed code equation ### - 0 \ 0 ### Code generator: dropping subsumed code equation ### Int.Neg ?m - Int.Neg ?n \ Int.sub ?n ?m ### Code generator: dropping subsumed code equation ### Int.Neg ?m - Int.Pos ?n \ Int.Neg (?m + ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m - Int.Neg ?n \ Int.Pos (?m + ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m - Int.Pos ?n \ Int.sub ?m ?n ### Code generator: dropping subsumed code equation ### 0 - ?l \ - ?l ### Code generator: dropping subsumed code equation ### ?k - 0 \ ?k ### Code generator: dropping subsumed code equation ### Int.dup (Int.Neg ?n) \ Int.Neg (num.Bit0 ?n) ### Code generator: dropping subsumed code equation ### Int.dup (Int.Pos ?n) \ Int.Pos (num.Bit0 ?n) ### Code generator: dropping subsumed code equation ### Int.dup 0 \ 0 ### Code generator: dropping subsumed code equation ### Int.Neg ?m * Int.Neg ?n \ Int.Pos (?m * ?n) ### Code generator: dropping subsumed code equation ### Int.Neg ?m * Int.Pos ?n \ Int.Neg (?m * ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m * Int.Neg ?n \ Int.Neg (?m * ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m * Int.Pos ?n \ Int.Pos (?m * ?n) ### Code generator: dropping subsumed code equation ### 0 * ?l \ 0 ### Code generator: dropping subsumed code equation ### ?k * 0 \ 0 ### Code generator: dropping subsumed code equation ### Int.Neg ?m div Int.Neg ?n \ fst (divmod ?m ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m div Int.Neg ?n \ - Divides.adjust_div (divmod ?m ?n) ### Code generator: dropping subsumed code equation ### Int.Neg ?m div Int.Pos ?n \ - Divides.adjust_div (divmod ?m ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m div Int.Pos ?n \ fst (divmod ?m ?n) ### Code generator: dropping subsumed code equation ### ?k div Int.Neg num.One \ - ?k ### Code generator: dropping subsumed code equation ### ?k div Int.Pos num.One \ ?k ### Code generator: dropping subsumed code equation ### 0 div ?k \ 0 ### Code generator: dropping subsumed code equation ### ?k div 0 \ 0 ### Code generator: dropping subsumed code equation ### Int.Neg ?m mod Int.Neg ?n \ - snd (divmod ?m ?n) ### Code generator: dropping subsumed code equation ### Int.Pos ?m mod Int.Neg ?n \ ### - Divides.adjust_mod (Int.Pos ?n) (snd (divmod ?m ?n)) ### Code generator: dropping subsumed code equation ### Int.Neg ?m mod Int.Pos ?n \ ### Divides.adjust_mod (Int.Pos ?n) (snd (divmod ?m ?n)) ### Code generator: dropping subsumed code equation ### Int.Pos ?m mod Int.Pos ?n \ snd (divmod ?m ?n) ### Code generator: dropping subsumed code equation ### ?k mod Int.Neg num.One \ 0 ### Code generator: dropping subsumed code equation ### ?k mod Int.Pos num.One \ 0 ### Code generator: dropping subsumed code equation ### 0 mod ?k \ 0 ### Code generator: dropping subsumed code equation ### ?k mod 0 \ ?k ### Code generator: dropping subsumed code equation ### divmod (num.Bit1 ?m) (num.Bit1 ?n) \ ### if ?m < ?n then (0, numeral (num.Bit1 ?m)) ### else divmod_step (num.Bit1 ?n) ### (divmod (num.Bit1 ?m) (num.Bit0 (num.Bit1 ?n))) ### Code generator: dropping subsumed code equation ### divmod (num.Bit0 ?m) (num.Bit1 ?n) \ ### if ?m \ ?n then (0, numeral (num.Bit0 ?m)) ### else divmod_step (num.Bit1 ?n) ### (divmod (num.Bit0 ?m) (num.Bit0 (num.Bit1 ?n))) ### Code generator: dropping subsumed code equation ### divmod (num.Bit1 ?m) (num.Bit0 ?n) \ ### case divmod ?m ?n of (q, r) \ (q, 2 * r + 1) ### Code generator: dropping subsumed code equation ### divmod (num.Bit0 ?m) (num.Bit0 ?n) \ ### case divmod ?m ?n of (q, r) \ (q, 2 * r) ### Code generator: dropping subsumed code equation ### divmod num.One (num.Bit1 ?n) \ (0, Numeral1) ### Code generator: dropping subsumed code equation ### divmod num.One (num.Bit0 ?n) \ (0, Numeral1) ### Code generator: dropping subsumed code equation ### divmod (num.Bit1 ?m) num.One \ (numeral (num.Bit1 ?m), 0) ### Code generator: dropping subsumed code equation ### divmod (num.Bit0 ?m) num.One \ (numeral (num.Bit0 ?m), 0) ### Code generator: dropping subsumed code equation ### divmod num.One num.One \ (Numeral1, 0) ### Code generator: dropping subsumed code equation ### equal_class.equal ?k ?k \ True ### Code generator: dropping subsumed code equation ### equal_class.equal (Int.Neg ?k) (Int.Neg ?l) \ equal_class.equal ?k ?l ### Code generator: dropping subsumed code equation ### equal_class.equal (Int.Neg ?k) (Int.Pos ?l) \ False ### Code generator: dropping subsumed code equation ### equal_class.equal (Int.Neg ?k) 0 \ False ### Code generator: dropping subsumed code equation ### equal_class.equal (Int.Pos ?k) (Int.Neg ?l) \ False ### Code generator: dropping subsumed code equation ### equal_class.equal (Int.Pos ?k) (Int.Pos ?l) \ equal_class.equal ?k ?l ### Code generator: dropping subsumed code equation ### equal_class.equal (Int.Pos ?k) 0 \ False ### Code generator: dropping subsumed code equation ### equal_class.equal 0 (Int.Neg ?l) \ False ### Code generator: dropping subsumed code equation ### equal_class.equal 0 (Int.Pos ?l) \ False ### Code generator: dropping subsumed code equation ### equal_class.equal 0 0 \ True ### Code generator: dropping subsumed code equation ### Int.Neg ?k \ Int.Neg ?l \ ?l \ ?k ### Code generator: dropping subsumed code equation ### Int.Neg ?k \ Int.Pos ?l \ True ### Code generator: dropping subsumed code equation ### Int.Neg ?k \ 0 \ True ### Code generator: dropping subsumed code equation ### Int.Pos ?k \ Int.Neg ?l \ False ### Code generator: dropping subsumed code equation ### Int.Pos ?k \ Int.Pos ?l \ ?k \ ?l ### Code generator: dropping subsumed code equation ### Int.Pos ?k \ 0 \ False ### Code generator: dropping subsumed code equation ### 0 \ Int.Neg ?l \ False ### Code generator: dropping subsumed code equation ### 0 \ Int.Pos ?l \ True ### Code generator: dropping subsumed code equation ### 0 \ 0 \ True ### Code generator: dropping subsumed code equation ### Int.Neg ?k < Int.Neg ?l \ ?l < ?k ### Code generator: dropping subsumed code equation ### Int.Neg ?k < Int.Pos ?l \ True ### Code generator: dropping subsumed code equation ### Int.Neg ?k < 0 \ True ### Code generator: dropping subsumed code equation ### Int.Pos ?k < Int.Neg ?l \ False ### Code generator: dropping subsumed code equation ### Int.Pos ?k < Int.Pos ?l \ ?k < ?l ### Code generator: dropping subsumed code equation ### Int.Pos ?k < 0 \ False ### Code generator: dropping subsumed code equation ### 0 < Int.Neg ?l \ False ### Code generator: dropping subsumed code equation ### 0 < Int.Pos ?l \ True ### Code generator: dropping subsumed code equation ### 0 < 0 \ False ### Code generator: dropping subsumed code equation ### of_int (Int.Pos ?k) \ numeral ?k ### Code generator: dropping subsumed code equation ### of_int 0 \ 0::?'a ### Code generator: dropping subsumed code equation ### of_int (Int.Neg ?k) \ - numeral ?k ### Code generator: dropping subsumed code equation ### nat (Int.Pos ?k) \ nat_of_num ?k ### Code generator: dropping subsumed code equation ### nat 0 \ 0 ### Code generator: dropping subsumed code equation ### nat (Int.Neg ?k) \ 0 ### theory "HOL-Library.Code_Target_Int" ### 0.164s elapsed time, 0.332s cpu time, 0.000s GC time Loading theory "HOL-Library.Code_Target_Numeral" Found termination order: "size <*mlex*> {}" consts prio :: "('e, 'a) BsSkewBinomialTree \ 'a" ### theory "HOL-Library.Code_Target_Numeral" ### 0.148s elapsed time, 0.296s cpu time, 0.000s GC time Loading theory "HOL-Library.Dlist" (required by "Collections.Dlist_add") Found termination order: "{}" Found termination order: "{}" instantiation dlist :: (equal) equal equal_dlist == equal_class.equal :: 'a dlist \ 'a dlist \ bool Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "{}" Found termination order: "{}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> (\p. size_list size (fst p)) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> (\p. size_list size (fst p)) <*mlex*> {}" ### theory "HOL-Library.Dlist" ### 0.996s elapsed time, 2.000s cpu time, 0.000s GC time Loading theory "Collections.SetIterator" (required by "Collections.RBT_add" via "Collections.Iterator" via "Collections.It_to_It" via "Collections.Proper_Iterator" via "Collections.SetIteratorOperations") Found termination order: "(\p. size_list size (fst p)) <*mlex*> {}" locale set_iterator_genord fixes iti :: "('\ \ bool) \ ('x \ '\ \ '\) \ '\ \ '\" and S0 :: "'x set" and R :: "'x \ 'x \ bool" assumes "set_iterator_genord iti S0 R" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" ### Missing patterns in function definition: ### getMinTree [] = undefined Found termination order: "size_list size <*mlex*> {}" consts findMin' :: "('a, 'b) BsSkewElem \ 'a \ 'b" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" Found termination order: "{}" Found termination order: "{}" Found termination order: "{}" Found termination order: "case_sum size (size_list size) <*mlex*> {}" Found termination order: "{}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" ### No equation for constructor "Inl" consts bs_findMin :: "'c + ('a, 'b) BsSkewElem \ 'a \ 'b" ### theory "Collections.SetIterator" ### 3.929s elapsed time, 7.920s cpu time, 4.464s GC time Loading theory "Collections.Idx_Iterator" (required by "Collections.RBT_add" via "Collections.Iterator") Found termination order: "{}" consts bs_insert :: "'e \ 'a \ unit + ('e, 'a) BsSkewElem \ unit + ('e, 'a) BsSkewElem" ### Missing patterns in function definition: ### \v. bs_deleteMin (Inl v) = undefined Found termination order: "{}" consts bs_invar :: "unit + ('e, 'a) BsSkewElem \ bool" consts bs_to_mset :: "unit + ('e, 'a) BsSkewElem \ ('e \ 'a) multiset" Found termination order: "(\p. size (fst (snd (snd p)))) <*mlex*> {}" ### theory "Collections.Idx_Iterator" ### 0.667s elapsed time, 1.224s cpu time, 0.292s GC time Loading theory "Collections.SetAbstractionIterator" locale set_iterator_abs_genord fixes \ :: "'xc \ 'xa" and invar :: "'xc \ bool" and iti :: "('\ \ bool) \ ('xc \ '\ \ '\) \ '\ \ '\" and S0 :: "'xa set" and R :: "'xa \ 'xa \ bool" assumes "set_iterator_abs_genord \ invar iti S0 R" locale SkewBinomialHeap_loc ### theory "Collections.SetAbstractionIterator" ### 0.533s elapsed time, 1.020s cpu time, 0.000s GC time Loading theory "Collections.SetIteratorOperations" (required by "Collections.RBT_add" via "Collections.Iterator" via "Collections.It_to_It" via "Collections.Proper_Iterator") ### theory "Binomial-Heaps.SkewBinomialHeap" ### 13.676s elapsed time, 27.128s cpu time, 7.016s GC time Loading theory "Collections.Sorted_List_Operations" Found termination order: "(\p. length (snd p)) <*mlex*> (\p. length (fst p)) <*mlex*> {}" Found termination order: "(\p. length (snd p)) <*mlex*> (\p. length (fst p)) <*mlex*> {}" Found termination order: "(\p. length (snd p)) <*mlex*> {}" Found termination order: "(\p. length (fst p)) <*mlex*> {}" Found termination order: "(\p. length (snd p)) <*mlex*> {}" Found termination order: "(\p. length (snd p)) <*mlex*> {}" ### theory "Collections.Sorted_List_Operations" ### 1.228s elapsed time, 2.184s cpu time, 0.000s GC time Loading theory "HOL-Library.RBT_Impl" (required by "Collections.RBT_add") ### theory "Collections.SetIteratorOperations" ### 2.754s elapsed time, 5.188s cpu time, 0.696s GC time Loading theory "Collections.Assoc_List" instantiation assoc_list :: (equal, equal) equal equal_assoc_list == equal_class.equal :: ('a, 'b) assoc_list \ ('a, 'b) assoc_list \ bool instantiation assoc_list :: (type, type) size size_assoc_list == size :: ('a, 'b) assoc_list \ nat consts map_ran :: "('key \ 'val \ 'val') \ ('key \ 'val) list \ ('key \ 'val') list" ### theory "Collections.Assoc_List" ### 0.557s elapsed time, 1.116s cpu time, 0.000s GC time Loading theory "Collections.Diff_Array" consts entries :: "('a, 'b) rbt \ ('a \ 'b) list" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" consts rbt_sorted :: "('a, 'b) rbt \ bool" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" consts rbt_lookup :: "('a, 'b) rbt \ 'a \ 'b option" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" consts color_of :: "('a, 'b) rbt \ color" consts bheight :: "('a, 'b) rbt \ nat" consts inv1 :: "('a, 'b) rbt \ bool" consts inv1l :: "('a, 'b) rbt \ bool" consts inv2 :: "('a, 'b) rbt \ bool" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" consts array_length :: "'a array \ nat" consts array_get :: "'a array \ nat \ 'a" consts array_set :: "'a array \ nat \ 'a \ 'a array" consts array_grow :: "'a array \ nat \ 'a \ 'a array" consts array_shrink :: "'a array \ nat \ 'a array" consts list_of_array :: "'a array \ 'a list" consts assoc_list_of_array :: "'a array \ (nat \ 'a) list" ### Rewrite rule not in simpset: ### Wellfounded.accp assoc_list_of_array_code_rel (?a1, ?n1) \ ### assoc_list_of_array_code ?a1 ?n1 \ ### if array_length ?a1 \ ?n1 then [] ### else (?n1, array_get ?a1 ?n1) # assoc_list_of_array_code ?a1 (?n1 + 1) Found termination order: "{}" ### Ignoring duplicate rewrite rule: ### balance Empty ?s1 ?t1 Empty \ Branch B Empty ?s1 ?t1 Empty ### Ignoring duplicate rewrite rule: ### balance (Branch B ?va1 ?vb1 ?vc1 ?vd1) ?s1 ?t1 Empty \ ### Branch B (Branch B ?va1 ?vb1 ?vc1 ?vd1) ?s1 ?t1 Empty ### Ignoring duplicate rewrite rule: ### balance Empty ?s1 ?t1 (Branch B ?va1 ?vb1 ?vc1 ?vd1) \ ### Branch B Empty ?s1 ?t1 (Branch B ?va1 ?vb1 ?vc1 ?vd1) class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" consts paint :: "color \ ('a, 'b) rbt \ ('a, 'b) rbt" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" Found termination order: "(\p. size (snd (snd (snd p)))) <*mlex*> {}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" datatype 'a ref = ref of 'a ROOT.ML:13: warning: Value identifier (idx) has not been referenced. structure STArray: sig exception AccessedOldVersion datatype 'a Cell = Invalid | Value of 'a Array.array structure IsabelleMapping: sig type 'a ArrayType = 'a array val array_get: 'a ArrayType -> int -> 'a val array_grow: 'a ArrayType -> int -> 'a -> 'a Cell ref val array_length: 'a ArrayType -> int val array_of_list: 'a list -> 'a Cell ref val array_set: 'a ArrayType -> int -> 'a -> 'a Cell ref val array_shrink: 'a ArrayType -> int -> 'a Cell ref val new_array: 'a -> int -> 'a Cell ref end val array: int * 'a -> 'a Cell ref type 'a array = 'a Cell ref val fromList: 'a list -> 'a Cell ref val grow: 'a Cell ref * int * 'a -> 'a Cell ref val length: 'a Cell ref -> int val shrink: 'a Cell ref * int -> 'a Cell ref val sub: 'a Cell ref * int -> 'a val tabulate: int * (int -> 'a) -> 'a Cell ref val update: 'a Cell ref * int * 'a -> 'a Cell ref end ROOT.ML:86: warning: Value identifier (v) has not been referenced. ROOT.ML:86: warning: Value identifier (i) has not been referenced. ROOT.ML:102: warning: Matches are not exhaustive. Found near case res of (Unsynchronized.ref (Value a)) => (Array.update (a, ...); res) ROOT.ML:109: warning: Value identifier (cr) has not been referenced. ROOT.ML:109: warning: Value identifier (i) has not been referenced. ROOT.ML:123: warning: Matches are not exhaustive. Found near case ra of (Unsynchronized.ref (Value a)) => Array.update (a, idx, ...) structure FArray: sig datatype 'a Cell = Upd of int * 'a * 'a Cell ref | Value of 'a Array.array structure IsabelleMapping: sig type 'a ArrayType = 'a array val array_get: 'a ArrayType -> int -> 'a val array_get_oo: 'a -> 'a ArrayType -> int -> 'a val array_grow: 'a ArrayType -> int -> 'a -> 'a Cell ref val array_length: 'a ArrayType -> int val array_of_list: 'a list -> 'a Cell ref val array_set: 'a ArrayType -> int -> 'a -> 'a Cell ref val array_set_oo: (unit -> 'a ArrayType) -> 'a ArrayType -> int -> 'a -> 'a Cell ref val array_shrink: 'a ArrayType -> int -> 'a Cell ref val new_array: 'a -> int -> 'a Cell ref end val array: int * 'a -> 'a Cell ref type 'a array = 'a Cell ref val fromList: 'a list -> 'a Cell ref val grow: 'a Cell ref * int * 'a -> 'a Cell ref val length: 'a Cell ref -> int val realize: 'a Cell ref -> 'a Cell ref val realize_aux: 'a Cell ref * 'a -> 'a Cell ref val shrink: 'a Cell ref * int -> 'a Cell ref val sub: 'a Cell ref * int -> 'a val tabulate: int * (int -> 'a) -> 'a Cell ref val update: 'a Cell ref * int * 'a -> 'a Cell ref end structure Generated_Code: sig val test_diffarray_setup: ('a list -> 'a FArray.IsabelleMapping.ArrayType) * (('b -> int -> 'b FArray.IsabelleMapping.ArrayType) * (('c FArray.IsabelleMapping.ArrayType -> int) * (('d FArray.IsabelleMapping.ArrayType -> int -> 'd) * (('e FArray.IsabelleMapping.ArrayType -> int -> 'e -> 'e FArray.IsabelleMapping.ArrayType) * (('f FArray.IsabelleMapping.ArrayType -> int -> 'f -> 'f FArray.IsabelleMapping.ArrayType) * (('g FArray.IsabelleMapping.ArrayType -> int -> 'g FArray.IsabelleMapping.ArrayType) * (('h list -> 'h FArray.IsabelleMapping.ArrayType) * (('i -> 'i FArray.IsabelleMapping.ArrayType -> ...) * (... -> ...))))))))) end class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" ### theory "Collections.Diff_Array" ### 14.711s elapsed time, 16.412s cpu time, 1.004s GC time Loading theory "Collections.Dlist_add" Found termination order: "{}" consts dlist_remove1' :: "'a \ 'a list \ 'a list \ 'a list" ### theory "Collections.Dlist_add" ### 0.441s elapsed time, 0.612s cpu time, 0.000s GC time Loading theory "Collections.Proper_Iterator" (required by "Collections.RBT_add" via "Collections.Iterator" via "Collections.It_to_It") class order = preorder + assumes "antisym": "\x y. \x \ y; y \ x\ \ x = y" structure Icf_Proper_Iterator: sig val add: attribute val add_thm: thm -> Context.generic -> Context.generic val del: attribute val del_thm: thm -> Context.generic -> Context.generic val get: Proof.context -> thm list structure icf_proper_iteratorI: NAMED_THMS val setup: theory -> theory end ### theory "Collections.Proper_Iterator" ### 1.228s elapsed time, 1.496s cpu time, 0.476s GC time Loading theory "Collections.It_to_It" (required by "Collections.RBT_add" via "Collections.Iterator") Found termination order: "{}" locale proper_it_loc fixes it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" and it' :: "'s \ ('\ \ bool) \ ('x \ '\ \ '\) \ '\ \ '\" assumes "proper_it_loc it it'" ### theory "Collections.It_to_It" ### 0.156s elapsed time, 0.236s cpu time, 0.000s GC time Loading theory "Collections.SetIteratorGA" (required by "Collections.RBT_add" via "Collections.Iterator") class order = preorder + assumes "antisym": "\x y. \x \ y; y \ x\ \ x = y" Found termination order: "(\p. size (snd p)) <*mlex*> (\p. size (fst p)) <*mlex*> {}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" ### theory "Collections.SetIteratorGA" ### 0.781s elapsed time, 1.428s cpu time, 0.000s GC time Loading theory "Collections.DatRef" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" locale while_algo fixes WA :: "'S while_algo" assumes "while_algo WA" locale wa_refine fixes WAC :: "'C while_algo" and WAA :: "'A while_algo" and \ :: "'C \ 'A" assumes "wa_refine WAC WAA \" locale wa_precise_refine fixes WAC :: "'C while_algo" and WAA :: "'A while_algo" and \ :: "'C \ 'A" assumes "wa_precise_refine WAC WAA \" locale det_while_algo fixes WA :: "'S det_while_algo" assumes "det_while_algo WA" ### theory "Collections.DatRef" ### 1.755s elapsed time, 2.540s cpu time, 0.568s GC time Loading theory "Native_Word.More_Bits_Int" (required by "Collections.HashCode" via "Native_Word.Uint32" via "Native_Word.Word_Misc") consts bin_mask :: "nat \ int" Found termination order: "(\p. size (snd p)) <*mlex*> {}" Found termination order: "(\p. size (snd p)) <*mlex*> {}" Found termination order: "(\p. size (snd p)) <*mlex*> {}" Found termination order: "(\p. size (snd p)) <*mlex*> {}" Found termination order: "(\p. size (snd p)) <*mlex*> {}" Proofs for inductive predicate(s) "wf_set_bits_int" Proving monotonicity ... Proving the introduction rules ... Proving the elimination rules ... Proving the induction rule ... Proving the simplification rules ... ### theory "Native_Word.More_Bits_Int" ### 1.893s elapsed time, 3.580s cpu time, 0.000s GC time Loading theory "Native_Word.Bits_Integer" (required by "Collections.HashCode" via "Native_Word.Uint32") instantiation integer :: bitss msb_integer == msb :: integer \ bool test_bit_integer == test_bit :: integer \ nat \ bool lsb_integer == lsb :: integer \ bool set_bit_integer == set_bit :: integer \ nat \ bool \ integer set_bits_integer == set_bits :: (nat \ bool) \ integer shiftl_integer == shiftl :: integer \ nat \ integer shiftr_integer == shiftr :: integer \ nat \ integer bitNOT_integer == bitNOT :: integer \ integer bitAND_integer == bitAND :: integer \ integer \ integer bitOR_integer == bitOR :: integer \ integer \ integer bitXOR_integer == bitXOR :: integer \ integer \ integer Found termination order: "(nat \ abs) <*mlex*> {}" Found termination order: "case_sum (\p. size (fst (snd p))) (case_sum (\p. size (snd (snd (snd (snd p))))) (\p. size (snd p))) <*mlex*> case_sum (\x. Suc 0) (\x. 0) <*mlex*> case_sum (\x. 0) (case_sum (\x. Suc 0) (\x. 0)) <*mlex*> {}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" consts rbt_map_entry :: "'a \ ('b \ 'b) \ ('a, 'b) rbt \ ('a, 'b) rbt" consts map :: "('a \ 'b \ 'c) \ ('a, 'b) rbt \ ('a, 'c) rbt" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" Found termination order: "(\p. size (fst (snd (snd p)))) <*mlex*> {}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" datatype 'a ref = ref of 'a structure Bits_Integer: sig val set_bit: int -> int -> bool -> int val shiftl: int -> int -> int val shiftr: int -> int -> int val test_bit: int -> int -> bool end ROOT.ML:38: warning: Pattern 3 is redundant. Found near fun equal_boola p true = p | equal_boola p ... = not p | equal_boola ... = p | equal_boola ... = ... ROOT.ML:39: warning: Pattern 4 is redundant. Found near fun equal_boola p true = p | equal_boola p ... = not p | equal_boola ... = p | equal_boola ... = ... ROOT.ML:85: warning: Value identifier (times) has not been referenced. ROOT.ML:88: warning: Value identifier (one_power) has not been referenced. ROOT.ML:89: warning: Value identifier (times_power) has not been referenced. ROOT.ML:98: warning: Value identifier (semigroup_add_ab_semigroup_add) has not been referenced. ROOT.ML:102: warning: Value identifier (times_semigroup_mult) has not been referenced. ROOT.ML:108: warning: Value identifier (ab_semigroup_add_semiring) has not been referenced. ROOT.ML:110: warning: Value identifier (semigroup_mult_semiring) has not been referenced. ROOT.ML:126: warning: Value identifier (times_mult_zero) has not been referenced. ROOT.ML:135: warning: Value identifier (semigroup_add_monoid_add) has not been referenced. ROOT.ML:137: warning: Value identifier (zero_monoid_add) has not been referenced. ROOT.ML:142: warning: Value identifier (ab_semigroup_add_comm_monoid_add) has not been referenced. ROOT.ML:144: warning: Value identifier (monoid_add_comm_monoid_add) has not been referenced. ROOT.ML:150: warning: Value identifier (comm_monoid_add_semiring_0) has not been referenced. ROOT.ML:154: warning: Value identifier (semiring_semiring_0) has not been referenced. ROOT.ML:175: warning: Value identifier (semigroup_mult_monoid_mult) has not been referenced. ROOT.ML:177: warning: Value identifier (power_monoid_mult) has not been referenced. ROOT.ML:183: warning: Value identifier (monoid_mult_semiring_numeral) has not been referenced. ROOT.ML:187: warning: Value identifier (semiring_semiring_numeral) has not been referenced. ROOT.ML:191: warning: Value identifier (one_zero_neq_one) has not been referenced. ROOT.ML:192: warning: Value identifier (zero_zero_neq_one) has not been referenced. ROOT.ML:202: warning: Value identifier (zero_neq_one_semiring_1) has not been referenced. ROOT.ML:247: warning: Value identifier (inc) has not been referenced. ROOT.ML:247: warning: Value identifier (A_) has not been referenced. ROOT.ML:280: warning: Value identifier (A_) has not been referenced. ROOT.ML:277: warning: Value identifier (x22) has not been referenced. ROOT.ML:277: warning: Value identifier (x21) has not been referenced. ROOT.ML:277: warning: Value identifier (A_) has not been referenced. ROOT.ML:276: warning: Value identifier (x22) has not been referenced. ROOT.ML:276: warning: Value identifier (x21) has not been referenced. ROOT.ML:276: warning: Value identifier (A_) has not been referenced. structure Generated_Code: sig val bit_integer_test: bool type nat type num end File "ROOT.ocaml", line 287, characters 32-33: Warning 20: this argument will not be used by the function. File "ROOT.ocaml", line 287, characters 34-35: Warning 20: this argument will not be used by the function. File "ROOT.ocaml", line 287, characters 36-37: Warning 20: this argument will not be used by the function. Found termination order: "case_sum (\p. size (fst p)) (\p. size (fst p)) <*mlex*> {}" Found termination order: "size <*mlex*> {}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" Found termination order: "{}" class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" ### Ambiguous input (line 1812 of "~~/src/HOL/Library/RBT_Impl.thy") produces 2 parse trees: ### ("_bigimpl" ### ("_asms" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" sorted) ### ("_applC" ("_position" map) ### ("_cargs" ("_position" fst) ("_position" xs))))) ### ("_asm" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" sorted) ### ("_applC" ("_position" map) ### ("_cargs" ("_position" fst) ("_position" ys))))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" map_of) ### ("_cargs" ### ("_applC" ("_position" sunion_with) ### ("_cargs" ("_position" f) ### ("_cargs" ("_position" xs) ("_position" ys)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" map_of) ### ("_cargs" ("_position" xs) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" map_of) ### ("_cargs" ("_position" ys) ("_position" k)))) ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" map_of) ### ("_cargs" ("_position" ys) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" Some) ("_position" v))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" v) ### ("_position" w)))))))))))))) ### ("_bigimpl" ### ("_asms" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" sorted) ### ("_applC" ("_position" map) ### ("_cargs" ("_position" fst) ("_position" xs))))) ### ("_asm" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" sorted) ### ("_applC" ("_position" map) ### ("_cargs" ("_position" fst) ("_position" ys))))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" map_of) ### ("_cargs" ### ("_applC" ("_position" sunion_with) ### ("_cargs" ("_position" f) ### ("_cargs" ("_position" xs) ("_position" ys)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" map_of) ### ("_cargs" ("_position" xs) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" map_of) ### ("_cargs" ("_position" ys) ("_position" k)))) ### ("_case2" ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" map_of) ### ("_cargs" ("_position" ys) ("_position" k))) ### ("_case1" ("_position" None) ### ("_applC" ("_position" Some) ("_position" v))))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" v) ("_position" w)))))))))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. class ord = type + fixes less_eq :: "'a \ 'a \ bool" and less :: "'a \ 'a \ bool" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" ### Ambiguous input (line 1926 of "~~/src/HOL/Library/RBT_Impl.thy") produces 2 parse trees: ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ### ("_applC" ("_position" fold) ### ("_cargs" ### ("_applC" ("_position" rbt_insert_with_key) ("_position" f)) ### ("_cargs" ("_position" t1) ("_position" t2)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t1) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k)))) ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" Some) ("_position" v))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" w) ("_position" v))))))))))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ### ("_applC" ("_position" fold) ### ("_cargs" ### ("_applC" ("_position" rbt_insert_with_key) ("_position" f)) ### ("_cargs" ("_position" t1) ("_position" t2)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t1) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k)))) ### ("_case2" ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k))) ### ("_case1" ("_position" None) ### ("_applC" ("_position" Some) ("_position" v))))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" w) ("_position" v))))))))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Ambiguous input (line 1947 of "~~/src/HOL/Library/RBT_Impl.thy") produces 2 parse trees: ### ("_bigimpl" ### ("_asms" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t1))) ### ("_asm" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t2))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ### ("_applC" ("_position" rbt_union_with_key) ### ("_cargs" ("_position" f) ### ("_cargs" ("_position" t1) ("_position" t2)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t1) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k)))) ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" Some) ("_position" v))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" v) ### ("_position" w)))))))))))))) ### ("_bigimpl" ### ("_asms" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t1))) ### ("_asm" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t2))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ### ("_applC" ("_position" rbt_union_with_key) ### ("_cargs" ("_position" f) ### ("_cargs" ("_position" t1) ("_position" t2)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t1) ("_position" k))) ### ("_case2" ### ("_case1" ("_position" None) ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k)))) ### ("_case2" ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k))) ### ("_case1" ("_position" None) ### ("_applC" ("_position" Some) ("_position" v))))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" v) ("_position" w)))))))))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Ambiguous input (line 1978 of "~~/src/HOL/Library/RBT_Impl.thy") produces 2 parse trees: ### ("_bigimpl" ### ("_asms" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t1))) ### ("_asm" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t2))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ### ("_applC" ("_position" rbt_inter_with_key) ### ("_cargs" ("_position" f) ### ("_cargs" ("_position" t1) ("_position" t2)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t1) ("_position" k))) ### ("_case2" ("_case1" ("_position" None) ("_position" None)) ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k))) ### ("_case2" ("_case1" ("_position" None) ("_position" None)) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" v) ### ("_position" w)))))))))))))) ### ("_bigimpl" ### ("_asms" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t1))) ### ("_asm" ### ("\<^const>HOL.Trueprop" ### ("_applC" ("_position" rbt_sorted) ("_position" t2))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ### ("_applC" ("_position" rbt_inter_with_key) ### ("_cargs" ("_position" f) ### ("_cargs" ("_position" t1) ("_position" t2)))) ### ("_position" k))) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t1) ("_position" k))) ### ("_case2" ("_case1" ("_position" None) ("_position" None)) ### ("_case2" ### ("_case1" ("_applC" ("_position" Some) ("_position" v)) ### ("_case_syntax" ### ("_applC" ("_position" rbt_lookup) ### ("_cargs" ("_position" t2) ("_position" k))) ### ("_case1" ("_position" None) ("_position" None)))) ### ("_case1" ("_applC" ("_position" Some) ("_position" w)) ### ("_applC" ("_position" Some) ### ("_applC" ("_position" f) ### ("_cargs" ("_position" k) ### ("_cargs" ("_position" v) ("_position" w)))))))))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Code generator: dropping subsumed code equation ### ord.sunion_with ?less ?f ((?k, ?v) # ?as) ((?k', ?v') # ?bs) \ ### if ?less ?k' ?k ### then (?k', ?v') # ord.sunion_with ?less ?f ((?k, ?v) # ?as) ?bs ### else if ?less ?k ?k' ### then (?k, ?v) # ord.sunion_with ?less ?f ?as ((?k', ?v') # ?bs) ### else (?k, ?f ?k ?v ?v') # ord.sunion_with ?less ?f ?as ?bs ### Code generator: dropping subsumed code equation ### ord.sunion_with ?less ?f [] ?bs \ ?bs ### Code generator: dropping subsumed code equation ### ord.sunion_with ?less ?f ?as [] \ ?as ### Code generator: dropping subsumed code equation ### ord.sinter_with ?less ?f ((?k, ?v) # ?as) ((?k', ?v') # ?bs) \ ### if ?less ?k' ?k then ord.sinter_with ?less ?f ((?k, ?v) # ?as) ?bs ### else if ?less ?k ?k' then ord.sinter_with ?less ?f ?as ((?k', ?v') # ?bs) ### else (?k, ?f ?k ?v ?v') # ord.sinter_with ?less ?f ?as ?bs ### Code generator: dropping subsumed code equation ### ord.sinter_with ?less ?f [] ?uu \ [] ### Code generator: dropping subsumed code equation ### ord.sinter_with ?less ?f ?uv [] \ [] ### Code generator: dropping subsumed code equation ### keys (Branch ?c ?l ?k ?v ?r) \ keys ?l @ ?k # keys ?r ### Code generator: dropping subsumed code equation ### keys Empty \ [] ### theory "HOL-Library.RBT_Impl" ### 36.390s elapsed time, 45.332s cpu time, 4.236s GC time Loading theory "Native_Word.Word_Misc" (required by "Collections.HashCode" via "Native_Word.Uint32") Found termination order: "(\p. size (snd p)) <*mlex*> {}" locale quickcheck_narrowing_samples fixes a_of_integer :: "integer \ 'a \ 'a" and zero :: "'a" and tr :: "typerep" ### theory "Native_Word.Bits_Integer" ### 14.057s elapsed time, 16.364s cpu time, 1.492s GC time Loading theory "Native_Word.Code_Target_Bits_Int" (required by "Collections.Code_Target_ICF") ### theory "Native_Word.Word_Misc" ### 0.769s elapsed time, 1.480s cpu time, 0.000s GC time Loading theory "Native_Word.Uint32" (required by "Collections.HashCode") ### theory "Native_Word.Code_Target_Bits_Int" ### 0.243s elapsed time, 0.440s cpu time, 0.000s GC time Loading theory "Collections.Code_Target_ICF" ### Generation of a parametrized correspondence relation failed. ### Reason: No relator for the type "Numeral_Type.bit0" found. instantiation uint32 :: {comm_monoid_mult,neg_numeral,comm_ring,modulo} modulo_uint32 == modulo :: uint32 \ uint32 \ uint32 divide_uint32 == divide :: uint32 \ uint32 \ uint32 minus_uint32 == minus :: uint32 \ uint32 \ uint32 uminus_uint32 == uminus :: uint32 \ uint32 zero_uint32 == zero_class.zero :: uint32 plus_uint32 == plus :: uint32 \ uint32 \ uint32 one_uint32 == one_class.one :: uint32 times_uint32 == times :: uint32 \ uint32 \ uint32 ### theory "Collections.Code_Target_ICF" ### 0.253s elapsed time, 0.484s cpu time, 0.000s GC time Loading theory "Collections.Locale_Code_Ex" instantiation uint32 :: linorder less_eq_uint32 == less_eq :: uint32 \ uint32 \ bool less_uint32 == less :: uint32 \ uint32 \ bool locale test fixes a :: "nat" and b :: "nat" assumes "test a b" instantiation uint32 :: bitss msb_uint32 == msb :: uint32 \ bool test_bit_uint32 == test_bit :: uint32 \ nat \ bool lsb_uint32 == lsb :: uint32 \ bool set_bit_uint32 == set_bit :: uint32 \ nat \ bool \ uint32 set_bits_uint32 == set_bits :: (nat \ bool) \ uint32 shiftl_uint32 == shiftl :: uint32 \ nat \ uint32 shiftr_uint32 == shiftr :: uint32 \ nat \ uint32 bitNOT_uint32 == bitNOT :: uint32 \ uint32 bitAND_uint32 == bitAND :: uint32 \ uint32 \ uint32 bitOR_uint32 == bitOR :: uint32 \ uint32 \ uint32 bitXOR_uint32 == bitXOR :: uint32 \ uint32 \ uint32 Found termination order: "case_sum size size <*mlex*> {}" instantiation uint32 :: equal equal_uint32 == equal_class.equal :: uint32 \ uint32 \ bool instantiation uint32 :: size size_uint32 == size :: uint32 \ nat ### Code generator: dropping subsumed code equation ### (!!) ?x \ (!!) (Rep_uint32 ?x) ### Code generator: dropping subsumed code equation ### lsb ?x \ lsb (Rep_uint32 ?x) structure Bits_Integer : sig val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int val shiftl : IntInf.int -> IntInf.int -> IntInf.int val shiftr : IntInf.int -> IntInf.int -> IntInf.int val test_bit : IntInf.int -> IntInf.int -> bool end = struct val maxWord = IntInf.pow (2, Word.wordSize); fun set_bit x n b = if n < maxWord then if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))) else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); fun shiftl x n = if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun shiftr x n = if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun test_bit x n = if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0 else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); end; (*struct Bits_Integer*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure Arith : sig type nat datatype num = One | Bit0 of num | Bit1 of num val plus_nat : nat -> nat -> nat val one_nat : nat val suc : nat -> nat val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool val minus_nat : nat -> nat -> nat val times_nat : nat -> nat -> nat end = struct val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype nat = Nat of IntInf.int; datatype num = One | Bit0 of num | Bit1 of num; fun integer_of_nat (Nat x) = x; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; val zero_nat : nat = Nat (0 : IntInf.int); fun nat_of_integer k = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); fun minus_nat m n = Nat (Orderings.max ord_integer (0 : IntInf.int) (IntInf.- (integer_of_nat m, integer_of_nat n))); fun times_nat m n = Nat (IntInf.* (integer_of_nat m, integer_of_nat n)); end; (*struct Arith*) structure Product_Type : sig val snd : 'a * 'b -> 'b end = struct fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure Locale_Code_Ex : sig val bar : Arith.nat -> Arith.nat -> Arith.nat val foo : Arith.nat -> Arith.nat -> Arith.nat end = struct val c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One : Arith.nat = Arith.plus_nat (Arith.nat_of_integer (5 : IntInf.int)) (Arith.nat_of_integer (5 : IntInf.int)); fun f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)))) (g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) and g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Arith.plus_nat (Arith.plus_nat (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One); fun f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Product_Type.snd (x, Arith.nat_of_integer (3 : IntInf.int))) (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (2 : IntInf.int))) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Product_Type.snd (x, Arith.nat_of_integer (3 : IntInf.int))) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (2 : IntInf.int))) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat)))) (g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat))) and g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x n = (if Arith.equal_nat n Arith.zero_nat then Product_Type.snd (x, Arith.nat_of_integer (3 : IntInf.int)) else Arith.plus_nat (Arith.plus_nat (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Product_Type.snd (x, Arith.nat_of_integer (3 : IntInf.int)))); fun f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Arith.nat_of_integer (5 : IntInf.int)) (Arith.nat_of_integer (5 : IntInf.int)) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.nat_of_integer (5 : IntInf.int)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.nat_of_integer (5 : IntInf.int)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)))) (g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) and g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.nat_of_integer (5 : IntInf.int) else Arith.plus_nat (Arith.plus_nat (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Arith.nat_of_integer (5 : IntInf.int))); fun f_Suc_uu_Suc_uu na n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Arith.suc na) (Arith.suc na) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.suc na) (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.suc na) (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat)))) (g_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat))) and g_Suc_uu_Suc_uu na n = (if Arith.equal_nat n Arith.zero_nat then Arith.suc na else Arith.plus_nat (Arith.plus_nat (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Arith.suc na)); fun f_zero_zero n = (if Arith.equal_nat n Arith.zero_nat then Arith.zero_nat else Arith.plus_nat (f_zero_zero (Arith.minus_nat n Arith.one_nat)) (g_zero_zero (Arith.minus_nat n Arith.one_nat))) and g_zero_zero n = (if Arith.equal_nat n Arith.zero_nat then Arith.zero_nat else Arith.plus_nat (Arith.plus_nat (f_zero_zero (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) Arith.zero_nat); fun f_one_one n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat Arith.one_nat Arith.one_nat else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat Arith.one_nat (f_one_one (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat Arith.one_nat (f_one_one (Arith.minus_nat n Arith.one_nat)))) (g_one_one (Arith.minus_nat n Arith.one_nat))) and g_one_one n = (if Arith.equal_nat n Arith.zero_nat then Arith.one_nat else Arith.plus_nat (Arith.plus_nat (f_one_one (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) Arith.one_nat); fun bar x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (f_zero_zero x) (f_Suc_uu_Suc_uu x y)) (f_one_one x)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y)) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One false x)) (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y); fun j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) y) x; fun k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x = Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x; fun i x y = Arith.plus_nat x y; fun h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) (k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y)) (i x y)) (j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y); fun j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y = Arith.plus_nat (Arith.plus_nat (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x) y) x; fun k_plus_one_numeral_Bit0_One x = Arith.plus_nat (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (2 : IntInf.int))) x; fun h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Product_Type.snd (xa, Arith.nat_of_integer (3 : IntInf.int))) x) (k_plus_one_numeral_Bit0_One y)) (i x y)) (j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y); fun j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) y) x; fun k_numeral_Bit1_Bit0_One x = Arith.plus_nat (Arith.nat_of_integer (5 : IntInf.int)) x; fun h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.nat_of_integer (5 : IntInf.int)) x) (k_numeral_Bit1_Bit0_One y)) (i x y)) (j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y); fun j_Suc_uu_Suc_uu n x y = Arith.plus_nat (Arith.plus_nat (f_Suc_uu_Suc_uu n x) y) x; fun k_Suc_uu n x = Arith.plus_nat (Arith.suc n) x; fun h_Suc_uu_Suc_uu n x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.suc n) x) (k_Suc_uu n y)) (i x y)) (j_Suc_uu_Suc_uu n x y); fun j_zero_zero x y = Arith.plus_nat (Arith.plus_nat (f_zero_zero x) y) x; fun k_zero x = Arith.plus_nat Arith.zero_nat x; fun h_zero_zeroa x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat x (k_zero y)) (i x y)) (j_zero_zero x y); val h_zero_zero : bool = true; fun j_one_one x y = Arith.plus_nat (Arith.plus_nat (f_one_one x) y) x; fun k_one x = Arith.plus_nat Arith.one_nat x; fun h_one_one x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat Arith.one_nat x) (k_one y)) (i x y)) (j_one_one x y); fun foo x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (h_zero_zeroa x y) (h_Suc_uu_Suc_uu x x y)) (h_one_one x y)) (h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y)) (h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One h_zero_zero x y)) (h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y); end; (*struct Locale_Code_Ex*) ### Ambiguous input (line 567 of "~~/afp/thys/Native_Word/Uint32.thy") produces 2 parse trees: ### ("\<^const>Pure.imp" ### ("\<^const>HOL.Trueprop" ### ("\<^const>Orderings.ord_class.less_eq" ### ("_applC" ("_position" size) ("_position" x)) ("_position" n))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Word.sshiftr" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("\<^const>Groups.minus_class.minus" ### ("_applC" ("_position" size) ("_position" x)) ### ("\<^const>Groups.one_class.one"))) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### ("\<^const>Pure.imp" ### ("\<^const>HOL.Trueprop" ### ("\<^const>Orderings.ord_class.less_eq" ### ("_applC" ("_position" size) ("_position" x)) ("_position" n))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Uint32.sshiftr_uint32" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("\<^const>Groups.minus_class.minus" ### ("_applC" ("_position" size) ("_position" x)) ### ("\<^const>Groups.one_class.one"))) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Ambiguous input (line 571 of "~~/afp/thys/Native_Word/Uint32.thy") produces 2 parse trees: ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Word.sshiftr" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("_Numeral" ("_constify" ("_position" 32)))) ### ("_applC" ("_position" uint32_sshiftr) ### ("_cargs" ("_position" x) ### ("_applC" ("_position" integer_of_nat) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("_Numeral" ("_constify" ("_position" 31)))) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Uint32.sshiftr_uint32" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("_Numeral" ("_constify" ("_position" 32)))) ### ("_applC" ("_position" uint32_sshiftr) ### ("_cargs" ("_position" x) ### ("_applC" ("_position" integer_of_nat) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("_Numeral" ("_constify" ("_position" 31)))) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. module Bits_Integer : sig val and_pninteger : Big_int.big_int -> Big_int.big_int -> Big_int.big_int val or_pninteger : Big_int.big_int -> Big_int.big_int -> Big_int.big_int val shiftl : Big_int.big_int -> Big_int.big_int -> Big_int.big_int val shiftr : Big_int.big_int -> Big_int.big_int -> Big_int.big_int val test_bit : Big_int.big_int -> Big_int.big_int -> bool end = struct let and_pninteger bi1 bi2 = Big_int.and_big_int bi1 (Big_int.xor_big_int (Big_int.pred_big_int (Big_int.shift_left_big_int Big_int.unit_big_int (max (Big_int.num_digits_big_int bi1 * Nat.length_of_digit) (Big_int.num_digits_big_int bi2 * Nat.length_of_digit)))) (Big_int.pred_big_int (Big_int.minus_big_int bi2)));; let or_pninteger bi1 bi2 = Big_int.pred_big_int (Big_int.minus_big_int (Big_int.and_big_int (Big_int.xor_big_int (Big_int.pred_big_int (Big_int.shift_left_big_int Big_int.unit_big_int (max (Big_int.num_digits_big_int bi1 * Nat.length_of_digit) (Big_int.num_digits_big_int bi2 * Nat.length_of_digit)))) bi1) (Big_int.pred_big_int (Big_int.minus_big_int bi2))));; (* We do not need an explicit range checks here, because Big_int.int_of_big_int raises Failure if the argument does not fit into an int. *) let shiftl x n = Big_int.shift_left_big_int x (Big_int.int_of_big_int n);; let shiftr x n = Big_int.shift_right_big_int x (Big_int.int_of_big_int n);; let test_bit x n = Big_int.eq_big_int (Big_int.extract_big_int x (Big_int.int_of_big_int n) 1) Big_int.unit_big_int end;; (*struct Bits_Integer*) module Orderings : sig type 'a ord = {less_eq : 'a -> 'a -> bool; less : 'a -> 'a -> bool} val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool; less : 'a -> 'a -> bool};; let less_eq _A = _A.less_eq;; let less _A = _A.less;; let rec max _A a b = (if less_eq _A a b then b else a);; end;; (*struct Orderings*) module Arith : sig type nat type num = One | Bit0 of num | Bit1 of num val plus_nat : nat -> nat -> nat val one_nat : nat val suc : nat -> nat val zero_nat : nat val nat_of_integer : Big_int.big_int -> nat val equal_nat : nat -> nat -> bool val minus_nat : nat -> nat -> nat val times_nat : nat -> nat -> nat end = struct let ord_integer = ({Orderings.less_eq = Big_int.le_big_int; Orderings.less = Big_int.lt_big_int} : Big_int.big_int Orderings.ord);; type nat = Nat of Big_int.big_int;; type num = One | Bit0 of num | Bit1 of num;; let rec integer_of_nat (Nat x) = x;; let rec plus_nat m n = Nat (Big_int.add_big_int (integer_of_nat m) (integer_of_nat n));; let one_nat : nat = Nat (Big_int.big_int_of_int 1);; let rec suc n = plus_nat n one_nat;; let zero_nat : nat = Nat Big_int.zero_big_int;; let rec nat_of_integer k = Nat (Orderings.max ord_integer Big_int.zero_big_int k);; let rec equal_nat m n = Big_int.eq_big_int (integer_of_nat m) (integer_of_nat n);; let rec minus_nat m n = Nat (Orderings.max ord_integer Big_int.zero_big_int (Big_int.sub_big_int (integer_of_nat m) (integer_of_nat n)));; let rec times_nat m n = Nat (Big_int.mult_big_int (integer_of_nat m) (integer_of_nat n));; end;; (*struct Arith*) module Product_Type : sig val snd : 'a * 'b -> 'b end = struct let rec snd (x1, x2) = x2;; end;; (*struct Product_Type*) module Locale_Code_Ex : sig val bar : Arith.nat -> Arith.nat -> Arith.nat val foo : Arith.nat -> Arith.nat -> Arith.nat end = struct let c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One : Arith.nat = Arith.plus_nat (Arith.nat_of_integer (Big_int.big_int_of_int 5)) (Arith.nat_of_integer (Big_int.big_int_of_int 5));; let rec f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)))) (g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) and g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Arith.plus_nat (Arith.plus_nat (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One);; let rec f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Product_Type.snd (x, Arith.nat_of_integer (Big_int.big_int_of_int 3))) (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (Big_int.big_int_of_int 2))) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Product_Type.snd (x, Arith.nat_of_integer (Big_int.big_int_of_int 3))) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (Big_int.big_int_of_int 2))) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat)))) (g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat))) and g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x n = (if Arith.equal_nat n Arith.zero_nat then Product_Type.snd (x, Arith.nat_of_integer (Big_int.big_int_of_int 3)) else Arith.plus_nat (Arith.plus_nat (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Product_Type.snd (x, Arith.nat_of_integer (Big_int.big_int_of_int 3))));; let rec f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Arith.nat_of_integer (Big_int.big_int_of_int 5)) (Arith.nat_of_integer (Big_int.big_int_of_int 5)) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.nat_of_integer (Big_int.big_int_of_int 5)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.nat_of_integer (Big_int.big_int_of_int 5)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)))) (g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) and g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.nat_of_integer (Big_int.big_int_of_int 5) else Arith.plus_nat (Arith.plus_nat (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Arith.nat_of_integer (Big_int.big_int_of_int 5)));; let rec f_Suc_uu_Suc_uu na n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Arith.suc na) (Arith.suc na) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.suc na) (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.suc na) (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat)))) (g_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat))) and g_Suc_uu_Suc_uu na n = (if Arith.equal_nat n Arith.zero_nat then Arith.suc na else Arith.plus_nat (Arith.plus_nat (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Arith.suc na));; let rec f_zero_zero n = (if Arith.equal_nat n Arith.zero_nat then Arith.zero_nat else Arith.plus_nat (f_zero_zero (Arith.minus_nat n Arith.one_nat)) (g_zero_zero (Arith.minus_nat n Arith.one_nat))) and g_zero_zero n = (if Arith.equal_nat n Arith.zero_nat then Arith.zero_nat else Arith.plus_nat (Arith.plus_nat (f_zero_zero (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) Arith.zero_nat);; let rec f_one_one n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat Arith.one_nat Arith.one_nat else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat Arith.one_nat (f_one_one (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat Arith.one_nat (f_one_one (Arith.minus_nat n Arith.one_nat)))) (g_one_one (Arith.minus_nat n Arith.one_nat))) and g_one_one n = (if Arith.equal_nat n Arith.zero_nat then Arith.one_nat else Arith.plus_nat (Arith.plus_nat (f_one_one (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) Arith.one_nat);; let rec bar x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (f_zero_zero x) (f_Suc_uu_Suc_uu x y)) (f_one_one x)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y)) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One false x)) (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y);; let rec j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) y) x;; let rec k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x = Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x;; let rec i x y = Arith.plus_nat x y;; let rec h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) (k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y)) (i x y)) (j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y);; let rec j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y = Arith.plus_nat (Arith.plus_nat (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x) y) x;; let rec k_plus_one_numeral_Bit0_One x = Arith.plus_nat (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (Big_int.big_int_of_int 2))) x;; let rec h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Product_Type.snd (xa, Arith.nat_of_integer (Big_int.big_int_of_int 3))) x) (k_plus_one_numeral_Bit0_One y)) (i x y)) (j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y);; let rec j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) y) x;; let rec k_numeral_Bit1_Bit0_One x = Arith.plus_nat (Arith.nat_of_integer (Big_int.big_int_of_int 5)) x;; let rec h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.nat_of_integer (Big_int.big_int_of_int 5)) x) (k_numeral_Bit1_Bit0_One y)) (i x y)) (j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y);; let rec j_Suc_uu_Suc_uu n x y = Arith.plus_nat (Arith.plus_nat (f_Suc_uu_Suc_uu n x) y) x;; let rec k_Suc_uu n x = Arith.plus_nat (Arith.suc n) x;; let rec h_Suc_uu_Suc_uu n x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.suc n) x) (k_Suc_uu n y)) (i x y)) (j_Suc_uu_Suc_uu n x y);; let rec j_zero_zero x y = Arith.plus_nat (Arith.plus_nat (f_zero_zero x) y) x;; let rec k_zero x = Arith.plus_nat Arith.zero_nat x;; let rec h_zero_zeroa x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat x (k_zero y)) (i x y)) (j_zero_zero x y);; let h_zero_zero : bool = true;; let rec j_one_one x y = Arith.plus_nat (Arith.plus_nat (f_one_one x) y) x;; let rec k_one x = Arith.plus_nat Arith.one_nat x;; let rec h_one_one x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat Arith.one_nat x) (k_one y)) (i x y)) (j_one_one x y);; let rec foo x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (h_zero_zeroa x y) (h_Suc_uu_Suc_uu x x y)) (h_one_one x y)) (h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y)) (h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One h_zero_zero x y)) (h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y);; end;; (*struct Locale_Code_Ex*) ### Ambiguous input (line 577 of "~~/afp/thys/Native_Word/Uint32.thy") produces 2 parse trees: ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" Rep_uint32) ### ("_applC" ("_position" uint32_sshiftr) ### ("_cargs" ("_position" w) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>HOL.disj" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("\<^const>Groups.zero_class.zero")) ### ("\<^const>Orderings.ord_class.less_eq" ### ("_Numeral" ("_constify" ("_position" 32))) ("_position" n))) ### ("_applC" ("_position" Rep_uint32) ### ("_applC" ("_position" undefined) ### ("_cargs" ("_position" sshiftr_uint32) ### ("_cargs" ("_position" w) ("_position" n))))) ### ("\<^const>Uint32.sshiftr_uint32" ### ("_applC" ("_position" Rep_uint32) ("_position" w)) ### ("_applC" ("_position" nat_of_integer) ("_position" n)))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" Rep_uint32) ### ("_applC" ("_position" uint32_sshiftr) ### ("_cargs" ("_position" w) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>HOL.disj" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("\<^const>Groups.zero_class.zero")) ### ("\<^const>Orderings.ord_class.less_eq" ### ("_Numeral" ("_constify" ("_position" 32))) ("_position" n))) ### ("_applC" ("_position" Rep_uint32) ### ("_applC" ("_position" undefined) ### ("_cargs" ("_position" sshiftr_uint32) ### ("_cargs" ("_position" w) ("_position" n))))) ### ("\<^const>Word.sshiftr" ### ("_applC" ("_position" Rep_uint32) ("_position" w)) ### ("_applC" ("_position" nat_of_integer) ("_position" n)))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Code generator: dropping subsumed code equation ### msb ?x \ msb (Rep_uint32 ?x) module Data_Bits where { import qualified Data.Bits; {- The ...Bounded functions assume that the Integer argument for the shift or bit index fits into an Int, is non-negative and (for types of fixed bit width) less than bitSize -} infixl 7 .&.; infixl 6 `xor`; infixl 5 .|.; (.&.) :: Data.Bits.Bits a => a -> a -> a; (.&.) = (Data.Bits..&.); xor :: Data.Bits.Bits a => a -> a -> a; xor = Data.Bits.xor; (.|.) :: Data.Bits.Bits a => a -> a -> a; (.|.) = (Data.Bits..|.); complement :: Data.Bits.Bits a => a -> a; complement = Data.Bits.complement; testBitUnbounded :: Data.Bits.Bits a => a -> Integer -> Bool; testBitUnbounded x b | b <= toInteger (Prelude.maxBound :: Int) = Data.Bits.testBit x (fromInteger b) | otherwise = error ("Bit index too large: " ++ show b) ; testBitBounded :: Data.Bits.Bits a => a -> Integer -> Bool; testBitBounded x b = Data.Bits.testBit x (fromInteger b); setBitUnbounded :: Data.Bits.Bits a => a -> Integer -> Bool -> a; setBitUnbounded x n b | n <= toInteger (Prelude.maxBound :: Int) = if b then Data.Bits.setBit x (fromInteger n) else Data.Bits.clearBit x (fromInteger n) | otherwise = error ("Bit index too large: " ++ show n) ; setBitBounded :: Data.Bits.Bits a => a -> Integer -> Bool -> a; setBitBounded x n True = Data.Bits.setBit x (fromInteger n); setBitBounded x n False = Data.Bits.clearBit x (fromInteger n); shiftlUnbounded :: Data.Bits.Bits a => a -> Integer -> a; shiftlUnbounded x n | n <= toInteger (Prelude.maxBound :: Int) = Data.Bits.shiftL x (fromInteger n) | otherwise = error ("Shift operand too large: " ++ show n) ; shiftlBounded :: Data.Bits.Bits a => a -> Integer -> a; shiftlBounded x n = Data.Bits.shiftL x (fromInteger n); shiftrUnbounded :: Data.Bits.Bits a => a -> Integer -> a; shiftrUnbounded x n | n <= toInteger (Prelude.maxBound :: Int) = Data.Bits.shiftR x (fromInteger n) | otherwise = error ("Shift operand too large: " ++ show n) ; shiftrBounded :: (Ord a, Data.Bits.Bits a) => a -> Integer -> a; shiftrBounded x n = Data.Bits.shiftR x (fromInteger n); } module Arith(Nat, Num(..), plus_nat, one_nat, suc, zero_nat, nat_of_integer, equal_nat, minus_nat, times_nat) where { import Prelude ((==), (/=), (<), (<=), (>=), (>), (+), (-), (*), (/), (**), (>>=), (>>), (=<<), (&&), (||), (^), (^^), (.), ($), ($!), (++), (!!), Eq, error, id, return, not, fst, snd, map, filter, concat, concatMap, reverse, zip, null, takeWhile, dropWhile, all, any, Integer, negate, abs, divMod, String, Bool(True, False), Maybe(Nothing, Just)); import qualified Prelude; import qualified Data_Bits; import qualified Orderings; instance Orderings.Ord Integer where { less_eq = (\ a b -> a <= b); less = (\ a b -> a < b); }; newtype Nat = Nat Integer; data Num = One | Bit0 Num | Bit1 Num; integer_of_nat :: Nat -> Integer; integer_of_nat (Nat x) = x; plus_nat :: Nat -> Nat -> Nat; plus_nat m n = Nat (integer_of_nat m + integer_of_nat n); one_nat :: Nat; one_nat = Nat (1 :: Integer); suc :: Nat -> Nat; suc n = plus_nat n one_nat; zero_nat :: Nat; zero_nat = Nat (0 :: Integer); nat_of_integer :: Integer -> Nat; nat_of_integer k = Nat (Orderings.max (0 :: Integer) k); equal_nat :: Nat -> Nat -> Bool; equal_nat m n = integer_of_nat m == integer_of_nat n; minus_nat :: Nat -> Nat -> Nat; minus_nat m n = Nat (Orderings.max (0 :: Integer) (integer_of_nat m - integer_of_nat n)); times_nat :: Nat -> Nat -> Nat; times_nat m n = Nat (integer_of_nat m * integer_of_nat n); } module Orderings(Ord(..), max) where { import Prelude ((==), (/=), (<), (<=), (>=), (>), (+), (-), (*), (/), (**), (>>=), (>>), (=<<), (&&), (||), (^), (^^), (.), ($), ($!), (++), (!!), Eq, error, id, return, not, fst, snd, map, filter, concat, concatMap, reverse, zip, null, takeWhile, dropWhile, all, any, Integer, negate, abs, divMod, String, Bool(True, False), Maybe(Nothing, Just)); import qualified Prelude; import qualified Data_Bits; class Ord a where { less_eq :: a -> a -> Bool; less :: a -> a -> Bool; }; max :: forall a. (Ord a) => a -> a -> a; max a b = (if less_eq a b then b else a); } module Locale_Code_Ex(bar, foo) where { import Prelude ((==), (/=), (<), (<=), (>=), (>), (+), (-), (*), (/), (**), (>>=), (>>), (=<<), (&&), (||), (^), (^^), (.), ($), ($!), (++), (!!), Eq, error, id, return, not, fst, snd, map, filter, concat, concatMap, reverse, zip, null, takeWhile, dropWhile, all, any, Integer, negate, abs, divMod, String, Bool(True, False), Maybe(Nothing, Just)); import qualified Prelude; import qualified Data_Bits; import qualified Arith; c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat; c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One = Arith.plus_nat (Arith.nat_of_integer (5 :: Integer)) (Arith.nat_of_integer (5 :: Integer)); f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat; f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)))) (g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))); g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat; g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Arith.plus_nat (Arith.plus_nat (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One); f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One :: forall a. a -> Arith.Nat -> Arith.Nat; f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (snd (x, Arith.nat_of_integer (3 :: Integer))) (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (2 :: Integer))) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (snd (x, Arith.nat_of_integer (3 :: Integer))) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (2 :: Integer))) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat)))) (g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat))); g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One :: forall a. a -> Arith.Nat -> Arith.Nat; g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x n = (if Arith.equal_nat n Arith.zero_nat then snd (x, Arith.nat_of_integer (3 :: Integer)) else Arith.plus_nat (Arith.plus_nat (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One x (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (snd (x, Arith.nat_of_integer (3 :: Integer)))); f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat; f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Arith.nat_of_integer (5 :: Integer)) (Arith.nat_of_integer (5 :: Integer)) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.nat_of_integer (5 :: Integer)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.nat_of_integer (5 :: Integer)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)))) (g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat))); g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat; g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One n = (if Arith.equal_nat n Arith.zero_nat then Arith.nat_of_integer (5 :: Integer) else Arith.plus_nat (Arith.plus_nat (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Arith.nat_of_integer (5 :: Integer))); f_Suc_uu_Suc_uu :: Arith.Nat -> Arith.Nat -> Arith.Nat; f_Suc_uu_Suc_uu na n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat (Arith.suc na) (Arith.suc na) else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.suc na) (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat (Arith.suc na) (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat)))) (g_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat))); g_Suc_uu_Suc_uu :: Arith.Nat -> Arith.Nat -> Arith.Nat; g_Suc_uu_Suc_uu na n = (if Arith.equal_nat n Arith.zero_nat then Arith.suc na else Arith.plus_nat (Arith.plus_nat (f_Suc_uu_Suc_uu na (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) (Arith.suc na)); f_zero_zero :: Arith.Nat -> Arith.Nat; f_zero_zero n = (if Arith.equal_nat n Arith.zero_nat then Arith.zero_nat else Arith.plus_nat (f_zero_zero (Arith.minus_nat n Arith.one_nat)) (g_zero_zero (Arith.minus_nat n Arith.one_nat))); g_zero_zero :: Arith.Nat -> Arith.Nat; g_zero_zero n = (if Arith.equal_nat n Arith.zero_nat then Arith.zero_nat else Arith.plus_nat (Arith.plus_nat (f_zero_zero (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) Arith.zero_nat); f_one_one :: Arith.Nat -> Arith.Nat; f_one_one n = (if Arith.equal_nat n Arith.zero_nat then Arith.plus_nat Arith.one_nat Arith.one_nat else Arith.plus_nat (Arith.plus_nat (Arith.plus_nat Arith.one_nat (f_one_one (Arith.minus_nat n Arith.one_nat))) (Arith.times_nat Arith.one_nat (f_one_one (Arith.minus_nat n Arith.one_nat)))) (g_one_one (Arith.minus_nat n Arith.one_nat))); g_one_one :: Arith.Nat -> Arith.Nat; g_one_one n = (if Arith.equal_nat n Arith.zero_nat then Arith.one_nat else Arith.plus_nat (Arith.plus_nat (f_one_one (Arith.minus_nat n Arith.one_nat)) (Arith.minus_nat n Arith.one_nat)) Arith.one_nat); bar :: Arith.Nat -> Arith.Nat -> Arith.Nat; bar x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (f_zero_zero x) (f_Suc_uu_Suc_uu x y)) (f_one_one x)) (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y)) (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One False x)) (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y); j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat -> Arith.Nat; j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) y) x; k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat; k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x = Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x; i :: Arith.Nat -> Arith.Nat -> Arith.Nat; i x y = Arith.plus_nat x y; h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat -> Arith.Nat; h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) (k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One y)) (i x y)) (j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y); j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One :: forall a. a -> Arith.Nat -> Arith.Nat -> Arith.Nat; j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y = Arith.plus_nat (Arith.plus_nat (f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x) y) x; k_plus_one_numeral_Bit0_One :: Arith.Nat -> Arith.Nat; k_plus_one_numeral_Bit0_One x = Arith.plus_nat (Arith.plus_nat Arith.one_nat (Arith.nat_of_integer (2 :: Integer))) x; h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One :: forall a. a -> Arith.Nat -> Arith.Nat -> Arith.Nat; h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (snd (xa, Arith.nat_of_integer (3 :: Integer))) x) (k_plus_one_numeral_Bit0_One y)) (i x y)) (j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One xa x y); j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat -> Arith.Nat; j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x) y) x; k_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat; k_numeral_Bit1_Bit0_One x = Arith.plus_nat (Arith.nat_of_integer (5 :: Integer)) x; h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One :: Arith.Nat -> Arith.Nat -> Arith.Nat; h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.nat_of_integer (5 :: Integer)) x) (k_numeral_Bit1_Bit0_One y)) (i x y)) (j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y); j_Suc_uu_Suc_uu :: Arith.Nat -> Arith.Nat -> Arith.Nat -> Arith.Nat; j_Suc_uu_Suc_uu n x y = Arith.plus_nat (Arith.plus_nat (f_Suc_uu_Suc_uu n x) y) x; k_Suc_uu :: Arith.Nat -> Arith.Nat -> Arith.Nat; k_Suc_uu n x = Arith.plus_nat (Arith.suc n) x; h_Suc_uu_Suc_uu :: Arith.Nat -> Arith.Nat -> Arith.Nat -> Arith.Nat; h_Suc_uu_Suc_uu n x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.suc n) x) (k_Suc_uu n y)) (i x y)) (j_Suc_uu_Suc_uu n x y); j_zero_zero :: Arith.Nat -> Arith.Nat -> Arith.Nat; j_zero_zero x y = Arith.plus_nat (Arith.plus_nat (f_zero_zero x) y) x; k_zero :: Arith.Nat -> Arith.Nat; k_zero x = Arith.plus_nat Arith.zero_nat x; h_zero_zeroa :: Arith.Nat -> Arith.Nat -> Arith.Nat; h_zero_zeroa x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat x (k_zero y)) (i x y)) (j_zero_zero x y); h_zero_zero :: Bool; h_zero_zero = True; j_one_one :: Arith.Nat -> Arith.Nat -> Arith.Nat; j_one_one x y = Arith.plus_nat (Arith.plus_nat (f_one_one x) y) x; k_one :: Arith.Nat -> Arith.Nat; k_one x = Arith.plus_nat Arith.one_nat x; h_one_one :: Arith.Nat -> Arith.Nat -> Arith.Nat; h_one_one x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat Arith.one_nat x) (k_one y)) (i x y)) (j_one_one x y); foo :: Arith.Nat -> Arith.Nat -> Arith.Nat; foo x y = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (h_zero_zeroa x y) (h_Suc_uu_Suc_uu x x y)) (h_one_one x y)) (h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y)) (h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One h_zero_zero x y)) (h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One x y); } object Bits_Integer { def setBit(x: BigInt, n: BigInt, b: Boolean) : BigInt = if (n.isValidInt) if (b) x.setBit(n.toInt) else x.clearBit(n.toInt) else sys.error("Bit index too large: " + n.toString) def shiftl(x: BigInt, n: BigInt) : BigInt = if (n.isValidInt) x << n.toInt else sys.error("Shift index too large: " + n.toString) def shiftr(x: BigInt, n: BigInt) : BigInt = if (n.isValidInt) x << n.toInt else sys.error("Shift index too large: " + n.toString) def testBit(x: BigInt, n: BigInt) : Boolean = if (n.isValidInt) x.testBit(n.toInt) else sys.error("Bit index too large: " + n.toString) } /* object Bits_Integer */ object Orderings { trait ord[A] { val `Orderings.less_eq`: (A, A) => Boolean val `Orderings.less`: (A, A) => Boolean } def less_eq[A](a: A, b: A)(implicit A: ord[A]): Boolean = A.`Orderings.less_eq`(a, b) def less[A](a: A, b: A)(implicit A: ord[A]): Boolean = A.`Orderings.less`(a, b) object ord { implicit def `Code_Numeral.ord_integer`: ord[BigInt] = new ord[BigInt] { val `Orderings.less_eq` = (a: BigInt, b: BigInt) => a <= b val `Orderings.less` = (a: BigInt, b: BigInt) => a < b } } def max[A : ord](a: A, b: A): A = (if (less_eq[A](a, b)) b else a) } /* object Orderings */ object Num { abstract sealed class num final case class One() extends num final case class Bit0(a: num) extends num final case class Bit1(a: num) extends num } /* object Num */ object Code_Numeral { def integer_of_nat(x0: Nat.nat): BigInt = x0 match { case Nat.Nata(x) => x } def nat_of_integer(k: BigInt): Nat.nat = Nat.Nata(Orderings.max[BigInt](BigInt(0), k)) } /* object Code_Numeral */ object Nat { abstract sealed class nat final case class Nata(a: BigInt) extends nat def plus_nat(m: nat, n: nat): nat = Nata(Code_Numeral.integer_of_nat(m) + Code_Numeral.integer_of_nat(n)) def one_nat: nat = Nata(BigInt(1)) def Suc(n: nat): nat = plus_nat(n, one_nat) def zero_nat: nat = Nata(BigInt(0)) def equal_nat(m: nat, n: nat): Boolean = Code_Numeral.integer_of_nat(m) == Code_Numeral.integer_of_nat(n) def minus_nat(m: nat, n: nat): nat = Nata(Orderings.max[BigInt](BigInt(0), Code_Numeral.integer_of_nat(m) - Code_Numeral.integer_of_nat(n))) def times_nat(m: nat, n: nat): nat = Nata(Code_Numeral.integer_of_nat(m) * Code_Numeral.integer_of_nat(n)) } /* object Nat */ object Product_Type { def snd[A, B](x0: (A, B)): B = x0 match { case (x1, x2) => x2 } } /* object Product_Type */ object Locale_Code_Ex { def c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One: Nat.nat = Nat.plus_nat(Code_Numeral.nat_of_integer(BigInt(5)), Code_Numeral.nat_of_integer(BigInt(5))) def g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else Nat.plus_nat(Nat.plus_nat(f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat)), Nat.minus_nat(n, Nat.one_nat)), c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One)) def f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.plus_nat(c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One, c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One) else Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One, f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat))), Nat.times_nat(c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One, f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat)))), g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat)))) def g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](x: A, n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Product_Type.snd[A, Nat.nat]((x, Code_Numeral.nat_of_integer(BigInt(3)))) else Nat.plus_nat(Nat.plus_nat(f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](x, Nat.minus_nat(n, Nat.one_nat)), Nat.minus_nat(n, Nat.one_nat)), Product_Type.snd[A, Nat.nat]((x, Code_Numeral.nat_of_integer(BigInt(3)))))) def f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](x: A, n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.plus_nat(Product_Type.snd[A, Nat.nat]((x, Code_Numeral.nat_of_integer(BigInt(3)))), Nat.plus_nat(Nat.one_nat, Code_Numeral.nat_of_integer(BigInt(2)))) else Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Product_Type.snd[A, Nat.nat]((x, Code_Numeral.nat_of_integer(BigInt(3)))), f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](x, Nat.minus_nat(n, Nat.one_nat))), Nat.times_nat(Nat.plus_nat(Nat.one_nat, Code_Numeral.nat_of_integer(BigInt(2))), f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](x, Nat.minus_nat(n, Nat.one_nat)))), g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](x, Nat.minus_nat(n, Nat.one_nat)))) def g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Code_Numeral.nat_of_integer(BigInt(5)) else Nat.plus_nat(Nat.plus_nat(f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat)), Nat.minus_nat(n, Nat.one_nat)), Code_Numeral.nat_of_integer(BigInt(5)))) def f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.plus_nat(Code_Numeral.nat_of_integer(BigInt(5)), Code_Numeral.nat_of_integer(BigInt(5))) else Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Code_Numeral.nat_of_integer(BigInt(5)), f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat))), Nat.times_nat(Code_Numeral.nat_of_integer(BigInt(5)), f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat)))), g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(Nat.minus_nat(n, Nat.one_nat)))) def g_Suc_uu_Suc_uu(na: Nat.nat, n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.Suc(na) else Nat.plus_nat(Nat.plus_nat(f_Suc_uu_Suc_uu(na, Nat.minus_nat(n, Nat.one_nat)), Nat.minus_nat(n, Nat.one_nat)), Nat.Suc(na))) def f_Suc_uu_Suc_uu(na: Nat.nat, n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.plus_nat(Nat.Suc(na), Nat.Suc(na)) else Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.Suc(na), f_Suc_uu_Suc_uu(na, Nat.minus_nat(n, Nat.one_nat))), Nat.times_nat(Nat.Suc(na), f_Suc_uu_Suc_uu(na, Nat.minus_nat(n, Nat.one_nat)))), g_Suc_uu_Suc_uu(na, Nat.minus_nat(n, Nat.one_nat)))) def g_zero_zero(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.zero_nat else Nat.plus_nat(Nat.plus_nat(f_zero_zero(Nat.minus_nat(n, Nat.one_nat)), Nat.minus_nat(n, Nat.one_nat)), Nat.zero_nat)) def f_zero_zero(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.zero_nat else Nat.plus_nat(f_zero_zero(Nat.minus_nat(n, Nat.one_nat)), g_zero_zero(Nat.minus_nat(n, Nat.one_nat)))) def g_one_one(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.one_nat else Nat.plus_nat(Nat.plus_nat(f_one_one(Nat.minus_nat(n, Nat.one_nat)), Nat.minus_nat(n, Nat.one_nat)), Nat.one_nat)) def f_one_one(n: Nat.nat): Nat.nat = (if (Nat.equal_nat(n, Nat.zero_nat)) Nat.plus_nat(Nat.one_nat, Nat.one_nat) else Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.one_nat, f_one_one(Nat.minus_nat(n, Nat.one_nat))), Nat.times_nat(Nat.one_nat, f_one_one(Nat.minus_nat(n, Nat.one_nat)))), g_one_one(Nat.minus_nat(n, Nat.one_nat)))) def bar(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(f_zero_zero(x), f_Suc_uu_Suc_uu(x, y)), f_one_one(x)), f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(y)), f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[Boolean](false, x)), f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(y)) def j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x), y), x) def k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x: Nat.nat): Nat.nat = Nat.plus_nat(c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One, x) def i(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(x, y) def h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One, x), k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(y)), i(x, y)), j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x, y)) def j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](xa: A, x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](xa, x), y), x) def k_plus_one_numeral_Bit0_One(x: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.one_nat, Code_Numeral.nat_of_integer(BigInt(2))), x) def h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](xa: A, x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Product_Type.snd[A, Nat.nat]((xa, Code_Numeral.nat_of_integer(BigInt(3)))), x), k_plus_one_numeral_Bit0_One(y)), i(x, y)), j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[A](xa, x, y)) def j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x), y), x) def k_numeral_Bit1_Bit0_One(x: Nat.nat): Nat.nat = Nat.plus_nat(Code_Numeral.nat_of_integer(BigInt(5)), x) def h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Code_Numeral.nat_of_integer(BigInt(5)), x), k_numeral_Bit1_Bit0_One(y)), i(x, y)), j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x, y)) def j_Suc_uu_Suc_uu(n: Nat.nat, x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(f_Suc_uu_Suc_uu(n, x), y), x) def k_Suc_uu(n: Nat.nat, x: Nat.nat): Nat.nat = Nat.plus_nat(Nat.Suc(n), x) def h_Suc_uu_Suc_uu(n: Nat.nat, x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.Suc(n), x), k_Suc_uu(n, y)), i(x, y)), j_Suc_uu_Suc_uu(n, x, y)) def j_zero_zero(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(f_zero_zero(x), y), x) def k_zero(x: Nat.nat): Nat.nat = Nat.plus_nat(Nat.zero_nat, x) def h_zero_zeroa(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(x, k_zero(y)), i(x, y)), j_zero_zero(x, y)) def h_zero_zero: Boolean = true def j_one_one(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(f_one_one(x), y), x) def k_one(x: Nat.nat): Nat.nat = Nat.plus_nat(Nat.one_nat, x) def h_one_one(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.one_nat, x), k_one(y)), i(x, y)), j_one_one(x, y)) def foo(x: Nat.nat, y: Nat.nat): Nat.nat = Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(Nat.plus_nat(h_zero_zeroa(x, y), h_Suc_uu_Suc_uu(x, x, y)), h_one_one(x, y)), h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x, y)), h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One[Boolean](h_zero_zero, x, y)), h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One(x, y)) } /* object Locale_Code_Ex */ ### theory "Collections.Locale_Code_Ex" ### 1.112s elapsed time, 2.172s cpu time, 0.000s GC time Loading theory "Collections.Gen_Iterator" (required by "Collections.RBT_add" via "Collections.Iterator") instantiation uint32 :: {exhaustive,full_exhaustive,random} random_uint32 == random_class.random :: natural \ natural \ natural \ (uint32 \ (unit \ term)) \ natural \ natural full_exhaustive_uint32 == full_exhaustive_class.full_exhaustive :: (uint32 \ (unit \ term) \ (bool \ term list) option) \ natural \ (bool \ term list) option exhaustive_uint32 == exhaustive_class.exhaustive :: (uint32 \ (bool \ term list) option) \ natural \ (bool \ term list) option instantiation uint32 :: narrowing narrowing_uint32 == narrowing :: integer \ uint32 ??.Quickcheck_Narrowing.narrowing_cons ### theory "Native_Word.Uint32" ### 1.721s elapsed time, 3.364s cpu time, 0.000s GC time Loading theory "Collections.HashCode" class hashable = type + fixes hashcode :: "'a \ uint32" and def_hashmap_size :: "'a itself \ nat" assumes "def_hashmap_size": "1 < def_hashmap_size TYPE('a)" instantiation unit :: hashable hashcode_unit == hashcode :: unit \ uint32 def_hashmap_size_unit == def_hashmap_size :: unit itself \ nat instantiation bool :: hashable hashcode_bool == hashcode :: bool \ uint32 def_hashmap_size_bool == def_hashmap_size :: bool itself \ nat instantiation int :: hashable hashcode_int == hashcode :: int \ uint32 def_hashmap_size_int == def_hashmap_size :: int itself \ nat instantiation integer :: hashable hashcode_integer == hashcode :: integer \ uint32 def_hashmap_size_integer == def_hashmap_size :: integer itself \ nat instantiation nat :: hashable hashcode_nat == hashcode :: nat \ uint32 def_hashmap_size_nat == def_hashmap_size :: nat itself \ nat instantiation char :: hashable hashcode_char == hashcode :: char \ uint32 def_hashmap_size_char == def_hashmap_size :: char itself \ nat instantiation prod :: (hashable, hashable) hashable hashcode_prod == hashcode :: 'a \ 'b \ uint32 def_hashmap_size_prod == def_hashmap_size :: ('a \ 'b) itself \ nat instantiation sum :: (hashable, hashable) hashable hashcode_sum == hashcode :: 'a + 'b \ uint32 def_hashmap_size_sum == def_hashmap_size :: ('a + 'b) itself \ nat instantiation list :: (hashable) hashable hashcode_list == hashcode :: 'a list \ uint32 def_hashmap_size_list == def_hashmap_size :: 'a list itself \ nat instantiation option :: (hashable) hashable hashcode_option == hashcode :: 'a option \ uint32 def_hashmap_size_option == def_hashmap_size :: 'a option itself \ nat instantiation String.literal :: hashable hashcode_literal == hashcode :: String.literal \ uint32 def_hashmap_size_literal == def_hashmap_size :: String.literal itself \ nat ### theory "Collections.HashCode" ### 0.415s elapsed time, 0.832s cpu time, 0.000s GC time ### theory "Collections.Gen_Iterator" ### 0.988s elapsed time, 1.768s cpu time, 0.440s GC time Loading theory "Collections.Iterator" (required by "Collections.RBT_add") val it = fn: (theory -> theory) -> (Proof.context -> Proof.context) -> Context.generic -> Context.generic ### theory "Collections.Iterator" ### 0.744s elapsed time, 1.276s cpu time, 0.000s GC time Loading theory "Collections.ICF_Spec_Base" (required by "Collections.Robdd" via "Collections.MapSpec") Loading theory "Collections.RBT_add" ### theory "Collections.ICF_Spec_Base" ### 0.345s elapsed time, 0.656s cpu time, 0.000s GC time Loading theory "Collections.MapSpec" (required by "Collections.Robdd") locale map fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" locale map_no_invar fixes \ :: "'a \ 'b \ 'c option" and invar :: "'a \ bool" assumes "map_no_invar invar" locale map_empty fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and empty :: "unit \ 's" assumes "map_empty \ invar empty" locale map_lookup fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and lookup :: "'u \ 's \ 'v option" assumes "map_lookup \ invar lookup" locale map_update fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and update :: "'u \ 'v \ 's \ 's" assumes "map_update \ invar update" locale map_update_dj fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and update_dj :: "'u \ 'v \ 's \ 's" assumes "map_update_dj \ invar update_dj" consts rm_iterateoi :: "('k, 'v) rbt \ ('\ \ bool) \ ('k \ 'v \ '\ \ '\) \ '\ \ '\" locale map_delete fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and delete :: "'u \ 's \ 's" assumes "map_delete \ invar delete" locale map_add fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and add :: "'s \ 's \ 's" assumes "MapSpec.map_add \ invar add" consts rm_reverse_iterateoi :: "('k, 'v) rbt \ ('\ \ bool) \ ('k \ 'v \ '\ \ '\) \ '\ \ '\" locale map_add_dj fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and add_dj :: "'s \ 's \ 's" assumes "map_add_dj \ invar add_dj" locale map_isEmpty fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and isEmpty :: "'s \ bool" assumes "map_isEmpty \ invar isEmpty" locale map_sng fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and sng :: "'u \ 'v \ 's" assumes "map_sng \ invar sng" locale map_isSng fixes \ :: "'s \ 'k \ 'v option" and invar :: "'s \ bool" and isSng :: "'s \ bool" assumes "map_isSng \ invar isSng" locale finite_map fixes \ :: "'a \ 'b \ 'c option" and invar :: "'a \ bool" assumes "finite_map \ invar" locale map_size fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and size :: "'s \ nat" assumes "map_size \ invar size" locale map_size_abort fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and size_abort :: "nat \ 's \ nat" assumes "map_size_abort \ invar size_abort" locale poly_map_iteratei_defs fixes list_it :: "'s \ (('u \ 'v) list \ bool) \ ('u \ 'v \ ('u \ 'v) list \ ('u \ 'v) list) \ ('u \ 'v) list \ ('u \ 'v) list" locale poly_map_iteratei fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and list_it :: "'s \ (('u \ 'v) list \ bool) \ ('u \ 'v \ ('u \ 'v) list \ ('u \ 'v) list) \ ('u \ 'v) list \ ('u \ 'v) list" assumes "poly_map_iteratei \ invar list_it" locale map_ball fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and ball :: "'s \ ('u \ 'v \ bool) \ bool" assumes "map_ball \ invar ball" locale map_bex fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and bex :: "'s \ ('u \ 'v \ bool) \ bool" assumes "map_bex \ invar bex" locale map_sel fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and sel :: "'s \ ('u \ 'v \ 'r option) \ 'r option" assumes "map_sel \ invar sel" locale map_sel' fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and sel' :: "'s \ ('u \ 'v \ bool) \ ('u \ 'v) option" assumes "map_sel' \ invar sel'" locale map_to_list fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and to_list :: "'s \ ('u \ 'v) list" assumes "map_to_list \ invar to_list" locale list_to_map fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and to_map :: "('u \ 'v) list \ 's" assumes "list_to_map \ invar to_map" locale map_image_filter fixes \1 :: "'m1 \ 'u1 \ 'v1 option" and invar1 :: "'m1 \ bool" and \2 :: "'m2 \ 'u2 \ 'v2 option" and invar2 :: "'m2 \ bool" and map_image_filter :: "('u1 \ 'v1 \ ('u2 \ 'v2) option) \ 'm1 \ 'm2" assumes "map_image_filter \1 invar1 \2 invar2 map_image_filter" locale map_value_image_filter fixes \1 :: "'m1 \ 'u \ 'v1 option" and invar1 :: "'m1 \ bool" and \2 :: "'m2 \ 'u \ 'v2 option" and invar2 :: "'m2 \ bool" and map_value_image_filter :: "('u \ 'v1 \ 'v2 option) \ 'm1 \ 'm2" assumes "map_value_image_filter \1 invar1 \2 invar2 map_value_image_filter" locale map_restrict fixes \1 :: "'m1 \ 'u \ 'v option" and invar1 :: "'m1 \ bool" and \2 :: "'m2 \ 'u \ 'v option" and invar2 :: "'m2 \ bool" and restrict :: "('u \ 'v \ bool) \ 'm1 \ 'm2" assumes "map_restrict \1 invar1 \2 invar2 restrict" locale ordered_map fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" locale ordered_finite_map fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" assumes "ordered_finite_map \ invar" locale poly_map_iterateoi_defs fixes olist_it :: "'s \ (('u \ 'v) list \ bool) \ ('u \ 'v \ ('u \ 'v) list \ ('u \ 'v) list) \ ('u \ 'v) list \ ('u \ 'v) list" locale poly_map_iterateoi fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and list_ordered_it :: "'s \ (('u \ 'v) list \ bool) \ ('u \ 'v \ ('u \ 'v) list \ ('u \ 'v) list) \ ('u \ 'v) list \ ('u \ 'v) list" assumes "poly_map_iterateoi \ invar list_ordered_it" locale poly_map_rev_iterateoi_defs fixes list_rev_it :: "'s \ (('u \ 'v) list \ bool) \ ('u \ 'v \ ('u \ 'v) list \ ('u \ 'v) list) \ ('u \ 'v) list \ ('u \ 'v) list" consts bheight_aux :: "('a, 'b) rbt \ nat \ nat" locale poly_map_rev_iterateoi fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and list_rev_it :: "'s \ (('u \ 'v) list \ bool) \ ('u \ 'v \ ('u \ 'v) list \ ('u \ 'v) list) \ ('u \ 'v) list \ ('u \ 'v) list" assumes "poly_map_rev_iterateoi \ invar list_rev_it" ### theory "Collections.RBT_add" ### 1.244s elapsed time, 2.364s cpu time, 0.000s GC time locale map_min fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and min :: "'s \ ('u \ 'v \ bool) \ ('u \ 'v) option" assumes "map_min \ invar min" locale map_max fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and max :: "'s \ ('u \ 'v \ bool) \ ('u \ 'v) option" assumes "map_max \ invar max" locale map_to_sorted_list fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and to_sorted_list :: "'s \ ('u \ 'v) list" assumes "MapSpec.map_to_sorted_list \ invar to_sorted_list" locale map_to_rev_list fixes \ :: "'s \ 'u \ 'v option" and invar :: "'s \ bool" and to_rev_list :: "'s \ ('u \ 'v) list" assumes "map_to_rev_list \ invar to_rev_list" locale StdMapDefs fixes ops :: "('k, 'v, 's, 'more) map_ops_scheme" ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g locale StdMap fixes ops :: "('k, 'v, 's, 'more) map_ops_scheme" assumes "StdMap ops" locale StdMap_no_invar fixes ops :: "('a, 'b, 'c, 'd) map_ops_scheme" assumes "StdMap_no_invar ops" locale StdOMapDefs fixes ops :: "('k, 'v, 's, 'more) omap_ops_scheme" locale StdOMap fixes ops :: "('k, 'v, 's, 'more) omap_ops_scheme" assumes "StdOMap ops" ### theory "Collections.MapSpec" ### 4.193s elapsed time, 7.588s cpu time, 0.660s GC time Loading theory "Collections.Robdd" consts robdd_\ :: "robdd \ (nat \ bool) \ bool" consts robdd_get_id :: "robdd \ nat" consts robdd_get_var :: "robdd \ nat" consts robdd_get_left :: "robdd \ robdd" consts robdd_get_right :: "robdd \ robdd" consts robdd_to_bool :: "robdd \ bool option" consts robdd_is_leaf :: "robdd \ bool" consts robdd_equiv :: "robdd \ robdd \ bool" consts subrobdds :: "robdd \ robdd set" consts robdd_invar_vars_greater :: "nat \ robdd \ bool" consts robdd_invar_reduced :: "robdd \ bool" consts robdd_used_vars :: "robdd \ nat set" Found termination order: "{}" Found termination order: "{}" locale robdd_locale fixes c_\ :: "'c_map \ nat \ nat \ robdd option" and c_invar :: "'c_map \ bool" and c_empty :: "unit \ 'c_map" and c_lookup :: "nat \ nat \ 'c_map \ robdd option" and c_update :: "nat \ nat \ robdd \ 'c_map \ 'c_map" and r_\ :: "'r_map \ nat \ nat \ nat \ robdd option" and r_invar :: "'r_map \ bool" and r_empty :: "unit \ 'r_map" and r_lookup :: "nat \ nat \ nat \ 'r_map \ robdd option" and r_update :: "nat \ nat \ nat \ robdd \ 'r_map \ 'r_map" assumes "robdd_locale c_\ c_invar c_empty c_lookup c_update r_\ r_invar r_empty r_lookup r_update" Found termination order: "{}" Found termination order: "{}" Found termination order: "(\p. size (snd (snd (snd (snd p))))) <*mlex*> {}" Found termination order: "(\p. size_list size (snd (snd p))) <*mlex*> {}" Found termination order: "(\p. size (snd (snd p))) <*mlex*> {}" ### theory "Collections.Robdd" ### 4.002s elapsed time, 7.916s cpu time, 0.908s GC time ### Ignoring duplicate rewrite rule: ### toList (?a1 \ ?t1) \ ?a1 # toList ?t1 ### Ignoring duplicate rewrite rule: ### toList (?a1 \ ?t1) \ ?a1 # toList ?t1 ### Introduced fixed type variable(s): 'c, 'd in "a__" or "m__" or "nda__" or "sa__" or "sf__" or "ux__" ### Introduced fixed type variable(s): 'c, 'd in "a__" or "m__" or "nda__" or "pr__" or "sa__" or "ux__" ### Introduced fixed type variable(s): 'c, 'd, 'e, 'f in "FingerTreeStruc__" or "Node__" or "ma__" or "sfa__" ### Introduced fixed type variable(s): 'c, 'd, 'e, 'f in "FingerTreeStruc__" or "Node__" or "ma__" or "sfa__" ### Introduced fixed type variable(s): 'c, 'd, 'e, 'f in "FingerTreeStruc__" or "Node__" or "ma__" or "pra__" ### Introduced fixed type variable(s): 'c, 'd, 'e, 'f in "FingerTreeStruc__" or "Node__" or "ma__" or "pra__" ### Introduced fixed type variable(s): 'b, 'c in "da__" or "ia__" or "la__" or "nda__" or "pa__" or "ra__" ### Introduced fixed type variable(s): 'c, 'd in "t__" ### Ignoring duplicate rewrite rule: ### FingerTreeStruc.ft_invar (FingerTreeStruc.toTree ?l1) \ True ### Ignoring duplicate rewrite rule: ### FingerTreeStruc.toList (FingerTreeStruc.toTree ?y) \ ?y ### Ignoring duplicate rewrite rule: ### FingerTreeStruc.count ?t1 \ length (FingerTreeStruc.toList ?t1) ### Ignoring duplicate rewrite rule: ### of_nat (?m1 * ?n1) \ of_nat ?m1 * of_nat ?n1 ### Ignoring duplicate rewrite rule: ### of_nat (?m1 * ?n1) \ of_nat ?m1 * of_nat ?n1 ### Rule already declared as introduction (intro) ### \?b = ?f ?x; ?x \ ?A\ \ ?b \ ?f ` ?A ### Introduced fixed type variable(s): 'd in "l__" ### Introduced fixed type variable(s): 'd in "\__" or "c__" or "f__" ### Ignoring duplicate rewrite rule: ### finite (dom (map_of ?l1)) \ True ### Ignoring duplicate rewrite rule: ### finite (dom (map_of ?l1)) \ True ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate rewrite rule: ### \?k1 \| ?l1; ?k1 \| ?r1\ ### \ ?k1 \| combine ?l1 ?r1 \ True ### Ignoring duplicate rewrite rule: ### \?l1 |\ ?k1; ?r1 |\ ?k1\ ### \ combine ?l1 ?r1 |\ ?k1 \ True ### Ignoring duplicate rewrite rule: ### \?l1 |\ ?k1; ?r1 |\ ?k1\ ### \ combine ?l1 ?r1 |\ ?k1 \ True ### Ignoring duplicate rewrite rule: ### \?k1 \| ?l1; ?k1 \| ?r1\ ### \ ?k1 \| combine ?l1 ?r1 \ True ### Metis: Unused theorems: "local.combine_rbt_greater", "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_2", "local.ineqs_3", "local.ineqs_4", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_3", "local.ineqs_4", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_greater_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_less", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.rbt_greater_simps_2", "local.rbt_greater_trans" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.rbt_greater_simps_2" ### Metis: Unused theorems: "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.rbt_greater_simps_2", "local.rbt_greater_trans" ### Metis: Unused theorems: "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_3", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.combine_rbt_less", "local.ineqs_1", "local.ineqs_2", "local.ineqs_3", "local.ineqs_4", "local.ineqs_5", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_3", "local.ineqs_4", "local.ineqs_5", "local.ineqs_6", "local.rbt_less_simps_2", "local.rbt_greater_simps_2", "local.rbt_less_trans" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.rbt_greater_simps_2", "local.rbt_greater_trans" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.rbt_greater_simps_2", "local.rbt_greater_trans" ### Metis: Unused theorems: "local.combine_rbt_greater", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.ineqs_1", "local.ineqs_2", "local.ineqs_4", "local.ineqs_6", "local.rbt_greater_simps_2", "local.rbt_greater_trans" ### Ignoring duplicate rewrite rule: ### ?y1 AND ?x1 AND ?z1 \ ?x1 AND ?y1 AND ?z1 ### Metis: Unused theorems: "More_Bits_Int.int_shiftl_numeral_2" ### Ignoring duplicate rewrite rule: ### ?x1 BIT ?b1 >> Suc ?n1 \ ?x1 >> ?n1 ### Metis: Unused theorems: "Nat.neq0_conv", "Num.numeral_class.numeral.numeral_One", "Num.semiring_char_0_class.zero_neq_numeral" ### Ignoring duplicate rewrite rule: ### 0 OR ?y \ ?y ### Ignoring duplicate rewrite rule: ### ?y OR 0 \ ?y ### Ignoring duplicate rewrite rule: ### 0 XOR ?y \ ?y ### Ignoring duplicate rewrite rule: ### ?y XOR 0 \ ?y ### Ignoring duplicate rewrite rule: ### 0 OR ?y \ ?y ### Ignoring duplicate rewrite rule: ### ?y OR 0 \ ?y ### Ignoring duplicate rewrite rule: ### ?n1 \ Suc (length ?kvs1) \ ### entries (fst (rbtreeify_g ?n1 ?kvs1)) \ take (?n1 - 1) ?kvs1 Found termination order: "(\p. size_list size (snd (snd p))) <*mlex*> (\p. size_list size (fst (snd p))) <*mlex*> {}" Found termination order: "(\p. size_list size (snd (snd p))) <*mlex*> (\p. size_list size (fst (snd p))) <*mlex*> {}" ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### (\x y. ?A x y \ ?B (?f x) (?g y)) \ ### (?A ===> ?B) ?f ?g ### Metis: Unused theorems: "Word.word_sint.Rep_inverse'", "Word.wi_hom_neg" ### Ignoring duplicate rewrite rule: ### \0 \ ?k1; ?k1 < ?l1\ ### \ ?k1 div ?l1 \ 0 ### Ignoring duplicate rewrite rule: ### \0 \ ?y; ?y < ?l1\ ### \ ?y mod ?l1 \ ?y ### Ignoring duplicate rewrite rule: ### ?y < ?n1 \ ?y mod ?n1 \ ?y ### Metis: Unused theorems: "Word.word_less_def" ### Ignoring duplicate rewrite rule: ### \0 \ ?y; ?y < ?l1\ ### \ ?y mod ?l1 \ ?y ### Ignoring duplicate rewrite rule: ### \0 \ ?y; ?y < ?l1\ ### \ ?y mod ?l1 \ ?y ### Metis: Unused theorems: "Nat.semiring_1_class.of_nat_mult" Testing conjecture with Quickcheck-random... Quickcheck found a counterexample: x = 0 y = 1 Testing conjecture with Quickcheck-narrowing... Testing conjecture with Quickcheck-exhaustive... Quickcheck found a counterexample: x = 0 y = - 1 Evaluated terms: x AND y = 0 x OR y = - 1 ### Ignoring duplicate rewrite rule: ### Numeral1 \ 1::?'a1 ### Ignoring duplicate rewrite rule: ### Numeral1 \ 1::?'a1 Code_Numeral.dup Code_Numeral.dup (Code_Numeral.Neg ?n) \ Code_Numeral.Neg (num.Bit0 ?n) Code_Numeral.dup (Code_Numeral.Pos ?n) \ Code_Numeral.Pos (num.Bit0 ?n) Code_Numeral.dup 0 \ 0 Code_Numeral.sub Code_Numeral.sub (num.Bit0 ?m) (num.Bit1 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) - Code_Numeral.Pos num.One Code_Numeral.sub (num.Bit1 ?m) (num.Bit0 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) + Code_Numeral.Pos num.One Code_Numeral.sub (num.Bit1 ?m) (num.Bit1 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) Code_Numeral.sub (num.Bit0 ?m) (num.Bit0 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) Code_Numeral.sub num.One (num.Bit1 ?n) \ Code_Numeral.Neg (num.Bit0 ?n) Code_Numeral.sub num.One (num.Bit0 ?n) \ Code_Numeral.Neg (Num.BitM ?n) Code_Numeral.sub (num.Bit1 ?m) num.One \ Code_Numeral.Pos (num.Bit0 ?m) Code_Numeral.sub (num.Bit0 ?m) num.One \ Code_Numeral.Pos (Num.BitM ?m) Code_Numeral.sub num.One num.One \ 0 If if False then ?x else ?y \ ?y if True then ?x else ?y \ ?x Num.BitM Num.BitM num.One \ num.One Num.BitM (num.Bit0 ?n) \ num.Bit1 (Num.BitM ?n) Num.BitM (num.Bit1 ?n) \ num.Bit1 (num.Bit0 ?n) Suc Suc ?n \ ?n + 1 c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One \ nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) equal_class.equal [integer] equal_class.equal ?k ?k \ True equal_class.equal (Code_Numeral.Neg ?k) (Code_Numeral.Neg ?l) \ equal_class.equal ?k ?l equal_class.equal (Code_Numeral.Neg ?k) (Code_Numeral.Pos ?l) \ False equal_class.equal (Code_Numeral.Neg ?k) 0 \ False equal_class.equal (Code_Numeral.Pos ?k) (Code_Numeral.Neg ?l) \ False equal_class.equal (Code_Numeral.Pos ?k) (Code_Numeral.Pos ?l) \ equal_class.equal ?k ?l equal_class.equal (Code_Numeral.Pos ?k) 0 \ False equal_class.equal 0 (Code_Numeral.Neg ?l) \ False equal_class.equal 0 (Code_Numeral.Pos ?l) \ False equal_class.equal 0 0 \ True equal_class.equal [nat] equal_class.equal ?m ?n \ equal_class.equal (integer_of_nat ?m) (integer_of_nat ?n) equal_class.equal [num] equal_class.equal ?x ?x \ True equal_class.equal (num.Bit0 ?x2.0) (num.Bit1 ?x3.0) \ False equal_class.equal (num.Bit1 ?x3.0) (num.Bit0 ?x2.0) \ False equal_class.equal num.One (num.Bit1 ?x3.0) \ False equal_class.equal (num.Bit1 ?x3.0) num.One \ False equal_class.equal num.One (num.Bit0 ?x2.0) \ False equal_class.equal (num.Bit0 ?x2.0) num.One \ False equal_class.equal (num.Bit1 ?x3.0) (num.Bit1 ?y3.0) \ equal_class.equal ?x3.0 ?y3.0 equal_class.equal (num.Bit0 ?x2.0) (num.Bit0 ?y2.0) \ equal_class.equal ?x2.0 ?y2.0 equal_class.equal num.One num.One \ True f_Suc_uu_Suc_uu f_Suc_uu_Suc_uu ?na ?n \ if equal_class.equal ?n 0 then Suc ?na + Suc ?na else Suc ?na + f_Suc_uu_Suc_uu ?na (?n - 1) + Suc ?na * f_Suc_uu_Suc_uu ?na (?n - 1) + g_Suc_uu_Suc_uu ?na (?n - 1) f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One + c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One + f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One * f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) else nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) * f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) f_one_one f_one_one ?n \ if equal_class.equal ?n 0 then 1 + 1 else 1 + f_one_one (?n - 1) + 1 * f_one_one (?n - 1) + g_one_one (?n - 1) f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x ?n \ if equal_class.equal ?n 0 then snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) + (1 + nat_of_integer (Code_Numeral.Pos (num.Bit0 num.One))) else snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) + f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) + (1 + nat_of_integer (Code_Numeral.Pos (num.Bit0 num.One))) * f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) + g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) f_zero_zero f_zero_zero ?n \ if equal_class.equal ?n 0 then 0 else f_zero_zero (?n - 1) + g_zero_zero (?n - 1) foo foo ?x ?y \ h_zero_zeroa ?x ?y + h_Suc_uu_Suc_uu ?x ?x ?y + h_one_one ?x ?y + h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y + h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One h_zero_zero ?x ?y + h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y g_Suc_uu_Suc_uu g_Suc_uu_Suc_uu ?na ?n \ if equal_class.equal ?n 0 then Suc ?na else f_Suc_uu_Suc_uu ?na (?n - 1) + (?n - 1) + Suc ?na g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + (?n - 1) + c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) else f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + (?n - 1) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) g_one_one g_one_one ?n \ if equal_class.equal ?n 0 then 1 else f_one_one (?n - 1) + (?n - 1) + 1 g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x ?n \ if equal_class.equal ?n 0 then snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) else f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) + (?n - 1) + snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) g_zero_zero g_zero_zero ?n \ if equal_class.equal ?n 0 then 0 else f_zero_zero (?n - 1) + (?n - 1) + 0 h_Suc_uu_Suc_uu h_Suc_uu_Suc_uu ?n ?x ?y \ Suc ?n + ?x + k_Suc_uu ?n ?y + i5.i ?x ?y + j_Suc_uu_Suc_uu ?n ?x ?y h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One h_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y \ c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One + ?x + k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?y + i5.i ?x ?y + j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One h_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y \ nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + ?x + k_numeral_Bit1_Bit0_One ?y + i5.i ?x ?y + j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y h_one_one h_one_one ?x ?y \ 1 + ?x + k_one ?y + i5.i ?x ?y + j_one_one ?x ?y h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One h_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?xa ?x ?y \ snd (?xa, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) + ?x + k_plus_one_numeral_Bit0_One ?y + i5.i ?x ?y + j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?xa ?x ?y h_zero_zero h_zero_zero \ True h_zero_zeroa h_zero_zeroa ?x ?y \ ?x + k_zero ?y + i5.i ?x ?y + j_zero_zero ?x ?y i5.i i5.i ?x ?y \ ?x + ?y integer_of_nat integer_of_nat (Code_Target_Nat.Nat ?x) \ ?x j_Suc_uu_Suc_uu j_Suc_uu_Suc_uu ?n ?x ?y \ f_Suc_uu_Suc_uu ?n ?x + ?y + ?x j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One j_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y \ f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x + ?y + ?x j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One j_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x ?y \ f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x + ?y + ?x j_one_one j_one_one ?x ?y \ f_one_one ?x + ?y + ?x j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One j_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?xa ?x ?y \ f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?xa ?x + ?y + ?x j_zero_zero j_zero_zero ?x ?y \ f_zero_zero ?x + ?y + ?x k_Suc_uu k_Suc_uu ?n ?x \ Suc ?n + ?x k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One k_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?x \ c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One + ?x k_numeral_Bit1_Bit0_One k_numeral_Bit1_Bit0_One ?x \ nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + ?x k_one k_one ?x \ 1 + ?x k_plus_one_numeral_Bit0_One k_plus_one_numeral_Bit0_One ?x \ 1 + nat_of_integer (Code_Numeral.Pos (num.Bit0 num.One)) + ?x k_zero k_zero ?x \ 0 + ?x less [integer] Code_Numeral.Neg ?k < Code_Numeral.Neg ?l \ ?l < ?k Code_Numeral.Neg ?k < Code_Numeral.Pos ?l \ True Code_Numeral.Neg ?k < 0 \ True Code_Numeral.Pos ?k < Code_Numeral.Neg ?l \ False Code_Numeral.Pos ?k < Code_Numeral.Pos ?l \ ?k < ?l Code_Numeral.Pos ?k < 0 \ False 0 < Code_Numeral.Neg ?l \ False 0 < Code_Numeral.Pos ?l \ True 0 < 0 \ False less [num] num.Bit1 ?m < num.Bit0 ?n \ ?m < ?n num.Bit1 ?m < num.Bit1 ?n \ ?m < ?n num.Bit0 ?m < num.Bit1 ?n \ ?m \ ?n num.Bit0 ?m < num.Bit0 ?n \ ?m < ?n num.One < num.Bit1 ?n \ True num.One < num.Bit0 ?n \ True ?m < num.One \ False less_eq [integer] Code_Numeral.Neg ?k \ Code_Numeral.Neg ?l \ ?l \ ?k Code_Numeral.Neg ?k \ Code_Numeral.Pos ?l \ True Code_Numeral.Neg ?k \ 0 \ True Code_Numeral.Pos ?k \ Code_Numeral.Neg ?l \ False Code_Numeral.Pos ?k \ Code_Numeral.Pos ?l \ ?k \ ?l Code_Numeral.Pos ?k \ 0 \ False 0 \ Code_Numeral.Neg ?l \ False 0 \ Code_Numeral.Pos ?l \ True 0 \ 0 \ True less_eq [num] num.Bit1 ?m \ num.Bit0 ?n \ ?m < ?n num.Bit1 ?m \ num.Bit1 ?n \ ?m \ ?n num.Bit0 ?m \ num.Bit1 ?n \ ?m \ ?n num.Bit0 ?m \ num.Bit0 ?n \ ?m \ ?n num.Bit1 ?m \ num.One \ False num.Bit0 ?m \ num.One \ False num.One \ ?n \ True max max ?a ?b \ if ?a \ ?b then ?b else ?a minus [integer] Code_Numeral.Neg ?m - Code_Numeral.Neg ?n \ Code_Numeral.sub ?n ?m Code_Numeral.Neg ?m - Code_Numeral.Pos ?n \ Code_Numeral.Neg (?m + ?n) Code_Numeral.Pos ?m - Code_Numeral.Neg ?n \ Code_Numeral.Pos (?m + ?n) Code_Numeral.Pos ?m - Code_Numeral.Pos ?n \ Code_Numeral.sub ?m ?n 0 - ?l \ - ?l ?k - 0 \ ?k minus [nat] integer_of_nat (?m - ?n) \ max 0 (integer_of_nat ?m - integer_of_nat ?n) nat_of_integer integer_of_nat (nat_of_integer ?k) \ max 0 ?k one_class.one [nat] integer_of_nat 1 \ Code_Numeral.Pos num.One plus [integer] Code_Numeral.Neg ?m + Code_Numeral.Neg ?n \ Code_Numeral.Neg (?m + ?n) Code_Numeral.Neg ?m + Code_Numeral.Pos ?n \ Code_Numeral.sub ?n ?m Code_Numeral.Pos ?m + Code_Numeral.Neg ?n \ Code_Numeral.sub ?m ?n Code_Numeral.Pos ?m + Code_Numeral.Pos ?n \ Code_Numeral.Pos (?m + ?n) 0 + ?l \ ?l ?k + 0 \ ?k plus [nat] integer_of_nat (?m + ?n) \ integer_of_nat ?m + integer_of_nat ?n plus [num] num.Bit1 ?m + num.Bit1 ?n \ num.Bit0 (?m + ?n + num.One) num.Bit1 ?m + num.Bit0 ?n \ num.Bit1 (?m + ?n) num.Bit1 ?m + num.One \ num.Bit0 (?m + num.One) num.Bit0 ?m + num.Bit1 ?n \ num.Bit1 (?m + ?n) num.Bit0 ?m + num.Bit0 ?n \ num.Bit0 (?m + ?n) num.Bit0 ?m + num.One \ num.Bit1 ?m num.One + num.Bit1 ?n \ num.Bit0 (?n + num.One) num.One + num.Bit0 ?n \ num.Bit1 ?n num.One + num.One \ num.Bit0 num.One snd snd (?x1.0, ?x2.0) \ ?x2.0 times [integer] Code_Numeral.Neg ?m * Code_Numeral.Neg ?n \ Code_Numeral.Pos (?m * ?n) Code_Numeral.Neg ?m * Code_Numeral.Pos ?n \ Code_Numeral.Neg (?m * ?n) Code_Numeral.Pos ?m * Code_Numeral.Neg ?n \ Code_Numeral.Neg (?m * ?n) Code_Numeral.Pos ?m * Code_Numeral.Pos ?n \ Code_Numeral.Pos (?m * ?n) 0 * ?l \ 0 ?k * 0 \ 0 times [nat] integer_of_nat (?m * ?n) \ integer_of_nat ?m * integer_of_nat ?n times [num] num.Bit1 ?m * num.Bit1 ?n \ num.Bit1 (?m + ?n + num.Bit0 (?m * ?n)) num.Bit1 ?m * num.Bit0 ?n \ num.Bit0 (num.Bit1 ?m * ?n) num.Bit0 ?m * num.Bit1 ?n \ num.Bit0 (?m * num.Bit1 ?n) num.Bit0 ?m * num.Bit0 ?n \ num.Bit0 (num.Bit0 (?m * ?n)) num.One * ?n \ ?n ?m * num.One \ ?m uminus [integer] - Code_Numeral.Neg ?m \ Code_Numeral.Pos ?m - Code_Numeral.Pos ?m \ Code_Numeral.Neg ?m - 0 \ 0 zero_class.zero [nat] integer_of_nat 0 \ 0 Code_Numeral.dup Code_Numeral.dup (Code_Numeral.Neg ?n) \ Code_Numeral.Neg (num.Bit0 ?n) Code_Numeral.dup (Code_Numeral.Pos ?n) \ Code_Numeral.Pos (num.Bit0 ?n) Code_Numeral.dup 0 \ 0 Code_Numeral.sub Code_Numeral.sub (num.Bit0 ?m) (num.Bit1 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) - Code_Numeral.Pos num.One Code_Numeral.sub (num.Bit1 ?m) (num.Bit0 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) + Code_Numeral.Pos num.One Code_Numeral.sub (num.Bit1 ?m) (num.Bit1 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) Code_Numeral.sub (num.Bit0 ?m) (num.Bit0 ?n) \ Code_Numeral.dup (Code_Numeral.sub ?m ?n) Code_Numeral.sub num.One (num.Bit1 ?n) \ Code_Numeral.Neg (num.Bit0 ?n) Code_Numeral.sub num.One (num.Bit0 ?n) \ Code_Numeral.Neg (Num.BitM ?n) Code_Numeral.sub (num.Bit1 ?m) num.One \ Code_Numeral.Pos (num.Bit0 ?m) Code_Numeral.sub (num.Bit0 ?m) num.One \ Code_Numeral.Pos (Num.BitM ?m) Code_Numeral.sub num.One num.One \ 0 If if False then ?x else ?y \ ?y if True then ?x else ?y \ ?x Num.BitM Num.BitM num.One \ num.One Num.BitM (num.Bit0 ?n) \ num.Bit1 (Num.BitM ?n) Num.BitM (num.Bit1 ?n) \ num.Bit1 (num.Bit0 ?n) Suc Suc ?n \ ?n + 1 bar bar ?x ?y \ f_zero_zero ?x + f_Suc_uu_Suc_uu ?x ?y + f_one_one ?x + f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?y + f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One False ?x + f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?y c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One \ nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) equal_class.equal [integer] equal_class.equal ?k ?k \ True equal_class.equal (Code_Numeral.Neg ?k) (Code_Numeral.Neg ?l) \ equal_class.equal ?k ?l equal_class.equal (Code_Numeral.Neg ?k) (Code_Numeral.Pos ?l) \ False equal_class.equal (Code_Numeral.Neg ?k) 0 \ False equal_class.equal (Code_Numeral.Pos ?k) (Code_Numeral.Neg ?l) \ False equal_class.equal (Code_Numeral.Pos ?k) (Code_Numeral.Pos ?l) \ equal_class.equal ?k ?l equal_class.equal (Code_Numeral.Pos ?k) 0 \ False equal_class.equal 0 (Code_Numeral.Neg ?l) \ False equal_class.equal 0 (Code_Numeral.Pos ?l) \ False equal_class.equal 0 0 \ True equal_class.equal [nat] equal_class.equal ?m ?n \ equal_class.equal (integer_of_nat ?m) (integer_of_nat ?n) equal_class.equal [num] equal_class.equal ?x ?x \ True equal_class.equal (num.Bit0 ?x2.0) (num.Bit1 ?x3.0) \ False equal_class.equal (num.Bit1 ?x3.0) (num.Bit0 ?x2.0) \ False equal_class.equal num.One (num.Bit1 ?x3.0) \ False equal_class.equal (num.Bit1 ?x3.0) num.One \ False equal_class.equal num.One (num.Bit0 ?x2.0) \ False equal_class.equal (num.Bit0 ?x2.0) num.One \ False equal_class.equal (num.Bit1 ?x3.0) (num.Bit1 ?y3.0) \ equal_class.equal ?x3.0 ?y3.0 equal_class.equal (num.Bit0 ?x2.0) (num.Bit0 ?y2.0) \ equal_class.equal ?x2.0 ?y2.0 equal_class.equal num.One num.One \ True f_Suc_uu_Suc_uu f_Suc_uu_Suc_uu ?na ?n \ if equal_class.equal ?n 0 then Suc ?na + Suc ?na else Suc ?na + f_Suc_uu_Suc_uu ?na (?n - 1) + Suc ?na * f_Suc_uu_Suc_uu ?na (?n - 1) + g_Suc_uu_Suc_uu ?na (?n - 1) f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One + c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One + f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One * f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) else nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) + f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) * f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) f_one_one f_one_one ?n \ if equal_class.equal ?n 0 then 1 + 1 else 1 + f_one_one (?n - 1) + 1 * f_one_one (?n - 1) + g_one_one (?n - 1) f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x ?n \ if equal_class.equal ?n 0 then snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) + (1 + nat_of_integer (Code_Numeral.Pos (num.Bit0 num.One))) else snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) + f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) + (1 + nat_of_integer (Code_Numeral.Pos (num.Bit0 num.One))) * f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) + g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) f_zero_zero f_zero_zero ?n \ if equal_class.equal ?n 0 then 0 else f_zero_zero (?n - 1) + g_zero_zero (?n - 1) g_Suc_uu_Suc_uu g_Suc_uu_Suc_uu ?na ?n \ if equal_class.equal ?n 0 then Suc ?na else f_Suc_uu_Suc_uu ?na (?n - 1) + (?n - 1) + Suc ?na g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One g_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One else f_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One_c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + (?n - 1) + c_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One g_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One ?n \ if equal_class.equal ?n 0 then nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) else f_numeral_Bit1_Bit0_One_numeral_Bit1_Bit0_One (?n - 1) + (?n - 1) + nat_of_integer (Code_Numeral.Pos (num.Bit1 (num.Bit0 num.One))) g_one_one g_one_one ?n \ if equal_class.equal ?n 0 then 1 else f_one_one (?n - 1) + (?n - 1) + 1 g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One g_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x ?n \ if equal_class.equal ?n 0 then snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) else f_snd_Pair_uu_numeral_Bit1_One_plus_one_numeral_Bit0_One ?x (?n - 1) + (?n - 1) + snd (?x, nat_of_integer (Code_Numeral.Pos (num.Bit1 num.One))) g_zero_zero g_zero_zero ?n \ if equal_class.equal ?n 0 then 0 else f_zero_zero (?n - 1) + (?n - 1) + 0 integer_of_nat integer_of_nat (Code_Target_Nat.Nat ?x) \ ?x less [integer] Code_Numeral.Neg ?k < Code_Numeral.Neg ?l \ ?l < ?k Code_Numeral.Neg ?k < Code_Numeral.Pos ?l \ True Code_Numeral.Neg ?k < 0 \ True Code_Numeral.Pos ?k < Code_Numeral.Neg ?l \ False Code_Numeral.Pos ?k < Code_Numeral.Pos ?l \ ?k < ?l Code_Numeral.Pos ?k < 0 \ False 0 < Code_Numeral.Neg ?l \ False 0 < Code_Numeral.Pos ?l \ True 0 < 0 \ False less [num] num.Bit1 ?m < num.Bit0 ?n \ ?m < ?n num.Bit1 ?m < num.Bit1 ?n \ ?m < ?n num.Bit0 ?m < num.Bit1 ?n \ ?m \ ?n num.Bit0 ?m < num.Bit0 ?n \ ?m < ?n num.One < num.Bit1 ?n \ True num.One < num.Bit0 ?n \ True ?m < num.One \ False less_eq [integer] Code_Numeral.Neg ?k \ Code_Numeral.Neg ?l \ ?l \ ?k Code_Numeral.Neg ?k \ Code_Numeral.Pos ?l \ True Code_Numeral.Neg ?k \ 0 \ True Code_Numeral.Pos ?k \ Code_Numeral.Neg ?l \ False Code_Numeral.Pos ?k \ Code_Numeral.Pos ?l \ ?k \ ?l Code_Numeral.Pos ?k \ 0 \ False 0 \ Code_Numeral.Neg ?l \ False 0 \ Code_Numeral.Pos ?l \ True 0 \ 0 \ True less_eq [num] num.Bit1 ?m \ num.Bit0 ?n \ ?m < ?n num.Bit1 ?m \ num.Bit1 ?n \ ?m \ ?n num.Bit0 ?m \ num.Bit1 ?n \ ?m \ ?n num.Bit0 ?m \ num.Bit0 ?n \ ?m \ ?n num.Bit1 ?m \ num.One \ False num.Bit0 ?m \ num.One \ False num.One \ ?n \ True max max ?a ?b \ if ?a \ ?b then ?b else ?a minus [integer] Code_Numeral.Neg ?m - Code_Numeral.Neg ?n \ Code_Numeral.sub ?n ?m Code_Numeral.Neg ?m - Code_Numeral.Pos ?n \ Code_Numeral.Neg (?m + ?n) Code_Numeral.Pos ?m - Code_Numeral.Neg ?n \ Code_Numeral.Pos (?m + ?n) Code_Numeral.Pos ?m - Code_Numeral.Pos ?n \ Code_Numeral.sub ?m ?n 0 - ?l \ - ?l ?k - 0 \ ?k minus [nat] integer_of_nat (?m - ?n) \ max 0 (integer_of_nat ?m - integer_of_nat ?n) nat_of_integer integer_of_nat (nat_of_integer ?k) \ max 0 ?k one_class.one [nat] integer_of_nat 1 \ Code_Numeral.Pos num.One plus [integer] Code_Numeral.Neg ?m + Code_Numeral.Neg ?n \ Code_Numeral.Neg (?m + ?n) Code_Numeral.Neg ?m + Code_Numeral.Pos ?n \ Code_Numeral.sub ?n ?m Code_Numeral.Pos ?m + Code_Numeral.Neg ?n \ Code_Numeral.sub ?m ?n Code_Numeral.Pos ?m + Code_Numeral.Pos ?n \ Code_Numeral.Pos (?m + ?n) 0 + ?l \ ?l ?k + 0 \ ?k plus [nat] integer_of_nat (?m + ?n) \ integer_of_nat ?m + integer_of_nat ?n plus [num] num.Bit1 ?m + num.Bit1 ?n \ num.Bit0 (?m + ?n + num.One) num.Bit1 ?m + num.Bit0 ?n \ num.Bit1 (?m + ?n) num.Bit1 ?m + num.One \ num.Bit0 (?m + num.One) num.Bit0 ?m + num.Bit1 ?n \ num.Bit1 (?m + ?n) num.Bit0 ?m + num.Bit0 ?n \ num.Bit0 (?m + ?n) num.Bit0 ?m + num.One \ num.Bit1 ?m num.One + num.Bit1 ?n \ num.Bit0 (?n + num.One) num.One + num.Bit0 ?n \ num.Bit1 ?n num.One + num.One \ num.Bit0 num.One snd snd (?x1.0, ?x2.0) \ ?x2.0 times [integer] Code_Numeral.Neg ?m * Code_Numeral.Neg ?n \ Code_Numeral.Pos (?m * ?n) Code_Numeral.Neg ?m * Code_Numeral.Pos ?n \ Code_Numeral.Neg (?m * ?n) Code_Numeral.Pos ?m * Code_Numeral.Neg ?n \ Code_Numeral.Neg (?m * ?n) Code_Numeral.Pos ?m * Code_Numeral.Pos ?n \ Code_Numeral.Pos (?m * ?n) 0 * ?l \ 0 ?k * 0 \ 0 times [nat] integer_of_nat (?m * ?n) \ integer_of_nat ?m * integer_of_nat ?n times [num] num.Bit1 ?m * num.Bit1 ?n \ num.Bit1 (?m + ?n + num.Bit0 (?m * ?n)) num.Bit1 ?m * num.Bit0 ?n \ num.Bit0 (num.Bit1 ?m * ?n) num.Bit0 ?m * num.Bit1 ?n \ num.Bit0 (?m * num.Bit1 ?n) num.Bit0 ?m * num.Bit0 ?n \ num.Bit0 (num.Bit0 (?m * ?n)) num.One * ?n \ ?n ?m * num.One \ ?m uminus [integer] - Code_Numeral.Neg ?m \ Code_Numeral.Pos ?m - Code_Numeral.Pos ?m \ Code_Numeral.Neg ?m - 0 \ 0 zero_class.zero [nat] integer_of_nat 0 \ 0 "34578" :: "nat" [1 of 5] Compiling Data_Bits ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Data_Bits.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Data_Bits.o ) [2 of 5] Compiling Typerep ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Typerep.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Typerep.o ) [3 of 5] Compiling Generated_Code ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Generated_Code.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Generated_Code.o ) [4 of 5] Compiling Narrowing_Engine ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Narrowing_Engine.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Narrowing_Engine.o ) [5 of 5] Compiling Main ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Main.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/Main.o ) Linking /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3798258/isabelle_quickcheck_narrowing ... "354189" :: "nat" Quickcheck found no counterexample. val it = Nat 34578: Isabelle3803348.Generated_Code.nat val it = Nat 354189: Isabelle3803348.Generated_Code.nat ### Ignoring duplicate rewrite rule: ### subrobdds_set (subrobdds_set ?bs1) \ subrobdds_set ?bs1 rank_invar (meld bq1 bq2) \ min (rank (link t1 t2)) (rank (hd (meld bq1 bq2))) \ rank (hd (ins (link t1 t2) (meld bq1 bq2))) \\t\set (filter (\t. rank t = 0) (children (getMinTree q))). rank t = 0 \ children t = []; queue_invar ?q\ \ queue_to_multiset (insertList (filter (\t. rank t = 0) (children (getMinTree q))) ?q) = queue_to_multiset (filter (\t. rank t = 0) (children (getMinTree q))) + queue_to_multiset ?q \\e a r ts. ?Q ts \ ?P (SkewBinomialHeapStruc.Node e a r ts); ?Q []; \t q. \?P t; ?Q q\ \ ?Q (t # q)\ \ ?P ?a0.0 \\e a r ts. ?Q ts \ ?P (SkewBinomialHeapStruc.Node e a r ts); ?Q []; \t q. \?P t; ?Q q\ \ ?Q (t # q)\ \ ?Q ?a1.0 Testing conjecture with Quickcheck-narrowing... [1 of 5] Compiling Data_Bits ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Data_Bits.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Data_Bits.o ) [2 of 5] Compiling Typerep ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Typerep.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Typerep.o ) [3 of 5] Compiling Generated_Code ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Generated_Code.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Generated_Code.o ) [4 of 5] Compiling Narrowing_Engine ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Narrowing_Engine.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Narrowing_Engine.o ) [5 of 5] Compiling Main ( /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Main.hs, /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/Main.o ) Linking /tmp/isabelle-jenkins/process2700961487925854726/Quickcheck_Narrowing3822208/isabelle_quickcheck_narrowing ... Quickcheck found no counterexample. Loading theory "Collections.GenCF_Chapter" Loading theory "Collections.GenCF_Gen_Chapter" ### theory "Collections.GenCF_Gen_Chapter" ### 0.042s elapsed time, 0.128s cpu time, 0.000s GC time Loading theory "Collections.GenCF_Impl_Chapter" ### theory "Collections.GenCF_Chapter" ### 0.042s elapsed time, 0.128s cpu time, 0.000s GC time Loading theory "Collections.GenCF_Intf_Chapter" ### theory "Collections.GenCF_Impl_Chapter" ### 0.035s elapsed time, 0.088s cpu time, 0.000s GC time ### theory "Collections.GenCF_Intf_Chapter" ### 0.035s elapsed time, 0.088s cpu time, 0.000s GC time Loading theory "Collections.Intf_Comp" Loading theory "Collections.Impl_Array_Stack" ### theory "Collections.Impl_Array_Stack" ### 0.453s elapsed time, 0.912s cpu time, 0.000s GC time Loading theory "HOL-Library.Product_Lexorder" (required by "Collections.Gen_Comp") instantiation prod :: (ord, ord) ord less_eq_prod == less_eq :: 'a \ 'b \ 'a \ 'b \ bool less_prod == less :: 'a \ 'b \ 'a \ 'b \ bool locale linorder_on fixes D :: "'a set" and cmp :: "'a \ 'a \ comp_res" assumes "linorder_on D cmp" instantiation prod :: (linorder, linorder) distrib_lattice inf_prod == inf :: 'a \ 'b \ 'a \ 'b \ 'a \ 'b sup_prod == sup :: 'a \ 'b \ 'a \ 'b \ 'a \ 'b instantiation prod :: (bot, bot) bot bot_prod == bot :: 'a \ 'b instantiation prod :: (top, top) top top_prod == top :: 'a \ 'b ### theory "HOL-Library.Product_Lexorder" ### 0.110s elapsed time, 0.224s cpu time, 0.000s GC time Loading theory "Collections.Intf_Hash" Found termination order: "(\p. length (snd (snd p))) <*mlex*> {}" consts cmp_lex' :: "('a \ 'b \ comp_res) \ 'a list \ 'b list \ comp_res" Found termination order: "{}" class linorder = order + assumes "linear": "\x y. x \ y \ y \ x" ### Ignoring duplicate rewrite rule: ### finite ?A1 \ sorted_list_of_set ?A1 = [] \ ?A1 = {} locale eq_linorder_on fixes D :: "'a set" and cmp :: "'a \ 'a \ comp_res" assumes "eq_linorder_on D cmp" ### theory "Collections.Intf_Hash" ### 0.644s elapsed time, 1.292s cpu time, 0.000s GC time Loading theory "Collections.Array_Iterator" (required by "Collections.Impl_Array_Hash_Map") ### theory "Collections.Intf_Comp" ### 1.396s elapsed time, 2.804s cpu time, 0.000s GC time Loading theory "Collections.Gen_Comp" ### theory "Collections.Array_Iterator" ### 0.227s elapsed time, 0.456s cpu time, 0.000s GC time Loading theory "Collections.Intf_Map" ### theory "Collections.Gen_Comp" ### 0.588s elapsed time, 1.120s cpu time, 0.560s GC time Loading theory "Collections.Intf_Set" ### theory "Collections.Intf_Map" ### 0.714s elapsed time, 1.372s cpu time, 0.560s GC time Loading theory "Collections.Gen_Map" ### theory "Collections.Intf_Set" ### 0.429s elapsed time, 0.860s cpu time, 0.000s GC time Loading theory "Collections.Impl_RBT_Map" ### theory "Collections.Gen_Map" ### 0.652s elapsed time, 1.308s cpu time, 0.000s GC time Loading theory "Collections.Impl_Array_Map" Proofs for inductive predicate(s) "color_relp" Proving monotonicity ... Proving the introduction rules ... Proving the elimination rules ... Proving the induction rule ... Proving the simplification rules ... Proofs for inductive predicate(s) "rbt_rel_auxp" Proving monotonicity ... Proving the introduction rules ... Proving the elimination rules ... Proving the induction rule ... Proving the simplification rules ... consts iam_iteratei_aux :: "nat \ 'v option array \ ('\ \ bool) \ (nat \ 'v \ '\ \ '\) \ '\ \ '\" ### theory "Collections.Impl_Array_Map" ### 0.796s elapsed time, 1.596s cpu time, 0.000s GC time Loading theory "Collections.Impl_List_Map" (required by "Collections.Impl_Array_Hash_Map") consts list_map_lookup :: "('k \ 'k \ bool) \ 'k \ ('k \ 'v) list \ 'v option" consts list_map_update_aux :: "('k \ 'k \ bool) \ 'k \ 'v \ ('k \ 'v) list \ ('k \ 'v) list \ ('k \ 'v) list" consts list_map_delete_aux :: "('k \ 'k \ bool) \ 'k \ ('k \ 'v) list \ ('k \ 'v) list \ ('k \ 'v) list" consts list_map_pick_remove :: "'a list \ 'a \ 'a list" ### theory "Collections.Impl_List_Map" ### 0.775s elapsed time, 1.556s cpu time, 0.000s GC time Loading theory "Collections.Impl_Array_Hash_Map" consts ahm_invar :: "(nat \ 'k \ nat) \ ('k, 'v) hashmap \ bool" consts ahm_lookup :: "('a \ 'a \ bool) \ (nat \ 'a \ nat) \ 'a \ ('a, 'b) hashmap \ 'b option" consts ahm_iteratei_aux :: "('k \ 'v) list array \ ('\ \ bool) \ ('k \ 'v \ '\ \ '\) \ '\ \ '\" consts ahm_iteratei :: "('k, 'v) hashmap \ ('\ \ bool) \ ('k \ 'v \ '\ \ '\) \ '\ \ '\" consts ahm_rehash :: "(nat \ 'k \ nat) \ ('k, 'v) hashmap \ nat \ ('k, 'v) hashmap" consts hm_grow :: "('k, 'v) hashmap \ nat" consts ahm_filled :: "('k, 'v) hashmap \ bool" consts ahm_update_aux :: "('k \ 'k \ bool) \ (nat \ 'k \ nat) \ ('k, 'v) hashmap \ 'k \ 'v \ ('k, 'v) hashmap" consts ahm_delete :: "('k \ 'k \ bool) \ (nat \ 'k \ nat) \ 'k \ ('k, 'v) hashmap \ ('k, 'v) hashmap" consts ahm_isEmpty :: "('k, 'v) hashmap \ bool" consts ahm_isSng :: "('k, 'v) hashmap \ bool" consts ahm_size :: "('k, 'v) hashmap \ nat" ### theory "Collections.Impl_RBT_Map" ### 4.951s elapsed time, 9.848s cpu time, 1.076s GC time Loading theory "Collections.Gen_Map2Set" ### theory "Collections.Impl_Array_Hash_Map" ### 3.441s elapsed time, 6.820s cpu time, 1.076s GC time Loading theory "Collections.Gen_Set" ### theory "Collections.Gen_Map2Set" ### 0.760s elapsed time, 1.524s cpu time, 0.000s GC time Loading theory "Collections.Impl_Cfun_Set" ### theory "Collections.Impl_Cfun_Set" ### 0.096s elapsed time, 0.192s cpu time, 0.000s GC time Loading theory "Collections.Impl_List_Set" consts glist_member :: "('a \ 'a \ bool) \ 'a \ 'a list \ bool" consts rev_append :: "'a list \ 'a list \ 'a list" consts glist_delete_aux :: "('a \ 'a \ bool) \ 'a \ 'a list \ 'a list \ 'a list" ### theory "Collections.Impl_List_Set" ### 0.469s elapsed time, 0.940s cpu time, 0.000s GC time "array_length" :: "'a array \ nat" ### Adding overloaded interface type to constant: a ::\<^sub>i i_of_rel Id ### Adding overloaded interface type to constant: b ::\<^sub>i i_of_rel Id ### Adding overloaded interface type to constant: {} ::\<^sub>i i_of_rel Rs ### Adding overloaded interface type to constant: ### insert ::\<^sub>i ### i_nat \\<^sub>i i_of_rel Rs \\<^sub>i i_of_rel Rs ### Ignoring duplicate rewrite rule: ### op_list_append_elem ?s ?x \ ?s @ [?x] "array_shrink" :: "'a array \ nat \ 'a array" ### Adding overloaded interface type to constant: ### atLeastLessThan ::\<^sub>i ### i_nat \\<^sub>i i_nat \\<^sub>i ?Rs ### Adding overloaded interface type to constant: ### atLeastLessThan ::\<^sub>i ### i_nat \\<^sub>i i_nat \\<^sub>i ?Rs ### Adding overloaded interface type to constant: ### atLeastLessThan ::\<^sub>i ### i_nat \\<^sub>i i_nat \\<^sub>i ?Rs ### Adding overloaded interface type to constant: ### atLeastLessThan ::\<^sub>i ### i_nat \\<^sub>i i_nat \\<^sub>i ?Rs ### theory "Collections.Gen_Set" ### 1.299s elapsed time, 2.604s cpu time, 0.000s GC time ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g linorder_on (?f ` ?D) ?cmp \ linorder_on ?D (cmp_img ?f ?cmp) ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g "cmp_lex" :: "('a \ 'b \ comp_res) \ 'a list \ 'b list \ comp_res" "cmp_prod" :: "('a \ 'b \ comp_res) \ ('c \ 'd \ comp_res) \ 'a \ 'c \ 'b \ 'd \ comp_res" ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate rewrite rule: ### nofail (SELECT ?P1) \ True ### Ignoring duplicate rewrite rule: ### \ nofail ?S1 \ inres ?S1 ?x1 \ True ### Ignoring duplicate rewrite rule: ### inres SUCCEED \ \_. False ### Ignoring duplicate rewrite rule: ### inres (RETURN ?x1) \ (=) ?x1 ### Ignoring duplicate rewrite rule: ### inres (RES ?X1) \ \x. x \ ?X1 ### Ignoring duplicate rewrite rule: ### inres FAIL \ \_. True ### Ignoring duplicate rewrite rule: ### nofail SUCCEED \ True ### Ignoring duplicate rewrite rule: ### nofail (RETURN ?x1) \ True ### Ignoring duplicate rewrite rule: ### nofail (RES ?X1) \ True ### Ignoring duplicate rewrite rule: ### nofail FAIL \ False ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g "op_map_restrict" :: "('a \ 'b \ bool) \ ('a \ 'b option) \ 'a \ 'b option" ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate rewrite rule: ### nofail (SELECT ?P1) \ True ### Ignoring duplicate rewrite rule: ### \ nofail ?S1 \ inres ?S1 ?x1 \ True ### Ignoring duplicate rewrite rule: ### inres SUCCEED \ \_. False ### Ignoring duplicate rewrite rule: ### inres (RETURN ?x1) \ (=) ?x1 ### Ignoring duplicate rewrite rule: ### inres (RES ?X1) \ \x. x \ ?X1 ### Ignoring duplicate rewrite rule: ### inres FAIL \ \_. True ### Ignoring duplicate rewrite rule: ### nofail SUCCEED \ True ### Ignoring duplicate rewrite rule: ### nofail (RETURN ?x1) \ True ### Ignoring duplicate rewrite rule: ### nofail (RES ?X1) \ True ### Ignoring duplicate rewrite rule: ### nofail FAIL \ False \(?x, color.R) \ color_rel; ?x = color.R \ ?P\ \ ?P \(?x, color.B) \ color_rel; ?x = color.B \ ?P\ \ ?P \(color.R, ?y) \ color_rel; ?y = color.R \ ?P\ \ ?P \(color.B, ?y) \ color_rel; ?y = color.B \ ?P\ \ ?P ### Ignoring duplicate rewrite rule: ### balance rbt.Empty ?s1 ?t1 rbt.Empty \ ### Branch color.B rbt.Empty ?s1 ?t1 rbt.Empty ### Ignoring duplicate rewrite rule: ### balance (Branch color.B ?va1 ?vb1 ?vc1 ?vd1) ?s1 ?t1 rbt.Empty \ ### Branch color.B (Branch color.B ?va1 ?vb1 ?vc1 ?vd1) ?s1 ?t1 rbt.Empty ### Ignoring duplicate rewrite rule: ### balance rbt.Empty ?s1 ?t1 (Branch color.B ?va1 ?vb1 ?vc1 ?vd1) \ ### Branch color.B rbt.Empty ?s1 ?t1 (Branch color.B ?va1 ?vb1 ?vc1 ?vd1) "rbt_insert" :: "'a \ 'b \ ('a, 'b) rbt \ ('a, 'b) rbt" "balance_left" :: "('a, 'b) rbt \ 'a \ 'b \ ('a, 'b) rbt \ ('a, 'b) rbt" "balance_right" :: "('a, 'b) rbt \ 'a \ 'b \ ('a, 'b) rbt \ ('a, 'b) rbt" "ord.rbt_insert_with_key" :: "('a \ 'a \ bool) \ ('a \ 'b \ 'b \ 'b) \ 'a \ 'b \ ('a, 'b) rbt \ ('a, 'b) rbt" ### Introduced fixed type variable(s): 'c, 'd in "s__" or "t__" "RBT_Impl.skip_red" :: "('a, 'b) rbt \ ('a, 'b) rbt" "case_rbt" :: "'a \ (color \ ('b, 'c) rbt \ 'b \ 'c \ ('b, 'c) rbt \ 'a) \ ('b, 'c) rbt \ 'a" "rm_iterateoi" :: "('a, 'b) rbt \ ('c \ bool) \ ('a \ 'b \ 'c \ 'c) \ 'c \ 'c" "bheight" :: "('a, 'b) rbt \ nat" "ord.rbt_less" :: "('a \ 'a \ bool) \ 'a \ ('a, 'b) rbt \ bool" "ord.rbt_greater" :: "('a \ 'a \ bool) \ 'a \ ('a, 'b) rbt \ bool" ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Rule already declared as introduction (intro) ### \(?a, ?b) \ ?r; (?b, ?c) \ ?s\ ### \ (?a, ?c) \ ?r O ?s ### Introduced fixed type variable(s): 'c in "j__" ### Introduced fixed type variable(s): 'c in "hm__" or "m__" ### Introduced fixed type variable(s): 'c in "hm__" or "m__" ### Introduced fixed type variable(s): 'c in "hm__" or "m__" ### Introduced fixed type variable(s): 'b in "l__" or "x__" List.insert ?x ?xs = (if ?x \ set ?xs then ?xs else ?x # ?xs) ### Ignoring duplicate rewrite rule: ### nofail (SELECT ?P1) \ True ### Ignoring duplicate rewrite rule: ### \ nofail ?S1 \ inres ?S1 ?x1 \ True ### Ignoring duplicate rewrite rule: ### inres SUCCEED \ \_. False ### Ignoring duplicate rewrite rule: ### inres (RETURN ?x1) \ (=) ?x1 ### Ignoring duplicate rewrite rule: ### inres (RES ?X1) \ \x. x \ ?X1 ### Ignoring duplicate rewrite rule: ### inres FAIL \ \_. True ### Ignoring duplicate rewrite rule: ### nofail SUCCEED \ True ### Ignoring duplicate rewrite rule: ### nofail (RETURN ?x1) \ True ### Ignoring duplicate rewrite rule: ### nofail (RES ?X1) \ True ### Ignoring duplicate rewrite rule: ### nofail FAIL \ False \?Rk, ?Rv\list_map_rel = \?Rk \\<^sub>r ?Rv\list_rel O br map_of list_map_invar \is_bounded_hashcode Id (=) ?bhc; ahm_invar_aux ?bhc ?n ?a\ \ finite (dom (ahm_\_aux ?bhc ?a)) is_map_to_list ?Rk ?Rv ?Rm ?tsl \ is_map_to_sorted_list (\_ _. True) ?Rk ?Rv ?Rm ?tsl \is_map_to_sorted_list ?ordR ?Rk ?Rv ?Rm ?tsl; (?m, ?m') \ \?Rk, ?Rv\?Rm; \l'. \(?tsl ?m, l') \ \?Rk \\<^sub>r ?Rv\list_rel; RETURN l' \ it_to_sorted_list (key_rel ?ordR) (map_to_set ?m')\ \ ?thesis\ \ ?thesis Loading theory "Native_Word.Uint" (required by "Collections.GenCF" via "Collections.Impl_Uv_Set") Loading theory "Collections.Gen_Hash" (required by "Collections.GenCF") ### theory "Collections.Gen_Hash" ### 0.061s elapsed time, 0.180s cpu time, 0.000s GC time Loading theory "Collections.Impl_Bit_Set" (required by "Collections.GenCF") instantiation dflt_size :: typerep typerep_dflt_size == typerep_class.typerep :: dflt_size itself \ typerep specification dflt_size_aux_g0: 0 < dflt_size_aux instantiation dflt_size :: len len_of_dflt_size == len_of :: dflt_size itself \ nat ### Generation of a parametrized correspondence relation failed. ### Reason: No relator for the type "Word.word" found. instantiation uint :: {comm_monoid_mult,neg_numeral,comm_ring,modulo} modulo_uint == modulo :: uint \ uint \ uint divide_uint == divide :: uint \ uint \ uint minus_uint == minus :: uint \ uint \ uint uminus_uint == uminus :: uint \ uint zero_uint == zero_class.zero :: uint plus_uint == plus :: uint \ uint \ uint one_uint == one_class.one :: uint times_uint == times :: uint \ uint \ uint instantiation uint :: linorder less_eq_uint == less_eq :: uint \ uint \ bool less_uint == less :: uint \ uint \ bool instantiation uint :: bitss msb_uint == msb :: uint \ bool test_bit_uint == test_bit :: uint \ nat \ bool lsb_uint == lsb :: uint \ bool set_bit_uint == set_bit :: uint \ nat \ bool \ uint set_bits_uint == set_bits :: (nat \ bool) \ uint shiftl_uint == shiftl :: uint \ nat \ uint shiftr_uint == shiftr :: uint \ nat \ uint bitNOT_uint == bitNOT :: uint \ uint bitAND_uint == bitAND :: uint \ uint \ uint bitOR_uint == bitOR :: uint \ uint \ uint bitXOR_uint == bitXOR :: uint \ uint \ uint instantiation uint :: equal equal_uint == equal_class.equal :: uint \ uint \ bool instantiation uint :: size size_uint == size :: uint \ nat ### Code generator: dropping subsumed code equation ### (!!) ?x \ (!!) (Rep_uint ?x) ### Code generator: dropping subsumed code equation ### lsb ?x \ lsb (Rep_uint ?x) structure Bits_Integer : sig val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int val shiftl : IntInf.int -> IntInf.int -> IntInf.int val shiftr : IntInf.int -> IntInf.int -> IntInf.int val test_bit : IntInf.int -> IntInf.int -> bool end = struct val maxWord = IntInf.pow (2, Word.wordSize); fun set_bit x n b = if n < maxWord then if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))) else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); fun shiftl x n = if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun shiftr x n = if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun test_bit x n = if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0 else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); end; (*struct Bits_Integer*) structure Arith : sig datatype num = One | Bit0 of num | Bit1 of num type nat val integer_of_nat : nat -> IntInf.int end = struct datatype num = One | Bit0 of num | Bit1 of num; val one_integera : IntInf.int = (1 : IntInf.int); type 'a one = {one : 'a}; val one = #one : 'a one -> 'a; val one_integer = {one = one_integera} : IntInf.int one; type 'a plus = {plus : 'a -> 'a -> 'a}; val plus = #plus : 'a plus -> 'a -> 'a -> 'a; val plus_integer = {plus = (fn a => fn b => IntInf.+ (a, b))} : IntInf.int plus; type 'a zero = {zero : 'a}; val zero = #zero : 'a zero -> 'a; val zero_integer = {zero = (0 : IntInf.int)} : IntInf.int zero; type 'a semigroup_add = {plus_semigroup_add : 'a plus}; val plus_semigroup_add = #plus_semigroup_add : 'a semigroup_add -> 'a plus; type 'a numeral = {one_numeral : 'a one, semigroup_add_numeral : 'a semigroup_add}; val one_numeral = #one_numeral : 'a numeral -> 'a one; val semigroup_add_numeral = #semigroup_add_numeral : 'a numeral -> 'a semigroup_add; val semigroup_add_integer = {plus_semigroup_add = plus_integer} : IntInf.int semigroup_add; val numeral_integer = {one_numeral = one_integer, semigroup_add_numeral = semigroup_add_integer} : IntInf.int numeral; type 'a times = {times : 'a -> 'a -> 'a}; val times = #times : 'a times -> 'a -> 'a -> 'a; type 'a power = {one_power : 'a one, times_power : 'a times}; val one_power = #one_power : 'a power -> 'a one; val times_power = #times_power : 'a power -> 'a times; val times_integer = {times = (fn a => fn b => IntInf.* (a, b))} : IntInf.int times; val power_integer = {one_power = one_integer, times_power = times_integer} : IntInf.int power; type 'a ab_semigroup_add = {semigroup_add_ab_semigroup_add : 'a semigroup_add}; val semigroup_add_ab_semigroup_add = #semigroup_add_ab_semigroup_add : 'a ab_semigroup_add -> 'a semigroup_add; type 'a semigroup_mult = {times_semigroup_mult : 'a times}; val times_semigroup_mult = #times_semigroup_mult : 'a semigroup_mult -> 'a times; type 'a semiring = {ab_semigroup_add_semiring : 'a ab_semigroup_add, semigroup_mult_semiring : 'a semigroup_mult}; val ab_semigroup_add_semiring = #ab_semigroup_add_semiring : 'a semiring -> 'a ab_semigroup_add; val semigroup_mult_semiring = #semigroup_mult_semiring : 'a semiring -> 'a semigroup_mult; val ab_semigroup_add_integer = {semigroup_add_ab_semigroup_add = semigroup_add_integer} : IntInf.int ab_semigroup_add; val semigroup_mult_integer = {times_semigroup_mult = times_integer} : IntInf.int semigroup_mult; val semiring_integer = {ab_semigroup_add_semiring = ab_semigroup_add_integer, semigroup_mult_semiring = semigroup_mult_integer} : IntInf.int semiring; type 'a mult_zero = {times_mult_zero : 'a times, zero_mult_zero : 'a zero}; val times_mult_zero = #times_mult_zero : 'a mult_zero -> 'a times; val zero_mult_zero = #zero_mult_zero : 'a mult_zero -> 'a zero; val mult_zero_integer = {times_mult_zero = times_integer, zero_mult_zero = zero_integer} : IntInf.int mult_zero; type 'a monoid_add = {semigroup_add_monoid_add : 'a semigroup_add, zero_monoid_add : 'a zero}; val semigroup_add_monoid_add = #semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add; val zero_monoid_add = #zero_monoid_add : 'a monoid_add -> 'a zero; type 'a comm_monoid_add = {ab_semigroup_add_comm_monoid_add : 'a ab_semigroup_add, monoid_add_comm_monoid_add : 'a monoid_add}; val ab_semigroup_add_comm_monoid_add = #ab_semigroup_add_comm_monoid_add : 'a comm_monoid_add -> 'a ab_semigroup_add; val monoid_add_comm_monoid_add = #monoid_add_comm_monoid_add : 'a comm_monoid_add -> 'a monoid_add; type 'a semiring_0 = {comm_monoid_add_semiring_0 : 'a comm_monoid_add, mult_zero_semiring_0 : 'a mult_zero, semiring_semiring_0 : 'a semiring}; val comm_monoid_add_semiring_0 = #comm_monoid_add_semiring_0 : 'a semiring_0 -> 'a comm_monoid_add; val mult_zero_semiring_0 = #mult_zero_semiring_0 : 'a semiring_0 -> 'a mult_zero; val semiring_semiring_0 = #semiring_semiring_0 : 'a semiring_0 -> 'a semiring; val monoid_add_integer = {semigroup_add_monoid_add = semigroup_add_integer, zero_monoid_add = zero_integer} : IntInf.int monoid_add; val comm_monoid_add_integer = {ab_semigroup_add_comm_monoid_add = ab_semigroup_add_integer, monoid_add_comm_monoid_add = monoid_add_integer} : IntInf.int comm_monoid_add; val semiring_0_integer = {comm_monoid_add_semiring_0 = comm_monoid_add_integer, mult_zero_semiring_0 = mult_zero_integer, semiring_semiring_0 = semiring_integer} : IntInf.int semiring_0; type 'a monoid_mult = {semigroup_mult_monoid_mult : 'a semigroup_mult, power_monoid_mult : 'a power}; val semigroup_mult_monoid_mult = #semigroup_mult_monoid_mult : 'a monoid_mult -> 'a semigroup_mult; val power_monoid_mult = #power_monoid_mult : 'a monoid_mult -> 'a power; type 'a semiring_numeral = {monoid_mult_semiring_numeral : 'a monoid_mult, numeral_semiring_numeral : 'a numeral, semiring_semiring_numeral : 'a semiring}; val monoid_mult_semiring_numeral = #monoid_mult_semiring_numeral : 'a semiring_numeral -> 'a monoid_mult; val numeral_semiring_numeral = #numeral_semiring_numeral : 'a semiring_numeral -> 'a numeral; val semiring_semiring_numeral = #semiring_semiring_numeral : 'a semiring_numeral -> 'a semiring; type 'a zero_neq_one = {one_zero_neq_one : 'a one, zero_zero_neq_one : 'a zero}; val one_zero_neq_one = #one_zero_neq_one : 'a zero_neq_one -> 'a one; val zero_zero_neq_one = #zero_zero_neq_one : 'a zero_neq_one -> 'a zero; type 'a semiring_1 = {semiring_numeral_semiring_1 : 'a semiring_numeral, semiring_0_semiring_1 : 'a semiring_0, zero_neq_one_semiring_1 : 'a zero_neq_one}; val semiring_numeral_semiring_1 = #semiring_numeral_semiring_1 : 'a semiring_1 -> 'a semiring_numeral; val semiring_0_semiring_1 = #semiring_0_semiring_1 : 'a semiring_1 -> 'a semiring_0; val zero_neq_one_semiring_1 = #zero_neq_one_semiring_1 : 'a semiring_1 -> 'a zero_neq_one; val monoid_mult_integer = {semigroup_mult_monoid_mult = semigroup_mult_integer, power_monoid_mult = power_integer} : IntInf.int monoid_mult; val semiring_numeral_integer = {monoid_mult_semiring_numeral = monoid_mult_integer, numeral_semiring_numeral = numeral_integer, semiring_semiring_numeral = semiring_integer} : IntInf.int semiring_numeral; val zero_neq_one_integer = {one_zero_neq_one = one_integer, zero_zero_neq_one = zero_integer} : IntInf.int zero_neq_one; val semiring_1_integer = {semiring_numeral_semiring_1 = semiring_numeral_integer, semiring_0_semiring_1 = semiring_0_integer, zero_neq_one_semiring_1 = zero_neq_one_integer} : IntInf.int semiring_1; datatype nat = Zero_nat | Suc of nat; fun of_nat_aux A_ inc Zero_nat i = i | of_nat_aux A_ inc (Suc n) i = of_nat_aux A_ inc n (inc i); fun of_nat A_ n = of_nat_aux A_ (fn i => plus ((plus_semigroup_add o semigroup_add_numeral o numeral_semiring_numeral o semiring_numeral_semiring_1) A_) i (one ((one_numeral o numeral_semiring_numeral o semiring_numeral_semiring_1) A_))) n (zero ((zero_mult_zero o mult_zero_semiring_0 o semiring_0_semiring_1) A_)); fun integer_of_nat x = of_nat semiring_1_integer x; end; (*struct Arith*) structure Bit_Int : sig val set_bit_integer : IntInf.int -> Arith.nat -> bool -> IntInf.int val test_bit_integer : IntInf.int -> Arith.nat -> bool end = struct fun set_bit_integer x i b = Bits_Integer.set_bit x (Arith.integer_of_nat i) b; fun test_bit_integer x n = Bits_Integer.test_bit x (Arith.integer_of_nat n); end; (*struct Bit_Int*) structure Impl_Bit_Set : sig val bs_eq : IntInf.int -> IntInf.int -> bool val bs_mem : Arith.nat -> IntInf.int -> bool val bs_UNIV : unit -> IntInf.int val bs_diff : IntInf.int -> IntInf.int -> IntInf.int val bs_empty : unit -> IntInf.int val bs_inter : IntInf.int -> IntInf.int -> IntInf.int val bs_union : IntInf.int -> IntInf.int -> IntInf.int val bs_delete : Arith.nat -> IntInf.int -> IntInf.int val bs_insert : Arith.nat -> IntInf.int -> IntInf.int val bs_isEmpty : IntInf.int -> bool val bs_disjoint : IntInf.int -> IntInf.int -> bool val bs_subset_eq : IntInf.int -> IntInf.int -> bool val bs_complement : IntInf.int -> IntInf.int end = struct fun bs_eq s1 s2 = ((s1 : IntInf.int) = s2); fun bs_mem i s = Bit_Int.test_bit_integer s i; fun bs_UNIV x = (fn _ => (~1 : IntInf.int)) x; fun bs_diff s1 s2 = IntInf.andb (s1, IntInf.notb s2); fun bs_empty x = (fn _ => (0 : IntInf.int)) x; fun bs_inter s1 s2 = IntInf.andb (s1, s2); fun bs_union s1 s2 = IntInf.orb (s1, s2); fun bs_delete i s = Bit_Int.set_bit_integer s i false; fun bs_insert i s = Bit_Int.set_bit_integer s i true; fun bs_isEmpty s = ((s : IntInf.int) = (0 : IntInf.int)); fun bs_disjoint s1 s2 = (((IntInf.andb (s1, s2)) : IntInf.int) = (0 : IntInf.int)); fun bs_subset_eq s1 s2 = (((IntInf.andb (s1, IntInf.notb s2)) : IntInf.int) = (0 : IntInf.int)); fun bs_complement s = IntInf.notb s; end; (*struct Impl_Bit_Set*) ### theory "Collections.Impl_Bit_Set" ### 1.177s elapsed time, 2.380s cpu time, 0.000s GC time ### Ambiguous input (line 720 of "~~/afp/thys/Native_Word/Uint.thy") produces 2 parse trees: ### ("\<^const>Pure.imp" ### ("\<^const>HOL.Trueprop" ### ("\<^const>Orderings.ord_class.less_eq" ### ("_applC" ("_position" size) ("_position" x)) ("_position" n))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Word.sshiftr" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("\<^const>Groups.minus_class.minus" ### ("_applC" ("_position" size) ("_position" x)) ### ("\<^const>Groups.one_class.one"))) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### ("\<^const>Pure.imp" ### ("\<^const>HOL.Trueprop" ### ("\<^const>Orderings.ord_class.less_eq" ### ("_applC" ("_position" size) ("_position" x)) ("_position" n))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Uint.sshiftr_uint" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("\<^const>Groups.minus_class.minus" ### ("_applC" ("_position" size) ("_position" x)) ### ("\<^const>Groups.one_class.one"))) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Ambiguous input (line 724 of "~~/afp/thys/Native_Word/Uint.thy") produces 2 parse trees: ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Word.sshiftr" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("_position" dflt_size)) ### ("_applC" ("_position" uint_sshiftr) ### ("_cargs" ("_position" x) ### ("_applC" ("_position" integer_of_nat) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("_position" wivs_index)) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("\<^const>Uint.sshiftr_uint" ("_position" x) ("_position" n)) ### ("\<^const>HOL.If" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("_position" dflt_size)) ### ("_applC" ("_position" uint_sshiftr) ### ("_cargs" ("_position" x) ### ("_applC" ("_position" integer_of_nat) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>Bits.bits_class.test_bit" ("_position" x) ### ("_position" wivs_index)) ### ("\<^const>Groups.uminus_class.uminus" ### ("\<^const>Groups.one_class.one")) ### ("\<^const>Groups.zero_class.zero"))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Ambiguous input (line 731 of "~~/afp/thys/Native_Word/Uint.thy") produces 2 parse trees: ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" Rep_uint) ### ("_applC" ("_position" uint_sshiftr) ### ("_cargs" ("_position" w) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>HOL.disj" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("\<^const>Groups.zero_class.zero")) ### ("\<^const>Orderings.ord_class.less_eq" ### ("_position" dflt_size_integer) ("_position" n))) ### ("_applC" ("_position" Rep_uint) ### ("_applC" ("_position" undefined) ### ("_cargs" ("_position" sshiftr_uint) ### ("_cargs" ("_position" w) ("_position" n))))) ### ("\<^const>Uint.sshiftr_uint" ### ("_applC" ("_position" Rep_uint) ("_position" w)) ### ("_applC" ("_position" nat_of_integer) ("_position" n)))))) ### ("\<^const>HOL.Trueprop" ### ("\<^const>HOL.eq" ### ("_applC" ("_position" Rep_uint) ### ("_applC" ("_position" uint_sshiftr) ### ("_cargs" ("_position" w) ("_position" n)))) ### ("\<^const>HOL.If" ### ("\<^const>HOL.disj" ### ("\<^const>Orderings.ord_class.less" ("_position" n) ### ("\<^const>Groups.zero_class.zero")) ### ("\<^const>Orderings.ord_class.less_eq" ### ("_position" dflt_size_integer) ("_position" n))) ### ("_applC" ("_position" Rep_uint) ### ("_applC" ("_position" undefined) ### ("_cargs" ("_position" sshiftr_uint) ### ("_cargs" ("_position" w) ("_position" n))))) ### ("\<^const>Word.sshiftr" ### ("_applC" ("_position" Rep_uint) ("_position" w)) ### ("_applC" ("_position" nat_of_integer) ("_position" n)))))) ### Fortunately, only one parse tree is well-formed and type-correct, ### but you may still want to disambiguate your grammar or your input. ### Code generator: dropping subsumed code equation ### msb ?x \ msb (Rep_uint ?x) instantiation uint :: {exhaustive,full_exhaustive,random} random_uint == random_class.random :: natural \ natural \ natural \ (uint \ (unit \ term)) \ natural \ natural full_exhaustive_uint == full_exhaustive_class.full_exhaustive :: (uint \ (unit \ term) \ (bool \ term list) option) \ natural \ (bool \ term list) option exhaustive_uint == exhaustive_class.exhaustive :: (uint \ (bool \ term list) option) \ natural \ (bool \ term list) option instantiation uint :: narrowing narrowing_uint == narrowing :: integer \ uint ??.Quickcheck_Narrowing.narrowing_cons ### theory "Native_Word.Uint" ### 1.448s elapsed time, 2.972s cpu time, 0.000s GC time Loading theory "Collections.Impl_Uv_Set" (required by "Collections.GenCF") consts lookup :: "nat \ 'a word list \ bool" ### Additional type variable(s) in specification of "single_bit_rel": 'a ### Additional type variable(s) in specification of "single_bit_dom": 'a consts set_bit :: "nat \ 'a word list \ 'a word list" consts reset_bit :: "nat \ 'a word list \ 'a word list" Found termination order: "(\p. size_list size (snd (snd p))) <*mlex*> (\p. size_list size (fst (snd p))) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "size_list size <*mlex*> {}" "set_bit" :: "'a \ nat \ bool \ 'a" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" "bs_empty" :: "unit \ integer" "insert" :: "'a \ 'a set \ 'a set" "op_set_delete" :: "'a \ 'a set \ 'a set" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" ### Ignoring duplicate rewrite rule: ### Numeral1 \ 1::?'a1 ### Ignoring duplicate rewrite rule: ### Numeral1 \ 1::?'a1 Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" Found termination order: "(\p. size_list size (snd p)) <*mlex*> {}" datatype 'a ref = ref of 'a structure Uint: sig val set_bit: word -> int -> bool -> word val shiftl: word -> int -> word val shiftr: word -> int -> word val shiftr_signed: word -> int -> word val test_bit: word -> int -> bool end structure Bits_Integer: sig val set_bit: int -> int -> bool -> int val shiftl: int -> int -> int val shiftr: int -> int -> int val test_bit: int -> int -> bool end ROOT.ML:114: warning: Value identifier (times) has not been referenced. ROOT.ML:117: warning: Value identifier (one_power) has not been referenced. ROOT.ML:118: warning: Value identifier (times_power) has not been referenced. ROOT.ML:127: warning: Value identifier (semigroup_add_ab_semigroup_add) has not been referenced. ROOT.ML:131: warning: Value identifier (times_semigroup_mult) has not been referenced. ROOT.ML:137: warning: Value identifier (ab_semigroup_add_semiring) has not been referenced. ROOT.ML:139: warning: Value identifier (semigroup_mult_semiring) has not been referenced. ROOT.ML:155: warning: Value identifier (times_mult_zero) has not been referenced. ROOT.ML:164: warning: Value identifier (semigroup_add_monoid_add) has not been referenced. ROOT.ML:166: warning: Value identifier (zero_monoid_add) has not been referenced. ROOT.ML:171: warning: Value identifier (ab_semigroup_add_comm_monoid_add) has not been referenced. ROOT.ML:173: warning: Value identifier (monoid_add_comm_monoid_add) has not been referenced. ROOT.ML:179: warning: Value identifier (comm_monoid_add_semiring_0) has not been referenced. ROOT.ML:183: warning: Value identifier (semiring_semiring_0) has not been referenced. ROOT.ML:204: warning: Value identifier (semigroup_mult_monoid_mult) has not been referenced. ROOT.ML:206: warning: Value identifier (power_monoid_mult) has not been referenced. ROOT.ML:212: warning: Value identifier (monoid_mult_semiring_numeral) has not been referenced. ROOT.ML:216: warning: Value identifier (semiring_semiring_numeral) has not been referenced. ROOT.ML:220: warning: Value identifier (one_zero_neq_one) has not been referenced. ROOT.ML:221: warning: Value identifier (zero_zero_neq_one) has not been referenced. ROOT.ML:231: warning: Value identifier (zero_neq_one_semiring_1) has not been referenced. ROOT.ML:265: warning: Value identifier (ws) has not been referenced. ROOT.ML:280: warning: Value identifier (ws) has not been referenced. ROOT.ML:279: warning: Value identifier (va) has not been referenced. ROOT.ML:279: warning: Value identifier (v) has not been referenced. ROOT.ML:327: warning: Value identifier (inc) has not been referenced. ROOT.ML:327: warning: Value identifier (A_) has not been referenced. ROOT.ML:345: warning: Value identifier (n) has not been referenced. ROOT.ML:347: warning: Value identifier (n) has not been referenced. ROOT.ML:353: warning: Value identifier (n) has not been referenced. ROOT.ML:359: warning: Value identifier (uu) has not been referenced. ROOT.ML:365: warning: Value identifier (ws) has not been referenced. ROOT.ML:370: warning: Value identifier (va) has not been referenced. ROOT.ML:370: warning: Value identifier (v) has not been referenced. ROOT.ML:392: warning: Value identifier (ws) has not been referenced. ROOT.ML:391: warning: Value identifier (va) has not been referenced. ROOT.ML:391: warning: Value identifier (v) has not been referenced. ROOT.ML:397: warning: Value identifier (i) has not been referenced. structure Generated_Code: sig type dflt_size type 'a itself type nat val uv_diff: word list -> word list -> word list val uv_disjoint: word list -> word list -> bool val uv_empty: word list val uv_equal: word list -> word list -> bool val uv_inter: word list -> word list -> word list val uv_lookup: nat -> word list -> bool val uv_reset_bit: nat -> word list -> word list val uv_set_bit: nat -> word list -> word list val uv_single_bit: nat -> word list val uv_subset: word list -> word list -> bool val uv_subseteq: word list -> word list -> bool val uv_union: word list -> word list -> word list val uv_zeroes: word list -> bool end find_consts name: "set_bit" found 18 constant(s): Word_Misc.set_bits_aux :: "(nat \ bool) \ 'a word \ nat \ 'a word" Word_Misc.set_bits_aux_sumC :: "(nat \ bool) \ 'a word \ nat \ 'a word" Word_Misc.set_bits_aux_dom :: "(nat \ bool) \ 'a word \ nat \ bool" Uint.uint_set_bits :: "(nat \ bool) \ uint \ nat \ uint" Word.bits_word_inst.set_bit_word :: "'a word \ nat \ bool \ 'a word" Bits.bits_class.set_bit :: "'a \ nat \ bool \ 'a" Bits_Integer.bits_integer_inst.set_bit_integer :: "integer \ nat \ bool \ integer" Bits_Integer.integer_set_bit :: "integer \ integer \ bool \ integer" Bool_List_Representation.bits_int_inst.set_bit_int :: "int \ nat \ bool \ int" Uint.bits_uint_inst.set_bit_uint :: "uint \ nat \ bool \ uint" Uint.uint_set_bit :: "uint \ integer \ bool \ uint" Word.bits_word_inst.set_bits_word :: "(nat \ bool) \ 'a word" Bits.bits_class.set_bits :: "(nat \ bool) \ 'a" Bits_Integer.bits_integer_inst.set_bits_integer :: "(nat \ bool) \ integer" Bits_Integer.wf_set_bits_integer :: "(nat \ bool) \ bool" Bool_List_Representation.bits_int_inst.set_bits_int :: "(nat \ bool) \ int" More_Bits_Int.wf_set_bits_int :: "(nat \ bool) \ bool" Uint.bits_uint_inst.set_bits_uint :: "(nat \ bool) \ uint" ### Rewrite rule not in simpset: ### subseteq ?vs1 ?ws1 \ \ ?vs1 \ \ ?ws1 Uint.hs:19:19: Warning: In the use of ‘Data.Bits.bitSize’ (imported from Data.Bits): Deprecated: "Use 'bitSizeMaybe' or 'finiteBitSize' instead" ### theory "Collections.Impl_Uv_Set" ### 12.973s elapsed time, 16.324s cpu time, 0.844s GC time Loading theory "Collections.GenCF" ### theory "Collections.GenCF" ### 3.575s elapsed time, 3.564s cpu time, 0.000s GC time Loading theory "Collections.ICF_Gen_Algo_Chapter" Loading theory "Collections.ICF_Chapter" ### theory "Collections.ICF_Gen_Algo_Chapter" ### 0.022s elapsed time, 0.068s cpu time, 0.000s GC time Loading theory "Collections.ICF_Impl_Chapter" ### theory "Collections.ICF_Chapter" ### 0.032s elapsed time, 0.096s cpu time, 0.000s GC time Loading theory "Collections.ICF_Spec_Chapter" ### theory "Collections.ICF_Impl_Chapter" ### 0.022s elapsed time, 0.064s cpu time, 0.000s GC time Loading theory "Trie.Trie" (required by "Collections.MapStdImpl" via "Collections.TrieMapImpl" via "Collections.Trie2" via "Collections.Trie_Impl") ### theory "Collections.ICF_Spec_Chapter" ### 0.028s elapsed time, 0.068s cpu time, 0.000s GC time Loading theory "HOL-Library.RBT" (required by "Collections.MapStdImpl" via "Collections.RBTMapImpl") ### theory "HOL-Library.RBT" ### 0.590s elapsed time, 1.192s cpu time, 0.000s GC time Loading theory "Collections.AnnotatedListSpec" locale al fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" locale al_no_invar fixes \ :: "'a \ ('b \ 'c) list" and invar :: "'a \ bool" assumes "al_no_invar invar" locale al_empty fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and empty :: "unit \ 's" assumes "al_empty \ invar empty" locale al_isEmpty fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and isEmpty :: "'s \ bool" assumes "al_isEmpty \ invar isEmpty" locale al_count fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and count :: "'s \ nat" assumes "al_count \ invar count" locale al_consl fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and consl :: "'e \ 'a \ 's \ 's" assumes "al_consl \ invar consl" locale al_consr fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and consr :: "'s \ 'e \ 'a \ 's" assumes "al_consr \ invar consr" locale al_head fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and head :: "'s \ 'e \ 'a" assumes "al_head \ invar head" Found termination order: "{}" locale al_tail fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and tail :: "'s \ 's" assumes "al_tail \ invar tail" locale al_headR fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and headR :: "'s \ 'e \ 'a" assumes "al_headR \ invar headR" locale al_tailR fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and tailR :: "'s \ 's" assumes "al_tailR \ invar tailR" locale al_foldl fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and foldl :: "('z \ 'e \ 'a \ 'z) \ 'z \ 's \ 'z" assumes "al_foldl \ invar foldl" locale al_foldr fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and foldr :: "('e \ 'a \ 'z \ 'z) \ 's \ 'z \ 'z" assumes "al_foldr \ invar foldr" locale poly_al_fold fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" locale al_app fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and app :: "'s \ 's \ 's" assumes "al_app \ invar app" locale al_annot fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and annot :: "'s \ 'a" assumes "al_annot \ invar annot" Found termination order: "(\p. length (snd p)) <*mlex*> {}" locale al_splits fixes \ :: "'s \ ('e \ 'a) list" and invar :: "'s \ bool" and splits :: "('a \ bool) \ 'a \ 's \ 's \ ('e \ 'a) \ 's" assumes "al_splits \ invar splits" Found termination order: "(\p. length (fst p)) <*mlex*> {}" Found termination order: "(\p. length (fst p)) <*mlex*> {}" Found termination order: "(\p. size (snd p)) <*mlex*> {}" Found termination order: "size <*mlex*> {}" ### theory "Trie.Trie" ### 1.644s elapsed time, 3.312s cpu time, 0.000s GC time Loading theory "Collections.Trie_Impl" (required by "Collections.MapStdImpl" via "Collections.TrieMapImpl" via "Collections.Trie2") Found termination order: "(\p. size (fst (snd p))) <*mlex*> {}" ### theory "Collections.Trie_Impl" ### 0.932s elapsed time, 1.792s cpu time, 0.740s GC time Loading theory "Collections.Trie2" (required by "Collections.MapStdImpl" via "Collections.TrieMapImpl") instantiation trie :: (equal, equal) equal equal_trie == equal_class.equal :: ('a, 'b) trie \ ('a, 'b) trie \ bool ### theory "Collections.Trie2" ### 0.163s elapsed time, 0.328s cpu time, 0.000s GC time Loading theory "Collections.ListSpec" locale list fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" locale list_no_invar fixes \ :: "'a \ 'b list" and invar :: "'a \ bool" assumes "list_no_invar invar" locale list_empty fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and empty :: "unit \ 's" assumes "list_empty \ invar empty" locale list_isEmpty fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and isEmpty :: "'s \ bool" assumes "list_isEmpty \ invar isEmpty" locale poly_list_iteratei fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" locale poly_list_rev_iteratei fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" locale list_size fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and size :: "'s \ nat" assumes "list_size \ invar size" locale StdALDefs fixes ops :: "('e, 'a, 's, 'more) alist_ops_scheme" locale list_appendl fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and appendl :: "'x \ 's \ 's" assumes "list_appendl \ invar appendl" locale list_removel fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and removel :: "'s \ 'x \ 's" assumes "list_removel \ invar removel" locale list_leftmost fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and leftmost :: "'s \ 'x" assumes "list_leftmost \ invar leftmost" locale list_appendr fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and appendr :: "'x \ 's \ 's" assumes "list_appendr \ invar appendr" locale list_remover fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and remover :: "'s \ 's \ 'x" assumes "list_remover \ invar remover" locale list_rightmost fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and rightmost :: "'s \ 'x" assumes "list_rightmost \ invar rightmost" locale list_get fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and get :: "'s \ nat \ 'x" assumes "list_get \ invar get" locale list_set fixes \ :: "'s \ 'x list" and invar :: "'s \ bool" and set :: "'s \ nat \ 'x \ 's" assumes "list_set \ invar set" locale StdAL fixes ops :: "('a, 'b, 'c, 'd) alist_ops_scheme" assumes "StdAL ops" locale StdAL_no_invar fixes ops :: "('a, 'b, 'c, 'd) alist_ops_scheme" assumes "StdAL_no_invar ops" ### theory "Collections.AnnotatedListSpec" ### 2.447s elapsed time, 4.832s cpu time, 0.740s GC time Loading theory "Collections.FTAnnotatedListImpl" locale StdListDefs fixes ops :: "('a, 's, 'more) list_ops_scheme" locale StdList fixes ops :: "('a, 's, 'more) list_ops_scheme" assumes "StdList ops" locale StdList_no_invar fixes ops :: "('a, 'b, 'c) list_ops_scheme" assumes "StdList_no_invar ops" ### theory "Collections.ListSpec" ### 1.429s elapsed time, 2.860s cpu time, 0.000s GC time Loading theory "Collections.ListGA" locale idx_iteratei_loc fixes \ :: "'s \ 'a list" and invar :: "'s \ bool" and size :: "'s \ nat" and get :: "'s \ nat \ 'a" assumes "idx_iteratei_loc \ invar size get" structure Arith : sig type 'a plus val plus : 'a plus -> 'a -> 'a -> 'a type 'a semigroup_add val plus_semigroup_add : 'a semigroup_add -> 'a plus type 'a zero val zero : 'a zero -> 'a type 'a monoid_add val semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add val zero_monoid_add : 'a monoid_add -> 'a zero datatype nat = Zero_nat | Suc of nat val one_nat : nat val plus_nat : nat -> nat -> nat end = struct type 'a plus = {plus : 'a -> 'a -> 'a}; val plus = #plus : 'a plus -> 'a -> 'a -> 'a; type 'a semigroup_add = {plus_semigroup_add : 'a plus}; val plus_semigroup_add = #plus_semigroup_add : 'a semigroup_add -> 'a plus; type 'a zero = {zero : 'a}; val zero = #zero : 'a zero -> 'a; type 'a monoid_add = {semigroup_add_monoid_add : 'a semigroup_add, zero_monoid_add : 'a zero}; val semigroup_add_monoid_add = #semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add; val zero_monoid_add = #zero_monoid_add : 'a monoid_add -> 'a zero; datatype nat = Zero_nat | Suc of nat; val one_nat : nat = Suc Zero_nat; fun plus_nat (Suc m) n = plus_nat m (Suc n) | plus_nat Zero_nat n = n; end; (*struct Arith*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure FingerTree : sig type ('a, 'b) fingerTreeStruc type ('b, 'a) splitres type ('b, 'a) fingerTree val app : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val head : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'a * 'b val tail : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val annot : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'b val count : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> Arith.nat val empty : 'b Arith.monoid_add -> ('a, 'b) fingerTree val foldl : 'c Arith.monoid_add -> ('a -> 'b * 'c -> 'a) -> 'a -> ('b, 'c) fingerTree -> 'a val foldr : 'b Arith.monoid_add -> ('a * 'b -> 'c -> 'c) -> ('a, 'b) fingerTree -> 'c -> 'c val headR : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'a * 'b val lcons : 'b Arith.monoid_add -> 'a * 'b -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val rcons : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'a * 'b -> ('a, 'b) fingerTree val tailR : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val isEmpty : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> bool val splitTree : 'a Arith.monoid_add -> ('a -> bool) -> 'a -> ('b, 'a) fingerTree -> ('b, 'a) fingerTree * (('b * 'a) * ('b, 'a) fingerTree) end = struct datatype ('a, 'b) node = Tip of 'a * 'b | Node2 of 'b * ('a, 'b) node * ('a, 'b) node | Node3 of 'b * ('a, 'b) node * ('a, 'b) node * ('a, 'b) node; datatype ('a, 'b) digit = One of ('a, 'b) node | Two of ('a, 'b) node * ('a, 'b) node | Three of ('a, 'b) node * ('a, 'b) node * ('a, 'b) node | Four of ('a, 'b) node * ('a, 'b) node * ('a, 'b) node * ('a, 'b) node; datatype ('a, 'b) fingerTreeStruc = Empty | Single of ('a, 'b) node | Deep of 'b * ('a, 'b) digit * ('a, 'b) fingerTreeStruc * ('a, 'b) digit; datatype ('b, 'a) splitres = Abs_splitres of (('b, 'a) fingerTreeStruc * (('b * 'a) * ('b, 'a) fingerTreeStruc)); datatype ('b, 'a) fingerTree = Abs_FingerTree of ('b, 'a) fingerTreeStruc; fun rep_splitres A_ (Abs_splitres x) = x; fun extract_splitres_r B_ r = Abs_FingerTree let val (_, (_, ra)) = rep_splitres B_ r; in ra end; fun extract_splitres_l B_ r = Abs_FingerTree let val (l, (_, _)) = rep_splitres B_ r; in l end; fun extract_splitres_a B_ r = let val (_, a) = rep_splitres B_ r; val (aa, _) = a; in aa end; fun extract_splitres B_ r = (extract_splitres_l B_ r, (extract_splitres_a B_ r, extract_splitres_r B_ r)); fun rep_FingerTree A_ (Abs_FingerTree x) = x; fun digitToNlist (One a) = [a] | digitToNlist (Two (a, b)) = [a, b] | digitToNlist (Three (a, b, c)) = [a, b, c] | digitToNlist (Four (a, b, c, d)) = [a, b, c, d]; fun gmn B_ (Tip (e, a)) = a | gmn B_ (Node2 (a, uu, uv)) = a | gmn B_ (Node3 (a, uw, ux, uy)) = a; fun node3 B_ nd1 nd2 nd3 = Node3 (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ nd1) (gmn B_ nd2)) (gmn B_ nd3), nd1, nd2, nd3); fun gmft B_ Empty = Arith.zero (Arith.zero_monoid_add B_) | gmft B_ (Single nd) = gmn B_ nd | gmft B_ (Deep (a, uu, uv, uw)) = a; fun gmd B_ (One a) = gmn B_ a | gmd B_ (Two (a, b)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b) | gmd B_ (Three (a, b, c)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b)) (gmn B_ c) | gmd B_ (Four (a, b, c, d)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b)) (gmn B_ c)) (gmn B_ d); fun deep B_ pr m sf = Deep (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmd B_ pr) (gmft B_ m)) (gmd B_ sf), pr, m, sf); fun nrcons B_ Empty a = Single a | nrcons B_ (Single b) a = deep B_ (One b) Empty (One a) | nrcons B_ (Deep (uu, pr, m, One b)) a = deep B_ pr m (Two (b, a)) | nrcons B_ (Deep (uv, pr, m, Two (b, c))) a = deep B_ pr m (Three (b, c, a)) | nrcons B_ (Deep (uw, pr, m, Three (b, c, d))) a = deep B_ pr m (Four (b, c, d, a)) | nrcons B_ (Deep (ux, pr, m, Four (b, c, d, e))) a = deep B_ pr (nrcons B_ m (node3 B_ b c d)) (Two (e, a)); fun rconsNlist B_ t [] = t | rconsNlist B_ t (x :: xs) = rconsNlist B_ (nrcons B_ t x) xs; fun nlcons B_ a Empty = Single a | nlcons B_ a (Single b) = deep B_ (One a) Empty (One b) | nlcons B_ a (Deep (uu, One b, m, sf)) = deep B_ (Two (a, b)) m sf | nlcons B_ a (Deep (uv, Two (b, c), m, sf)) = deep B_ (Three (a, b, c)) m sf | nlcons B_ a (Deep (uw, Three (b, c, d), m, sf)) = deep B_ (Four (a, b, c, d)) m sf | nlcons B_ a (Deep (ux, Four (b, c, d, e), m, sf)) = deep B_ (Two (a, b)) (nlcons B_ (node3 B_ c d e) m) sf; fun lconsNlist B_ [] t = t | lconsNlist B_ (x :: xs) t = nlcons B_ x (lconsNlist B_ xs t); fun node2 B_ nd1 nd2 = Node2 (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ nd1) (gmn B_ nd2), nd1, nd2); fun nodes B_ [a, b] = [node2 B_ a b] | nodes B_ [a, b, c] = [node3 B_ a b c] | nodes B_ [a, b, c, d] = [node2 B_ a b, node2 B_ c d] | nodes B_ (a :: b :: c :: v :: vb :: vc) = node3 B_ a b c :: nodes B_ (v :: vb :: vc); fun app3 B_ Empty xs t = lconsNlist B_ xs t | app3 B_ (Single v) xs Empty = rconsNlist B_ (Single v) xs | app3 B_ (Deep (v, va, vb, vc)) xs Empty = rconsNlist B_ (Deep (v, va, vb, vc)) xs | app3 B_ (Single x) xs (Single v) = nlcons B_ x (lconsNlist B_ xs (Single v)) | app3 B_ (Single x) xs (Deep (v, va, vb, vc)) = nlcons B_ x (lconsNlist B_ xs (Deep (v, va, vb, vc))) | app3 B_ (Deep (v, va, vb, vc)) xs (Single x) = nrcons B_ (rconsNlist B_ (Deep (v, va, vb, vc)) xs) x | app3 B_ (Deep (uu, pr1, m1, sf1)) ts (Deep (uv, pr2, m2, sf2)) = deep B_ pr1 (app3 B_ m1 (nodes B_ (digitToNlist sf1 @ ts @ digitToNlist pr2)) m2) sf2; fun appa B_ t1 t2 = app3 B_ t1 [] t2; fun app B_ s t = Abs_FingerTree (appa B_ (rep_FingerTree B_ s) (rep_FingerTree B_ t)); fun n_unwrap (Tip (e, a)) = (e, a) | n_unwrap (Node2 (uu, a, b)) = (raise Fail "undefined") | n_unwrap (Node3 (uv, a, b, c)) = (raise Fail "undefined"); fun nodeToDigit (Tip (e, a)) = One (Tip (e, a)) | nodeToDigit (Node2 (uu, a, b)) = Two (a, b) | nodeToDigit (Node3 (uv, a, b, c)) = Three (a, b, c); fun digitToTree B_ (One a) = Single a | digitToTree B_ (Two (a, b)) = deep B_ (One a) Empty (One b) | digitToTree B_ (Three (a, b, c)) = deep B_ (Two (a, b)) Empty (One c) | digitToTree B_ (Four (a, b, c, d)) = deep B_ (Two (a, b)) Empty (Two (c, d)); fun viewLn B_ Empty = NONE | viewLn B_ (Single a) = SOME (a, Empty) | viewLn B_ (Deep (uu, Two (a, b), m, sf)) = SOME (a, deep B_ (One b) m sf) | viewLn B_ (Deep (uv, Three (a, b, c), m, sf)) = SOME (a, deep B_ (Two (b, c)) m sf) | viewLn B_ (Deep (uw, Four (a, b, c, d), m, sf)) = SOME (a, deep B_ (Three (b, c, d)) m sf) | viewLn B_ (Deep (ux, One a, m, sf)) = (case viewLn B_ m of NONE => SOME (a, digitToTree B_ sf) | SOME b => let val (ba, m2) = b; in SOME (a, deep B_ (nodeToDigit ba) m2 sf) end); fun viewL B_ t = (case viewLn B_ t of NONE => NONE | SOME a => let val (aa, t2) = a; in SOME (n_unwrap aa, t2) end); fun heada B_ t = let val SOME a = viewL B_ t; val (aa, _) = a; in aa end; fun head B_ t = heada B_ (rep_FingerTree B_ t); fun isEmptya t = (case t of Empty => true | Single _ => false | Deep (_, _, _, _) => false); fun taila B_ t = let val SOME (_, m) = viewL B_ t; in m end; fun tail B_ t = Abs_FingerTree (if isEmptya (rep_FingerTree B_ t) then Empty else taila B_ (rep_FingerTree B_ t)); fun annota B_ t = gmft B_ t; fun annot B_ t = annota B_ (rep_FingerTree B_ t); fun count_node (Tip (uu, a)) = Arith.one_nat | count_node (Node2 (uv, a, b)) = Arith.plus_nat (count_node a) (count_node b) | count_node (Node3 (uw, a, b, c)) = Arith.plus_nat (Arith.plus_nat (count_node a) (count_node b)) (count_node c); fun count_digit (One a) = count_node a | count_digit (Two (a, b)) = Arith.plus_nat (count_node a) (count_node b) | count_digit (Three (a, b, c)) = Arith.plus_nat (Arith.plus_nat (count_node a) (count_node b)) (count_node c) | count_digit (Four (a, b, c, d)) = Arith.plus_nat (Arith.plus_nat (Arith.plus_nat (count_node a) (count_node b)) (count_node c)) (count_node d); fun counta Empty = Arith.Zero_nat | counta (Single a) = count_node a | counta (Deep (uu, pr, m, sf)) = Arith.plus_nat (Arith.plus_nat (count_digit pr) (counta m)) (count_digit sf); fun count B_ t = counta (rep_FingerTree B_ t); fun empty B_ = Abs_FingerTree Empty; fun foldl_node f sigma (Tip (e, a)) = f sigma (e, a) | foldl_node f sigma (Node2 (uu, a, b)) = foldl_node f (foldl_node f sigma a) b | foldl_node f sigma (Node3 (uv, a, b, c)) = foldl_node f (foldl_node f (foldl_node f sigma a) b) c; fun foldl_digit f sigma (One n1) = foldl_node f sigma n1 | foldl_digit f sigma (Two (n1, n2)) = foldl_node f (foldl_node f sigma n1) n2 | foldl_digit f sigma (Three (n1, n2, n3)) = foldl_node f (foldl_node f (foldl_node f sigma n1) n2) n3 | foldl_digit f sigma (Four (n1, n2, n3, n4)) = foldl_node f (foldl_node f (foldl_node f (foldl_node f sigma n1) n2) n3) n4; fun foldla f sigma Empty = sigma | foldla f sigma (Single nd) = foldl_node f sigma nd | foldla f sigma (Deep (uu, d1, m, d2)) = foldl_digit f (foldla f (foldl_digit f sigma d1) m) d2; fun foldl C_ f sigma t = foldla f sigma (rep_FingerTree C_ t); fun foldr_node f (Tip (e, a)) sigma = f (e, a) sigma | foldr_node f (Node2 (uu, a, b)) sigma = foldr_node f a (foldr_node f b sigma) | foldr_node f (Node3 (uv, a, b, c)) sigma = foldr_node f a (foldr_node f b (foldr_node f c sigma)); fun foldr_digit f (One n1) sigma = foldr_node f n1 sigma | foldr_digit f (Two (n1, n2)) sigma = foldr_node f n1 (foldr_node f n2 sigma) | foldr_digit f (Three (n1, n2, n3)) sigma = foldr_node f n1 (foldr_node f n2 (foldr_node f n3 sigma)) | foldr_digit f (Four (n1, n2, n3, n4)) sigma = foldr_node f n1 (foldr_node f n2 (foldr_node f n3 (foldr_node f n4 sigma))); fun foldra f Empty sigma = sigma | foldra f (Single nd) sigma = foldr_node f nd sigma | foldra f (Deep (uu, d1, m, d2)) sigma = foldr_digit f d1 (foldra f m (foldr_digit f d2 sigma)); fun foldr B_ f t sigma = foldra f (rep_FingerTree B_ t) sigma; fun viewRn B_ Empty = NONE | viewRn B_ (Single a) = SOME (a, Empty) | viewRn B_ (Deep (uu, pr, m, Two (a, b))) = SOME (b, deep B_ pr m (One a)) | viewRn B_ (Deep (uv, pr, m, Three (a, b, c))) = SOME (c, deep B_ pr m (Two (a, b))) | viewRn B_ (Deep (uw, pr, m, Four (a, b, c, d))) = SOME (d, deep B_ pr m (Three (a, b, c))) | viewRn B_ (Deep (ux, pr, m, One a)) = (case viewRn B_ m of NONE => SOME (a, digitToTree B_ pr) | SOME b => let val (ba, m2) = b; in SOME (a, deep B_ pr m2 (nodeToDigit ba)) end); fun viewR B_ t = (case viewRn B_ t of NONE => NONE | SOME a => let val (aa, t2) = a; in SOME (n_unwrap aa, t2) end); fun headRa B_ t = let val SOME a = viewR B_ t; val (aa, _) = a; in aa end; fun headR B_ t = headRa B_ (rep_FingerTree B_ t); fun lconsa B_ a t = nlcons B_ (Tip (Product_Type.fst a, Product_Type.snd a)) t; fun lcons B_ a t = Abs_FingerTree (lconsa B_ a (rep_FingerTree B_ t)); fun rconsa B_ t a = nrcons B_ t (Tip (Product_Type.fst a, Product_Type.snd a)); fun rcons B_ t a = Abs_FingerTree (rconsa B_ (rep_FingerTree B_ t) a); fun tailRa B_ t = let val SOME (_, m) = viewR B_ t; in m end; fun tailR B_ t = Abs_FingerTree (if isEmptya (rep_FingerTree B_ t) then Empty else tailRa B_ (rep_FingerTree B_ t)); fun isEmpty B_ t = isEmptya (rep_FingerTree B_ t); fun nlistToTree B_ xs = lconsNlist B_ xs Empty; fun splitNlist A_ p i [a] = ([], (a, [])) | splitNlist A_ p i (a :: v :: va) = let val i2 = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) i (gmn A_ a); in (if p i2 then ([], (a, v :: va)) else let val (l, (x, r)) = splitNlist A_ p i2 (v :: va); in (a :: l, (x, r)) end) end; fun splitDigit A_ p i d = splitNlist A_ p i (digitToNlist d); fun nlistToDigit [a] = One a | nlistToDigit [a, b] = Two (a, b) | nlistToDigit [a, b, c] = Three (a, b, c) | nlistToDigit [a, b, c, d] = Four (a, b, c, d); fun deepR B_ pr m [] = (case viewRn B_ m of NONE => digitToTree B_ pr | SOME a => let val (aa, m2) = a; in deep B_ pr m2 (nodeToDigit aa) end) | deepR B_ pr m (v :: va) = deep B_ pr m (nlistToDigit (v :: va)); fun deepL B_ [] m sf = (case viewLn B_ m of NONE => digitToTree B_ sf | SOME a => let val (aa, m2) = a; in deep B_ (nodeToDigit aa) m2 sf end) | deepL B_ (v :: va) m sf = deep B_ (nlistToDigit (v :: va)) m sf; fun nsplitTree A_ p i Empty = (Empty, (Tip ((raise Fail "undefined"), (raise Fail "undefined")), Empty)) | nsplitTree A_ p i (Single ea) = (Empty, (ea, Empty)) | nsplitTree A_ p i (Deep (uu, pr, m, sf)) = let val vpr = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) i (gmd A_ pr); val vm = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) vpr (gmft A_ m); in (if p vpr then let val (l, (x, r)) = splitDigit A_ p i pr; in (nlistToTree A_ l, (x, deepL A_ r m sf)) end else (if p vm then let val (ml, (xs, mr)) = nsplitTree A_ p vpr m; val (l, (x, r)) = splitDigit A_ p (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) vpr (gmft A_ ml)) (nodeToDigit xs); in (deepR A_ pr ml l, (x, deepL A_ r mr sf)) end else let val (l, (x, r)) = splitDigit A_ p vm sf; in (deepR A_ pr m l, (x, nlistToTree A_ r)) end)) end; fun splitTreea A_ p i t = let val (l, (x, r)) = nsplitTree A_ p i t; in (l, (n_unwrap x, r)) end; fun splitTree_aux B_ p i t = Abs_splitres (if not (p i) andalso p (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) i (annot B_ t)) then splitTreea B_ p i (rep_FingerTree B_ t) else (Empty, ((raise Fail "undefined"), Empty))); fun splitTree A_ p i t = extract_splitres A_ (splitTree_aux A_ p i t); end; (*struct FingerTree*) structure FTAnnotatedListImpl : sig val test_codegen : 'b Arith.monoid_add -> 'd Arith.monoid_add -> 'f Arith.monoid_add -> 'h Arith.monoid_add -> 'j Arith.monoid_add -> 'l Arith.monoid_add -> 'n Arith.monoid_add -> 'p Arith.monoid_add -> 'r Arith.monoid_add -> 't Arith.monoid_add -> 'v Arith.monoid_add -> 'w Arith.monoid_add -> 'aa Arith.monoid_add -> 'ac Arith.monoid_add -> (unit -> ('a, 'b) FingerTree.fingerTree) * ((('c, 'd) FingerTree.fingerTree -> bool) * ((('e, 'f) FingerTree.fingerTree -> Arith.nat) * (('g -> 'h -> ('g, 'h) FingerTree.fingerTree -> ('g, 'h) FingerTree.fingerTree) * ((('i, 'j) FingerTree.fingerTree -> 'i -> 'j -> ('i, 'j) FingerTree.fingerTree) * ((('k, 'l) FingerTree.fingerTree -> 'k * 'l) * ((('m, 'n) FingerTree.fingerTree -> ('m, 'n) FingerTree.fingerTree) * ((('o, 'p) FingerTree.fingerTree -> 'o * 'p) * ((('q, 'r) FingerTree.fingerTree -> ('q, 'r) FingerTree.fingerTree) * ((('s, 't) FingerTree.fingerTree -> ('s, 't) FingerTree.fingerTree -> ('s, 't) FingerTree.fingerTree) * ((('u, 'v) FingerTree.fingerTree -> 'v) * ((('w -> bool) -> 'w -> ('x, 'w) FingerTree.fingerTree -> ('x, 'w) FingerTree.fingerTree * (('x * 'w) * ('x, 'w) FingerTree.fingerTree)) * ((('y -> 'z * 'aa -> 'y) -> 'y -> ('z, 'aa) FingerTree.fingerTree -> 'y) * (('ab * 'ac -> 'ad -> 'ad) -> ('ab, 'ac) FingerTree.fingerTree -> 'ad -> 'ad))))))))))))) end = struct fun ft_app B_ = FingerTree.app B_; fun ft_head B_ = FingerTree.head B_; fun ft_tail B_ = FingerTree.tail B_; fun ft_annot B_ = FingerTree.annot B_; fun ft_consl B_ e a s = FingerTree.lcons B_ (e, a) s; fun ft_consr B_ s e a = FingerTree.rcons B_ s (e, a); fun ft_count B_ = FingerTree.count B_; fun ft_empty B_ = (fn _ => FingerTree.empty B_); fun ft_foldl C_ = FingerTree.foldl C_; fun ft_foldr B_ = FingerTree.foldr B_; fun ft_headR B_ = FingerTree.headR B_; fun ft_tailR B_ = FingerTree.tailR B_; fun ft_splits A_ = FingerTree.splitTree A_; fun ft_isEmpty B_ = FingerTree.isEmpty B_; fun foldr_alist_op_alpha_ft_ops B_ f s sigma = ft_foldr B_ f s sigma; fun foldl_alist_op_alpha_ft_ops C_ f sigma s = ft_foldl C_ f sigma s; fun test_codegen B_ D_ F_ H_ J_ L_ N_ P_ R_ T_ V_ W_ Aa_ Ac_ = (ft_empty B_, (ft_isEmpty D_, (ft_count F_, (ft_consl H_, (ft_consr J_, (ft_head L_, (ft_tail N_, (ft_headR P_, (ft_tailR R_, (ft_app T_, (ft_annot V_, (ft_splits W_, (foldl_alist_op_alpha_ft_ops Aa_, foldr_alist_op_alpha_ft_ops Ac_))))))))))))); end; (*struct FTAnnotatedListImpl*) ### theory "Collections.FTAnnotatedListImpl" ### 1.249s elapsed time, 2.504s cpu time, 0.000s GC time Loading theory "Collections.PrioSpec" locale prio fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" locale prio_no_invar fixes \ :: "'a \ ('b \ 'c) multiset" and invar :: "'a \ bool" assumes "prio_no_invar invar" locale prio_empty fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" and empty :: "unit \ 'p" assumes "prio_empty \ invar empty" locale prio_isEmpty fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" and isEmpty :: "'p \ bool" assumes "prio_isEmpty \ invar isEmpty" locale prio_find fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" and find :: "'p \ 'e \ 'a" assumes "prio_find \ invar find" locale prio_insert fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" and insert :: "'e \ 'a \ 'p \ 'p" assumes "prio_insert \ invar insert" locale prio_meld fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" and meld :: "'p \ 'p \ 'p" assumes "prio_meld \ invar meld" Found termination order: "(\p. size (fst (snd p))) <*mlex*> {}" locale prio_delete fixes \ :: "'p \ ('e \ 'a) multiset" and invar :: "'p \ bool" and find :: "'p \ 'e \ 'a" and delete :: "'p \ 'p" assumes "prio_delete \ invar find delete" Found termination order: "(\p. size (fst (snd p))) <*mlex*> {}" locale it_size_loc fixes \ :: "'s \ 'a list" and invar :: "'s \ bool" locale rev_it_size_loc fixes \ :: "'s \ 'a list" and invar :: "'s \ bool" locale it_get_loc fixes \ :: "'s \ 'a list" and invar :: "'s \ bool" ### theory "Collections.ListGA" ### 0.640s elapsed time, 1.280s cpu time, 0.000s GC time Loading theory "Collections.Fifo" locale StdPrioDefs fixes ops :: "('e, 'a, 'p) prio_ops" locale StdPrio fixes ops :: "('a, 'b, 'c) prio_ops" assumes "StdPrio ops" locale StdPrio_no_invar fixes ops :: "('a, 'b, 'c) prio_ops" assumes "StdPrio_no_invar ops" ### theory "Collections.PrioSpec" ### 1.493s elapsed time, 2.928s cpu time, 0.748s GC time Loading theory "Collections.BinoPrioImpl" structure HOL : sig type 'a equal val equal : 'a equal -> 'a -> 'a -> bool val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b val equal_prod : 'a HOL.equal -> 'b HOL.equal -> 'a * 'b -> 'a * 'b -> bool end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; fun equal_prod A_ B_ (x1, x2) (y1, y2) = HOL.eq A_ x1 y1 andalso HOL.eq B_ x2 y2; end; (*struct Product_Type*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b val foldri : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); fun foldri (x :: l) c f sigma = let val sigmaa = foldri l c f sigma; in (if c sigmaa then f x sigmaa else sigmaa) end | foldri [] c f sigma = sigma; end; (*struct Foldi*) structure Arith : sig datatype nat = Zero_nat | Suc of nat val less_nat : nat -> nat -> bool val plus_nat : nat -> nat -> nat val minus_nat : nat -> nat -> nat end = struct datatype nat = Zero_nat | Suc of nat; fun less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun plus_nat (Suc m) n = plus_nat m (Suc n) | plus_nat Zero_nat n = n; fun minus_nat (Suc m) (Suc n) = minus_nat m n | minus_nat Zero_nat n = Zero_nat | minus_nat m Zero_nat = m; end; (*struct Arith*) structure List : sig val equal_list : 'a HOL.equal -> ('a list) HOL.equal val nth : 'a list -> Arith.nat -> 'a val rev : 'a list -> 'a list val last : 'a list -> 'a val hd : 'a list -> 'a val tl : 'a list -> 'a list val list_update : 'a list -> Arith.nat -> 'a -> 'a list val size_list : 'a list -> Arith.nat end = struct fun equal_lista A_ [] (x21 :: x22) = false | equal_lista A_ (x21 :: x22) [] = false | equal_lista A_ (x21 :: x22) (y21 :: y22) = HOL.eq A_ x21 y21 andalso equal_lista A_ x22 y22 | equal_lista A_ [] [] = true; fun equal_list A_ = {equal = equal_lista A_} : ('a list) HOL.equal; fun nth (x :: xs) (Arith.Suc n) = nth xs n | nth (x :: xs) Arith.Zero_nat = x; fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun null [] = true | null (x :: xs) = false; fun last (x :: xs) = (if null xs then x else last xs); fun hd (x21 :: x22) = x21; fun tl [] = [] | tl (x21 :: x22) = x22; fun gen_length n (x :: xs) = gen_length (Arith.Suc n) xs | gen_length n [] = n; fun list_update (x :: xs) (Arith.Suc i) y = x :: list_update xs i y | list_update (x :: xs) Arith.Zero_nat y = y :: xs | list_update [] i y = []; fun size_list x = gen_length Arith.Zero_nat x; end; (*struct List*) structure Fifo : sig val test_codegen : 'b HOL.equal -> (unit -> 'a list * 'a list) * (('b list * 'b list -> bool) * (('c list * 'c list -> Arith.nat) * (('d -> 'd list * 'd list -> 'd list * 'd list) * (('e list * 'e list -> 'e * ('e list * 'e list)) * (('f list * 'f list -> 'f) * (('g -> 'g list * 'g list -> 'g list * 'g list) * (('h list * 'h list -> ('h list * 'h list) * 'h) * (('i list * 'i list -> 'i) * (('j list * 'j list -> Arith.nat -> 'j) * (('k list * 'k list -> Arith.nat -> 'k -> 'k list * 'k list) * (('l list * 'l list -> ('m -> bool) -> ('l -> 'm -> 'm) -> 'm -> 'm) * ('n list * 'n list -> ('o -> bool) -> ('n -> 'o -> 'o) -> 'o -> 'o)))))))))))) end = struct fun fifo_get f i = let val l2 = List.size_list (Product_Type.snd f); in (if Arith.less_nat i l2 then List.nth (Product_Type.snd f) i else List.nth (Product_Type.fst f) (Arith.minus_nat (List.size_list (Product_Type.fst f)) (Arith.Suc (Arith.minus_nat i l2)))) end; fun fifo_set f i a = let val (f1, f2) = f; val l2 = List.size_list f2; in (if Arith.less_nat i l2 then (f1, List.list_update f2 i a) else (List.list_update f1 (Arith.minus_nat (List.size_list (Product_Type.fst f)) (Arith.Suc (Arith.minus_nat i l2))) a, f2)) end; fun fifo_size f = Arith.plus_nat (List.size_list (Product_Type.fst f)) (List.size_list (Product_Type.snd f)); fun fifo_empty x = (fn _ => ([], [])) x; fun fifo_appendl x f = let val (e, d) = f; in (e, x :: d) end; fun fifo_appendr a f = (a :: Product_Type.fst f, Product_Type.snd f); fun fifo_isEmpty A_ f = Product_Type.equal_prod (List.equal_list A_) (List.equal_list A_) f ([], []); fun fifo_removel f = (case Product_Type.snd f of [] => let val rp = List.rev (Product_Type.fst f); in (List.hd rp, ([], List.tl rp)) end | a :: l => (a, (Product_Type.fst f, l))); fun fifo_remover f = (case Product_Type.fst f of [] => let val rp = List.rev (Product_Type.snd f); in ((List.tl rp, []), List.hd rp) end | a :: l => ((l, Product_Type.snd f), a)); fun fifo_alpha f = Product_Type.snd f @ List.rev (Product_Type.fst f); fun rev_iteratei_list_op_alpha_fifo_ops s = Foldi.foldri (fifo_alpha s); fun iteratei_list_op_alpha_fifo_ops s = Foldi.foldli (fifo_alpha s); fun fifo_rightmost f = (case f of ([], xb) => List.last xb | (x :: _, _) => x); fun fifo_leftmost f = (case f of (xa, []) => List.last xa | (_, x :: _) => x); fun test_codegen B_ = (fifo_empty, (fifo_isEmpty B_, (fifo_size, (fifo_appendl, (fifo_removel, (fifo_leftmost, (fifo_appendr, (fifo_remover, (fifo_rightmost, (fifo_get, (fifo_set, (iteratei_list_op_alpha_fifo_ops, rev_iteratei_list_op_alpha_fifo_ops)))))))))))); end; (*struct Fifo*) ### theory "Collections.Fifo" ### 0.987s elapsed time, 1.920s cpu time, 0.748s GC time Loading theory "Collections.PrioByAnnotatedList" structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure List : sig val rev : 'a list -> 'a list val null : 'a list -> bool end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun null [] = true | null (x :: xs) = false; end; (*struct List*) structure Arith : sig datatype nat = Zero_nat | Suc of nat val less_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; fun less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; end; (*struct Arith*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; end; (*struct Orderings*) structure BinomialHeap : sig type ('a, 'b) binomialTree type ('b, 'a) binomialHeap val meld : 'b Orderings.linorder -> ('a, 'b) binomialHeap -> ('a, 'b) binomialHeap -> ('a, 'b) binomialHeap val empty : 'b Orderings.linorder -> ('a, 'b) binomialHeap val insert : 'b Orderings.linorder -> 'a -> 'b -> ('a, 'b) binomialHeap -> ('a, 'b) binomialHeap val findMin : 'b Orderings.linorder -> ('a, 'b) binomialHeap -> 'a * 'b val isEmpty : 'b Orderings.linorder -> ('a, 'b) binomialHeap -> bool val deleteMin : 'b HOL.equal * 'b Orderings.linorder -> ('a, 'b) binomialHeap -> ('a, 'b) binomialHeap end = struct datatype ('a, 'b) binomialTree = Node of 'a * 'b * Arith.nat * ('a, 'b) binomialTree list; datatype ('b, 'a) binomialHeap = Abs_BinomialHeap of ('b, 'a) binomialTree list; fun rep_BinomialHeap A_ (Abs_BinomialHeap x) = x; fun rank B_ (Node (x1, x2, x3, x4)) = x3; fun link B_ (Node (e1, a1, r1, ts1)) (Node (e2, a2, r2, ts2)) = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) a1 a2 then Node (e1, a1, Arith.Suc r1, Node (e2, a2, r2, ts2) :: ts1) else Node (e2, a2, Arith.Suc r2, Node (e1, a1, r1, ts1) :: ts2)); fun ins B_ t [] = [t] | ins B_ ta (t :: bq) = (if Arith.less_nat (rank B_ ta) (rank B_ t) then ta :: t :: bq else (if Arith.less_nat (rank B_ t) (rank B_ ta) then t :: ins B_ ta bq else ins B_ (link B_ ta t) bq)); fun melda B_ [] bq = bq | melda B_ (v :: va) [] = v :: va | melda B_ (t1 :: bq1) (t2 :: bq2) = (if Arith.less_nat (rank B_ t1) (rank B_ t2) then t1 :: melda B_ bq1 (t2 :: bq2) else (if Arith.less_nat (rank B_ t2) (rank B_ t1) then t2 :: melda B_ (t1 :: bq1) bq2 else ins B_ (link B_ t1 t2) (melda B_ bq1 bq2))); fun meld B_ q1 q2 = Abs_BinomialHeap (melda B_ (rep_BinomialHeap B_ q1) (rep_BinomialHeap B_ q2)); fun empty B_ = Abs_BinomialHeap []; fun inserta B_ e a bq = ins B_ (Node (e, a, Arith.Zero_nat, [])) bq; fun insert B_ e a q = Abs_BinomialHeap (inserta B_ e a (rep_BinomialHeap B_ q)); fun prio B_ (Node (x1, x2, x3, x4)) = x2; fun vala B_ (Node (x1, x2, x3, x4)) = x1; fun getMinTree B_ [t] = t | getMinTree B_ (t :: v :: va) = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) (prio B_ t) (prio B_ (getMinTree B_ (v :: va))) then t else getMinTree B_ (v :: va)); fun findMina B_ bq = let val min = getMinTree B_ bq; in (vala B_ min, prio B_ min) end; fun findMin B_ q = findMina B_ (rep_BinomialHeap B_ q); fun isEmpty B_ q = List.null (rep_BinomialHeap B_ q); fun children B_ (Node (x1, x2, x3, x4)) = x4; fun remove1Prio (A1_, A2_) a [] = [] | remove1Prio (A1_, A2_) a (t :: bq) = (if HOL.eq A1_ (prio A2_ t) a then bq else t :: remove1Prio (A1_, A2_) a bq); fun deleteMina (B1_, B2_) bq = let val min = getMinTree B2_ bq; in melda B2_ (List.rev (children B2_ min)) (remove1Prio (B1_, B2_) (prio B2_ min) bq) end; fun deleteMin (B1_, B2_) q = Abs_BinomialHeap (case rep_BinomialHeap B2_ q of [] => [] | _ :: _ => deleteMina (B1_, B2_) (rep_BinomialHeap B2_ q)); end; (*struct BinomialHeap*) structure BinoPrioImpl : sig val test_codegen : 'b Orderings.linorder -> 'd Orderings.linorder -> 'f Orderings.linorder -> 'h Orderings.linorder -> 'j Orderings.linorder -> 'l HOL.equal * 'l Orderings.linorder -> (unit -> ('a, 'b) BinomialHeap.binomialHeap) * ((('c, 'd) BinomialHeap.binomialHeap -> bool) * ((('e, 'f) BinomialHeap.binomialHeap -> 'e * 'f) * (('g -> 'h -> ('g, 'h) BinomialHeap.binomialHeap -> ('g, 'h) BinomialHeap.binomialHeap) * ((('i, 'j) BinomialHeap.binomialHeap -> ('i, 'j) BinomialHeap.binomialHeap -> ('i, 'j) BinomialHeap.binomialHeap) * (('k, 'l) BinomialHeap.binomialHeap -> ('k, 'l) BinomialHeap.binomialHeap))))) end = struct fun bino_find B_ = BinomialHeap.findMin B_; fun bino_meld B_ = BinomialHeap.meld B_; fun bino_empty B_ = (fn _ => BinomialHeap.empty B_); fun bino_delete (B1_, B2_) = BinomialHeap.deleteMin (B1_, B2_); fun bino_insert B_ = BinomialHeap.insert B_; fun bino_isEmpty B_ = BinomialHeap.isEmpty B_; fun test_codegen B_ D_ F_ H_ J_ (L1_, L2_) = (bino_empty B_, (bino_isEmpty D_, (bino_find F_, (bino_insert H_, (bino_meld J_, bino_delete (L1_, L2_)))))); end; (*struct BinoPrioImpl*) ### theory "Collections.BinoPrioImpl" ### 0.590s elapsed time, 1.188s cpu time, 0.000s GC time Loading theory "Collections.SkewPrioImpl" ### Missing patterns in function definition: ### p_unwrap Infty = undefined Found termination order: "{}" Found termination order: "{}" instantiation Prio :: (type, linorder) monoid_add zero_Prio == zero_class.zero :: ('a, 'b) Prio plus_Prio == plus :: ('a, 'b) Prio \ ('a, 'b) Prio \ ('a, 'b) Prio structure HOL : sig type 'a equal val equal : 'a equal -> 'a -> 'a -> bool val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure List : sig val rev : 'a list -> 'a list val filter : ('a -> bool) -> 'a list -> 'a list val equal_list : 'a HOL.equal -> 'a list -> 'a list -> bool end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun filter p [] = [] | filter p (x :: xs) = (if p x then x :: filter p xs else filter p xs); fun equal_list A_ [] (x21 :: x22) = false | equal_list A_ (x21 :: x22) [] = false | equal_list A_ (x21 :: x22) (y21 :: y22) = HOL.eq A_ x21 y21 andalso equal_list A_ x22 y22 | equal_list A_ [] [] = true; end; (*struct List*) structure Arith : sig datatype nat = Zero_nat | Suc of nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; fun less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Sum_Type : sig datatype ('a, 'b) sum = Inl of 'a | Inr of 'b val equal_sum : 'a HOL.equal -> 'b HOL.equal -> ('a, 'b) sum -> ('a, 'b) sum -> bool end = struct datatype ('a, 'b) sum = Inl of 'a | Inr of 'b; fun equal_sum A_ B_ (Inl x1) (Inr x2) = false | equal_sum A_ B_ (Inr x2) (Inl x1) = false | equal_sum A_ B_ (Inr x2) (Inr y2) = HOL.eq B_ x2 y2 | equal_sum A_ B_ (Inl x1) (Inl y1) = HOL.eq A_ x1 y1; end; (*struct Sum_Type*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; end; (*struct Orderings*) structure Product_Type : sig val equal_unit : unit HOL.equal end = struct fun equal_unita u v = true; val equal_unit = {equal = equal_unita} : unit HOL.equal; end; (*struct Product_Type*) structure SkewBinomialHeap : sig type ('a, 'b) bsSkewElem type ('a, 'b) bsSkewBinomialTree type ('b, 'a) skewBinomialHeap val meldb : 'b Orderings.linorder -> ('a, 'b) skewBinomialHeap -> ('a, 'b) skewBinomialHeap -> ('a, 'b) skewBinomialHeap val empty : 'b Orderings.linorder -> ('a, 'b) skewBinomialHeap val insertb : 'b Orderings.linorder -> 'a -> 'b -> ('a, 'b) skewBinomialHeap -> ('a, 'b) skewBinomialHeap val findMinb : 'b Orderings.linorder -> ('a, 'b) skewBinomialHeap -> 'a * 'b val isEmpty : 'a HOL.equal -> 'b HOL.equal * 'b Orderings.linorder -> ('a, 'b) skewBinomialHeap -> bool val deleteMinb : 'b HOL.equal * 'b Orderings.linorder -> ('a, 'b) skewBinomialHeap -> ('a, 'b) skewBinomialHeap end = struct datatype ('a, 'b) bsSkewElem = Element of 'a * 'b * ('a, 'b) bsSkewBinomialTree list and ('a, 'b) bsSkewBinomialTree = BsNode of ('a, 'b) bsSkewElem * Arith.nat * ('a, 'b) bsSkewBinomialTree list; fun equal_BsSkewElema A_ (B1_, B2_) (Element (x1, x2, x3)) (Element (y1, y2, y3)) = HOL.eq A_ x1 y1 andalso (HOL.eq B1_ x2 y2 andalso List.equal_list (equal_BsSkewBinomialTree A_ (B1_, B2_)) x3 y3) and equal_BsSkewBinomialTreea A_ (B1_, B2_) (BsNode (x1, x2, x3)) (BsNode (y1, y2, y3)) = equal_BsSkewElema A_ (B1_, B2_) x1 y1 andalso (Arith.equal_nat x2 y2 andalso List.equal_list (equal_BsSkewBinomialTree A_ (B1_, B2_)) x3 y3) and equal_BsSkewBinomialTree A_ (B1_, B2_) = {equal = equal_BsSkewBinomialTreea A_ (B1_, B2_)} : ('a, 'b) bsSkewBinomialTree HOL.equal; fun equal_BsSkewElem A_ (B1_, B2_) = {equal = equal_BsSkewElema A_ (B1_, B2_)} : ('a, 'b) bsSkewElem HOL.equal; datatype ('b, 'a) skewBinomialHeap = Abs_SkewBinomialHeap of (unit, ('b, 'a) bsSkewElem) Sum_Type.sum; fun rank B_ (BsNode (x1, x2, x3)) = x2; fun eprio B_ (Element (x1, x2, x3)) = x2; fun link B_ (BsNode (e1, r1, ts1)) (BsNode (e2, r2, ts2)) = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) (eprio B_ e1) (eprio B_ e2) then BsNode (e1, Arith.Suc r1, BsNode (e2, r2, ts2) :: ts1) else BsNode (e2, Arith.Suc r2, BsNode (e1, r1, ts1) :: ts2)); fun ins B_ t [] = [t] | ins B_ ta (t :: bq) = (if Arith.less_nat (rank B_ ta) (rank B_ t) then ta :: t :: bq else (if Arith.less_nat (rank B_ t) (rank B_ ta) then t :: ins B_ ta bq else ins B_ (link B_ ta t) bq)); fun meldUniq B_ [] bq = bq | meldUniq B_ (v :: va) [] = v :: va | meldUniq B_ (t1 :: bq1) (t2 :: bq2) = (if Arith.less_nat (rank B_ t1) (rank B_ t2) then t1 :: meldUniq B_ bq1 (t2 :: bq2) else (if Arith.less_nat (rank B_ t2) (rank B_ t1) then t2 :: meldUniq B_ (t1 :: bq1) bq2 else ins B_ (link B_ t1 t2) (meldUniq B_ bq1 bq2))); fun uniqify B_ [] = [] | uniqify B_ (t :: bq) = ins B_ t bq; fun meld B_ bq1 bq2 = meldUniq B_ (uniqify B_ bq1) (uniqify B_ bq2); fun prio B_ (BsNode (e, r, ts)) = eprio B_ e; fun children B_ (BsNode (x1, x2, x3)) = x3; fun vala B_ (BsNode (x1, x2, x3)) = x1; fun skewlink B_ e ta t = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) (eprio B_ e) (prio B_ ta) andalso Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) (eprio B_ e) (prio B_ t) then BsNode (e, Arith.Suc (rank B_ ta), [ta, t]) else (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) (prio B_ ta) (prio B_ t) then BsNode (vala B_ ta, Arith.Suc (rank B_ ta), BsNode (e, Arith.Zero_nat, []) :: t :: children B_ ta) else BsNode (vala B_ t, Arith.Suc (rank B_ t), BsNode (e, Arith.Zero_nat, []) :: ta :: children B_ t))); fun insert B_ e [] = [BsNode (e, Arith.Zero_nat, [])] | insert B_ e [t] = [BsNode (e, Arith.Zero_nat, []), t] | insert B_ e (ta :: t :: bq) = (if not (Arith.equal_nat (rank B_ ta) (rank B_ t)) then BsNode (e, Arith.Zero_nat, []) :: ta :: t :: bq else skewlink B_ e ta t :: bq); fun melda B_ (Element (e1, a1, q1)) (Element (e2, a2, q2)) = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) a1 a2 then Element (e1, a1, insert B_ (Element (e2, a2, q2)) q1) else Element (e2, a2, insert B_ (Element (e1, a1, q1)) q2)); fun bs_meld B_ (Sum_Type.Inl uu) x = x | bs_meld B_ (Sum_Type.Inr v) (Sum_Type.Inl uv) = Sum_Type.Inr v | bs_meld B_ (Sum_Type.Inr xa) (Sum_Type.Inr x) = Sum_Type.Inr (melda B_ xa x); fun getMinTree B_ [t] = t | getMinTree B_ (t :: v :: va) = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) (prio B_ t) (prio B_ (getMinTree B_ (v :: va))) then t else getMinTree B_ (v :: va)); fun findMin B_ bq = vala B_ (getMinTree B_ bq); fun inserta B_ e a q = melda B_ (Element (e, a, [])) q; val bs_empty : (unit, 'a) Sum_Type.sum = Sum_Type.Inl (); fun findMina B_ (Element (e, a, q)) = (e, a); fun bs_insert B_ e a (Sum_Type.Inl uu) = Sum_Type.Inr (Element (e, a, [])) | bs_insert B_ e a (Sum_Type.Inr x) = Sum_Type.Inr (inserta B_ e a x); fun remove1Prio (A1_, A2_) a [] = [] | remove1Prio (A1_, A2_) a (t :: bq) = (if HOL.eq A1_ (prio A2_ t) a then bq else t :: remove1Prio (A1_, A2_) a bq); fun insertList B_ [] tbq = tbq | insertList B_ (t :: bq) tbq = insertList B_ bq (insert B_ (vala B_ t) tbq); fun deleteMin (B1_, B2_) bq = let val min = getMinTree B2_ bq; in insertList B2_ (List.filter (fn t => Arith.equal_nat (rank B2_ t) Arith.Zero_nat) (children B2_ min)) (meld B2_ (List.rev (List.filter (fn t => Arith.less_nat Arith.Zero_nat (rank B2_ t)) (children B2_ min))) (remove1Prio (B1_, B2_) (prio B2_ min) bq)) end; fun bs_findMin C_ (Sum_Type.Inr x) = findMina C_ x; fun deleteMina (B1_, B2_) (Element (e, a, q)) = let val Element (ey, ay, q1) = findMin B2_ q; in Element (ey, ay, meld B2_ q1 (deleteMin (B1_, B2_) q)) end; fun bs_deleteMin (B1_, B2_) (Sum_Type.Inr (Element (e, a, []))) = Sum_Type.Inl () | bs_deleteMin (B1_, B2_) (Sum_Type.Inr (Element (e, a, v :: va))) = Sum_Type.Inr (deleteMina (B1_, B2_) (Element (e, a, v :: va))); fun rep_SkewBinomialHeap A_ (Abs_SkewBinomialHeap x) = x; fun meldb B_ q1 q2 = Abs_SkewBinomialHeap (bs_meld B_ (rep_SkewBinomialHeap B_ q1) (rep_SkewBinomialHeap B_ q2)); fun empty B_ = Abs_SkewBinomialHeap bs_empty; fun insertb B_ e a q = Abs_SkewBinomialHeap (bs_insert B_ e a (rep_SkewBinomialHeap B_ q)); fun findMinb B_ q = bs_findMin B_ (rep_SkewBinomialHeap B_ q); fun isEmpty A_ (B1_, B2_) q = Sum_Type.equal_sum Product_Type.equal_unit (equal_BsSkewElem A_ (B1_, B2_)) (rep_SkewBinomialHeap B2_ q) bs_empty; fun deleteMinb (B1_, B2_) q = Abs_SkewBinomialHeap (case rep_SkewBinomialHeap B2_ q of Sum_Type.Inl _ => bs_empty | Sum_Type.Inr _ => bs_deleteMin (B1_, B2_) (rep_SkewBinomialHeap B2_ q)); end; (*struct SkewBinomialHeap*) structure SkewPrioImpl : sig val test_codegen : 'b Orderings.linorder -> 'c HOL.equal -> 'd HOL.equal * 'd Orderings.linorder -> 'f Orderings.linorder -> 'h Orderings.linorder -> 'j Orderings.linorder -> 'l HOL.equal * 'l Orderings.linorder -> (unit -> ('a, 'b) SkewBinomialHeap.skewBinomialHeap) * ((('c, 'd) SkewBinomialHeap.skewBinomialHeap -> bool) * ((('e, 'f) SkewBinomialHeap.skewBinomialHeap -> 'e * 'f) * (('g -> 'h -> ('g, 'h) SkewBinomialHeap.skewBinomialHeap -> ('g, 'h) SkewBinomialHeap.skewBinomialHeap) * ((('i, 'j) SkewBinomialHeap.skewBinomialHeap -> ('i, 'j) SkewBinomialHeap.skewBinomialHeap -> ('i, 'j) SkewBinomialHeap.skewBinomialHeap) * (('k, 'l) SkewBinomialHeap.skewBinomialHeap -> ('k, 'l) SkewBinomialHeap.skewBinomialHeap))))) end = struct fun skew_find B_ = SkewBinomialHeap.findMinb B_; fun skew_meld B_ = SkewBinomialHeap.meldb B_; fun skew_empty B_ = (fn _ => SkewBinomialHeap.empty B_); fun skew_delete (B1_, B2_) = SkewBinomialHeap.deleteMinb (B1_, B2_); fun skew_insert B_ = SkewBinomialHeap.insertb B_; fun skew_isEmpty A_ (B1_, B2_) = SkewBinomialHeap.isEmpty A_ (B1_, B2_); fun test_codegen B_ C_ (D1_, D2_) F_ H_ J_ (L1_, L2_) = (skew_empty B_, (skew_isEmpty C_ (D1_, D2_), (skew_find F_, (skew_insert H_, (skew_meld J_, skew_delete (L1_, L2_)))))); end; (*struct SkewPrioImpl*) ### theory "Collections.SkewPrioImpl" ### 0.689s elapsed time, 1.384s cpu time, 0.000s GC time Loading theory "Collections.PrioUniqueSpec" Found termination order: "{}" locale uprio fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" locale uprio_no_invar fixes \ :: "'a \ 'b \ 'c option" and invar :: "'a \ bool" assumes "uprio_no_invar invar" locale uprio_finite fixes \ :: "'a \ 'b \ 'c option" and invar :: "'a \ bool" assumes "uprio_finite \ invar" locale uprio_empty fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" and empty :: "unit \ 's" assumes "uprio_empty \ invar empty" locale uprio_isEmpty fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" and isEmpty :: "'s \ bool" assumes "uprio_isEmpty \ invar isEmpty" locale uprio_pop fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" and pop :: "'s \ 'e \ 'a \ 's" assumes "uprio_pop \ invar pop" locale uprio_insert fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" and insert :: "'s \ 'e \ 'a \ 's" assumes "uprio_insert \ invar insert" locale uprio_distinct_insert fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" and insert :: "'s \ 'e \ 'a \ 's" assumes "uprio_distinct_insert \ invar insert" locale uprio_prio fixes \ :: "'s \ 'e \ 'a option" and invar :: "'s \ bool" and prio :: "'s \ 'e \ 'a option" assumes "uprio_prio \ invar prio" Found termination order: "{}" instantiation Prio :: (type, linorder) preorder less_eq_Prio == less_eq :: ('a, 'b) Prio \ ('a, 'b) Prio \ bool less_Prio == less :: ('a, 'b) Prio \ ('a, 'b) Prio \ bool locale alprio_defs fixes ops :: "(unit, ('e, 'a) Prio, 's) alist_ops" locale alprio fixes ops :: "(unit, ('e, 'a) Prio, 's) alist_ops" assumes "alprio ops" ### theory "Collections.PrioByAnnotatedList" ### 1.749s elapsed time, 3.516s cpu time, 0.000s GC time Loading theory "Collections.FTPrioImpl" locale StdUprioDefs fixes ops :: "('e, 'a, 's, 'more) uprio_ops_scheme" locale StdUprio fixes ops :: "('a, 'b, 'c, 'd) uprio_ops_scheme" assumes "StdUprio ops" locale StdUprio_no_invar fixes ops :: "('a, 'b, 'c, 'd) uprio_ops_scheme" assumes "StdUprio_no_invar ops" ### theory "Collections.PrioUniqueSpec" ### 0.890s elapsed time, 1.788s cpu time, 0.000s GC time Loading theory "Collections.PrioUniqueByAnnotatedList" structure Arith : sig type 'a plus val plus : 'a plus -> 'a -> 'a -> 'a type 'a semigroup_add val plus_semigroup_add : 'a semigroup_add -> 'a plus type 'a zero val zero : 'a zero -> 'a type 'a monoid_add val semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add val zero_monoid_add : 'a monoid_add -> 'a zero end = struct type 'a plus = {plus : 'a -> 'a -> 'a}; val plus = #plus : 'a plus -> 'a -> 'a -> 'a; type 'a semigroup_add = {plus_semigroup_add : 'a plus}; val plus_semigroup_add = #plus_semigroup_add : 'a semigroup_add -> 'a plus; type 'a zero = {zero : 'a}; val zero = #zero : 'a zero -> 'a; type 'a monoid_add = {semigroup_add_monoid_add : 'a semigroup_add, zero_monoid_add : 'a zero}; val semigroup_add_monoid_add = #semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add; val zero_monoid_add = #zero_monoid_add : 'a monoid_add -> 'a zero; end; (*struct Arith*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; end; (*struct Orderings*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure PrioByAnnotatedList : sig type ('a, 'b) prio val monoid_add_Prio : 'b Orderings.linorder -> ('a, 'b) prio Arith.monoid_add val alprio_find : 'c Orderings.linorder -> ('a -> ('b, 'c) prio) -> 'a -> 'b * 'c val alprio_meld : 'a -> 'a val alprio_empty : 'a -> 'a val alprio_delete : 'b Orderings.linorder -> ((('a, 'b) prio -> bool) -> ('a, 'b) prio -> 'c -> 'c * ((unit * ('a, 'b) prio) * 'c)) -> ('c -> ('a, 'b) prio) -> ('c -> 'c -> 'c) -> 'c -> 'c val alprio_insert : 'b Orderings.linorder -> (unit -> ('a, 'b) prio -> 'c -> 'c) -> 'a -> 'b -> 'c -> 'c val alprio_isEmpty : 'a -> 'a end = struct datatype ('a, 'b) prio = Infty | Prio of 'a * 'b; fun p_min B_ Infty Infty = Infty | p_min B_ Infty (Prio (e, a)) = Prio (e, a) | p_min B_ (Prio (e, a)) Infty = Prio (e, a) | p_min B_ (Prio (e1, a)) (Prio (e2, b)) = (if Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) a b then Prio (e1, a) else Prio (e2, b)); fun plus_Prioa B_ a b = p_min B_ a b; fun plus_Prio B_ = {plus = plus_Prioa B_} : ('a, 'b) prio Arith.plus; fun zero_Prioa B_ = Infty; fun zero_Prio B_ = {zero = zero_Prioa B_} : ('a, 'b) prio Arith.zero; fun semigroup_add_Prio B_ = {plus_semigroup_add = plus_Prio B_} : ('a, 'b) prio Arith.semigroup_add; fun monoid_add_Prio B_ = {semigroup_add_monoid_add = semigroup_add_Prio B_, zero_monoid_add = zero_Prio B_} : ('a, 'b) prio Arith.monoid_add; fun p_unwrap (Prio (e, a)) = (e, a); fun p_less_eq B_ (Prio (e, a)) (Prio (f, b)) = Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) a b | p_less_eq B_ uu Infty = true | p_less_eq B_ Infty (Prio (e, a)) = false; fun alprio_find C_ annot s = p_unwrap (annot s); fun alprio_meld app = app; fun alprio_empty empt = empt; fun less_eq_Prio B_ = p_less_eq B_; fun alprio_delete B_ splits annot app s = let val a = splits (fn x => less_eq_Prio B_ x (annot s)) Infty s; val (l, aa) = a; val (_, ab) = aa; in app l ab end; fun alprio_insert B_ consl e a s = consl () (Prio (e, a)) s; fun alprio_isEmpty isEmpty = isEmpty; end; (*struct PrioByAnnotatedList*) structure FingerTree : sig type ('a, 'b) fingerTreeStruc type ('b, 'a) splitres type ('b, 'a) fingerTree val app : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val annot : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'b val empty : 'b Arith.monoid_add -> ('a, 'b) fingerTree val lcons : 'b Arith.monoid_add -> 'a * 'b -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val isEmpty : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> bool val splitTree : 'a Arith.monoid_add -> ('a -> bool) -> 'a -> ('b, 'a) fingerTree -> ('b, 'a) fingerTree * (('b * 'a) * ('b, 'a) fingerTree) end = struct datatype ('a, 'b) node = Tip of 'a * 'b | Node2 of 'b * ('a, 'b) node * ('a, 'b) node | Node3 of 'b * ('a, 'b) node * ('a, 'b) node * ('a, 'b) node; datatype ('a, 'b) digit = One of ('a, 'b) node | Two of ('a, 'b) node * ('a, 'b) node | Three of ('a, 'b) node * ('a, 'b) node * ('a, 'b) node | Four of ('a, 'b) node * ('a, 'b) node * ('a, 'b) node * ('a, 'b) node; datatype ('a, 'b) fingerTreeStruc = Empty | Single of ('a, 'b) node | Deep of 'b * ('a, 'b) digit * ('a, 'b) fingerTreeStruc * ('a, 'b) digit; datatype ('b, 'a) splitres = Abs_splitres of (('b, 'a) fingerTreeStruc * (('b * 'a) * ('b, 'a) fingerTreeStruc)); datatype ('b, 'a) fingerTree = Abs_FingerTree of ('b, 'a) fingerTreeStruc; fun rep_splitres A_ (Abs_splitres x) = x; fun extract_splitres_r B_ r = Abs_FingerTree let val (_, (_, ra)) = rep_splitres B_ r; in ra end; fun extract_splitres_l B_ r = Abs_FingerTree let val (l, (_, _)) = rep_splitres B_ r; in l end; fun extract_splitres_a B_ r = let val (_, a) = rep_splitres B_ r; val (aa, _) = a; in aa end; fun extract_splitres B_ r = (extract_splitres_l B_ r, (extract_splitres_a B_ r, extract_splitres_r B_ r)); fun rep_FingerTree A_ (Abs_FingerTree x) = x; fun digitToNlist (One a) = [a] | digitToNlist (Two (a, b)) = [a, b] | digitToNlist (Three (a, b, c)) = [a, b, c] | digitToNlist (Four (a, b, c, d)) = [a, b, c, d]; fun gmn B_ (Tip (e, a)) = a | gmn B_ (Node2 (a, uu, uv)) = a | gmn B_ (Node3 (a, uw, ux, uy)) = a; fun node3 B_ nd1 nd2 nd3 = Node3 (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ nd1) (gmn B_ nd2)) (gmn B_ nd3), nd1, nd2, nd3); fun gmft B_ Empty = Arith.zero (Arith.zero_monoid_add B_) | gmft B_ (Single nd) = gmn B_ nd | gmft B_ (Deep (a, uu, uv, uw)) = a; fun gmd B_ (One a) = gmn B_ a | gmd B_ (Two (a, b)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b) | gmd B_ (Three (a, b, c)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b)) (gmn B_ c) | gmd B_ (Four (a, b, c, d)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b)) (gmn B_ c)) (gmn B_ d); fun deep B_ pr m sf = Deep (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmd B_ pr) (gmft B_ m)) (gmd B_ sf), pr, m, sf); fun nrcons B_ Empty a = Single a | nrcons B_ (Single b) a = deep B_ (One b) Empty (One a) | nrcons B_ (Deep (uu, pr, m, One b)) a = deep B_ pr m (Two (b, a)) | nrcons B_ (Deep (uv, pr, m, Two (b, c))) a = deep B_ pr m (Three (b, c, a)) | nrcons B_ (Deep (uw, pr, m, Three (b, c, d))) a = deep B_ pr m (Four (b, c, d, a)) | nrcons B_ (Deep (ux, pr, m, Four (b, c, d, e))) a = deep B_ pr (nrcons B_ m (node3 B_ b c d)) (Two (e, a)); fun rconsNlist B_ t [] = t | rconsNlist B_ t (x :: xs) = rconsNlist B_ (nrcons B_ t x) xs; fun nlcons B_ a Empty = Single a | nlcons B_ a (Single b) = deep B_ (One a) Empty (One b) | nlcons B_ a (Deep (uu, One b, m, sf)) = deep B_ (Two (a, b)) m sf | nlcons B_ a (Deep (uv, Two (b, c), m, sf)) = deep B_ (Three (a, b, c)) m sf | nlcons B_ a (Deep (uw, Three (b, c, d), m, sf)) = deep B_ (Four (a, b, c, d)) m sf | nlcons B_ a (Deep (ux, Four (b, c, d, e), m, sf)) = deep B_ (Two (a, b)) (nlcons B_ (node3 B_ c d e) m) sf; fun lconsNlist B_ [] t = t | lconsNlist B_ (x :: xs) t = nlcons B_ x (lconsNlist B_ xs t); fun node2 B_ nd1 nd2 = Node2 (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ nd1) (gmn B_ nd2), nd1, nd2); fun nodes B_ [a, b] = [node2 B_ a b] | nodes B_ [a, b, c] = [node3 B_ a b c] | nodes B_ [a, b, c, d] = [node2 B_ a b, node2 B_ c d] | nodes B_ (a :: b :: c :: v :: vb :: vc) = node3 B_ a b c :: nodes B_ (v :: vb :: vc); fun app3 B_ Empty xs t = lconsNlist B_ xs t | app3 B_ (Single v) xs Empty = rconsNlist B_ (Single v) xs | app3 B_ (Deep (v, va, vb, vc)) xs Empty = rconsNlist B_ (Deep (v, va, vb, vc)) xs | app3 B_ (Single x) xs (Single v) = nlcons B_ x (lconsNlist B_ xs (Single v)) | app3 B_ (Single x) xs (Deep (v, va, vb, vc)) = nlcons B_ x (lconsNlist B_ xs (Deep (v, va, vb, vc))) | app3 B_ (Deep (v, va, vb, vc)) xs (Single x) = nrcons B_ (rconsNlist B_ (Deep (v, va, vb, vc)) xs) x | app3 B_ (Deep (uu, pr1, m1, sf1)) ts (Deep (uv, pr2, m2, sf2)) = deep B_ pr1 (app3 B_ m1 (nodes B_ (digitToNlist sf1 @ ts @ digitToNlist pr2)) m2) sf2; fun appa B_ t1 t2 = app3 B_ t1 [] t2; fun app B_ s t = Abs_FingerTree (appa B_ (rep_FingerTree B_ s) (rep_FingerTree B_ t)); fun annota B_ t = gmft B_ t; fun annot B_ t = annota B_ (rep_FingerTree B_ t); fun empty B_ = Abs_FingerTree Empty; fun lconsa B_ a t = nlcons B_ (Tip (Product_Type.fst a, Product_Type.snd a)) t; fun lcons B_ a t = Abs_FingerTree (lconsa B_ a (rep_FingerTree B_ t)); fun isEmptya t = (case t of Empty => true | Single _ => false | Deep (_, _, _, _) => false); fun isEmpty B_ t = isEmptya (rep_FingerTree B_ t); fun nodeToDigit (Tip (e, a)) = One (Tip (e, a)) | nodeToDigit (Node2 (uu, a, b)) = Two (a, b) | nodeToDigit (Node3 (uv, a, b, c)) = Three (a, b, c); fun nlistToTree B_ xs = lconsNlist B_ xs Empty; fun splitNlist A_ p i [a] = ([], (a, [])) | splitNlist A_ p i (a :: v :: va) = let val i2 = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) i (gmn A_ a); in (if p i2 then ([], (a, v :: va)) else let val (l, (x, r)) = splitNlist A_ p i2 (v :: va); in (a :: l, (x, r)) end) end; fun splitDigit A_ p i d = splitNlist A_ p i (digitToNlist d); fun nlistToDigit [a] = One a | nlistToDigit [a, b] = Two (a, b) | nlistToDigit [a, b, c] = Three (a, b, c) | nlistToDigit [a, b, c, d] = Four (a, b, c, d); fun digitToTree B_ (One a) = Single a | digitToTree B_ (Two (a, b)) = deep B_ (One a) Empty (One b) | digitToTree B_ (Three (a, b, c)) = deep B_ (Two (a, b)) Empty (One c) | digitToTree B_ (Four (a, b, c, d)) = deep B_ (Two (a, b)) Empty (Two (c, d)); fun viewRn B_ Empty = NONE | viewRn B_ (Single a) = SOME (a, Empty) | viewRn B_ (Deep (uu, pr, m, Two (a, b))) = SOME (b, deep B_ pr m (One a)) | viewRn B_ (Deep (uv, pr, m, Three (a, b, c))) = SOME (c, deep B_ pr m (Two (a, b))) | viewRn B_ (Deep (uw, pr, m, Four (a, b, c, d))) = SOME (d, deep B_ pr m (Three (a, b, c))) | viewRn B_ (Deep (ux, pr, m, One a)) = (case viewRn B_ m of NONE => SOME (a, digitToTree B_ pr) | SOME b => let val (ba, m2) = b; in SOME (a, deep B_ pr m2 (nodeToDigit ba)) end); fun deepR B_ pr m [] = (case viewRn B_ m of NONE => digitToTree B_ pr | SOME a => let val (aa, m2) = a; in deep B_ pr m2 (nodeToDigit aa) end) | deepR B_ pr m (v :: va) = deep B_ pr m (nlistToDigit (v :: va)); fun viewLn B_ Empty = NONE | viewLn B_ (Single a) = SOME (a, Empty) | viewLn B_ (Deep (uu, Two (a, b), m, sf)) = SOME (a, deep B_ (One b) m sf) | viewLn B_ (Deep (uv, Three (a, b, c), m, sf)) = SOME (a, deep B_ (Two (b, c)) m sf) | viewLn B_ (Deep (uw, Four (a, b, c, d), m, sf)) = SOME (a, deep B_ (Three (b, c, d)) m sf) | viewLn B_ (Deep (ux, One a, m, sf)) = (case viewLn B_ m of NONE => SOME (a, digitToTree B_ sf) | SOME b => let val (ba, m2) = b; in SOME (a, deep B_ (nodeToDigit ba) m2 sf) end); fun deepL B_ [] m sf = (case viewLn B_ m of NONE => digitToTree B_ sf | SOME a => let val (aa, m2) = a; in deep B_ (nodeToDigit aa) m2 sf end) | deepL B_ (v :: va) m sf = deep B_ (nlistToDigit (v :: va)) m sf; fun nsplitTree A_ p i Empty = (Empty, (Tip ((raise Fail "undefined"), (raise Fail "undefined")), Empty)) | nsplitTree A_ p i (Single ea) = (Empty, (ea, Empty)) | nsplitTree A_ p i (Deep (uu, pr, m, sf)) = let val vpr = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) i (gmd A_ pr); val vm = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) vpr (gmft A_ m); in (if p vpr then let val (l, (x, r)) = splitDigit A_ p i pr; in (nlistToTree A_ l, (x, deepL A_ r m sf)) end else (if p vm then let val (ml, (xs, mr)) = nsplitTree A_ p vpr m; val (l, (x, r)) = splitDigit A_ p (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) vpr (gmft A_ ml)) (nodeToDigit xs); in (deepR A_ pr ml l, (x, deepL A_ r mr sf)) end else let val (l, (x, r)) = splitDigit A_ p vm sf; in (deepR A_ pr m l, (x, nlistToTree A_ r)) end)) end; fun n_unwrap (Tip (e, a)) = (e, a) | n_unwrap (Node2 (uu, a, b)) = (raise Fail "undefined") | n_unwrap (Node3 (uv, a, b, c)) = (raise Fail "undefined"); fun splitTreea A_ p i t = let val (l, (x, r)) = nsplitTree A_ p i t; in (l, (n_unwrap x, r)) end; fun splitTree_aux B_ p i t = Abs_splitres (if not (p i) andalso p (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) i (annot B_ t)) then splitTreea B_ p i (rep_FingerTree B_ t) else (Empty, ((raise Fail "undefined"), Empty))); fun splitTree A_ p i t = extract_splitres A_ (splitTree_aux A_ p i t); end; (*struct FingerTree*) structure FTAnnotatedListImpl : sig val ft_app : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> ('a, 'b) FingerTree.fingerTree -> ('a, 'b) FingerTree.fingerTree val ft_annot : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> 'b val ft_consl : 'b Arith.monoid_add -> 'a -> 'b -> ('a, 'b) FingerTree.fingerTree -> ('a, 'b) FingerTree.fingerTree val ft_empty : 'b Arith.monoid_add -> unit -> ('a, 'b) FingerTree.fingerTree val ft_splits : 'a Arith.monoid_add -> ('a -> bool) -> 'a -> ('b, 'a) FingerTree.fingerTree -> ('b, 'a) FingerTree.fingerTree * (('b * 'a) * ('b, 'a) FingerTree.fingerTree) val ft_isEmpty : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> bool end = struct fun ft_app B_ = FingerTree.app B_; fun ft_annot B_ = FingerTree.annot B_; fun ft_consl B_ e a s = FingerTree.lcons B_ (e, a) s; fun ft_empty B_ = (fn _ => FingerTree.empty B_); fun ft_splits A_ = FingerTree.splitTree A_; fun ft_isEmpty B_ = FingerTree.isEmpty B_; end; (*struct FTAnnotatedListImpl*) structure FTPrioImpl : sig val test_codegen : 'b Orderings.linorder -> 'd Orderings.linorder -> 'f Orderings.linorder -> 'h Orderings.linorder -> 'j Orderings.linorder -> 'l Orderings.linorder -> (unit -> (unit, ('a, 'b) PrioByAnnotatedList.prio) FingerTree.fingerTree) * (((unit, ('c, 'd) PrioByAnnotatedList.prio) FingerTree.fingerTree -> bool) * (('e -> 'f -> (unit, ('e, 'f) PrioByAnnotatedList.prio) FingerTree.fingerTree -> (unit, ('e, 'f) PrioByAnnotatedList.prio) FingerTree.fingerTree) * (((unit, ('g, 'h) PrioByAnnotatedList.prio) FingerTree.fingerTree -> 'g * 'h) * (((unit, ('i, 'j) PrioByAnnotatedList.prio) FingerTree.fingerTree -> (unit, ('i, 'j) PrioByAnnotatedList.prio) FingerTree.fingerTree) * ((unit, ('k, 'l) PrioByAnnotatedList.prio) FingerTree.fingerTree -> (unit, ('k, 'l) PrioByAnnotatedList.prio) FingerTree.fingerTree -> (unit, ('k, 'l) PrioByAnnotatedList.prio) FingerTree.fingerTree))))) end = struct fun test_codegen B_ D_ F_ H_ J_ L_ = (PrioByAnnotatedList.alprio_empty (FTAnnotatedListImpl.ft_empty (PrioByAnnotatedList.monoid_add_Prio B_)), (PrioByAnnotatedList.alprio_isEmpty (FTAnnotatedListImpl.ft_isEmpty (PrioByAnnotatedList.monoid_add_Prio D_)), (PrioByAnnotatedList.alprio_insert F_ (FTAnnotatedListImpl.ft_consl (PrioByAnnotatedList.monoid_add_Prio F_)), (PrioByAnnotatedList.alprio_find H_ (FTAnnotatedListImpl.ft_annot (PrioByAnnotatedList.monoid_add_Prio H_)), (PrioByAnnotatedList.alprio_delete J_ (FTAnnotatedListImpl.ft_splits (PrioByAnnotatedList.monoid_add_Prio J_)) (FTAnnotatedListImpl.ft_annot (PrioByAnnotatedList.monoid_add_Prio J_)) (FTAnnotatedListImpl.ft_app (PrioByAnnotatedList.monoid_add_Prio J_)), PrioByAnnotatedList.alprio_meld (FTAnnotatedListImpl.ft_app (PrioByAnnotatedList.monoid_add_Prio L_))))))); end; (*struct FTPrioImpl*) ### theory "Collections.FTPrioImpl" ### 0.735s elapsed time, 1.476s cpu time, 0.000s GC time Loading theory "Collections.SetSpec" locale set fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" locale set_no_invar fixes \ :: "'a \ 'b set" and invar :: "'a \ bool" assumes "set_no_invar invar" locale set_empty fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and empty :: "unit \ 's" assumes "set_empty \ invar empty" locale set_memb fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and memb :: "'x \ 's \ bool" assumes "set_memb \ invar memb" locale set_ins fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and ins :: "'x \ 's \ 's" assumes "set_ins \ invar ins" locale set_ins_dj fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and ins_dj :: "'x \ 's \ 's" assumes "set_ins_dj \ invar ins_dj" locale set_delete fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and delete :: "'x \ 's \ 's" assumes "set_delete \ invar delete" locale set_isEmpty fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and isEmpty :: "'s \ bool" assumes "set_isEmpty \ invar isEmpty" locale set_ball fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and ball :: "'s \ ('x \ bool) \ bool" assumes "set_ball \ invar ball" locale set_bex fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and bex :: "'s \ ('x \ bool) \ bool" assumes "set_bex \ invar bex" locale finite_set fixes \ :: "'a \ 'b set" and invar :: "'a \ bool" assumes "finite_set \ invar" locale set_size fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and size :: "'s \ nat" assumes "set_size \ invar size" locale set_size_abort fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and size_abort :: "nat \ 's \ nat" assumes "set_size_abort \ invar size_abort" locale set_sng fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and sng :: "'x \ 's" assumes "set_sng \ invar sng" locale set_isSng fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and isSng :: "'s \ bool" assumes "set_isSng \ invar isSng" locale poly_set_iteratei_defs fixes list_it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" locale poly_set_iteratei fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and list_it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" assumes "poly_set_iteratei \ invar list_it" locale set_copy fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and copy :: "'s1 \ 's2" assumes "set_copy \1 invar1 \2 invar2 copy" locale set_union fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and \3 :: "'s3 \ 'a set" and invar3 :: "'s3 \ bool" and union :: "'s1 \ 's2 \ 's3" assumes "set_union \1 invar1 \2 invar2 \3 invar3 union" locale set_union_dj fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and \3 :: "'s3 \ 'a set" and invar3 :: "'s3 \ bool" and union_dj :: "'s1 \ 's2 \ 's3" assumes "set_union_dj \1 invar1 \2 invar2 \3 invar3 union_dj" locale set_union_list fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and union_list :: "'s1 list \ 's2" assumes "set_union_list \1 invar1 \2 invar2 union_list" locale set_diff fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and diff :: "'s1 \ 's2 \ 's1" assumes "set_diff \1 invar1 \2 invar2 diff" locale set_inter fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and \3 :: "'s3 \ 'a set" and invar3 :: "'s3 \ bool" and inter :: "'s1 \ 's2 \ 's3" assumes "set_inter \1 invar1 \2 invar2 \3 invar3 inter" locale set_subset fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and subset :: "'s1 \ 's2 \ bool" assumes "set_subset \1 invar1 \2 invar2 subset" locale set_equal fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and equal :: "'s1 \ 's2 \ bool" assumes "set_equal \1 invar1 \2 invar2 equal" locale set_image_filter fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'b set" and invar2 :: "'s2 \ bool" and image_filter :: "('a \ 'b option) \ 's1 \ 's2" assumes "set_image_filter \1 invar1 \2 invar2 image_filter" locale set_inj_image_filter fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'b set" and invar2 :: "'s2 \ bool" and inj_image_filter :: "('a \ 'b option) \ 's1 \ 's2" assumes "set_inj_image_filter \1 invar1 \2 invar2 inj_image_filter" locale set_image fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'b set" and invar2 :: "'s2 \ bool" and image :: "('a \ 'b) \ 's1 \ 's2" assumes "set_image \1 invar1 \2 invar2 image" locale set_inj_image fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'b set" and invar2 :: "'s2 \ bool" and inj_image :: "('a \ 'b) \ 's1 \ 's2" assumes "set_inj_image \1 invar1 \2 invar2 inj_image" locale set_filter fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and filter :: "('a \ bool) \ 's1 \ 's2" assumes "set_filter \1 invar1 \2 invar2 filter" locale set_Union_image fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'b set" and invar2 :: "'s2 \ bool" and \3 :: "'s3 \ 'b set" and invar3 :: "'s3 \ bool" and Union_image :: "('a \ 's2) \ 's1 \ 's3" assumes "set_Union_image \1 invar1 \2 invar2 \3 invar3 Union_image" locale set_disjoint fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and disjoint :: "'s1 \ 's2 \ bool" assumes "set_disjoint \1 invar1 \2 invar2 disjoint" locale set_disjoint_witness fixes \1 :: "'s1 \ 'a set" and invar1 :: "'s1 \ bool" and \2 :: "'s2 \ 'a set" and invar2 :: "'s2 \ bool" and disjoint_witness :: "'s1 \ 's2 \ 'a option" assumes "set_disjoint_witness \1 invar1 \2 invar2 disjoint_witness" locale set_sel fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and sel :: "'s \ ('x \ 'r option) \ 'r option" assumes "set_sel \ invar sel" locale set_sel' fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and sel' :: "'s \ ('x \ bool) \ 'x option" assumes "set_sel' \ invar sel'" locale set_to_list fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and to_list :: "'s \ 'x list" assumes "set_to_list \ invar to_list" locale list_to_set fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and to_set :: "'x list \ 's" assumes "list_to_set \ invar to_set" locale ordered_set fixes \ :: "'s \ 'u set" and invar :: "'s \ bool" locale ordered_finite_set fixes \ :: "'s \ 'u set" and invar :: "'s \ bool" assumes "ordered_finite_set \ invar" locale poly_set_iterateoi_defs fixes olist_it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" ### Missing patterns in function definition: ### p_unwrap Infty = undefined locale poly_set_iterateoi fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and list_ordered_it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" assumes "poly_set_iterateoi \ invar list_ordered_it" Found termination order: "{}" locale poly_set_rev_iterateoi_defs fixes list_rev_it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" locale poly_set_rev_iterateoi fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and list_rev_it :: "'s \ ('x list \ bool) \ ('x \ 'x list \ 'x list) \ 'x list \ 'x list" assumes "poly_set_rev_iterateoi \ invar list_rev_it" locale set_min fixes \ :: "'s \ 'u set" and invar :: "'s \ bool" and min :: "'s \ ('u \ bool) \ 'u option" assumes "set_min \ invar min" Found termination order: "{}" locale set_max fixes \ :: "'s \ 'u set" and invar :: "'s \ bool" and max :: "'s \ ('u \ bool) \ 'u option" assumes "set_max \ invar max" locale set_to_sorted_list fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and to_sorted_list :: "'s \ 'x list" assumes "SetSpec.set_to_sorted_list \ invar to_sorted_list" locale set_to_rev_list fixes \ :: "'s \ 'x set" and invar :: "'s \ bool" and to_rev_list :: "'s \ 'x list" assumes "set_to_rev_list \ invar to_rev_list" Found termination order: "{}" instantiation LP :: (linorder, linorder) monoid_add zero_LP == zero_class.zero :: ('a, 'b) LP plus_LP == plus :: ('a, 'b) LP \ ('a, 'b) LP \ ('a, 'b) LP Found termination order: "{}" Found termination order: "{}" instantiation LP :: (type, linorder) preorder less_eq_LP == less_eq :: ('a, 'b) LP \ ('a, 'b) LP \ bool less_LP == less :: ('a, 'b) LP \ ('a, 'b) LP \ bool locale aluprio_defs fixes ops :: "(unit, ('e, 'a) LP, 's) alist_ops" locale aluprio fixes ops :: "(unit, ('e, 'a) LP, 's) alist_ops" assumes "aluprio ops" ### theory "Collections.PrioUniqueByAnnotatedList" ### 2.314s elapsed time, 4.588s cpu time, 0.756s GC time Loading theory "Collections.FTPrioUniqueImpl" locale StdSetDefs fixes ops :: "('x, 's, 'more) set_ops_scheme" locale StdSet fixes ops :: "('x, 's, 'more) set_ops_scheme" assumes "StdSet ops" locale StdSet_no_invar fixes ops :: "('a, 'b, 'c) set_ops_scheme" assumes "StdSet_no_invar ops" structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Arith : sig type 'a plus val plus : 'a plus -> 'a -> 'a -> 'a type 'a semigroup_add val plus_semigroup_add : 'a semigroup_add -> 'a plus type 'a zero val zero : 'a zero -> 'a type 'a monoid_add val semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add val zero_monoid_add : 'a monoid_add -> 'a zero end = struct type 'a plus = {plus : 'a -> 'a -> 'a}; val plus = #plus : 'a plus -> 'a -> 'a -> 'a; type 'a semigroup_add = {plus_semigroup_add : 'a plus}; val plus_semigroup_add = #plus_semigroup_add : 'a semigroup_add -> 'a plus; type 'a zero = {zero : 'a}; val zero = #zero : 'a zero -> 'a; type 'a monoid_add = {semigroup_add_monoid_add : 'a semigroup_add, zero_monoid_add : 'a zero}; val semigroup_add_monoid_add = #semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add; val zero_monoid_add = #zero_monoid_add : 'a monoid_add -> 'a zero; end; (*struct Arith*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order val max : 'a ord -> 'a -> 'a -> 'a val min : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; fun max A_ a b = (if less_eq A_ a b then b else a); fun min A_ a b = (if less_eq A_ a b then a else b); end; (*struct Orderings*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure FingerTree : sig type ('a, 'b) fingerTreeStruc type ('b, 'a) splitres type ('b, 'a) fingerTree val app : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree -> ('a, 'b) fingerTree val annot : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'b val empty : 'b Arith.monoid_add -> ('a, 'b) fingerTree val rcons : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> 'a * 'b -> ('a, 'b) fingerTree val isEmpty : 'b Arith.monoid_add -> ('a, 'b) fingerTree -> bool val splitTree : 'a Arith.monoid_add -> ('a -> bool) -> 'a -> ('b, 'a) fingerTree -> ('b, 'a) fingerTree * (('b * 'a) * ('b, 'a) fingerTree) end = struct datatype ('a, 'b) node = Tip of 'a * 'b | Node2 of 'b * ('a, 'b) node * ('a, 'b) node | Node3 of 'b * ('a, 'b) node * ('a, 'b) node * ('a, 'b) node; datatype ('a, 'b) digit = One of ('a, 'b) node | Two of ('a, 'b) node * ('a, 'b) node | Three of ('a, 'b) node * ('a, 'b) node * ('a, 'b) node | Four of ('a, 'b) node * ('a, 'b) node * ('a, 'b) node * ('a, 'b) node; datatype ('a, 'b) fingerTreeStruc = Empty | Single of ('a, 'b) node | Deep of 'b * ('a, 'b) digit * ('a, 'b) fingerTreeStruc * ('a, 'b) digit; datatype ('b, 'a) splitres = Abs_splitres of (('b, 'a) fingerTreeStruc * (('b * 'a) * ('b, 'a) fingerTreeStruc)); datatype ('b, 'a) fingerTree = Abs_FingerTree of ('b, 'a) fingerTreeStruc; fun rep_splitres A_ (Abs_splitres x) = x; fun extract_splitres_r B_ r = Abs_FingerTree let val (_, (_, ra)) = rep_splitres B_ r; in ra end; fun extract_splitres_l B_ r = Abs_FingerTree let val (l, (_, _)) = rep_splitres B_ r; in l end; fun extract_splitres_a B_ r = let val (_, a) = rep_splitres B_ r; val (aa, _) = a; in aa end; fun extract_splitres B_ r = (extract_splitres_l B_ r, (extract_splitres_a B_ r, extract_splitres_r B_ r)); fun rep_FingerTree A_ (Abs_FingerTree x) = x; fun digitToNlist (One a) = [a] | digitToNlist (Two (a, b)) = [a, b] | digitToNlist (Three (a, b, c)) = [a, b, c] | digitToNlist (Four (a, b, c, d)) = [a, b, c, d]; fun gmn B_ (Tip (e, a)) = a | gmn B_ (Node2 (a, uu, uv)) = a | gmn B_ (Node3 (a, uw, ux, uy)) = a; fun node3 B_ nd1 nd2 nd3 = Node3 (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ nd1) (gmn B_ nd2)) (gmn B_ nd3), nd1, nd2, nd3); fun gmft B_ Empty = Arith.zero (Arith.zero_monoid_add B_) | gmft B_ (Single nd) = gmn B_ nd | gmft B_ (Deep (a, uu, uv, uw)) = a; fun gmd B_ (One a) = gmn B_ a | gmd B_ (Two (a, b)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b) | gmd B_ (Three (a, b, c)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b)) (gmn B_ c) | gmd B_ (Four (a, b, c, d)) = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ a) (gmn B_ b)) (gmn B_ c)) (gmn B_ d); fun deep B_ pr m sf = Deep (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmd B_ pr) (gmft B_ m)) (gmd B_ sf), pr, m, sf); fun nrcons B_ Empty a = Single a | nrcons B_ (Single b) a = deep B_ (One b) Empty (One a) | nrcons B_ (Deep (uu, pr, m, One b)) a = deep B_ pr m (Two (b, a)) | nrcons B_ (Deep (uv, pr, m, Two (b, c))) a = deep B_ pr m (Three (b, c, a)) | nrcons B_ (Deep (uw, pr, m, Three (b, c, d))) a = deep B_ pr m (Four (b, c, d, a)) | nrcons B_ (Deep (ux, pr, m, Four (b, c, d, e))) a = deep B_ pr (nrcons B_ m (node3 B_ b c d)) (Two (e, a)); fun rconsNlist B_ t [] = t | rconsNlist B_ t (x :: xs) = rconsNlist B_ (nrcons B_ t x) xs; fun nlcons B_ a Empty = Single a | nlcons B_ a (Single b) = deep B_ (One a) Empty (One b) | nlcons B_ a (Deep (uu, One b, m, sf)) = deep B_ (Two (a, b)) m sf | nlcons B_ a (Deep (uv, Two (b, c), m, sf)) = deep B_ (Three (a, b, c)) m sf | nlcons B_ a (Deep (uw, Three (b, c, d), m, sf)) = deep B_ (Four (a, b, c, d)) m sf | nlcons B_ a (Deep (ux, Four (b, c, d, e), m, sf)) = deep B_ (Two (a, b)) (nlcons B_ (node3 B_ c d e) m) sf; fun lconsNlist B_ [] t = t | lconsNlist B_ (x :: xs) t = nlcons B_ x (lconsNlist B_ xs t); fun node2 B_ nd1 nd2 = Node2 (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) (gmn B_ nd1) (gmn B_ nd2), nd1, nd2); fun nodes B_ [a, b] = [node2 B_ a b] | nodes B_ [a, b, c] = [node3 B_ a b c] | nodes B_ [a, b, c, d] = [node2 B_ a b, node2 B_ c d] | nodes B_ (a :: b :: c :: v :: vb :: vc) = node3 B_ a b c :: nodes B_ (v :: vb :: vc); fun app3 B_ Empty xs t = lconsNlist B_ xs t | app3 B_ (Single v) xs Empty = rconsNlist B_ (Single v) xs | app3 B_ (Deep (v, va, vb, vc)) xs Empty = rconsNlist B_ (Deep (v, va, vb, vc)) xs | app3 B_ (Single x) xs (Single v) = nlcons B_ x (lconsNlist B_ xs (Single v)) | app3 B_ (Single x) xs (Deep (v, va, vb, vc)) = nlcons B_ x (lconsNlist B_ xs (Deep (v, va, vb, vc))) | app3 B_ (Deep (v, va, vb, vc)) xs (Single x) = nrcons B_ (rconsNlist B_ (Deep (v, va, vb, vc)) xs) x | app3 B_ (Deep (uu, pr1, m1, sf1)) ts (Deep (uv, pr2, m2, sf2)) = deep B_ pr1 (app3 B_ m1 (nodes B_ (digitToNlist sf1 @ ts @ digitToNlist pr2)) m2) sf2; fun appa B_ t1 t2 = app3 B_ t1 [] t2; fun app B_ s t = Abs_FingerTree (appa B_ (rep_FingerTree B_ s) (rep_FingerTree B_ t)); fun annota B_ t = gmft B_ t; fun annot B_ t = annota B_ (rep_FingerTree B_ t); fun empty B_ = Abs_FingerTree Empty; fun rconsa B_ t a = nrcons B_ t (Tip (Product_Type.fst a, Product_Type.snd a)); fun rcons B_ t a = Abs_FingerTree (rconsa B_ (rep_FingerTree B_ t) a); fun isEmptya t = (case t of Empty => true | Single _ => false | Deep (_, _, _, _) => false); fun isEmpty B_ t = isEmptya (rep_FingerTree B_ t); fun nodeToDigit (Tip (e, a)) = One (Tip (e, a)) | nodeToDigit (Node2 (uu, a, b)) = Two (a, b) | nodeToDigit (Node3 (uv, a, b, c)) = Three (a, b, c); fun nlistToTree B_ xs = lconsNlist B_ xs Empty; fun splitNlist A_ p i [a] = ([], (a, [])) | splitNlist A_ p i (a :: v :: va) = let val i2 = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) i (gmn A_ a); in (if p i2 then ([], (a, v :: va)) else let val (l, (x, r)) = splitNlist A_ p i2 (v :: va); in (a :: l, (x, r)) end) end; fun splitDigit A_ p i d = splitNlist A_ p i (digitToNlist d); fun nlistToDigit [a] = One a | nlistToDigit [a, b] = Two (a, b) | nlistToDigit [a, b, c] = Three (a, b, c) | nlistToDigit [a, b, c, d] = Four (a, b, c, d); fun digitToTree B_ (One a) = Single a | digitToTree B_ (Two (a, b)) = deep B_ (One a) Empty (One b) | digitToTree B_ (Three (a, b, c)) = deep B_ (Two (a, b)) Empty (One c) | digitToTree B_ (Four (a, b, c, d)) = deep B_ (Two (a, b)) Empty (Two (c, d)); fun viewRn B_ Empty = NONE | viewRn B_ (Single a) = SOME (a, Empty) | viewRn B_ (Deep (uu, pr, m, Two (a, b))) = SOME (b, deep B_ pr m (One a)) | viewRn B_ (Deep (uv, pr, m, Three (a, b, c))) = SOME (c, deep B_ pr m (Two (a, b))) | viewRn B_ (Deep (uw, pr, m, Four (a, b, c, d))) = SOME (d, deep B_ pr m (Three (a, b, c))) | viewRn B_ (Deep (ux, pr, m, One a)) = (case viewRn B_ m of NONE => SOME (a, digitToTree B_ pr) | SOME b => let val (ba, m2) = b; in SOME (a, deep B_ pr m2 (nodeToDigit ba)) end); fun deepR B_ pr m [] = (case viewRn B_ m of NONE => digitToTree B_ pr | SOME a => let val (aa, m2) = a; in deep B_ pr m2 (nodeToDigit aa) end) | deepR B_ pr m (v :: va) = deep B_ pr m (nlistToDigit (v :: va)); fun viewLn B_ Empty = NONE | viewLn B_ (Single a) = SOME (a, Empty) | viewLn B_ (Deep (uu, Two (a, b), m, sf)) = SOME (a, deep B_ (One b) m sf) | viewLn B_ (Deep (uv, Three (a, b, c), m, sf)) = SOME (a, deep B_ (Two (b, c)) m sf) | viewLn B_ (Deep (uw, Four (a, b, c, d), m, sf)) = SOME (a, deep B_ (Three (b, c, d)) m sf) | viewLn B_ (Deep (ux, One a, m, sf)) = (case viewLn B_ m of NONE => SOME (a, digitToTree B_ sf) | SOME b => let val (ba, m2) = b; in SOME (a, deep B_ (nodeToDigit ba) m2 sf) end); fun deepL B_ [] m sf = (case viewLn B_ m of NONE => digitToTree B_ sf | SOME a => let val (aa, m2) = a; in deep B_ (nodeToDigit aa) m2 sf end) | deepL B_ (v :: va) m sf = deep B_ (nlistToDigit (v :: va)) m sf; fun nsplitTree A_ p i Empty = (Empty, (Tip ((raise Fail "undefined"), (raise Fail "undefined")), Empty)) | nsplitTree A_ p i (Single ea) = (Empty, (ea, Empty)) | nsplitTree A_ p i (Deep (uu, pr, m, sf)) = let val vpr = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) i (gmd A_ pr); val vm = Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) vpr (gmft A_ m); in (if p vpr then let val (l, (x, r)) = splitDigit A_ p i pr; in (nlistToTree A_ l, (x, deepL A_ r m sf)) end else (if p vm then let val (ml, (xs, mr)) = nsplitTree A_ p vpr m; val (l, (x, r)) = splitDigit A_ p (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) A_) vpr (gmft A_ ml)) (nodeToDigit xs); in (deepR A_ pr ml l, (x, deepL A_ r mr sf)) end else let val (l, (x, r)) = splitDigit A_ p vm sf; in (deepR A_ pr m l, (x, nlistToTree A_ r)) end)) end; fun n_unwrap (Tip (e, a)) = (e, a) | n_unwrap (Node2 (uu, a, b)) = (raise Fail "undefined") | n_unwrap (Node3 (uv, a, b, c)) = (raise Fail "undefined"); fun splitTreea A_ p i t = let val (l, (x, r)) = nsplitTree A_ p i t; in (l, (n_unwrap x, r)) end; fun splitTree_aux B_ p i t = Abs_splitres (if not (p i) andalso p (Arith.plus ((Arith.plus_semigroup_add o Arith.semigroup_add_monoid_add) B_) i (annot B_ t)) then splitTreea B_ p i (rep_FingerTree B_ t) else (Empty, ((raise Fail "undefined"), Empty))); fun splitTree A_ p i t = extract_splitres A_ (splitTree_aux A_ p i t); end; (*struct FingerTree*) structure PrioUniqueByAnnotatedList : sig type ('a, 'b) lp val monoid_add_LP : 'a Orderings.linorder -> 'b Orderings.linorder -> ('a, 'b) lp Arith.monoid_add val aluprio_pop : 'a Orderings.linorder -> 'b Orderings.linorder -> ((('a, 'b) lp -> bool) -> ('a, 'b) lp -> 'c -> 'c * ((unit * ('a, 'b) lp) * 'c)) -> ('c -> ('a, 'b) lp) -> ('c -> 'c -> 'c) -> 'c -> 'a * ('b * 'c) val aluprio_prio : 'a HOL.equal * 'a Orderings.linorder -> 'b Orderings.linorder -> ((('a, 'b) lp -> bool) -> ('a, 'b) lp -> 'c -> 'c * ((unit * ('a, 'b) lp) * 'c)) -> ('c -> ('a, 'b) lp) -> ('c -> bool) -> 'c -> 'a -> 'b option val aluprio_empty : 'a -> 'a val aluprio_insert : 'a Orderings.linorder -> 'b Orderings.linorder -> ((('a, 'b) lp -> bool) -> ('a, 'b) lp -> 'c -> 'c * ((unit * ('a, 'b) lp) * 'c)) -> ('c -> ('a, 'b) lp) -> ('c -> bool) -> ('c -> 'c -> 'c) -> ('c -> unit -> ('a, 'b) lp -> 'c) -> 'c -> 'a -> 'b -> 'c val aluprio_isEmpty : 'a -> 'a end = struct datatype ('a, 'b) lp = Infty | LP of 'a * 'b; fun p_min A_ B_ Infty Infty = Infty | p_min A_ B_ Infty (LP (e, a)) = LP (e, a) | p_min A_ B_ (LP (e, a)) Infty = LP (e, a) | p_min A_ B_ (LP (e1, a)) (LP (e2, b)) = LP (Orderings.max ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) e1 e2, Orderings.min ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) a b); fun plus_LPa A_ B_ a b = p_min A_ B_ a b; fun plus_LP A_ B_ = {plus = plus_LPa A_ B_} : ('a, 'b) lp Arith.plus; fun zero_LPa A_ B_ = Infty; fun zero_LP A_ B_ = {zero = zero_LPa A_ B_} : ('a, 'b) lp Arith.zero; fun semigroup_add_LP A_ B_ = {plus_semigroup_add = plus_LP A_ B_} : ('a, 'b) lp Arith.semigroup_add; fun monoid_add_LP A_ B_ = {semigroup_add_monoid_add = semigroup_add_LP A_ B_, zero_monoid_add = zero_LP A_ B_} : ('a, 'b) lp Arith.monoid_add; fun p_unwrap (LP (e, a)) = (e, a); fun e_less_eq A_ B_ e Infty = false | e_less_eq A_ B_ ea (LP (e, uu)) = Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) ea e; fun p_less_eq B_ (LP (e, a)) (LP (f, b)) = Orderings.less_eq ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) B_) a b | p_less_eq B_ uu Infty = true | p_less_eq B_ Infty (LP (e, a)) = false; fun less_eq_LP B_ = p_less_eq B_; fun aluprio_pop A_ B_ splits annot app s = let val a = splits (fn x => less_eq_LP B_ x (annot s)) Infty s; val (l, aa) = a; val (ab, b) = aa; in let val (_, lp) = ab; in (fn r => let val LP (e, ac) = lp; in (e, (ac, app l r)) end) end b end; fun aluprio_prio (A1_, A2_) B_ splits annot isEmpty s e = (if e_less_eq A2_ B_ e (annot s) andalso not (isEmpty s) then let val a = splits (e_less_eq A2_ B_ e) Infty s; val (_, aa) = a; val (ab, b) = aa; in let val (_, lp) = ab; in (fn _ => (if HOL.eq A1_ e (Product_Type.fst (p_unwrap lp)) then SOME (Product_Type.snd (p_unwrap lp)) else NONE)) end b end else NONE); fun aluprio_empty empt = empt; fun aluprio_insert A_ B_ splits annot isEmpty app consr s e a = (if e_less_eq A_ B_ e (annot s) andalso not (isEmpty s) then let val b = splits (e_less_eq A_ B_ e) Infty s; val (l, ba) = b; val (bb, c) = ba; in let val (_, lp) = bb; in (fn r => (if Orderings.less ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) e (Product_Type.fst (p_unwrap lp)) then app (consr (consr l () (LP (e, a))) () lp) r else app (consr l () (LP (e, a))) r)) end c end else consr s () (LP (e, a))); fun aluprio_isEmpty isEmpty = isEmpty; end; (*struct PrioUniqueByAnnotatedList*) structure FTAnnotatedListImpl : sig val ft_app : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> ('a, 'b) FingerTree.fingerTree -> ('a, 'b) FingerTree.fingerTree val ft_annot : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> 'b val ft_consr : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> 'a -> 'b -> ('a, 'b) FingerTree.fingerTree val ft_empty : 'b Arith.monoid_add -> unit -> ('a, 'b) FingerTree.fingerTree val ft_splits : 'a Arith.monoid_add -> ('a -> bool) -> 'a -> ('b, 'a) FingerTree.fingerTree -> ('b, 'a) FingerTree.fingerTree * (('b * 'a) * ('b, 'a) FingerTree.fingerTree) val ft_isEmpty : 'b Arith.monoid_add -> ('a, 'b) FingerTree.fingerTree -> bool end = struct fun ft_app B_ = FingerTree.app B_; fun ft_annot B_ = FingerTree.annot B_; fun ft_consr B_ s e a = FingerTree.rcons B_ s (e, a); fun ft_empty B_ = (fn _ => FingerTree.empty B_); fun ft_splits A_ = FingerTree.splitTree A_; fun ft_isEmpty B_ = FingerTree.isEmpty B_; end; (*struct FTAnnotatedListImpl*) structure FTPrioUniqueImpl : sig val test_codegen : 'a Orderings.linorder -> 'b Orderings.linorder -> 'c Orderings.linorder -> 'd Orderings.linorder -> 'e Orderings.linorder -> 'f Orderings.linorder -> 'g Orderings.linorder -> 'h Orderings.linorder -> 'i HOL.equal * 'i Orderings.linorder -> 'j Orderings.linorder -> (unit -> (unit, ('a, 'b) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree) * (((unit, ('c, 'd) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree -> bool) * (((unit, ('e, 'f) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree -> 'e -> 'f -> (unit, ('e, 'f) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree) * (((unit, ('g, 'h) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree -> 'g * ('h * (unit, ('g, 'h) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree)) * ((unit, ('i, 'j) PrioUniqueByAnnotatedList.lp) FingerTree.fingerTree -> 'i -> 'j option)))) end = struct fun test_codegen A_ B_ C_ D_ E_ F_ G_ H_ (I1_, I2_) J_ = (PrioUniqueByAnnotatedList.aluprio_empty (FTAnnotatedListImpl.ft_empty (PrioUniqueByAnnotatedList.monoid_add_LP A_ B_)), (PrioUniqueByAnnotatedList.aluprio_isEmpty (FTAnnotatedListImpl.ft_isEmpty (PrioUniqueByAnnotatedList.monoid_add_LP C_ D_)), (PrioUniqueByAnnotatedList.aluprio_insert E_ F_ (FTAnnotatedListImpl.ft_splits (PrioUniqueByAnnotatedList.monoid_add_LP E_ F_)) (FTAnnotatedListImpl.ft_annot (PrioUniqueByAnnotatedList.monoid_add_LP E_ F_)) (FTAnnotatedListImpl.ft_isEmpty (PrioUniqueByAnnotatedList.monoid_add_LP E_ F_)) (FTAnnotatedListImpl.ft_app (PrioUniqueByAnnotatedList.monoid_add_LP E_ F_)) (FTAnnotatedListImpl.ft_consr (PrioUniqueByAnnotatedList.monoid_add_LP E_ F_)), (PrioUniqueByAnnotatedList.aluprio_pop G_ H_ (FTAnnotatedListImpl.ft_splits (PrioUniqueByAnnotatedList.monoid_add_LP G_ H_)) (FTAnnotatedListImpl.ft_annot (PrioUniqueByAnnotatedList.monoid_add_LP G_ H_)) (FTAnnotatedListImpl.ft_app (PrioUniqueByAnnotatedList.monoid_add_LP G_ H_)), PrioUniqueByAnnotatedList.aluprio_prio (I1_, I2_) J_ (FTAnnotatedListImpl.ft_splits (PrioUniqueByAnnotatedList.monoid_add_LP I2_ J_)) (FTAnnotatedListImpl.ft_annot (PrioUniqueByAnnotatedList.monoid_add_LP I2_ J_)) (FTAnnotatedListImpl.ft_isEmpty (PrioUniqueByAnnotatedList.monoid_add_LP I2_ J_)))))); end; (*struct FTPrioUniqueImpl*) ### theory "Collections.FTPrioUniqueImpl" ### 0.731s elapsed time, 1.464s cpu time, 0.000s GC time Found termination order: "size <*mlex*> {}" locale StdOSetDefs fixes ops :: "('x, 's, 'more) oset_ops_scheme" Found termination order: "(\p. length (fst p)) <*mlex*> {}" ### Introduced fixed type variable(s): 'd in "ks__" locale StdOSet fixes ops :: "('x, 's, 'more) oset_ops_scheme" assumes "StdOSet ops" ### theory "Collections.SetSpec" ### 4.090s elapsed time, 8.080s cpu time, 1.584s GC time Loading theory "Collections.Algos" Loading theory "Collections.SetIndex" locale index_loc fixes m_ops :: "('i, 's, 'm, 'more1) map_ops_scheme" and s_ops :: "('x, 's, 'more2) set_ops_scheme" assumes "index_loc m_ops s_ops" locale map_to_nat_loc fixes s_ops :: "('x, 's, 'more1) set_ops_scheme" and m_ops :: "('x, nat, 'm, 'more2) map_ops_scheme" assumes "map_to_nat_loc s_ops m_ops" locale build_index_loc fixes m_ops :: "('i, 's, 'm, 'more1) map_ops_scheme" and s_ops :: "('x, 's, 'more3) set_ops_scheme" and t_ops :: "('x, 't, 'more2) set_ops_scheme" assumes "build_index_loc m_ops s_ops t_ops" locale it_dom_fun_to_map_loc fixes s_ops :: "('k, 's, 'more1) set_ops_scheme" and m_ops :: "('k, 'v, 'm, 'more2) map_ops_scheme" assumes "it_dom_fun_to_map_loc s_ops m_ops" ### theory "Collections.SetIndex" ### 0.512s elapsed time, 1.024s cpu time, 0.000s GC time Loading theory "Collections.SetIteratorCollectionsGA" (required by "Collections.MapGA") locale set_to_list_defs_loc fixes s_ops :: "('x, 's, 'more1) set_ops_scheme" and l_ops :: "('x, 'l, 'more2) list_ops_scheme" locale set_to_list_loc fixes s_ops :: "('x, 's, 'more1) set_ops_scheme" and l_ops :: "('x, 'l, 'more2) list_ops_scheme" assumes "set_to_list_loc s_ops l_ops" ### theory "Collections.Algos" ### 0.640s elapsed time, 1.284s cpu time, 0.000s GC time ### theory "Collections.SetIteratorCollectionsGA" ### 0.377s elapsed time, 0.756s cpu time, 0.000s GC time Loading theory "Collections.MapGA" Loading theory "Collections.SetGA" locale g_set_xx_defs_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('x, 's2, 'more2) set_ops_scheme" locale g_set_xx_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('x, 's2, 'more2) set_ops_scheme" assumes "g_set_xx_loc ops1 ops2" locale g_set_xxx_defs_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('x, 's2, 'more2) set_ops_scheme" and ops3 :: "('x, 's3, 'more3) set_ops_scheme" locale g_set_xxx_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('x, 's2, 'more2) set_ops_scheme" and ops3 :: "('x, 's3, 'more3) set_ops_scheme" assumes "g_set_xxx_loc ops1 ops2 ops3" locale g_set_xy_defs_loc fixes ops1 :: "('x1, 's1, 'more1) set_ops_scheme" and ops2 :: "('x2, 's2, 'more2) set_ops_scheme" assumes "g_set_xy_defs_loc ops1 ops2" locale StdBasicMapDefs fixes ops :: "('k, 'v, 's, 'more) map_basic_ops_scheme" locale StdBasicOMapDefs fixes ops :: "('k, 'v, 's, 'more) omap_basic_ops_scheme" locale g_set_xy_loc fixes ops1 :: "('x1, 's1, 'more1) set_ops_scheme" and ops2 :: "('x2, 's2, 'more2) set_ops_scheme" assumes "g_set_xy_loc ops1 ops2" locale StdBasicMap fixes ops :: "('k, 'v, 's, 'more) map_basic_ops_scheme" assumes "StdBasicMap ops" locale StdBasicOMap fixes ops :: "('k, 'v, 's, 'more) omap_basic_ops_scheme" assumes "StdBasicOMap ops" locale StdBasicMapDefs fixes ops :: "('k, 'v, 's, 'more) map_basic_ops_scheme" locale g_set_xyy_defs_loc fixes ops0 :: "('x0, 's0, 'more0) set_ops_scheme" and ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('x, 's2, 'more2) set_ops_scheme" locale g_set_xyy_loc fixes ops0 :: "('x0, 's0, 'more0) set_ops_scheme" and ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('x, 's2, 'more2) set_ops_scheme" assumes "g_set_xyy_loc ops0 ops1 ops2" locale StdBasicMap fixes ops :: "('k, 'v, 's, 'more) map_basic_ops_scheme" assumes "StdBasicMap ops" locale StdBasicOMapDefs fixes ops :: "('k, 'v, 's, 'more) omap_basic_ops_scheme" locale StdBasicOMap fixes ops :: "('k, 'v, 's, 'more) omap_basic_ops_scheme" assumes "StdBasicOMap ops" locale g_image_filter_defs_loc fixes ops1 :: "('k1, 'v1, 's1, 'm1) map_ops_scheme" and ops2 :: "('k2, 'v2, 's2, 'm2) map_ops_scheme" locale StdBasicSetDefs fixes ops :: "('x, 's, 'more) set_basic_ops_scheme" locale StdBasicOSetDefs fixes ops :: "('x, 's, 'more) oset_basic_ops_scheme" locale g_image_filter_loc fixes ops1 :: "('k1, 'v1, 's1, 'm1) map_ops_scheme" and ops2 :: "('k2, 'v2, 's2, 'm2) map_ops_scheme" assumes "g_image_filter_loc ops1 ops2" locale StdBasicSet fixes ops :: "('x, 's, 'more) set_basic_ops_scheme" assumes "StdBasicSet ops" locale g_value_image_filter_defs_loc fixes ops1 :: "('k, 'v1, 's1, 'm1) map_ops_scheme" and ops2 :: "('k, 'v2, 's2, 'm2) map_ops_scheme" locale StdBasicOSet fixes ops :: "('x, 's, 'more) oset_basic_ops_scheme" assumes "StdBasicOSet ops" locale StdBasicSetDefs fixes ops :: "('x, 's, 'more) set_basic_ops_scheme" locale g_value_image_filter_loc fixes ops1 :: "('k, 'v1, 's1, 'm1) map_ops_scheme" and ops2 :: "('k, 'v2, 's2, 'm2) map_ops_scheme" assumes "g_value_image_filter_loc ops1 ops2" ### theory "Collections.MapGA" ### 2.320s elapsed time, 4.604s cpu time, 0.656s GC time Loading theory "Collections.ArrayMapImpl" (required by "Collections.MapStdImpl") Found termination order: "(\p. length (snd p)) <*mlex*> {}" locale StdBasicSet fixes ops :: "('x, 's, 'more) set_basic_ops_scheme" assumes "StdBasicSet ops" Found termination order: "(\p. size (fst p)) <*mlex*> {}" locale StdBasicSet fixes ops :: "('x, 's, 'more) set_basic_ops_scheme" assumes "StdBasicSet ops" locale StdBasicOSetDefs fixes ops :: "('x, 's, 'more) oset_basic_ops_scheme" locale StdBasicOSet fixes ops :: "('x, 's, 'more) oset_basic_ops_scheme" assumes "StdBasicOSet ops" locale image_filter_cp_defs_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('y, 's2, 'more2) set_ops_scheme" and ops3 :: "('z, 's3, 'more3) set_ops_scheme" locale image_filter_cp_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('y, 's2, 'more2) set_ops_scheme" and ops3 :: "('z, 's3, 'more3) set_ops_scheme" assumes "image_filter_cp_loc ops1 ops2 ops3" locale inj_image_filter_cp_defs_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('y, 's2, 'more2) set_ops_scheme" and ops3 :: "('z, 's3, 'more3) set_ops_scheme" locale inj_image_filter_cp_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('y, 's2, 'more2) set_ops_scheme" and ops3 :: "('z, 's3, 'more3) set_ops_scheme" assumes "inj_image_filter_cp_loc ops1 ops2 ops3" locale cart_defs_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('y, 's2, 'more2) set_ops_scheme" and ops3 :: "('x \ 'y, 's3, 'more3) set_ops_scheme" locale cart_loc fixes ops1 :: "('x, 's1, 'more1) set_ops_scheme" and ops2 :: "('y, 's2, 'more2) set_ops_scheme" and ops3 :: "('x \ 'y, 's3, 'more3) set_ops_scheme" assumes "cart_loc ops1 ops2 ops3" ### theory "Collections.SetGA" ### 3.882s elapsed time, 7.732s cpu time, 0.656s GC time Loading theory "Collections.ListMapImpl" (required by "Collections.MapStdImpl") structure STArray = struct datatype 'a Cell = Invalid | Value of 'a array; exception AccessedOldVersion; type 'a array = 'a Cell Unsynchronized.ref; fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun array (size, v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun sub (Unsynchronized.ref Invalid, idx) = raise AccessedOldVersion | sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx); fun update (aref,idx,v) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( aref := Invalid; Array.update (a,idx,v); Unsynchronized.ref (Value a) ); fun length (Unsynchronized.ref Invalid) = raise AccessedOldVersion | length (Unsynchronized.ref (Value a)) = Array.length a fun grow (aref, i, x) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+i,x) in aref := Invalid; Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( aref:=Invalid; Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); end; end; structure FArray = struct datatype 'a Cell = Value of 'a Array.array | Upd of (int*'a*'a Cell Unsynchronized.ref); type 'a array = 'a Cell Unsynchronized.ref; fun array (size,v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx) | sub (Unsynchronized.ref (Upd (i,v,cr)),idx) = if i=idx then v else sub (cr,idx); fun length (Unsynchronized.ref (Value a)) = Array.length a | length (Unsynchronized.ref (Upd (i,v,cr))) = length cr; fun realize_aux (aref, v) = case aref of (Unsynchronized.ref (Value a)) => ( let val len = Array.length a; val a' = Array.array (len,v); in Array.copy {src=a, dst=a', di=0}; Unsynchronized.ref (Value a') end ) | (Unsynchronized.ref (Upd (i,v,cr))) => ( let val res=realize_aux (cr,v) in case res of (Unsynchronized.ref (Value a)) => (Array.update (a,i,v); res) end ); fun realize aref = case aref of (Unsynchronized.ref (Value _)) => aref | (Unsynchronized.ref (Upd (i,v,cr))) => realize_aux(aref,v); fun update (aref,idx,v) = case aref of (Unsynchronized.ref (Value a)) => ( let val nref=Unsynchronized.ref (Value a) in aref := Upd (idx,Array.sub(a,idx),nref); Array.update (a,idx,v); nref end ) | (Unsynchronized.ref (Upd _)) => let val ra = realize_aux(aref,v) in case ra of (Unsynchronized.ref (Value a)) => Array.update (a,idx,v); ra end ; fun grow (aref, inc, x) = case aref of (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+inc,x) in Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ) | (Unsynchronized.ref (Upd _)) => ( grow (realize aref, inc, x) ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ) | (Unsynchronized.ref (Upd _)) => ( shrink (realize aref,sz) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); fun array_get_oo (d:'a) (a:'a ArrayType) (i:IntInf.int) = sub (a,IntInf.toInt i) handle Subscript => d fun array_set_oo (d:(unit->'a ArrayType)) (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e) handle Subscript => d () end; end; structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure List : sig val rev : 'a list -> 'a list val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; end; (*struct List*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure Arith : sig type nat val integer_of_nat : nat -> IntInf.int val less_eq_nat : nat -> nat -> bool val less_nat : nat -> nat -> bool val ord_nat : nat Orderings.ord datatype num = One | Bit0 of num | Bit1 of num val plus_nat : nat -> nat -> nat val one_nat : nat val suc : nat -> nat val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool val minus_nat : nat -> nat -> nat val times_nat : nat -> nat -> nat end = struct datatype nat = Nat of IntInf.int; fun integer_of_nat (Nat x) = x; fun less_eq_nat m n = IntInf.<= (integer_of_nat m, integer_of_nat n); fun less_nat m n = IntInf.< (integer_of_nat m, integer_of_nat n); val ord_nat = {less_eq = less_eq_nat, less = less_nat} : nat Orderings.ord; val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype num = One | Bit0 of num | Bit1 of num; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; val zero_nat : nat = Nat (0 : IntInf.int); fun nat_of_integer k = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); fun minus_nat m n = Nat (Orderings.max ord_integer (0 : IntInf.int) (IntInf.- (integer_of_nat m, integer_of_nat n))); fun times_nat m n = Nat (IntInf.* (integer_of_nat m, integer_of_nat n)); end; (*struct Arith*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Diff_Array : sig val array_get : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a val array_set : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType val array_grow : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType val array_get_oo : 'a -> 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a val array_length : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat val array_set_oo : (unit -> 'a FArray.IsabelleMapping.ArrayType) -> 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType end = struct fun array_get a = FArray.IsabelleMapping.array_get a o Arith.integer_of_nat; fun array_set a = FArray.IsabelleMapping.array_set a o Arith.integer_of_nat; fun array_grow a = FArray.IsabelleMapping.array_grow a o Arith.integer_of_nat; fun array_get_oo x a = FArray.IsabelleMapping.array_get_oo x a o Arith.integer_of_nat; fun array_length x = (Arith.nat_of_integer o FArray.IsabelleMapping.array_length) x; fun array_set_oo f a = FArray.IsabelleMapping.array_set_oo f a o Arith.integer_of_nat; end; (*struct Diff_Array*) structure ArrayMapImpl : sig val test_codegen : (('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType) * ((('b option) FArray.IsabelleMapping.ArrayType -> ('b option) FArray.IsabelleMapping.ArrayType -> ('b option) FArray.IsabelleMapping.ArrayType) * ((('c option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'c -> bool) -> bool) * ((('d option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'd -> bool) -> bool) * ((Arith.nat -> ('e option) FArray.IsabelleMapping.ArrayType -> ('e option) FArray.IsabelleMapping.ArrayType) * ((unit -> ('f option) FArray.IsabelleMapping.ArrayType) * ((('g option) FArray.IsabelleMapping.ArrayType -> bool) * ((('h option) FArray.IsabelleMapping.ArrayType -> bool) * ((('i option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'i -> 'j -> 'j) -> 'j -> 'j) * ((('k option) FArray.IsabelleMapping.ArrayType -> ('l -> bool) -> (Arith.nat * 'k -> 'l -> 'l) -> 'l -> 'l) * ((('m option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'm -> 'n -> 'n) -> 'n -> 'n) * ((('o option) FArray.IsabelleMapping.ArrayType -> ('p -> bool) -> (Arith.nat * 'o -> 'p -> 'p) -> 'p -> 'p) * ((('q option) FArray.IsabelleMapping.ArrayType -> ((Arith.nat * 'q) list -> bool) -> (Arith.nat * 'q -> (Arith.nat * 'q) list -> (Arith.nat * 'q) list) -> (Arith.nat * 'q) list -> (Arith.nat * 'q) list) * ((Arith.nat -> ('r option) FArray.IsabelleMapping.ArrayType -> 'r option) * ((('s option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 's -> bool) -> (Arith.nat * 's) option) * ((('t option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 't -> bool) -> (Arith.nat * 't) option) * (((Arith.nat * 'u -> bool) -> ('u option) FArray.IsabelleMapping.ArrayType -> ('u option) FArray.IsabelleMapping.ArrayType) * ((('v option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'v -> 'w -> 'w) -> 'w -> 'w) * ((('x option) FArray.IsabelleMapping.ArrayType -> ('y -> bool) -> (Arith.nat * 'x -> 'y -> 'y) -> 'y -> 'y) * ((('z option) FArray.IsabelleMapping.ArrayType -> ((Arith.nat * 'z) list -> bool) -> (Arith.nat * 'z -> (Arith.nat * 'z) list -> (Arith.nat * 'z) list) -> (Arith.nat * 'z) list -> (Arith.nat * 'z) list) * ((('aa option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'aa -> 'ab -> 'ab) -> 'ab -> 'ab) * ((('ac option) FArray.IsabelleMapping.ArrayType -> ('ad -> bool) -> (Arith.nat * 'ac -> 'ad -> 'ad) -> 'ad -> 'ad) * ((('ae option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'ae -> bool) -> (Arith.nat * 'ae) option) * ((('af option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * ((Arith.nat -> ('ag option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * ((Arith.nat -> 'ah -> ('ah option) FArray.IsabelleMapping.ArrayType) * ((('ai option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'ai) list) * (((Arith.nat * 'aj) list -> ('aj option) FArray.IsabelleMapping.ArrayType) * ((('ak option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'ak) list) * ((('al option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'al) list) * ((Arith.nat -> 'am -> ('am option) FArray.IsabelleMapping.ArrayType -> ('am option) FArray.IsabelleMapping.ArrayType) * (Arith.nat -> 'an -> ('an option) FArray.IsabelleMapping.ArrayType -> ('an option) FArray.IsabelleMapping.ArrayType))))))))))))))))))))))))))))))) end = struct fun iam_empty x = (fn _ => FArray.IsabelleMapping.array_of_list []) x; fun iam_delete k a = Diff_Array.array_set_oo (fn _ => a) a k NONE; fun iam_alpha a i = Diff_Array.array_get_oo NONE a i; fun iam_lookup k a = iam_alpha a k; fun iam_increment l idx = Orderings.max Arith.ord_nat (Arith.minus_nat (Arith.plus_nat idx Arith.one_nat) l) (Arith.plus_nat (Arith.times_nat (Arith.nat_of_integer (2 : IntInf.int)) l) (Arith.nat_of_integer (3 : IntInf.int))); fun iam_update k v a = Diff_Array.array_set_oo (fn _ => Diff_Array.array_set (Diff_Array.array_grow a (iam_increment (Diff_Array.array_length a) k) NONE) k (SOME v)) a k (SOME v); fun iam_rev_iterateoi_aux v a c f sigma = (if Arith.equal_nat v Arith.zero_nat then sigma else (if c sigma then iam_rev_iterateoi_aux (Arith.minus_nat (Arith.suc (Arith.minus_nat v Arith.one_nat)) Arith.one_nat) a c f (case Diff_Array.array_get a (Arith.minus_nat (Arith.suc (Arith.minus_nat v Arith.one_nat)) Arith.one_nat) of NONE => sigma | SOME x => f (Arith.minus_nat (Arith.suc (Arith.minus_nat v Arith.one_nat)) Arith.one_nat, x) sigma) else sigma)); fun iam_rev_iterateoi a = iam_rev_iterateoi_aux (Diff_Array.array_length a) a; fun rev_iterateoi_map_op_rev_list_it_iam_ops s = iam_rev_iterateoi s; fun iam_iterateoi_aux i len a c f sigma = (if Arith.less_eq_nat len i orelse not (c sigma) then sigma else let val b = (case Diff_Array.array_get a i of NONE => sigma | SOME x => f (i, x) sigma); in iam_iterateoi_aux (Arith.plus_nat i Arith.one_nat) len a c f b end); fun iam_iterateoi a = iam_iterateoi_aux Arith.zero_nat (Diff_Array.array_length a) a; fun iterateoi_map_op_ordered_list_it_iam_ops s = iam_iterateoi s; fun iteratei_map_op_list_it_iam_ops s = iam_rev_iterateoi s; fun rev_iterateoi_bmap_op_rev_list_it_iam_basic_ops s = iam_rev_iterateoi s; fun g_to_sorted_list_iam_basic_ops m = rev_iterateoi_bmap_op_rev_list_it_iam_basic_ops m (fn _ => true) (fn a => fn b => a :: b) []; fun iterateoi_bmap_op_ordered_list_it_iam_basic_ops s = iam_iterateoi s; fun g_to_rev_list_iam_basic_ops m = iterateoi_bmap_op_ordered_list_it_iam_basic_ops m (fn _ => true) (fn a => fn b => a :: b) []; fun g_list_to_map_iam_basic_ops l = List.foldl (fn m => fn (k, v) => iam_update k v m) (iam_empty ()) (List.rev l); fun iteratei_bmap_op_list_it_iam_basic_ops s = iam_rev_iterateoi s; fun g_size_abort_iam_basic_ops b m = iteratei_bmap_op_list_it_iam_basic_ops m (fn s => Arith.less_nat s b) (fn _ => Arith.suc) Arith.zero_nat; fun iam_update_dj x = iam_update x; fun g_restrict_iam_basic_ops p m = iteratei_bmap_op_list_it_iam_basic_ops m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then iam_update_dj k v sigma else sigma)) (iam_empty ()); fun g_to_list_iam_basic_ops m = iteratei_bmap_op_list_it_iam_basic_ops m (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_iam_basic_ops m = Arith.equal_nat (g_size_abort_iam_basic_ops Arith.one_nat m) Arith.zero_nat; fun g_add_dj_iam_basic_ops m1 m2 = iteratei_bmap_op_list_it_iam_basic_ops m2 (fn _ => true) (fn (a, b) => iam_update_dj a b) m1; fun g_isSng_iam_basic_ops m = Arith.equal_nat (g_size_abort_iam_basic_ops (Arith.nat_of_integer (2 : IntInf.int)) m) Arith.one_nat; fun g_size_iam_basic_ops m = iteratei_bmap_op_list_it_iam_basic_ops m (fn _ => true) (fn _ => Arith.suc) Arith.zero_nat; fun g_ball_iam_basic_ops m p = iteratei_bmap_op_list_it_iam_basic_ops m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_iam_basic_ops k v = iam_update k v (iam_empty ()); fun g_sel_iam_basic_ops m p = iteratei_bmap_op_list_it_iam_basic_ops m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_min_iam_basic_ops m p = iterateoi_bmap_op_ordered_list_it_iam_basic_ops m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_max_iam_basic_ops m p = rev_iterateoi_bmap_op_rev_list_it_iam_basic_ops m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_iam_basic_ops m p = iteratei_bmap_op_list_it_iam_basic_ops m not (fn kv => fn _ => p kv) false; fun g_add_iam_basic_ops m1 m2 = iteratei_bmap_op_list_it_iam_basic_ops m2 (fn _ => true) (fn (a, b) => iam_update a b) m1; val test_codegen : (('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType) * ((('b option) FArray.IsabelleMapping.ArrayType -> ('b option) FArray.IsabelleMapping.ArrayType -> ('b option) FArray.IsabelleMapping.ArrayType) * ((('c option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'c -> bool) -> bool) * ((('d option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'd -> bool) -> bool) * ((Arith.nat -> ('e option) FArray.IsabelleMapping.ArrayType -> ('e option) FArray.IsabelleMapping.ArrayType) * ((unit -> ('f option) FArray.IsabelleMapping.ArrayType) * ((('g option) FArray.IsabelleMapping.ArrayType -> bool) * ((('h option) FArray.IsabelleMapping.ArrayType -> bool) * ((('i option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'i -> 'j -> 'j) -> 'j -> 'j) * ((('k option) FArray.IsabelleMapping.ArrayType -> ('l -> bool) -> (Arith.nat * 'k -> 'l -> 'l) -> 'l -> 'l) * ((('m option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'm -> 'n -> 'n) -> 'n -> 'n) * ((('o option) FArray.IsabelleMapping.ArrayType -> ('p -> bool) -> (Arith.nat * 'o -> 'p -> 'p) -> 'p -> 'p) * ((('q option) FArray.IsabelleMapping.ArrayType -> ((Arith.nat * 'q) list -> bool) -> (Arith.nat * 'q -> (Arith.nat * 'q) list -> (Arith.nat * 'q) list) -> (Arith.nat * 'q) list -> (Arith.nat * 'q) list) * ((Arith.nat -> ('r option) FArray.IsabelleMapping.ArrayType -> 'r option) * ((('s option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 's -> bool) -> (Arith.nat * 's) option) * ((('t option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 't -> bool) -> (Arith.nat * 't) option) * (((Arith.nat * 'u -> bool) -> ('u option) FArray.IsabelleMapping.ArrayType -> ('u option) FArray.IsabelleMapping.ArrayType) * ((('v option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'v -> 'w -> 'w) -> 'w -> 'w) * ((('x option) FArray.IsabelleMapping.ArrayType -> ('y -> bool) -> (Arith.nat * 'x -> 'y -> 'y) -> 'y -> 'y) * ((('z option) FArray.IsabelleMapping.ArrayType -> ((Arith.nat * 'z) list -> bool) -> (Arith.nat * 'z -> (Arith.nat * 'z) list -> (Arith.nat * 'z) list) -> (Arith.nat * 'z) list -> (Arith.nat * 'z) list) * ((('aa option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'aa -> 'ab -> 'ab) -> 'ab -> 'ab) * ((('ac option) FArray.IsabelleMapping.ArrayType -> ('ad -> bool) -> (Arith.nat * 'ac -> 'ad -> 'ad) -> 'ad -> 'ad) * ((('ae option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'ae -> bool) -> (Arith.nat * 'ae) option) * ((('af option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * ((Arith.nat -> ('ag option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * ((Arith.nat -> 'ah -> ('ah option) FArray.IsabelleMapping.ArrayType) * ((('ai option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'ai) list) * (((Arith.nat * 'aj) list -> ('aj option) FArray.IsabelleMapping.ArrayType) * ((('ak option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'ak) list) * ((('al option) FArray.IsabelleMapping.ArrayType -> (Arith.nat * 'al) list) * ((Arith.nat -> 'am -> ('am option) FArray.IsabelleMapping.ArrayType -> ('am option) FArray.IsabelleMapping.ArrayType) * (Arith.nat -> 'an -> ('an option) FArray.IsabelleMapping.ArrayType -> ('an option) FArray.IsabelleMapping.ArrayType))))))))))))))))))))))))))))))) = (g_add_iam_basic_ops, (g_add_dj_iam_basic_ops, (g_ball_iam_basic_ops, (g_bex_iam_basic_ops, (iam_delete, (iam_empty, (g_isEmpty_iam_basic_ops, (g_isSng_iam_basic_ops, ((fn m => iteratei_map_op_list_it_iam_ops m (fn _ => true)), (iteratei_map_op_list_it_iam_ops, ((fn m => iterateoi_map_op_ordered_list_it_iam_ops m (fn _ => true)), (iterateoi_map_op_ordered_list_it_iam_ops, (iam_rev_iterateoi, (iam_lookup, (g_max_iam_basic_ops, (g_min_iam_basic_ops, (g_restrict_iam_basic_ops, ((fn m => rev_iterateoi_map_op_rev_list_it_iam_ops m (fn _ => true)), (rev_iterateoi_map_op_rev_list_it_iam_ops, (iam_rev_iterateoi, ((fn m => rev_iterateoi_map_op_rev_list_it_iam_ops m (fn _ => true)), (rev_iterateoi_map_op_rev_list_it_iam_ops, (g_sel_iam_basic_ops, (g_size_iam_basic_ops, (g_size_abort_iam_basic_ops, (g_sng_iam_basic_ops, (g_to_list_iam_basic_ops, (g_list_to_map_iam_basic_ops, (g_to_rev_list_iam_basic_ops, (g_to_sorted_list_iam_basic_ops, (iam_update, iam_update_dj))))))))))))))))))))))))))))))); end; (*struct ArrayMapImpl*) ### theory "Collections.ArrayMapImpl" ### 1.967s elapsed time, 3.948s cpu time, 0.000s GC time Loading theory "Collections.ListMapImpl_Invar" (required by "Collections.MapStdImpl") structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure List : sig val rev : 'a list -> 'a list val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; end; (*struct List*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val delete_aux : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update_with_aux : 'b HOL.equal -> 'a -> 'b -> ('a -> 'a) -> ('b * 'a) list -> ('b * 'a) list end = struct fun delete_aux A_ k [] = [] | delete_aux A_ ka ((k, v) :: xs) = (if HOL.eq A_ ka k then xs else (k, v) :: delete_aux A_ ka xs); fun update_with_aux B_ v k f [] = [(k, f v)] | update_with_aux B_ v k f (p :: ps) = (if HOL.eq B_ (Product_Type.fst p) k then (k, f (Product_Type.snd p)) :: ps else p :: update_with_aux B_ v k f ps); end; (*struct AList*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Assoc_List : sig type ('b, 'a) assoc_list val empty : ('a, 'b) assoc_list val delete : 'a HOL.equal -> 'a -> ('a, 'b) assoc_list -> ('a, 'b) assoc_list val lookup : 'a HOL.equal -> ('a, 'b) assoc_list -> 'a -> 'b option val update : 'a HOL.equal -> 'a -> 'b -> ('a, 'b) assoc_list -> ('a, 'b) assoc_list val iteratei : ('a, 'b) assoc_list -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) assoc_list = Assoc_List of ('b * 'a) list; val empty : ('a, 'b) assoc_list = Assoc_List []; fun impl_of (Assoc_List x) = x; fun delete A_ k al = Assoc_List (AList.delete_aux A_ k (impl_of al)); fun lookup A_ al = Map.map_of A_ (impl_of al); fun update_with A_ v k f al = Assoc_List (AList.update_with_aux A_ v k f (impl_of al)); fun update A_ k v = update_with A_ v k (fn _ => v); fun iteratei al c f = Foldi.foldli (impl_of al) c f; end; (*struct Assoc_List*) structure ListMapImpl : sig val test_codegen : 'a HOL.equal -> 'c HOL.equal -> 'i HOL.equal -> 'y HOL.equal -> 'aa HOL.equal -> 'ai HOL.equal -> 'am HOL.equal -> 'ao HOL.equal -> 'aq HOL.equal -> (('a, 'b) Assoc_List.assoc_list -> ('a, 'b) Assoc_List.assoc_list -> ('a, 'b) Assoc_List.assoc_list) * ((('c, 'd) Assoc_List.assoc_list -> ('c, 'd) Assoc_List.assoc_list -> ('c, 'd) Assoc_List.assoc_list) * ((('e, 'f) Assoc_List.assoc_list -> ('e * 'f -> bool) -> bool) * ((('g, 'h) Assoc_List.assoc_list -> ('g * 'h -> bool) -> bool) * (('i -> ('i, 'j) Assoc_List.assoc_list -> ('i, 'j) Assoc_List.assoc_list) * ((unit -> ('k, 'l) Assoc_List.assoc_list) * ((('m, 'n) Assoc_List.assoc_list -> bool) * ((('o, 'p) Assoc_List.assoc_list -> bool) * ((('q, 'r) Assoc_List.assoc_list -> ('q * 'r -> 's -> 's) -> 's -> 's) * ((('t, 'u) Assoc_List.assoc_list -> ('v -> bool) -> ('t * 'u -> 'v -> 'v) -> 'v -> 'v) * ((('w, 'x) Assoc_List.assoc_list -> (('w * 'x) list -> bool) -> ('w * 'x -> ('w * 'x) list -> ('w * 'x) list) -> ('w * 'x) list -> ('w * 'x) list) * (('y -> ('y, 'z) Assoc_List.assoc_list -> 'z option) * ((('aa * 'ab -> bool) -> ('aa, 'ab) Assoc_List.assoc_list -> ('aa, 'ab) Assoc_List.assoc_list) * ((('ac, 'ad) Assoc_List.assoc_list -> ('ac * 'ad -> bool) -> ('ac * 'ad) option) * ((('ae, 'af) Assoc_List.assoc_list -> Arith.nat) * ((Arith.nat -> ('ag, 'ah) Assoc_List.assoc_list -> Arith.nat) * (('ai -> 'aj -> ('ai, 'aj) Assoc_List.assoc_list) * ((('ak, 'al) Assoc_List.assoc_list -> ('ak * 'al) list) * ((('am * 'an) list -> ('am, 'an) Assoc_List.assoc_list) * (('ao -> 'ap -> ('ao, 'ap) Assoc_List.assoc_list -> ('ao, 'ap) Assoc_List.assoc_list) * ('aq -> 'ar -> ('aq, 'ar) Assoc_List.assoc_list -> ('aq, 'ar) Assoc_List.assoc_list)))))))))))))))))))) end = struct fun iteratei_map_op_list_it_lm_ops s = Assoc_List.iteratei s; fun g_list_to_map_lm_basic_ops A_ l = List.foldl (fn m => fn (k, v) => Assoc_List.update A_ k v m) Assoc_List.empty (List.rev l); fun iteratei_bmap_op_list_it_lm_basic_ops s = Assoc_List.iteratei s; fun g_size_abort_lm_basic_ops b m = iteratei_bmap_op_list_it_lm_basic_ops m (fn s => Arith.less_nat s b) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_restrict_lm_basic_ops A_ p m = iteratei_bmap_op_list_it_lm_basic_ops m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then Assoc_List.update A_ k v sigma else sigma)) Assoc_List.empty; fun g_to_list_lm_basic_ops m = iteratei_bmap_op_list_it_lm_basic_ops m (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_lm_basic_ops m = Arith.equal_nat (g_size_abort_lm_basic_ops Arith.one_nat m) Arith.Zero_nat; fun g_add_dj_lm_basic_ops A_ m1 m2 = iteratei_bmap_op_list_it_lm_basic_ops m2 (fn _ => true) (fn (a, b) => Assoc_List.update A_ a b) m1; fun g_isSng_lm_basic_ops m = Arith.equal_nat (g_size_abort_lm_basic_ops (Arith.nat_of_num (Arith.Bit0 Arith.One)) m) Arith.one_nat; fun g_size_lm_basic_ops m = iteratei_bmap_op_list_it_lm_basic_ops m (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_ball_lm_basic_ops m p = iteratei_bmap_op_list_it_lm_basic_ops m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_lm_basic_ops A_ k v = Assoc_List.update A_ k v Assoc_List.empty; fun g_sel_lm_basic_ops m p = iteratei_bmap_op_list_it_lm_basic_ops m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_lm_basic_ops m p = iteratei_bmap_op_list_it_lm_basic_ops m not (fn kv => fn _ => p kv) false; fun g_add_lm_basic_ops A_ m1 m2 = iteratei_bmap_op_list_it_lm_basic_ops m2 (fn _ => true) (fn (a, b) => Assoc_List.update A_ a b) m1; fun test_codegen A_ C_ I_ Y_ Aa_ Ai_ Am_ Ao_ Aq_ = (g_add_lm_basic_ops A_, (g_add_dj_lm_basic_ops C_, (g_ball_lm_basic_ops, (g_bex_lm_basic_ops, (Assoc_List.delete I_, ((fn _ => Assoc_List.empty), (g_isEmpty_lm_basic_ops, (g_isSng_lm_basic_ops, ((fn m => iteratei_map_op_list_it_lm_ops m (fn _ => true)), (iteratei_map_op_list_it_lm_ops, (Assoc_List.iteratei, ((fn k => fn m => Assoc_List.lookup Y_ m k), (g_restrict_lm_basic_ops Aa_, (g_sel_lm_basic_ops, (g_size_lm_basic_ops, (g_size_abort_lm_basic_ops, (g_sng_lm_basic_ops Ai_, (g_to_list_lm_basic_ops, (g_list_to_map_lm_basic_ops Am_, (Assoc_List.update Ao_, Assoc_List.update Aq_)))))))))))))))))))); end; (*struct ListMapImpl*) ### theory "Collections.ListMapImpl" ### 1.347s elapsed time, 2.644s cpu time, 0.628s GC time Loading theory "Collections.ArrayHashMap_Impl" (required by "Collections.MapStdImpl" via "Collections.ArrayHashMap") structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure Arith : sig datatype nat = Zero_nat | Suc of nat val less_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; fun less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; end; (*struct Arith*) structure List : sig val rev : 'a list -> 'a list val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val size_list : 'a list -> Arith.nat end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; fun gen_length n (x :: xs) = gen_length (Arith.Suc n) xs | gen_length n [] = n; fun size_list x = gen_length Arith.Zero_nat x; end; (*struct List*) structure Misc : sig val revg : 'a list -> 'a list -> 'a list end = struct fun revg [] b = b | revg (a :: asa) b = revg asa (a :: b); end; (*struct Misc*) structure Product_Type : sig val fst : 'a * 'b -> 'a end = struct fun fst (x1, x2) = x1; end; (*struct Product_Type*) structure AList : sig val update : 'a HOL.equal -> 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list val delete_aux : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list end = struct fun update A_ k v [] = [(k, v)] | update A_ k v (p :: ps) = (if HOL.eq A_ (Product_Type.fst p) k then (k, v) :: ps else p :: update A_ k v ps); fun delete_aux A_ k [] = [] | delete_aux A_ ka ((k, v) :: xs) = (if HOL.eq A_ ka k then xs else (k, v) :: delete_aux A_ ka xs); end; (*struct AList*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure ListMapImpl_Invar : sig val test_codegen : 'a HOL.equal -> 'i HOL.equal -> 'y HOL.equal -> 'ai HOL.equal -> 'am HOL.equal -> 'ao HOL.equal -> (('a * 'b) list -> ('a * 'b) list -> ('a * 'b) list) * ((('c * 'd) list -> ('c * 'd) list -> ('c * 'd) list) * ((('e * 'f) list -> ('e * 'f -> bool) -> bool) * ((('g * 'h) list -> ('g * 'h -> bool) -> bool) * (('i -> ('i * 'j) list -> ('i * 'j) list) * ((unit -> ('k * 'l) list) * ((('m * 'n) list -> bool) * ((('o * 'p) list -> bool) * ((('q * 'r) list -> ('q * 'r -> 's -> 's) -> 's -> 's) * ((('t * 'u) list -> ('v -> bool) -> ('t * 'u -> 'v -> 'v) -> 'v -> 'v) * ((('w * 'x) list -> (('w * 'x) list -> bool) -> ('w * 'x -> ('w * 'x) list -> ('w * 'x) list) -> ('w * 'x) list -> ('w * 'x) list) * (('y -> ('y * 'z) list -> 'z option) * ((('aa * 'ab -> bool) -> ('aa * 'ab) list -> ('aa * 'ab) list) * ((('ac * 'ad) list -> ('ac * 'ad -> bool) -> ('ac * 'ad) option) * ((('ae * 'af) list -> Arith.nat) * ((Arith.nat -> ('ag * 'ah) list -> Arith.nat) * (('ai -> 'aj -> ('ai * 'aj) list) * ((('ak * 'al) list -> ('ak * 'al) list) * ((('am * 'an) list -> ('am * 'an) list) * (('ao -> 'ap -> ('ao * 'ap) list -> ('ao * 'ap) list) * (('aq -> 'ar -> ('aq * 'ar) list -> ('aq * 'ar) list) * (('as * 'at) list -> ('as * 'at) list))))))))))))))))))))) end = struct fun iteratei_map_op_list_it_lmi_ops s = Foldi.foldli s; fun g_list_to_map_lmi_basic_ops A_ l = List.foldl (fn m => fn (k, v) => AList.update A_ k v m) [] (List.rev l); fun iteratei_bmap_op_list_it_lmi_basic_ops s = Foldi.foldli s; fun g_size_abort_lmi_basic_ops b m = iteratei_bmap_op_list_it_lmi_basic_ops m (fn s => Arith.less_nat s b) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_restrict_lmi_basic_ops p m = iteratei_bmap_op_list_it_lmi_basic_ops m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then (k, v) :: sigma else sigma)) []; fun g_ball_lmi_basic_ops m p = iteratei_bmap_op_list_it_lmi_basic_ops m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_lmi_basic_ops A_ k v = AList.update A_ k v []; fun g_sel_lmi_basic_ops m p = iteratei_bmap_op_list_it_lmi_basic_ops m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_lmi_basic_ops m p = iteratei_bmap_op_list_it_lmi_basic_ops m not (fn kv => fn _ => p kv) false; fun g_add_lmi_basic_ops A_ m1 m2 = iteratei_bmap_op_list_it_lmi_basic_ops m2 (fn _ => true) (fn (a, b) => AList.update A_ a b) m1; fun lmi_from_list_dj x = Fun.id x; fun test_codegen A_ I_ Y_ Ai_ Am_ Ao_ = (g_add_lmi_basic_ops A_, (Misc.revg, (g_ball_lmi_basic_ops, (g_bex_lmi_basic_ops, (AList.delete_aux I_, ((fn _ => []), ((fn a => (case a of [] => true | _ :: _ => false)), ((fn a => (case a of [] => false | [_] => true | _ :: _ :: _ => false)), ((fn m => iteratei_map_op_list_it_lmi_ops m (fn _ => true)), (iteratei_map_op_list_it_lmi_ops, (Foldi.foldli, ((fn k => fn m => Map.map_of Y_ m k), (g_restrict_lmi_basic_ops, (g_sel_lmi_basic_ops, (List.size_list, (g_size_abort_lmi_basic_ops, (g_sng_lmi_basic_ops Ai_, (Fun.id, (g_list_to_map_lmi_basic_ops Am_, (AList.update Ao_, ((fn k => fn v => (fn a => (k, v) :: a)), lmi_from_list_dj))))))))))))))))))))); end; (*struct ListMapImpl_Invar*) ### theory "Collections.ListMapImpl_Invar" ### 2.141s elapsed time, 4.232s cpu time, 0.628s GC time Loading theory "Collections.TrieMapImpl" (required by "Collections.MapStdImpl") structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure List : sig val rev : 'a list -> 'a list val null : 'a list -> bool val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun null [] = true | null (x :: xs) = false; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; end; (*struct List*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val update : 'a HOL.equal -> 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list val delete_aux : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update_with_aux : 'b HOL.equal -> 'a -> 'b -> ('a -> 'a) -> ('b * 'a) list -> ('b * 'a) list end = struct fun update A_ k v [] = [(k, v)] | update A_ k v (p :: ps) = (if HOL.eq A_ (Product_Type.fst p) k then (k, v) :: ps else p :: update A_ k v ps); fun delete_aux A_ k [] = [] | delete_aux A_ ka ((k, v) :: xs) = (if HOL.eq A_ ka k then xs else (k, v) :: delete_aux A_ ka xs); fun update_with_aux B_ v k f [] = [(k, f v)] | update_with_aux B_ v k f (p :: ps) = (if HOL.eq B_ (Product_Type.fst p) k then (k, f (Product_Type.snd p)) :: ps else p :: update_with_aux B_ v k f ps); end; (*struct AList*) structure Trie : sig datatype ('a, 'b) trie = Trie of 'b option * ('a * ('a, 'b) trie) list val empty_trie : ('a, 'b) trie val delete_trie : 'a HOL.equal -> 'a list -> ('a, 'b) trie -> ('a, 'b) trie val lookup_trie : 'a HOL.equal -> ('a, 'b) trie -> 'a list -> 'b option val update_trie : 'a HOL.equal -> 'a list -> 'b -> ('a, 'b) trie -> ('a, 'b) trie end = struct datatype ('a, 'b) trie = Trie of 'b option * ('a * ('a, 'b) trie) list; val empty_trie : ('a, 'b) trie = Trie (NONE, []); fun is_empty_trie (Trie (v, m)) = Option.is_none v andalso List.null m; fun delete_trie A_ [] (Trie (vo, ts)) = Trie (NONE, ts) | delete_trie A_ (k :: ks) (Trie (vo, ts)) = (case Map.map_of A_ ts k of NONE => Trie (vo, ts) | SOME t => let val ta = delete_trie A_ ks t; in (if is_empty_trie ta then Trie (vo, AList.delete_aux A_ k ts) else Trie (vo, AList.update A_ k ta ts)) end); fun lookup_trie A_ (Trie (v, m)) [] = v | lookup_trie A_ (Trie (v, m)) (k :: ks) = (case Map.map_of A_ m k of NONE => NONE | SOME st => lookup_trie A_ st ks); fun update_with_trie A_ [] f (Trie (v, ps)) = Trie (SOME (f v), ps) | update_with_trie A_ (k :: ks) f (Trie (v, ps)) = Trie (v, AList.update_with_aux A_ empty_trie k (update_with_trie A_ ks f) ps); fun update_trie A_ ks v = update_with_trie A_ ks (fn _ => v); end; (*struct Trie*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Trie_Impl : sig val iteratei : ('a, 'b) Trie.trie -> ('c -> bool) -> ('a list * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun iteratei_postfixed ks (Trie.Trie (vo, ts)) c f sigma = (if c sigma then Foldi.foldli ts c (fn (k, t) => iteratei_postfixed (k :: ks) t c f) (case vo of NONE => sigma | SOME v => f (ks, v) sigma) else sigma); fun iteratei t c f sigma = iteratei_postfixed [] t c f sigma; end; (*struct Trie_Impl*) structure Trie2 : sig type ('b, 'a) trie val empty : ('a, 'b) trie val delete : 'a HOL.equal -> 'a list -> ('a, 'b) trie -> ('a, 'b) trie val lookup : 'a HOL.equal -> ('a, 'b) trie -> 'a list -> 'b option val update : 'a HOL.equal -> 'a list -> 'b -> ('a, 'b) trie -> ('a, 'b) trie val iteratei : ('a, 'b) trie -> ('c -> bool) -> ('a list * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) trie = Trie of ('b, 'a) Trie.trie; val empty : ('a, 'b) trie = Trie Trie.empty_trie; fun impl_of (Trie x) = x; fun delete A_ ks t = Trie (Trie.delete_trie A_ ks (impl_of t)); fun lookup A_ t = Trie.lookup_trie A_ (impl_of t); fun update A_ ks v t = Trie (Trie.update_trie A_ ks v (impl_of t)); fun iteratei t c f = Trie_Impl.iteratei (impl_of t) c (fn (ks, v) => f (List.rev ks, v)); end; (*struct Trie2*) structure TrieMapImpl : sig val test_codegen : 'a HOL.equal -> 'c HOL.equal -> 'i HOL.equal -> 'y HOL.equal -> 'aa HOL.equal -> 'ai HOL.equal -> 'am HOL.equal -> 'ao HOL.equal -> 'aq HOL.equal -> (('a, 'b) Trie2.trie -> ('a, 'b) Trie2.trie -> ('a, 'b) Trie2.trie) * ((('c, 'd) Trie2.trie -> ('c, 'd) Trie2.trie -> ('c, 'd) Trie2.trie) * ((('e, 'f) Trie2.trie -> ('e list * 'f -> bool) -> bool) * ((('g, 'h) Trie2.trie -> ('g list * 'h -> bool) -> bool) * (('i list -> ('i, 'j) Trie2.trie -> ('i, 'j) Trie2.trie) * ((unit -> ('k, 'l) Trie2.trie) * ((('m, 'n) Trie2.trie -> bool) * ((('o, 'p) Trie2.trie -> bool) * ((('q, 'r) Trie2.trie -> ('q list * 'r -> 's -> 's) -> 's -> 's) * ((('t, 'u) Trie2.trie -> ('v -> bool) -> ('t list * 'u -> 'v -> 'v) -> 'v -> 'v) * ((('w, 'x) Trie2.trie -> (('w list * 'x) list -> bool) -> ('w list * 'x -> ('w list * 'x) list -> ('w list * 'x) list) -> ('w list * 'x) list -> ('w list * 'x) list) * (('y list -> ('y, 'z) Trie2.trie -> 'z option) * ((('aa list * 'ab -> bool) -> ('aa, 'ab) Trie2.trie -> ('aa, 'ab) Trie2.trie) * ((('ac, 'ad) Trie2.trie -> ('ac list * 'ad -> bool) -> ('ac list * 'ad) option) * ((('ae, 'af) Trie2.trie -> Arith.nat) * ((Arith.nat -> ('ag, 'ah) Trie2.trie -> Arith.nat) * (('ai list -> 'aj -> ('ai, 'aj) Trie2.trie) * ((('ak, 'al) Trie2.trie -> ('ak list * 'al) list) * ((('am list * 'an) list -> ('am, 'an) Trie2.trie) * (('ao list -> 'ap -> ('ao, 'ap) Trie2.trie -> ('ao, 'ap) Trie2.trie) * ('aq list -> 'ar -> ('aq, 'ar) Trie2.trie -> ('aq, 'ar) Trie2.trie)))))))))))))))))))) end = struct fun iteratei_map_op_list_it_tm_ops s = Trie2.iteratei s; fun g_list_to_map_tm_basic_ops A_ l = List.foldl (fn m => fn (k, v) => Trie2.update A_ k v m) Trie2.empty (List.rev l); fun iteratei_bmap_op_list_it_tm_basic_ops s = Trie2.iteratei s; fun g_size_abort_tm_basic_ops b m = iteratei_bmap_op_list_it_tm_basic_ops m (fn s => Arith.less_nat s b) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_restrict_tm_basic_ops A_ p m = iteratei_bmap_op_list_it_tm_basic_ops m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then Trie2.update A_ k v sigma else sigma)) Trie2.empty; fun g_to_list_tm_basic_ops m = iteratei_bmap_op_list_it_tm_basic_ops m (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_tm_basic_ops m = Arith.equal_nat (g_size_abort_tm_basic_ops Arith.one_nat m) Arith.Zero_nat; fun g_add_dj_tm_basic_ops A_ m1 m2 = iteratei_bmap_op_list_it_tm_basic_ops m2 (fn _ => true) (fn (a, b) => Trie2.update A_ a b) m1; fun g_isSng_tm_basic_ops m = Arith.equal_nat (g_size_abort_tm_basic_ops (Arith.nat_of_num (Arith.Bit0 Arith.One)) m) Arith.one_nat; fun g_size_tm_basic_ops m = iteratei_bmap_op_list_it_tm_basic_ops m (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_ball_tm_basic_ops m p = iteratei_bmap_op_list_it_tm_basic_ops m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_tm_basic_ops A_ k v = Trie2.update A_ k v Trie2.empty; fun g_sel_tm_basic_ops m p = iteratei_bmap_op_list_it_tm_basic_ops m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_tm_basic_ops m p = iteratei_bmap_op_list_it_tm_basic_ops m not (fn kv => fn _ => p kv) false; fun g_add_tm_basic_ops A_ m1 m2 = iteratei_bmap_op_list_it_tm_basic_ops m2 (fn _ => true) (fn (a, b) => Trie2.update A_ a b) m1; fun test_codegen A_ C_ I_ Y_ Aa_ Ai_ Am_ Ao_ Aq_ = (g_add_tm_basic_ops A_, (g_add_dj_tm_basic_ops C_, (g_ball_tm_basic_ops, (g_bex_tm_basic_ops, (Trie2.delete I_, ((fn _ => Trie2.empty), (g_isEmpty_tm_basic_ops, (g_isSng_tm_basic_ops, ((fn m => iteratei_map_op_list_it_tm_ops m (fn _ => true)), (iteratei_map_op_list_it_tm_ops, (Trie2.iteratei, ((fn k => fn m => Trie2.lookup Y_ m k), (g_restrict_tm_basic_ops Aa_, (g_sel_tm_basic_ops, (g_size_tm_basic_ops, (g_size_abort_tm_basic_ops, (g_sng_tm_basic_ops Ai_, (g_to_list_tm_basic_ops, (g_list_to_map_tm_basic_ops Am_, (Trie2.update Ao_, Trie2.update Aq_)))))))))))))))))))); end; (*struct TrieMapImpl*) ### theory "Collections.TrieMapImpl" ### 1.063s elapsed time, 2.140s cpu time, 0.000s GC time Loading theory "Collections.ListSetImpl" (required by "Collections.SetStdImpl") consts ahm_invar :: "('key, 'val) hashmap \ bool" consts ahm_\ :: "('key, 'val) hashmap \ 'key \ 'val option" consts ahm_iteratei_aux :: "('key \ 'val) list array \ ('\ \ bool) \ ('key \ 'val \ '\ \ '\) \ '\ \ '\" consts ahm_iteratei :: "('key, 'val) hashmap \ ('\ \ bool) \ ('key \ 'val \ '\ \ '\) \ '\ \ '\" consts ahm_rehash :: "('key, 'val) hashmap \ nat \ ('key, 'val) hashmap" consts hm_grow :: "('key, 'val) hashmap \ nat" consts ahm_filled :: "('key, 'val) hashmap \ bool" consts ahm_update_aux :: "('key, 'val) hashmap \ 'key \ 'val \ ('key, 'val) hashmap" consts ahm_delete :: "'key \ ('key, 'val) hashmap \ ('key, 'val) hashmap" ### theory "Collections.ArrayHashMap_Impl" ### 3.010s elapsed time, 5.984s cpu time, 0.664s GC time Loading theory "Collections.ArrayHashMap" (required by "Collections.MapStdImpl") structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure List : sig val member : 'a HOL.equal -> 'a list -> 'a -> bool val insert : 'a HOL.equal -> 'a -> 'a list -> 'a list end = struct fun member A_ [] y = false | member A_ (x :: xs) y = HOL.eq A_ x y orelse member A_ xs y; fun insert A_ x xs = (if member A_ xs x then xs else x :: xs); end; (*struct List*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Dlist : sig datatype 'a dlist = Dlist of 'a list val empty : 'a dlist val list_of_dlist : 'a dlist -> 'a list val insert : 'a HOL.equal -> 'a -> 'a dlist -> 'a dlist val member : 'a HOL.equal -> 'a dlist -> 'a -> bool end = struct datatype 'a dlist = Dlist of 'a list; val empty : 'a dlist = Dlist []; fun list_of_dlist (Dlist x) = x; fun insert A_ x dxs = Dlist (List.insert A_ x (list_of_dlist dxs)); fun member A_ dxs = List.member A_ (list_of_dlist dxs); end; (*struct Dlist*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Dlist_add : sig val dlist_remove : 'a HOL.equal -> 'a -> 'a Dlist.dlist -> 'a Dlist.dlist val dlist_iteratei : 'a Dlist.dlist -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun dlist_remove1 A_ x z [] = z | dlist_remove1 A_ x z (y :: ys) = (if HOL.eq A_ x y then z @ ys else dlist_remove1 A_ x (y :: z) ys); fun dlist_remove A_ a xs = Dlist.Dlist (dlist_remove1 A_ a [] (Dlist.list_of_dlist xs)); fun dlist_iteratei xs = Foldi.foldli (Dlist.list_of_dlist xs); end; (*struct Dlist_add*) structure ListSetImpl : sig val test_codegen : 'b HOL.equal -> 'c HOL.equal -> 'd HOL.equal -> 'f HOL.equal -> 'm HOL.equal -> 'n HOL.equal -> 'o HOL.equal -> 'p HOL.equal -> 'q HOL.equal -> 'r HOL.equal -> 's HOL.equal -> 't HOL.equal -> 'u HOL.equal -> 'x HOL.equal -> (unit -> 'a Dlist.dlist) * (('b -> 'b Dlist.dlist -> bool) * (('c -> 'c Dlist.dlist -> 'c Dlist.dlist) * (('d -> 'd Dlist.dlist -> 'd Dlist.dlist) * (('e Dlist.dlist -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> 'f Dlist.dlist) * (('g Dlist.dlist -> bool) * (('h Dlist.dlist -> bool) * (('i Dlist.dlist -> ('i -> bool) -> bool) * (('j Dlist.dlist -> ('j -> bool) -> bool) * (('k Dlist.dlist -> Arith.nat) * ((Arith.nat -> 'l Dlist.dlist -> Arith.nat) * (('m Dlist.dlist -> 'm Dlist.dlist -> 'm Dlist.dlist) * (('n Dlist.dlist -> 'n Dlist.dlist -> 'n Dlist.dlist) * (('o Dlist.dlist -> 'o Dlist.dlist -> 'o Dlist.dlist) * ((('p -> bool) -> 'p Dlist.dlist -> 'p Dlist.dlist) * (('q Dlist.dlist -> 'q Dlist.dlist -> 'q Dlist.dlist) * (('r Dlist.dlist -> 'r Dlist.dlist -> bool) * (('s Dlist.dlist -> 's Dlist.dlist -> bool) * (('t Dlist.dlist -> 't Dlist.dlist -> bool) * (('u Dlist.dlist -> 'u Dlist.dlist -> 'u option) * (('v Dlist.dlist -> ('v -> bool) -> 'v option) * (('w Dlist.dlist -> 'w list) * ('x list -> 'x Dlist.dlist))))))))))))))))))))))) end = struct fun iteratei_bset_op_list_it_ls_basic_ops s = Dlist_add.dlist_iteratei s; fun g_sel_ls_basic_ops s p = iteratei_bset_op_list_it_ls_basic_ops s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_disjoint_witness_ls_basic_ops A_ s1 s2 = g_sel_ls_basic_ops s1 (Dlist.member A_ s2); fun g_size_abort_ls_basic_ops m s = iteratei_bset_op_list_it_ls_basic_ops s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_from_list_aux_ls_basic_ops A_ y [] = y | g_from_list_aux_ls_basic_ops A_ accs (x :: l) = g_from_list_aux_ls_basic_ops A_ (Dlist.insert A_ x accs) l; fun g_from_list_ls_basic_ops A_ l = g_from_list_aux_ls_basic_ops A_ Dlist.empty l; fun g_union_dj_ls_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_ls_basic_ops s1 (fn _ => true) (Dlist.insert A_) s2; fun g_ball_ls_basic_ops s p = iteratei_bset_op_list_it_ls_basic_ops s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_ls_basic_ops A_ s1 s2 = g_ball_ls_basic_ops s1 (fn x => not (Dlist.member A_ s2 x)); fun g_isEmpty_ls_basic_ops s = iteratei_bset_op_list_it_ls_basic_ops s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_ls_basic_ops A_ s1 s2 = g_ball_ls_basic_ops s1 (Dlist.member A_ s2); fun g_filter_ls_basic_ops A_ p s = iteratei_bset_op_list_it_ls_basic_ops s (fn _ => true) (fn x => fn sigma => (if p x then Dlist.insert A_ x sigma else sigma)) Dlist.empty; fun g_union_ls_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_ls_basic_ops s1 (fn _ => true) (Dlist.insert A_) s2; fun g_isSng_ls_basic_ops s = Arith.equal_nat (iteratei_bset_op_list_it_ls_basic_ops s (fn sigma => Arith.less_nat sigma (Arith.nat_of_num (Arith.Bit0 Arith.One))) (fn _ => Arith.Suc) Arith.Zero_nat) Arith.one_nat; fun g_inter_ls_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_ls_basic_ops s1 (fn _ => true) (fn x => fn s => (if Dlist.member A_ s2 x then Dlist.insert A_ x s else s)) Dlist.empty; fun g_equal_ls_basic_ops A_ s1 s2 = g_subset_ls_basic_ops A_ s1 s2 andalso g_subset_ls_basic_ops A_ s2 s1; fun g_size_ls_basic_ops s = iteratei_bset_op_list_it_ls_basic_ops s (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_diff_ls_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_ls_basic_ops s2 (fn _ => true) (Dlist_add.dlist_remove A_) s1; fun g_sng_ls_basic_ops A_ x = Dlist.insert A_ x Dlist.empty; fun g_bex_ls_basic_ops s p = iteratei_bset_op_list_it_ls_basic_ops s not (fn x => fn _ => p x) false; fun test_codegen B_ C_ D_ F_ M_ N_ O_ P_ Q_ R_ S_ T_ U_ X_ = ((fn _ => Dlist.empty), ((fn x => fn s => Dlist.member B_ s x), (Dlist.insert C_, (Dlist_add.dlist_remove D_, (Dlist_add.dlist_iteratei, (g_sng_ls_basic_ops F_, (g_isEmpty_ls_basic_ops, (g_isSng_ls_basic_ops, (g_ball_ls_basic_ops, (g_bex_ls_basic_ops, (g_size_ls_basic_ops, (g_size_abort_ls_basic_ops, (g_union_ls_basic_ops M_, (g_union_dj_ls_basic_ops N_, (g_diff_ls_basic_ops O_, (g_filter_ls_basic_ops P_, (g_inter_ls_basic_ops Q_, (g_subset_ls_basic_ops R_, (g_equal_ls_basic_ops S_, (g_disjoint_ls_basic_ops T_, (g_disjoint_witness_ls_basic_ops U_, (g_sel_ls_basic_ops, (Dlist.list_of_dlist, g_from_list_ls_basic_ops X_))))))))))))))))))))))); end; (*struct ListSetImpl*) ### theory "Collections.ListSetImpl" ### 1.411s elapsed time, 2.772s cpu time, 0.664s GC time Loading theory "Collections.ListSetImpl_Invar" (required by "Collections.SetStdImpl") (* Test that words can handle numbers between 0 and 31 *) val _ = if 5 <= Word.wordSize then () else raise (Fail ("wordSize less than 5")); structure Uint32 : sig val set_bit : Word32.word -> IntInf.int -> bool -> Word32.word val shiftl : Word32.word -> IntInf.int -> Word32.word val shiftr : Word32.word -> IntInf.int -> Word32.word val shiftr_signed : Word32.word -> IntInf.int -> Word32.word val test_bit : Word32.word -> IntInf.int -> bool end = struct fun set_bit x n b = let val mask = Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n)) in if b then Word32.orb (x, mask) else Word32.andb (x, Word32.notb mask) end fun shiftl x n = Word32.<< (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr x n = Word32.>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr_signed x n = Word32.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun test_bit x n = Word32.andb (x, Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word32.fromInt 0 end; (* struct Uint32 *) structure STArray = struct datatype 'a Cell = Invalid | Value of 'a array; exception AccessedOldVersion; type 'a array = 'a Cell Unsynchronized.ref; fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun array (size, v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun sub (Unsynchronized.ref Invalid, idx) = raise AccessedOldVersion | sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx); fun update (aref,idx,v) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( aref := Invalid; Array.update (a,idx,v); Unsynchronized.ref (Value a) ); fun length (Unsynchronized.ref Invalid) = raise AccessedOldVersion | length (Unsynchronized.ref (Value a)) = Array.length a fun grow (aref, i, x) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+i,x) in aref := Invalid; Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( aref:=Invalid; Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); end; end; structure FArray = struct datatype 'a Cell = Value of 'a Array.array | Upd of (int*'a*'a Cell Unsynchronized.ref); type 'a array = 'a Cell Unsynchronized.ref; fun array (size,v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx) | sub (Unsynchronized.ref (Upd (i,v,cr)),idx) = if i=idx then v else sub (cr,idx); fun length (Unsynchronized.ref (Value a)) = Array.length a | length (Unsynchronized.ref (Upd (i,v,cr))) = length cr; fun realize_aux (aref, v) = case aref of (Unsynchronized.ref (Value a)) => ( let val len = Array.length a; val a' = Array.array (len,v); in Array.copy {src=a, dst=a', di=0}; Unsynchronized.ref (Value a') end ) | (Unsynchronized.ref (Upd (i,v,cr))) => ( let val res=realize_aux (cr,v) in case res of (Unsynchronized.ref (Value a)) => (Array.update (a,i,v); res) end ); fun realize aref = case aref of (Unsynchronized.ref (Value _)) => aref | (Unsynchronized.ref (Upd (i,v,cr))) => realize_aux(aref,v); fun update (aref,idx,v) = case aref of (Unsynchronized.ref (Value a)) => ( let val nref=Unsynchronized.ref (Value a) in aref := Upd (idx,Array.sub(a,idx),nref); Array.update (a,idx,v); nref end ) | (Unsynchronized.ref (Upd _)) => let val ra = realize_aux(aref,v) in case ra of (Unsynchronized.ref (Value a)) => Array.update (a,idx,v); ra end ; fun grow (aref, inc, x) = case aref of (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+inc,x) in Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ) | (Unsynchronized.ref (Upd _)) => ( grow (realize aref, inc, x) ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ) | (Unsynchronized.ref (Upd _)) => ( shrink (realize aref,sz) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); fun array_get_oo (d:'a) (a:'a ArrayType) (i:IntInf.int) = sub (a,IntInf.toInt i) handle Subscript => d fun array_set_oo (d:(unit->'a ArrayType)) (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e) handle Subscript => d () end; end; structure Bits_Integer : sig val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int val shiftl : IntInf.int -> IntInf.int -> IntInf.int val shiftr : IntInf.int -> IntInf.int -> IntInf.int val test_bit : IntInf.int -> IntInf.int -> bool end = struct val maxWord = IntInf.pow (2, Word.wordSize); fun set_bit x n b = if n < maxWord then if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))) else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); fun shiftl x n = if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun shiftr x n = if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun test_bit x n = if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0 else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); end; (*struct Bits_Integer*) structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal datatype 'a itself = Type val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; datatype 'a itself = Type; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure List : sig val rev : 'a list -> 'a list val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val filter : ('a -> bool) -> 'a list -> 'a list end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; fun filter p [] = [] | filter p (x :: xs) = (if p x then x :: filter p xs else filter p xs); end; (*struct List*) structure Product_Type : sig val apsnd : ('a -> 'b) -> 'c * 'a -> 'c * 'b val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun apsnd f (x, y) = (x, f y); fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val delete : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update : 'a HOL.equal -> 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list end = struct fun delete A_ k = List.filter (fn (ka, _) => not (HOL.eq A_ k ka)); fun update A_ k v [] = [(k, v)] | update A_ k v (p :: ps) = (if HOL.eq A_ (Product_Type.fst p) k then (k, v) :: ps else p :: update A_ k v ps); end; (*struct AList*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure Arith : sig type nat datatype num = One | Bit0 of num | Bit1 of num val integer_of_nat : nat -> IntInf.int val plus_nat : nat -> nat -> nat val one_nat : nat val suc : nat -> nat val less_nat : nat -> nat -> bool val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool val minus_nat : nat -> nat -> nat val less_eq_nat : nat -> nat -> bool val times_nat : nat -> nat -> nat val modulo_nat : nat -> nat -> nat end = struct val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype nat = Nat of IntInf.int; datatype num = One | Bit0 of num | Bit1 of num; fun integer_of_nat (Nat x) = x; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; fun less_nat m n = IntInf.< (integer_of_nat m, integer_of_nat n); val zero_nat : nat = Nat (0 : IntInf.int); 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 (Product_Type.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 = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); fun minus_nat m n = Nat (Orderings.max ord_integer (0 : IntInf.int) (IntInf.- (integer_of_nat m, integer_of_nat n))); fun less_eq_nat m n = IntInf.<= (integer_of_nat m, integer_of_nat n); fun times_nat m n = Nat (IntInf.* (integer_of_nat m, integer_of_nat n)); fun modulo_integer k l = Product_Type.snd (divmod_integer k l); fun modulo_nat m n = Nat (modulo_integer (integer_of_nat m) (integer_of_nat n)); end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Uint32a : sig val nat_of_uint32 : Word32.word -> Arith.nat end = struct fun nat_of_uint32 x = Arith.nat_of_integer (IntInf.fromLarge (Word32.toLargeInt x) : IntInf.int); end; (*struct Uint32a*) structure HashCode : sig type 'a hashable val hashcode : 'a hashable -> 'a -> Word32.word val def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat val bounded_hashcode_nat : 'a hashable -> Arith.nat -> 'a -> Arith.nat end = struct type 'a hashable = {hashcode : 'a -> Word32.word, def_hashmap_size : 'a HOL.itself -> Arith.nat}; val hashcode = #hashcode : 'a hashable -> 'a -> Word32.word; val def_hashmap_size = #def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat; fun nat_of_hashcode x = Uint32a.nat_of_uint32 x; fun bounded_hashcode_nat A_ n x = Arith.modulo_nat (nat_of_hashcode (hashcode A_ x)) n; end; (*struct HashCode*) structure Diff_Array : sig val array_get : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a val array_set : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType val new_array : 'a -> Arith.nat -> 'a FArray.IsabelleMapping.ArrayType val array_length : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat end = struct fun array_get a = FArray.IsabelleMapping.array_get a o Arith.integer_of_nat; fun array_set a = FArray.IsabelleMapping.array_set a o Arith.integer_of_nat; fun new_array v = FArray.IsabelleMapping.new_array v o Arith.integer_of_nat; fun array_length x = (Arith.nat_of_integer o FArray.IsabelleMapping.array_length) x; end; (*struct Diff_Array*) structure ArrayHashMap_Impl : sig type ('a, 'b) hashmap val ahm_empty : 'a HashCode.hashable -> unit -> ('a, 'b) hashmap val ahm_delete : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> ('a, 'b) hashmap val ahm_lookup : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> 'b option val ahm_update : 'a HOL.equal * 'a HashCode.hashable -> 'a -> 'b -> ('a, 'b) hashmap -> ('a, 'b) hashmap val ahm_iteratei : 'a HashCode.hashable -> ('a, 'b) hashmap -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('a, 'b) hashmap = HashMap of (('a * 'b) list) FArray.IsabelleMapping.ArrayType * Arith.nat; fun hm_grow A_ (HashMap (a, n)) = Arith.plus_nat (Arith.times_nat (Arith.nat_of_integer (2 : IntInf.int)) (Diff_Array.array_length a)) (Arith.nat_of_integer (3 : IntInf.int)); fun new_hashmap_with A_ size = HashMap (Diff_Array.new_array [] size, Arith.zero_nat); fun ahm_empty A_ = (fn _ => new_hashmap_with A_ (HashCode.def_hashmap_size A_ HOL.Type)); fun ahm_delete (A1_, A2_) k (HashMap (a, n)) = let val h = HashCode.bounded_hashcode_nat A2_ (Diff_Array.array_length a) k; val m = Diff_Array.array_get a h; val deleted = not (Option.is_none (Map.map_of A1_ m k)); in HashMap (Diff_Array.array_set a h (AList.delete A1_ k m), (if deleted then Arith.minus_nat n Arith.one_nat else n)) end; val load_factor : Arith.nat = Arith.nat_of_integer (75 : IntInf.int); fun ahm_filled A_ (HashMap (a, n)) = Arith.less_eq_nat (Arith.times_nat (Diff_Array.array_length a) load_factor) (Arith.times_nat n (Arith.nat_of_integer (100 : IntInf.int))); fun ahm_alpha_aux (A1_, A2_) a k = Map.map_of A1_ (Diff_Array.array_get a (HashCode.bounded_hashcode_nat A2_ (Diff_Array.array_length a) k)) k; fun ahm_alpha (A1_, A2_) (HashMap (a, uu)) = ahm_alpha_aux (A1_, A2_) a; fun ahm_lookup (A1_, A2_) k hm = ahm_alpha (A1_, A2_) hm k; fun idx_iteratei_aux_array_get sz i l c f sigma = (if Arith.equal_nat i Arith.zero_nat orelse not (c sigma) then sigma else idx_iteratei_aux_array_get sz (Arith.minus_nat i Arith.one_nat) l c f (f (Diff_Array.array_get l (Arith.minus_nat sz i)) sigma)); fun idx_iteratei_array_length_array_get l c f sigma = idx_iteratei_aux_array_get (Diff_Array.array_length l) (Diff_Array.array_length l) l c f sigma; fun ahm_iteratei_aux A_ a c f sigma = idx_iteratei_array_length_array_get a c (fn x => Foldi.foldli x c f) sigma; fun ahm_rehash_auxa A_ n kv a = let val h = HashCode.bounded_hashcode_nat A_ n (Product_Type.fst kv); in Diff_Array.array_set a h (kv :: Diff_Array.array_get a h) end; fun ahm_rehash_aux A_ a sz = ahm_iteratei_aux A_ a (fn _ => true) (ahm_rehash_auxa A_ sz) (Diff_Array.new_array [] sz); fun ahm_rehash A_ (HashMap (a, n)) sz = HashMap (ahm_rehash_aux A_ a sz, n); fun ahm_update_aux (A1_, A2_) (HashMap (a, n)) k v = let val h = HashCode.bounded_hashcode_nat A2_ (Diff_Array.array_length a) k; val m = Diff_Array.array_get a h; val insert = Option.is_none (Map.map_of A1_ m k); in HashMap (Diff_Array.array_set a h (AList.update A1_ k v m), (if insert then Arith.plus_nat n Arith.one_nat else n)) end; fun ahm_update (A1_, A2_) k v hm = let val hma = ahm_update_aux (A1_, A2_) hm k v; in (if ahm_filled A2_ hma then ahm_rehash A2_ hma (hm_grow A2_ hma) else hma) end; fun ahm_iteratei A_ (HashMap (a, n)) = ahm_iteratei_aux A_ a; end; (*struct ArrayHashMap_Impl*) structure ArrayHashMap : sig type ('b, 'a) hashmap val test_codegen : 'a HOL.equal * 'a HashCode.hashable -> 'c HOL.equal * 'c HashCode.hashable -> 'e HashCode.hashable -> 'g HashCode.hashable -> 'i HOL.equal * 'i HashCode.hashable -> 'k HashCode.hashable -> 'm HashCode.hashable -> 'o HashCode.hashable -> 'q HashCode.hashable -> 't HashCode.hashable -> 'w HashCode.hashable -> 'y HOL.equal * 'y HashCode.hashable -> 'aa HOL.equal * 'aa HashCode.hashable -> 'ac HashCode.hashable -> 'ae HashCode.hashable -> 'ag HashCode.hashable -> 'ai HOL.equal * 'ai HashCode.hashable -> 'ak HashCode.hashable -> 'am HOL.equal * 'am HashCode.hashable -> 'ao HOL.equal * 'ao HashCode.hashable -> 'aq HOL.equal * 'aq HashCode.hashable -> (('a, 'b) hashmap -> ('a, 'b) hashmap -> ('a, 'b) hashmap) * ((('c, 'd) hashmap -> ('c, 'd) hashmap -> ('c, 'd) hashmap) * ((('e, 'f) hashmap -> ('e * 'f -> bool) -> bool) * ((('g, 'h) hashmap -> ('g * 'h -> bool) -> bool) * (('i -> ('i, 'j) hashmap -> ('i, 'j) hashmap) * ((unit -> ('k, 'l) hashmap) * ((('m, 'n) hashmap -> bool) * ((('o, 'p) hashmap -> bool) * ((('q, 'r) hashmap -> ('q * 'r -> 's -> 's) -> 's -> 's) * ((('t, 'u) hashmap -> ('v -> bool) -> ('t * 'u -> 'v -> 'v) -> 'v -> 'v) * ((('w, 'x) hashmap -> (('w * 'x) list -> bool) -> ('w * 'x -> ('w * 'x) list -> ('w * 'x) list) -> ('w * 'x) list -> ('w * 'x) list) * (('y -> ('y, 'z) hashmap -> 'z option) * ((('aa * 'ab -> bool) -> ('aa, 'ab) hashmap -> ('aa, 'ab) hashmap) * ((('ac, 'ad) hashmap -> ('ac * 'ad -> bool) -> ('ac * 'ad) option) * ((('ae, 'af) hashmap -> Arith.nat) * ((Arith.nat -> ('ag, 'ah) hashmap -> Arith.nat) * (('ai -> 'aj -> ('ai, 'aj) hashmap) * ((('ak, 'al) hashmap -> ('ak * 'al) list) * ((('am * 'an) list -> ('am, 'an) hashmap) * (('ao -> 'ap -> ('ao, 'ap) hashmap -> ('ao, 'ap) hashmap) * ('aq -> 'ar -> ('aq, 'ar) hashmap -> ('aq, 'ar) hashmap)))))))))))))))))))) end = struct datatype ('b, 'a) hashmap = HashMap of ('b, 'a) ArrayHashMap_Impl.hashmap; fun ahm_empty_const A_ = HashMap (ArrayHashMap_Impl.ahm_empty A_ ()); fun ahm_empty A_ = (fn _ => ahm_empty_const A_); fun impl_of B_ (HashMap x) = x; fun ahm_delete (A1_, A2_) k hm = HashMap (ArrayHashMap_Impl.ahm_delete (A1_, A2_) k (impl_of A2_ hm)); fun ahm_lookup (A1_, A2_) k hm = ArrayHashMap_Impl.ahm_lookup (A1_, A2_) k (impl_of A2_ hm); fun ahm_update (A1_, A2_) k v hm = HashMap (ArrayHashMap_Impl.ahm_update (A1_, A2_) k v (impl_of A2_ hm)); fun ahm_iteratei A_ hm = ArrayHashMap_Impl.ahm_iteratei A_ (impl_of A_ hm); fun iteratei_map_op_list_it_ahm_ops A_ s = ahm_iteratei A_ s; fun g_list_to_map_ahm_basic_ops (A1_, A2_) l = List.foldl (fn m => fn (k, v) => ahm_update (A1_, A2_) k v m) (ahm_empty A2_ ()) (List.rev l); fun iteratei_bmap_op_list_it_ahm_basic_ops A_ s = ahm_iteratei A_ s; fun g_size_abort_ahm_basic_ops A_ b m = iteratei_bmap_op_list_it_ahm_basic_ops A_ m (fn s => Arith.less_nat s b) (fn _ => Arith.suc) Arith.zero_nat; fun g_restrict_ahm_basic_ops (A1_, A2_) p m = iteratei_bmap_op_list_it_ahm_basic_ops A2_ m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then ahm_update (A1_, A2_) k v sigma else sigma)) (ahm_empty A2_ ()); fun g_to_list_ahm_basic_ops A_ m = iteratei_bmap_op_list_it_ahm_basic_ops A_ m (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_ahm_basic_ops A_ m = Arith.equal_nat (g_size_abort_ahm_basic_ops A_ Arith.one_nat m) Arith.zero_nat; fun g_add_dj_ahm_basic_ops (A1_, A2_) m1 m2 = iteratei_bmap_op_list_it_ahm_basic_ops A2_ m2 (fn _ => true) (fn (a, b) => ahm_update (A1_, A2_) a b) m1; fun g_isSng_ahm_basic_ops A_ m = Arith.equal_nat (g_size_abort_ahm_basic_ops A_ (Arith.nat_of_integer (2 : IntInf.int)) m) Arith.one_nat; fun g_size_ahm_basic_ops A_ m = iteratei_bmap_op_list_it_ahm_basic_ops A_ m (fn _ => true) (fn _ => Arith.suc) Arith.zero_nat; fun g_ball_ahm_basic_ops A_ m p = iteratei_bmap_op_list_it_ahm_basic_ops A_ m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_ahm_basic_ops (A1_, A2_) k v = ahm_update (A1_, A2_) k v (ahm_empty A2_ ()); fun g_sel_ahm_basic_ops A_ m p = iteratei_bmap_op_list_it_ahm_basic_ops A_ m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_ahm_basic_ops A_ m p = iteratei_bmap_op_list_it_ahm_basic_ops A_ m not (fn kv => fn _ => p kv) false; fun g_add_ahm_basic_ops (A1_, A2_) m1 m2 = iteratei_bmap_op_list_it_ahm_basic_ops A2_ m2 (fn _ => true) (fn (a, b) => ahm_update (A1_, A2_) a b) m1; fun test_codegen (A1_, A2_) (C1_, C2_) E_ G_ (I1_, I2_) K_ M_ O_ Q_ T_ W_ (Y1_, Y2_) (Aa1_, Aa2_) Ac_ Ae_ Ag_ (Ai1_, Ai2_) Ak_ (Am1_, Am2_) (Ao1_, Ao2_) (Aq1_, Aq2_) = (g_add_ahm_basic_ops (A1_, A2_), (g_add_dj_ahm_basic_ops (C1_, C2_), (g_ball_ahm_basic_ops E_, (g_bex_ahm_basic_ops G_, (ahm_delete (I1_, I2_), (ahm_empty K_, (g_isEmpty_ahm_basic_ops M_, (g_isSng_ahm_basic_ops O_, ((fn m => iteratei_map_op_list_it_ahm_ops Q_ m (fn _ => true)), (iteratei_map_op_list_it_ahm_ops T_, (ahm_iteratei W_, (ahm_lookup (Y1_, Y2_), (g_restrict_ahm_basic_ops (Aa1_, Aa2_), (g_sel_ahm_basic_ops Ac_, (g_size_ahm_basic_ops Ae_, (g_size_abort_ahm_basic_ops Ag_, (g_sng_ahm_basic_ops (Ai1_, Ai2_), (g_to_list_ahm_basic_ops Ak_, (g_list_to_map_ahm_basic_ops (Am1_, Am2_), (ahm_update (Ao1_, Ao2_), ahm_update (Aq1_, Aq2_))))))))))))))))))))); end; (*struct ArrayHashMap*) ### theory "Collections.ArrayHashMap" ### 1.479s elapsed time, 2.964s cpu time, 0.000s GC time Loading theory "Collections.ListSetImpl_NotDist" (required by "Collections.SetStdImpl") structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure List : sig val member : 'a HOL.equal -> 'a list -> 'a -> bool end = struct fun member A_ [] y = false | member A_ (x :: xs) y = HOL.eq A_ x y orelse member A_ xs y; end; (*struct List*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Dlist_add : sig val dlist_remove1 : 'a HOL.equal -> 'a -> 'a list -> 'a list -> 'a list end = struct fun dlist_remove1 A_ x z [] = z | dlist_remove1 A_ x z (y :: ys) = (if HOL.eq A_ x y then z @ ys else dlist_remove1 A_ x (y :: z) ys); end; (*struct Dlist_add*) structure ListSetImpl_Invar : sig val test_codegen : 'b HOL.equal -> 'c HOL.equal -> 'd HOL.equal -> 'f HOL.equal -> 'm HOL.equal -> 'o HOL.equal -> 'q HOL.equal -> 'r HOL.equal -> 's HOL.equal -> 't HOL.equal -> 'u HOL.equal -> 'x HOL.equal -> (unit -> 'a list) * (('b -> 'b list -> bool) * (('c -> 'c list -> 'c list) * (('d -> 'd list -> 'd list) * (('e list -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> 'f list) * (('g list -> bool) * (('h list -> bool) * (('i list -> ('i -> bool) -> bool) * (('j list -> ('j -> bool) -> bool) * (('k list -> Arith.nat) * ((Arith.nat -> 'l list -> Arith.nat) * (('m list -> 'm list -> 'm list) * (('n list -> 'n list -> 'n list) * (('o list -> 'o list -> 'o list) * ((('p -> bool) -> 'p list -> 'p list) * (('q list -> 'q list -> 'q list) * (('r list -> 'r list -> bool) * (('s list -> 's list -> bool) * (('t list -> 't list -> bool) * (('u list -> 'u list -> 'u option) * (('v list -> ('v -> bool) -> 'v option) * (('w list -> 'w list) * ('x list -> 'x list))))))))))))))))))))))) end = struct fun lsi_ins A_ x l = (if List.member A_ l x then l else x :: l); fun iteratei_bset_op_list_it_lsi_basic_ops s = Foldi.foldli s; fun g_sel_lsi_basic_ops s p = iteratei_bset_op_list_it_lsi_basic_ops s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_disjoint_witness_lsi_basic_ops A_ s1 s2 = g_sel_lsi_basic_ops s1 (List.member A_ s2); fun g_size_abort_lsi_basic_ops m s = iteratei_bset_op_list_it_lsi_basic_ops s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_from_list_aux_lsi_basic_ops A_ y [] = y | g_from_list_aux_lsi_basic_ops A_ accs (x :: l) = g_from_list_aux_lsi_basic_ops A_ (lsi_ins A_ x accs) l; fun g_from_list_lsi_basic_ops A_ l = g_from_list_aux_lsi_basic_ops A_ [] l; fun g_ball_lsi_basic_ops s p = iteratei_bset_op_list_it_lsi_basic_ops s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_lsi_basic_ops A_ s1 s2 = g_ball_lsi_basic_ops s1 (fn x => not (List.member A_ s2 x)); fun g_isEmpty_lsi_basic_ops s = iteratei_bset_op_list_it_lsi_basic_ops s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_lsi_basic_ops A_ s1 s2 = g_ball_lsi_basic_ops s1 (List.member A_ s2); fun g_filter_lsi_basic_ops p s = iteratei_bset_op_list_it_lsi_basic_ops s (fn _ => true) (fn x => fn sigma => (if p x then x :: sigma else sigma)) []; fun g_union_lsi_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_lsi_basic_ops s1 (fn _ => true) (lsi_ins A_) s2; fun g_isSng_lsi_basic_ops s = Arith.equal_nat (iteratei_bset_op_list_it_lsi_basic_ops s (fn sigma => Arith.less_nat sigma (Arith.nat_of_num (Arith.Bit0 Arith.One))) (fn _ => Arith.Suc) Arith.Zero_nat) Arith.one_nat; fun g_inter_lsi_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_lsi_basic_ops s1 (fn _ => true) (fn x => fn s => (if List.member A_ s2 x then x :: s else s)) []; fun g_equal_lsi_basic_ops A_ s1 s2 = g_subset_lsi_basic_ops A_ s1 s2 andalso g_subset_lsi_basic_ops A_ s2 s1; fun g_size_lsi_basic_ops s = iteratei_bset_op_list_it_lsi_basic_ops s (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_diff_lsi_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_lsi_basic_ops s2 (fn _ => true) (fn x => Dlist_add.dlist_remove1 A_ x []) s1; fun g_sng_lsi_basic_ops A_ x = lsi_ins A_ x []; fun g_bex_lsi_basic_ops s p = iteratei_bset_op_list_it_lsi_basic_ops s not (fn x => fn _ => p x) false; fun test_codegen B_ C_ D_ F_ M_ O_ Q_ R_ S_ T_ U_ X_ = ((fn _ => []), ((fn x => fn s => List.member B_ s x), (lsi_ins C_, ((fn x => Dlist_add.dlist_remove1 D_ x []), (Foldi.foldli, (g_sng_lsi_basic_ops F_, (g_isEmpty_lsi_basic_ops, (g_isSng_lsi_basic_ops, (g_ball_lsi_basic_ops, (g_bex_lsi_basic_ops, (g_size_lsi_basic_ops, (g_size_abort_lsi_basic_ops, (g_union_lsi_basic_ops M_, ((fn a => fn b => a @ b), (g_diff_lsi_basic_ops O_, (g_filter_lsi_basic_ops, (g_inter_lsi_basic_ops Q_, (g_subset_lsi_basic_ops R_, (g_equal_lsi_basic_ops S_, (g_disjoint_lsi_basic_ops T_, (g_disjoint_witness_lsi_basic_ops U_, (g_sel_lsi_basic_ops, (Fun.id, g_from_list_lsi_basic_ops X_))))))))))))))))))))))); end; (*struct ListSetImpl_Invar*) ### theory "Collections.ListSetImpl_Invar" ### 1.147s elapsed time, 2.300s cpu time, 0.000s GC time Loading theory "Collections.ListSetImpl_Sorted" (required by "Collections.SetStdImpl") structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure List : sig val null : 'a list -> bool val member : 'a HOL.equal -> 'a list -> 'a -> bool val remdups : 'a HOL.equal -> 'a list -> 'a list end = struct fun null [] = true | null (x :: xs) = false; fun member A_ [] y = false | member A_ (x :: xs) y = HOL.eq A_ x y orelse member A_ xs y; fun remdups A_ [] = [] | remdups A_ (x :: xs) = (if member A_ xs x then remdups A_ xs else x :: remdups A_ xs); end; (*struct List*) structure Misc : sig val revg : 'a list -> 'a list -> 'a list val remove_rev : 'a HOL.equal -> 'a -> 'a list -> 'a list end = struct fun revg [] b = b | revg (a :: asa) b = revg asa (a :: b); fun filter_rev_aux a p [] = a | filter_rev_aux a p (x :: xs) = (if p x then filter_rev_aux (x :: a) p xs else filter_rev_aux a p xs); fun filter_rev x = filter_rev_aux [] x; fun remove_rev A_ x = filter_rev (not o HOL.eq A_ x); end; (*struct Misc*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure ListSetImpl_NotDist : sig val test_codegen : 'b HOL.equal -> 'd HOL.equal -> 'e HOL.equal -> 'h HOL.equal -> 'i HOL.equal -> 'j HOL.equal -> 'k HOL.equal -> 'l HOL.equal -> 'o HOL.equal -> 'p HOL.equal -> 'q HOL.equal -> 'r HOL.equal -> 's HOL.equal -> 't HOL.equal -> 'u HOL.equal -> 'v HOL.equal -> 'w HOL.equal -> (unit -> 'a list) * (('b -> 'b list -> bool) * (('c -> 'c list -> 'c list) * (('d -> 'd list -> 'd list) * (('e list -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> 'f list) * (('g list -> bool) * (('h list -> bool) * (('i list -> ('i -> bool) -> bool) * (('j list -> ('j -> bool) -> bool) * (('k list -> Arith.nat) * ((Arith.nat -> 'l list -> Arith.nat) * (('m list -> 'm list -> 'm list) * (('n list -> 'n list -> 'n list) * (('o list -> 'o list -> 'o list) * ((('p -> bool) -> 'p list -> 'p list) * (('q list -> 'q list -> 'q list) * (('r list -> 'r list -> bool) * (('s list -> 's list -> bool) * (('t list -> 't list -> bool) * (('u list -> 'u list -> 'u option) * (('v list -> ('v -> bool) -> 'v option) * (('w list -> 'w list) * ('x list -> 'x list))))))))))))))))))))))) end = struct fun lsnd_ins x l = x :: l; fun lsnd_memb A_ x l = List.member A_ l x; fun lsnd_empty x = (fn _ => []) x; fun lsnd_union s1 s2 = Misc.revg s1 s2; fun lsnd_delete A_ x l = Misc.remove_rev A_ x l; fun lsnd_ins_dj x l = x :: l; fun list_to_lsnd x = Fun.id x; fun lsnd_isEmpty s = List.null s; fun lsnd_to_list A_ = List.remdups A_; fun lsnd_iteratei A_ l = Foldi.foldli (List.remdups A_ l); fun iteratei_bset_op_list_it_lsnd_basic_ops A_ s = lsnd_iteratei A_ s; fun g_sel_lsnd_basic_ops A_ s p = iteratei_bset_op_list_it_lsnd_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_disjoint_witness_lsnd_basic_ops A_ s1 s2 = g_sel_lsnd_basic_ops A_ s1 (fn x => lsnd_memb A_ x s2); fun g_size_abort_lsnd_basic_ops A_ m s = iteratei_bset_op_list_it_lsnd_basic_ops A_ s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_ball_lsnd_basic_ops A_ s p = iteratei_bset_op_list_it_lsnd_basic_ops A_ s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_lsnd_basic_ops A_ s1 s2 = g_ball_lsnd_basic_ops A_ s1 (fn x => not (lsnd_memb A_ x s2)); fun g_subset_lsnd_basic_ops A_ s1 s2 = g_ball_lsnd_basic_ops A_ s1 (fn x => lsnd_memb A_ x s2); fun g_filter_lsnd_basic_ops A_ p s = iteratei_bset_op_list_it_lsnd_basic_ops A_ s (fn _ => true) (fn x => fn sigma => (if p x then lsnd_ins_dj x sigma else sigma)) (lsnd_empty ()); fun g_isSng_lsnd_basic_ops A_ s = Arith.equal_nat (iteratei_bset_op_list_it_lsnd_basic_ops A_ s (fn sigma => Arith.less_nat sigma (Arith.nat_of_num (Arith.Bit0 Arith.One))) (fn _ => Arith.Suc) Arith.Zero_nat) Arith.one_nat; fun g_inter_lsnd_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_lsnd_basic_ops A_ s1 (fn _ => true) (fn x => fn s => (if lsnd_memb A_ x s2 then lsnd_ins_dj x s else s)) (lsnd_empty ()); fun g_equal_lsnd_basic_ops A_ s1 s2 = g_subset_lsnd_basic_ops A_ s1 s2 andalso g_subset_lsnd_basic_ops A_ s2 s1; fun g_size_lsnd_basic_ops A_ s = iteratei_bset_op_list_it_lsnd_basic_ops A_ s (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_diff_lsnd_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_lsnd_basic_ops A_ s2 (fn _ => true) (lsnd_delete A_) s1; fun g_sng_lsnd_basic_ops x = lsnd_ins x (lsnd_empty ()); fun g_bex_lsnd_basic_ops A_ s p = iteratei_bset_op_list_it_lsnd_basic_ops A_ s not (fn x => fn _ => p x) false; fun lsnd_union_dj s1 s2 = Misc.revg s1 s2; fun test_codegen B_ D_ E_ H_ I_ J_ K_ L_ O_ P_ Q_ R_ S_ T_ U_ V_ W_ = (lsnd_empty, (lsnd_memb B_, (lsnd_ins, (lsnd_delete D_, (lsnd_iteratei E_, (g_sng_lsnd_basic_ops, (lsnd_isEmpty, (g_isSng_lsnd_basic_ops H_, (g_ball_lsnd_basic_ops I_, (g_bex_lsnd_basic_ops J_, (g_size_lsnd_basic_ops K_, (g_size_abort_lsnd_basic_ops L_, (lsnd_union, (lsnd_union_dj, (g_diff_lsnd_basic_ops O_, (g_filter_lsnd_basic_ops P_, (g_inter_lsnd_basic_ops Q_, (g_subset_lsnd_basic_ops R_, (g_equal_lsnd_basic_ops S_, (g_disjoint_lsnd_basic_ops T_, (g_disjoint_witness_lsnd_basic_ops U_, (g_sel_lsnd_basic_ops V_, (lsnd_to_list W_, list_to_lsnd))))))))))))))))))))))); end; (*struct ListSetImpl_NotDist*) ### theory "Collections.ListSetImpl_NotDist" ### 1.718s elapsed time, 3.396s cpu time, 0.448s GC time Loading theory "Collections.SetByMap" locale SetByMapDefs fixes ops :: "('x, unit, 's, 'more) map_basic_ops_scheme" locale SetByMap fixes ops :: "('x, unit, 's, 'more) map_basic_ops_scheme" assumes "SetByMap ops" locale OSetByOMapDefs fixes ops :: "('x, unit, 's, 'more) omap_basic_ops_scheme" structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure List : sig val null : 'a list -> bool val filter : ('a -> bool) -> 'a list -> 'a list val map : ('a -> 'b) -> 'a list -> 'b list end = struct fun null [] = true | null (x :: xs) = false; fun filter p [] = [] | filter p (x :: xs) = (if p x then x :: filter p xs else filter p xs); fun map f [] = [] | map f (x21 :: x22) = f x21 :: map f x22; end; (*struct List*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; end; (*struct Orderings*) structure Misc : sig val merge : 'a HOL.equal * 'a Orderings.linorder -> 'a list -> 'a list -> 'a list val mergesort_remdups : 'a HOL.equal * 'a Orderings.linorder -> 'a list -> 'a list end = struct fun merge (A1_, A2_) [] l2 = l2 | merge (A1_, A2_) (v :: va) [] = v :: va | merge (A1_, A2_) (x1 :: l1) (x2 :: l2) = (if Orderings.less ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A2_) x1 x2 then x1 :: merge (A1_, A2_) l1 (x2 :: l2) else (if HOL.eq A1_ x1 x2 then x1 :: merge (A1_, A2_) l1 l2 else x2 :: merge (A1_, A2_) (x1 :: l1) l2)); fun merge_list (A1_, A2_) [] [] = [] | merge_list (A1_, A2_) [] [l] = l | merge_list (A1_, A2_) (la :: acc2) [] = merge_list (A1_, A2_) [] (la :: acc2) | merge_list (A1_, A2_) (la :: acc2) [l] = merge_list (A1_, A2_) [] (l :: la :: acc2) | merge_list (A1_, A2_) acc2 (l1 :: l2 :: ls) = merge_list (A1_, A2_) (merge (A1_, A2_) l1 l2 :: acc2) ls; fun mergesort_remdups (A1_, A2_) xs = merge_list (A1_, A2_) [] (List.map (fn x => [x]) xs); end; (*struct Misc*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Sorted_List_Operations : sig val memb_sorted : 'a HOL.equal * 'a Orderings.ord -> 'a list -> 'a -> bool val delete_sorted : 'a HOL.equal * 'a Orderings.ord -> 'a -> 'a list -> 'a list val insertion_sort : 'a HOL.equal * 'a Orderings.ord -> 'a -> 'a list -> 'a list end = struct fun memb_sorted (A1_, A2_) [] x = false | memb_sorted (A1_, A2_) (y :: xs) x = (if Orderings.less A2_ y x then memb_sorted (A1_, A2_) xs x else HOL.eq A1_ x y); fun delete_sorted (A1_, A2_) x [] = [] | delete_sorted (A1_, A2_) x (y :: xs) = (if Orderings.less A2_ y x then y :: delete_sorted (A1_, A2_) x xs else (if HOL.eq A1_ x y then xs else y :: xs)); fun insertion_sort (A1_, A2_) x [] = [x] | insertion_sort (A1_, A2_) x (y :: xs) = (if Orderings.less A2_ y x then y :: insertion_sort (A1_, A2_) x xs else (if HOL.eq A1_ x y then y :: xs else x :: y :: xs)); end; (*struct Sorted_List_Operations*) structure ListSetImpl_Sorted : sig val test_codegen : 'a Orderings.linorder -> 'b HOL.equal * 'b Orderings.linorder -> 'c HOL.equal * 'c Orderings.linorder -> 'd HOL.equal * 'd Orderings.linorder -> 'e Orderings.linorder -> 'f HOL.equal * 'f Orderings.linorder -> 'g Orderings.linorder -> 'h Orderings.linorder -> 'i Orderings.linorder -> 'j Orderings.linorder -> 'k Orderings.linorder -> 'l Orderings.linorder -> 'm HOL.equal * 'm Orderings.linorder -> 'n HOL.equal * 'n Orderings.linorder -> 'o HOL.equal * 'o Orderings.linorder -> 'p Orderings.linorder -> 'q HOL.equal * 'q Orderings.linorder -> 'r HOL.equal * 'r Orderings.linorder -> 's HOL.equal * 's Orderings.linorder -> 't HOL.equal * 't Orderings.linorder -> 'u HOL.equal * 'u Orderings.linorder -> 'v Orderings.linorder -> 'w Orderings.linorder -> 'x HOL.equal * 'x Orderings.linorder -> (unit -> 'a list) * (('b -> 'b list -> bool) * (('c -> 'c list -> 'c list) * (('d -> 'd list -> 'd list) * (('e list -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> 'f list) * (('g list -> bool) * (('h list -> bool) * (('i list -> ('i -> bool) -> bool) * (('j list -> ('j -> bool) -> bool) * (('k list -> Arith.nat) * ((Arith.nat -> 'l list -> Arith.nat) * (('m list -> 'm list -> 'm list) * (('n list -> 'n list -> 'n list) * (('o list -> 'o list -> 'o list) * ((('p -> bool) -> 'p list -> 'p list) * (('q list -> 'q list -> 'q list) * (('r list -> 'r list -> bool) * (('s list -> 's list -> bool) * (('t list -> 't list -> bool) * (('u list -> 'u list -> 'u option) * (('v list -> ('v -> bool) -> 'v option) * (('w list -> 'w list) * ('x list -> 'x list))))))))))))))))))))))) end = struct fun lss_ins (A1_, A2_) x l = Sorted_List_Operations.insertion_sort (A1_, (Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A2_) x l; fun lss_memb (A1_, A2_) x l = Sorted_List_Operations.memb_sorted (A1_, (Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A2_) l x; fun lss_empty x = (fn _ => []) x; fun lss_union (A1_, A2_) s1 s2 = Misc.merge (A1_, A2_) s1 s2; fun lss_delete (A1_, A2_) x l = Sorted_List_Operations.delete_sorted (A1_, (Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A2_) x l; fun lss_ins_dj (A1_, A2_) = lss_ins (A1_, A2_); fun list_to_lss (A1_, A2_) = Misc.mergesort_remdups (A1_, A2_); fun lss_isEmpty s = List.null s; fun lss_to_list x = Fun.id x; fun lss_iteratei l = Foldi.foldli l; fun lss_union_dj (A1_, A2_) = lss_union (A1_, A2_); fun iteratei_bset_op_list_it_lss_basic_ops A_ s = lss_iteratei s; fun g_sel_lss_basic_ops A_ s p = iteratei_bset_op_list_it_lss_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_disjoint_witness_lss_basic_ops (A1_, A2_) s1 s2 = g_sel_lss_basic_ops A2_ s1 (fn x => lss_memb (A1_, A2_) x s2); fun g_size_abort_lss_basic_ops A_ m s = iteratei_bset_op_list_it_lss_basic_ops A_ s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_ball_lss_basic_ops A_ s p = iteratei_bset_op_list_it_lss_basic_ops A_ s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_lss_basic_ops (A1_, A2_) s1 s2 = g_ball_lss_basic_ops A2_ s1 (fn x => not (lss_memb (A1_, A2_) x s2)); fun g_subset_lss_basic_ops (A1_, A2_) s1 s2 = g_ball_lss_basic_ops A2_ s1 (fn x => lss_memb (A1_, A2_) x s2); fun g_isSng_lss_basic_ops A_ s = Arith.equal_nat (iteratei_bset_op_list_it_lss_basic_ops A_ s (fn sigma => Arith.less_nat sigma (Arith.nat_of_num (Arith.Bit0 Arith.One))) (fn _ => Arith.Suc) Arith.Zero_nat) Arith.one_nat; fun g_inter_lss_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_lss_basic_ops A2_ s1 (fn _ => true) (fn x => fn s => (if lss_memb (A1_, A2_) x s2 then lss_ins_dj (A1_, A2_) x s else s)) (lss_empty ()); fun g_equal_lss_basic_ops (A1_, A2_) s1 s2 = g_subset_lss_basic_ops (A1_, A2_) s1 s2 andalso g_subset_lss_basic_ops (A1_, A2_) s2 s1; fun g_size_lss_basic_ops A_ s = iteratei_bset_op_list_it_lss_basic_ops A_ s (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_diff_lss_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_lss_basic_ops A2_ s2 (fn _ => true) (lss_delete (A1_, A2_)) s1; fun g_sng_lss_basic_ops (A1_, A2_) x = lss_ins (A1_, A2_) x (lss_empty ()); fun g_bex_lss_basic_ops A_ s p = iteratei_bset_op_list_it_lss_basic_ops A_ s not (fn x => fn _ => p x) false; fun test_codegen A_ (B1_, B2_) (C1_, C2_) (D1_, D2_) E_ (F1_, F2_) G_ H_ I_ J_ K_ L_ (M1_, M2_) (N1_, N2_) (O1_, O2_) P_ (Q1_, Q2_) (R1_, R2_) (S1_, S2_) (T1_, T2_) (U1_, U2_) V_ W_ (X1_, X2_) = (lss_empty, (lss_memb (B1_, B2_), (lss_ins (C1_, C2_), (lss_delete (D1_, D2_), (lss_iteratei, (g_sng_lss_basic_ops (F1_, F2_), (lss_isEmpty, (g_isSng_lss_basic_ops H_, (g_ball_lss_basic_ops I_, (g_bex_lss_basic_ops J_, (g_size_lss_basic_ops K_, (g_size_abort_lss_basic_ops L_, (lss_union (M1_, M2_), (lss_union_dj (N1_, N2_), (g_diff_lss_basic_ops (O1_, O2_), (List.filter, (g_inter_lss_basic_ops (Q1_, Q2_), (g_subset_lss_basic_ops (R1_, R2_), (g_equal_lss_basic_ops (S1_, S2_), (g_disjoint_lss_basic_ops (T1_, T2_), (g_disjoint_witness_lss_basic_ops (U1_, U2_), (g_sel_lss_basic_ops V_, (lss_to_list, list_to_lss (X1_, X2_)))))))))))))))))))))))); end; (*struct ListSetImpl_Sorted*) ### theory "Collections.ListSetImpl_Sorted" ### 2.571s elapsed time, 5.104s cpu time, 0.448s GC time Loading theory "Collections.RBTMapImpl" (required by "Collections.MapStdImpl") locale OSetByOMap fixes ops :: "('x, unit, 's, 'more) omap_basic_ops_scheme" assumes "OSetByOMap ops" ### theory "Collections.SetByMap" ### 1.512s elapsed time, 3.028s cpu time, 0.000s GC time Loading theory "Collections.ArrayHashSet" (required by "Collections.SetStdImpl") ### Ignoring sort constraints in type variables(s): "'a" ### in type abbreviation "ahs" (* Test that words can handle numbers between 0 and 31 *) val _ = if 5 <= Word.wordSize then () else raise (Fail ("wordSize less than 5")); structure Uint32 : sig val set_bit : Word32.word -> IntInf.int -> bool -> Word32.word val shiftl : Word32.word -> IntInf.int -> Word32.word val shiftr : Word32.word -> IntInf.int -> Word32.word val shiftr_signed : Word32.word -> IntInf.int -> Word32.word val test_bit : Word32.word -> IntInf.int -> bool end = struct fun set_bit x n b = let val mask = Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n)) in if b then Word32.orb (x, mask) else Word32.andb (x, Word32.notb mask) end fun shiftl x n = Word32.<< (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr x n = Word32.>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr_signed x n = Word32.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun test_bit x n = Word32.andb (x, Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word32.fromInt 0 end; (* struct Uint32 *) structure STArray = struct datatype 'a Cell = Invalid | Value of 'a array; exception AccessedOldVersion; type 'a array = 'a Cell Unsynchronized.ref; fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun array (size, v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun sub (Unsynchronized.ref Invalid, idx) = raise AccessedOldVersion | sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx); fun update (aref,idx,v) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( aref := Invalid; Array.update (a,idx,v); Unsynchronized.ref (Value a) ); fun length (Unsynchronized.ref Invalid) = raise AccessedOldVersion | length (Unsynchronized.ref (Value a)) = Array.length a fun grow (aref, i, x) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+i,x) in aref := Invalid; Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( aref:=Invalid; Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); end; end; structure FArray = struct datatype 'a Cell = Value of 'a Array.array | Upd of (int*'a*'a Cell Unsynchronized.ref); type 'a array = 'a Cell Unsynchronized.ref; fun array (size,v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx) | sub (Unsynchronized.ref (Upd (i,v,cr)),idx) = if i=idx then v else sub (cr,idx); fun length (Unsynchronized.ref (Value a)) = Array.length a | length (Unsynchronized.ref (Upd (i,v,cr))) = length cr; fun realize_aux (aref, v) = case aref of (Unsynchronized.ref (Value a)) => ( let val len = Array.length a; val a' = Array.array (len,v); in Array.copy {src=a, dst=a', di=0}; Unsynchronized.ref (Value a') end ) | (Unsynchronized.ref (Upd (i,v,cr))) => ( let val res=realize_aux (cr,v) in case res of (Unsynchronized.ref (Value a)) => (Array.update (a,i,v); res) end ); fun realize aref = case aref of (Unsynchronized.ref (Value _)) => aref | (Unsynchronized.ref (Upd (i,v,cr))) => realize_aux(aref,v); fun update (aref,idx,v) = case aref of (Unsynchronized.ref (Value a)) => ( let val nref=Unsynchronized.ref (Value a) in aref := Upd (idx,Array.sub(a,idx),nref); Array.update (a,idx,v); nref end ) | (Unsynchronized.ref (Upd _)) => let val ra = realize_aux(aref,v) in case ra of (Unsynchronized.ref (Value a)) => Array.update (a,idx,v); ra end ; fun grow (aref, inc, x) = case aref of (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+inc,x) in Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ) | (Unsynchronized.ref (Upd _)) => ( grow (realize aref, inc, x) ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ) | (Unsynchronized.ref (Upd _)) => ( shrink (realize aref,sz) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); fun array_get_oo (d:'a) (a:'a ArrayType) (i:IntInf.int) = sub (a,IntInf.toInt i) handle Subscript => d fun array_set_oo (d:(unit->'a ArrayType)) (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e) handle Subscript => d () end; end; structure Bits_Integer : sig val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int val shiftl : IntInf.int -> IntInf.int -> IntInf.int val shiftr : IntInf.int -> IntInf.int -> IntInf.int val test_bit : IntInf.int -> IntInf.int -> bool end = struct val maxWord = IntInf.pow (2, Word.wordSize); fun set_bit x n b = if n < maxWord then if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))) else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); fun shiftl x n = if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun shiftr x n = if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun test_bit x n = if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0 else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); end; (*struct Bits_Integer*) structure HOL : sig type 'a equal datatype 'a itself = Type val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; datatype 'a itself = Type; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure List : sig val filter : ('a -> bool) -> 'a list -> 'a list end = struct fun filter p [] = [] | filter p (x :: xs) = (if p x then x :: filter p xs else filter p xs); end; (*struct List*) structure Product_Type : sig val apsnd : ('a -> 'b) -> 'c * 'a -> 'c * 'b val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun apsnd f (x, y) = (x, f y); fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val delete : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update : 'a HOL.equal -> 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list end = struct fun delete A_ k = List.filter (fn (ka, _) => not (HOL.eq A_ k ka)); fun update A_ k v [] = [(k, v)] | update A_ k v (p :: ps) = (if HOL.eq A_ (Product_Type.fst p) k then (k, v) :: ps else p :: update A_ k v ps); end; (*struct AList*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure Arith : sig type nat datatype num = One | Bit0 of num | Bit1 of num val integer_of_nat : nat -> IntInf.int val plus_nat : nat -> nat -> nat val one_nat : nat val suc : nat -> nat val less_nat : nat -> nat -> bool val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool val minus_nat : nat -> nat -> nat val less_eq_nat : nat -> nat -> bool val times_nat : nat -> nat -> nat val modulo_nat : nat -> nat -> nat end = struct val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype nat = Nat of IntInf.int; datatype num = One | Bit0 of num | Bit1 of num; fun integer_of_nat (Nat x) = x; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; fun less_nat m n = IntInf.< (integer_of_nat m, integer_of_nat n); val zero_nat : nat = Nat (0 : IntInf.int); 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 (Product_Type.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 = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); fun minus_nat m n = Nat (Orderings.max ord_integer (0 : IntInf.int) (IntInf.- (integer_of_nat m, integer_of_nat n))); fun less_eq_nat m n = IntInf.<= (integer_of_nat m, integer_of_nat n); fun times_nat m n = Nat (IntInf.* (integer_of_nat m, integer_of_nat n)); fun modulo_integer k l = Product_Type.snd (divmod_integer k l); fun modulo_nat m n = Nat (modulo_integer (integer_of_nat m) (integer_of_nat n)); end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Uint32a : sig val nat_of_uint32 : Word32.word -> Arith.nat end = struct fun nat_of_uint32 x = Arith.nat_of_integer (IntInf.fromLarge (Word32.toLargeInt x) : IntInf.int); end; (*struct Uint32a*) structure HashCode : sig type 'a hashable val hashcode : 'a hashable -> 'a -> Word32.word val def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat val bounded_hashcode_nat : 'a hashable -> Arith.nat -> 'a -> Arith.nat end = struct type 'a hashable = {hashcode : 'a -> Word32.word, def_hashmap_size : 'a HOL.itself -> Arith.nat}; val hashcode = #hashcode : 'a hashable -> 'a -> Word32.word; val def_hashmap_size = #def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat; fun nat_of_hashcode x = Uint32a.nat_of_uint32 x; fun bounded_hashcode_nat A_ n x = Arith.modulo_nat (nat_of_hashcode (hashcode A_ x)) n; end; (*struct HashCode*) structure Diff_Array : sig val array_get : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a val array_set : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType val new_array : 'a -> Arith.nat -> 'a FArray.IsabelleMapping.ArrayType val array_length : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat end = struct fun array_get a = FArray.IsabelleMapping.array_get a o Arith.integer_of_nat; fun array_set a = FArray.IsabelleMapping.array_set a o Arith.integer_of_nat; fun new_array v = FArray.IsabelleMapping.new_array v o Arith.integer_of_nat; fun array_length x = (Arith.nat_of_integer o FArray.IsabelleMapping.array_length) x; end; (*struct Diff_Array*) structure ArrayHashMap_Impl : sig type ('a, 'b) hashmap val ahm_empty : 'a HashCode.hashable -> unit -> ('a, 'b) hashmap val ahm_delete : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> ('a, 'b) hashmap val ahm_lookup : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> 'b option val ahm_update : 'a HOL.equal * 'a HashCode.hashable -> 'a -> 'b -> ('a, 'b) hashmap -> ('a, 'b) hashmap val ahm_iteratei : 'a HashCode.hashable -> ('a, 'b) hashmap -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('a, 'b) hashmap = HashMap of (('a * 'b) list) FArray.IsabelleMapping.ArrayType * Arith.nat; fun hm_grow A_ (HashMap (a, n)) = Arith.plus_nat (Arith.times_nat (Arith.nat_of_integer (2 : IntInf.int)) (Diff_Array.array_length a)) (Arith.nat_of_integer (3 : IntInf.int)); fun new_hashmap_with A_ size = HashMap (Diff_Array.new_array [] size, Arith.zero_nat); fun ahm_empty A_ = (fn _ => new_hashmap_with A_ (HashCode.def_hashmap_size A_ HOL.Type)); fun ahm_delete (A1_, A2_) k (HashMap (a, n)) = let val h = HashCode.bounded_hashcode_nat A2_ (Diff_Array.array_length a) k; val m = Diff_Array.array_get a h; val deleted = not (Option.is_none (Map.map_of A1_ m k)); in HashMap (Diff_Array.array_set a h (AList.delete A1_ k m), (if deleted then Arith.minus_nat n Arith.one_nat else n)) end; val load_factor : Arith.nat = Arith.nat_of_integer (75 : IntInf.int); fun ahm_filled A_ (HashMap (a, n)) = Arith.less_eq_nat (Arith.times_nat (Diff_Array.array_length a) load_factor) (Arith.times_nat n (Arith.nat_of_integer (100 : IntInf.int))); fun ahm_alpha_aux (A1_, A2_) a k = Map.map_of A1_ (Diff_Array.array_get a (HashCode.bounded_hashcode_nat A2_ (Diff_Array.array_length a) k)) k; fun ahm_alpha (A1_, A2_) (HashMap (a, uu)) = ahm_alpha_aux (A1_, A2_) a; fun ahm_lookup (A1_, A2_) k hm = ahm_alpha (A1_, A2_) hm k; fun idx_iteratei_aux_array_get sz i l c f sigma = (if Arith.equal_nat i Arith.zero_nat orelse not (c sigma) then sigma else idx_iteratei_aux_array_get sz (Arith.minus_nat i Arith.one_nat) l c f (f (Diff_Array.array_get l (Arith.minus_nat sz i)) sigma)); fun idx_iteratei_array_length_array_get l c f sigma = idx_iteratei_aux_array_get (Diff_Array.array_length l) (Diff_Array.array_length l) l c f sigma; fun ahm_iteratei_aux A_ a c f sigma = idx_iteratei_array_length_array_get a c (fn x => Foldi.foldli x c f) sigma; fun ahm_rehash_auxa A_ n kv a = let val h = HashCode.bounded_hashcode_nat A_ n (Product_Type.fst kv); in Diff_Array.array_set a h (kv :: Diff_Array.array_get a h) end; fun ahm_rehash_aux A_ a sz = ahm_iteratei_aux A_ a (fn _ => true) (ahm_rehash_auxa A_ sz) (Diff_Array.new_array [] sz); fun ahm_rehash A_ (HashMap (a, n)) sz = HashMap (ahm_rehash_aux A_ a sz, n); fun ahm_update_aux (A1_, A2_) (HashMap (a, n)) k v = let val h = HashCode.bounded_hashcode_nat A2_ (Diff_Array.array_length a) k; val m = Diff_Array.array_get a h; val insert = Option.is_none (Map.map_of A1_ m k); in HashMap (Diff_Array.array_set a h (AList.update A1_ k v m), (if insert then Arith.plus_nat n Arith.one_nat else n)) end; fun ahm_update (A1_, A2_) k v hm = let val hma = ahm_update_aux (A1_, A2_) hm k v; in (if ahm_filled A2_ hma then ahm_rehash A2_ hma (hm_grow A2_ hma) else hma) end; fun ahm_iteratei A_ (HashMap (a, n)) = ahm_iteratei_aux A_ a; end; (*struct ArrayHashMap_Impl*) structure ArrayHashMap : sig type ('b, 'a) hashmap val ahm_empty : 'a HashCode.hashable -> unit -> ('a, 'b) hashmap val ahm_delete : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> ('a, 'b) hashmap val ahm_lookup : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> 'b option val ahm_update : 'a HOL.equal * 'a HashCode.hashable -> 'a -> 'b -> ('a, 'b) hashmap -> ('a, 'b) hashmap val ahm_iteratei : 'a HashCode.hashable -> ('a, 'b) hashmap -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) hashmap = HashMap of ('b, 'a) ArrayHashMap_Impl.hashmap; fun ahm_empty_const A_ = HashMap (ArrayHashMap_Impl.ahm_empty A_ ()); fun ahm_empty A_ = (fn _ => ahm_empty_const A_); fun impl_of B_ (HashMap x) = x; fun ahm_delete (A1_, A2_) k hm = HashMap (ArrayHashMap_Impl.ahm_delete (A1_, A2_) k (impl_of A2_ hm)); fun ahm_lookup (A1_, A2_) k hm = ArrayHashMap_Impl.ahm_lookup (A1_, A2_) k (impl_of A2_ hm); fun ahm_update (A1_, A2_) k v hm = HashMap (ArrayHashMap_Impl.ahm_update (A1_, A2_) k v (impl_of A2_ hm)); fun ahm_iteratei A_ hm = ArrayHashMap_Impl.ahm_iteratei A_ (impl_of A_ hm); end; (*struct ArrayHashMap*) structure ArrayHashSet : sig val test_codegen : 'a HashCode.hashable -> 'b HOL.equal * 'b HashCode.hashable -> 'c HOL.equal * 'c HashCode.hashable -> 'd HOL.equal * 'd HashCode.hashable -> 'e HashCode.hashable -> 'f HOL.equal * 'f HashCode.hashable -> 'g HashCode.hashable -> 'h HashCode.hashable -> 'i HashCode.hashable -> 'j HashCode.hashable -> 'k HashCode.hashable -> 'l HashCode.hashable -> 'm HOL.equal * 'm HashCode.hashable -> 'n HOL.equal * 'n HashCode.hashable -> 'o HOL.equal * 'o HashCode.hashable -> 'p HOL.equal * 'p HashCode.hashable -> 'q HOL.equal * 'q HashCode.hashable -> 'r HOL.equal * 'r HashCode.hashable -> 's HOL.equal * 's HashCode.hashable -> 't HOL.equal * 't HashCode.hashable -> 'u HOL.equal * 'u HashCode.hashable -> 'v HashCode.hashable -> 'w HashCode.hashable -> 'x HOL.equal * 'x HashCode.hashable -> (unit -> ('a, unit) ArrayHashMap.hashmap) * (('b -> ('b, unit) ArrayHashMap.hashmap -> bool) * (('c -> ('c, unit) ArrayHashMap.hashmap -> ('c, unit) ArrayHashMap.hashmap) * (('d -> ('d, unit) ArrayHashMap.hashmap -> ('d, unit) ArrayHashMap.hashmap) * ((('e, unit) ArrayHashMap.hashmap -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> ('f, unit) ArrayHashMap.hashmap) * ((('g, unit) ArrayHashMap.hashmap -> bool) * ((('h, unit) ArrayHashMap.hashmap -> bool) * ((('i, unit) ArrayHashMap.hashmap -> ('i -> bool) -> bool) * ((('j, unit) ArrayHashMap.hashmap -> ('j -> bool) -> bool) * ((('k, unit) ArrayHashMap.hashmap -> Arith.nat) * ((Arith.nat -> ('l, unit) ArrayHashMap.hashmap -> Arith.nat) * ((('m, unit) ArrayHashMap.hashmap -> ('m, unit) ArrayHashMap.hashmap -> ('m, unit) ArrayHashMap.hashmap) * ((('n, unit) ArrayHashMap.hashmap -> ('n, unit) ArrayHashMap.hashmap -> ('n, unit) ArrayHashMap.hashmap) * ((('o, unit) ArrayHashMap.hashmap -> ('o, unit) ArrayHashMap.hashmap -> ('o, unit) ArrayHashMap.hashmap) * ((('p -> bool) -> ('p, unit) ArrayHashMap.hashmap -> ('p, unit) ArrayHashMap.hashmap) * ((('q, unit) ArrayHashMap.hashmap -> ('q, unit) ArrayHashMap.hashmap -> ('q, unit) ArrayHashMap.hashmap) * ((('r, unit) ArrayHashMap.hashmap -> ('r, unit) ArrayHashMap.hashmap -> bool) * ((('s, unit) ArrayHashMap.hashmap -> ('s, unit) ArrayHashMap.hashmap -> bool) * ((('t, unit) ArrayHashMap.hashmap -> ('t, unit) ArrayHashMap.hashmap -> bool) * ((('u, unit) ArrayHashMap.hashmap -> ('u, unit) ArrayHashMap.hashmap -> 'u option) * ((('v, unit) ArrayHashMap.hashmap -> ('v -> bool) -> 'v option) * ((('w, unit) ArrayHashMap.hashmap -> 'w list) * ('x list -> ('x, unit) ArrayHashMap.hashmap))))))))))))))))))))))) end = struct fun iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s = (fn c => fn f => ArrayHashMap.ahm_iteratei A_ s c (f o Product_Type.fst)); fun g_sel_dflt_basic_ops_ahm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun memb_ahm_basic_ops (A1_, A2_) x s = not (Option.is_none (ArrayHashMap.ahm_lookup (A1_, A2_) x s)); fun g_disjoint_witness_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = g_sel_dflt_basic_ops_ahm_basic_ops A2_ s1 (fn x => memb_ahm_basic_ops (A1_, A2_) x s2); fun g_size_abort_dflt_basic_ops_ahm_basic_ops A_ m s = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.suc) Arith.zero_nat; fun ins_ahm_basic_ops (A1_, A2_) x s = ArrayHashMap.ahm_update (A1_, A2_) x () s; fun g_from_list_aux_dflt_basic_ops_ahm_basic_ops (A1_, A2_) accs (x :: l) = g_from_list_aux_dflt_basic_ops_ahm_basic_ops (A1_, A2_) (ins_ahm_basic_ops (A1_, A2_) x accs) l | g_from_list_aux_dflt_basic_ops_ahm_basic_ops (A1_, A2_) y [] = y; fun empty_ahm_basic_ops A_ = ArrayHashMap.ahm_empty A_; fun g_from_list_dflt_basic_ops_ahm_basic_ops (A1_, A2_) l = g_from_list_aux_dflt_basic_ops_ahm_basic_ops (A1_, A2_) (empty_ahm_basic_ops A2_ ()) l; fun ins_dj_ahm_basic_ops (A1_, A2_) x s = ArrayHashMap.ahm_update (A1_, A2_) x () s; fun g_union_dj_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A2_ s1 (fn _ => true) (ins_dj_ahm_basic_ops (A1_, A2_)) s2; fun g_ball_dflt_basic_ops_ahm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = g_ball_dflt_basic_ops_ahm_basic_ops A2_ s1 (fn x => not (memb_ahm_basic_ops (A1_, A2_) x s2)); fun g_to_list_dflt_basic_ops_ahm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_dflt_basic_ops_ahm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = g_ball_dflt_basic_ops_ahm_basic_ops A2_ s1 (fn x => memb_ahm_basic_ops (A1_, A2_) x s2); fun g_filter_dflt_basic_ops_ahm_basic_ops (A1_, A2_) p s = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A2_ s (fn _ => true) (fn x => fn sigma => (if p x then ins_dj_ahm_basic_ops (A1_, A2_) x sigma else sigma)) (empty_ahm_basic_ops A2_ ()); fun g_union_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A2_ s1 (fn _ => true) (ins_ahm_basic_ops (A1_, A2_)) s2; fun g_isSng_dflt_basic_ops_ahm_basic_ops A_ s = Arith.equal_nat (iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s (fn sigma => Arith.less_nat sigma (Arith.nat_of_integer (2 : IntInf.int))) (fn _ => Arith.suc) Arith.zero_nat) Arith.one_nat; fun g_inter_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A2_ s1 (fn _ => true) (fn x => fn s => (if memb_ahm_basic_ops (A1_, A2_) x s2 then ins_dj_ahm_basic_ops (A1_, A2_) x s else s)) (empty_ahm_basic_ops A2_ ()); fun g_equal_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = g_subset_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 andalso g_subset_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s2 s1; fun g_size_dflt_basic_ops_ahm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s (fn _ => true) (fn _ => Arith.suc) Arith.zero_nat; fun delete_ahm_basic_ops (A1_, A2_) x s = ArrayHashMap.ahm_delete (A1_, A2_) x s; fun g_diff_dflt_basic_ops_ahm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A2_ s2 (fn _ => true) (delete_ahm_basic_ops (A1_, A2_)) s1; fun g_sng_dflt_basic_ops_ahm_basic_ops (A1_, A2_) x = ins_ahm_basic_ops (A1_, A2_) x (empty_ahm_basic_ops A2_ ()); fun g_bex_dflt_basic_ops_ahm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_ops_ahm_basic_ops A_ s not (fn x => fn _ => p x) false; fun test_codegen A_ (B1_, B2_) (C1_, C2_) (D1_, D2_) E_ (F1_, F2_) G_ H_ I_ J_ K_ L_ (M1_, M2_) (N1_, N2_) (O1_, O2_) (P1_, P2_) (Q1_, Q2_) (R1_, R2_) (S1_, S2_) (T1_, T2_) (U1_, U2_) V_ W_ (X1_, X2_) = (empty_ahm_basic_ops A_, (memb_ahm_basic_ops (B1_, B2_), (ins_ahm_basic_ops (C1_, C2_), (delete_ahm_basic_ops (D1_, D2_), ((fn s => fn c => fn f => ArrayHashMap.ahm_iteratei E_ s c (f o Product_Type.fst)), (g_sng_dflt_basic_ops_ahm_basic_ops (F1_, F2_), (g_isEmpty_dflt_basic_ops_ahm_basic_ops G_, (g_isSng_dflt_basic_ops_ahm_basic_ops H_, (g_ball_dflt_basic_ops_ahm_basic_ops I_, (g_bex_dflt_basic_ops_ahm_basic_ops J_, (g_size_dflt_basic_ops_ahm_basic_ops K_, (g_size_abort_dflt_basic_ops_ahm_basic_ops L_, (g_union_dflt_basic_ops_ahm_basic_ops (M1_, M2_), (g_union_dj_dflt_basic_ops_ahm_basic_ops (N1_, N2_), (g_diff_dflt_basic_ops_ahm_basic_ops (O1_, O2_), (g_filter_dflt_basic_ops_ahm_basic_ops (P1_, P2_), (g_inter_dflt_basic_ops_ahm_basic_ops (Q1_, Q2_), (g_subset_dflt_basic_ops_ahm_basic_ops (R1_, R2_), (g_equal_dflt_basic_ops_ahm_basic_ops (S1_, S2_), (g_disjoint_dflt_basic_ops_ahm_basic_ops (T1_, T2_), (g_disjoint_witness_dflt_basic_ops_ahm_basic_ops (U1_, U2_), (g_sel_dflt_basic_ops_ahm_basic_ops V_, (g_to_list_dflt_basic_ops_ahm_basic_ops W_, g_from_list_dflt_basic_ops_ahm_basic_ops (X1_, X2_)))))))))))))))))))))))); end; (*struct ArrayHashSet*) ### theory "Collections.ArrayHashSet" ### 1.912s elapsed time, 3.780s cpu time, 0.396s GC time Loading theory "Collections.ArraySetImpl" (required by "Collections.SetStdImpl") structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; end; (*struct Orderings*) structure Product_Type : sig val apfst : ('a -> 'b) -> 'a * 'c -> 'b * 'c val fst : 'a * 'b -> 'a end = struct fun apfst f (x, y) = (f x, y); fun fst (x1, x2) = x1; end; (*struct Product_Type*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val equal_nat : nat -> nat -> bool val less_nat : nat -> nat -> bool val divmod_nat : nat -> nat -> nat * nat end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 minus_nat (Suc m) (Suc n) = minus_nat m n | minus_nat Zero_nat n = Zero_nat | minus_nat m Zero_nat = m; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; fun less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun divmod_nat m n = (if equal_nat n Zero_nat orelse less_nat m n then (Zero_nat, m) else let val a = divmod_nat (minus_nat m n) n; val (q, aa) = a; in (Suc q, aa) end); end; (*struct Arith*) structure List : sig val rev : 'a list -> 'a list val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val size_list : 'a list -> Arith.nat end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; fun gen_length n (x :: xs) = gen_length (Arith.Suc n) xs | gen_length n [] = n; fun size_list x = gen_length Arith.Zero_nat x; end; (*struct List*) structure RBT_Impl : sig type color datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt val rbt_union : 'a Orderings.ord -> ('a, 'b) rbt -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_delete : 'a Orderings.ord -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_insert : 'a Orderings.ord -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_lookup : 'a Orderings.ord -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype color = R | B; datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt; datatype compare = LT | GT | EQ; fun fold f (Branch (c, lt, k, v, rt)) x = fold f rt (f k v (fold f lt x)) | fold f Empty x = x; fun paint c Empty = Empty | paint c (Branch (uu, l, k, v, r)) = Branch (c, l, k, v, r); fun balance (Branch (R, a, w, x, b)) s t (Branch (R, c, y, z, d)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z Empty = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (B, va, vb, vc, vd), w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Branch (B, ve, vf, vg, vh), w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Branch (B, ve, vf, vg, vh), w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance Empty w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, d)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, va, vb, vc, vd))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, ve, vf, vg, vh))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Branch (B, ve, vf, vg, vh))) | balance Empty s t Empty = Branch (B, Empty, s, t, Empty) | balance Empty s t (Branch (B, va, vb, vc, vd)) = Branch (B, Empty, s, t, Branch (B, va, vb, vc, vd)) | balance Empty s t (Branch (v, Empty, vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Empty)) | balance Empty s t (Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) | balance Empty s t (Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) | balance Empty s t (Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) | balance (Branch (B, va, vb, vc, vd)) s t Empty = Branch (B, Branch (B, va, vb, vc, vd), s, t, Empty) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (B, ve, vf, vg, vh)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (B, ve, vf, vg, vh)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (v, Empty, vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Empty), s, t, Empty) | balance (Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh))) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh)), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl))) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl)), s, t, Empty) | balance (Branch (v, Empty, vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl)), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp)), s, t, Branch (B, va, vb, vc, vd)); fun balance_left (Branch (R, a, k, x, b)) s y c = Branch (R, Branch (B, a, k, x, b), s, y, c) | balance_left Empty k x (Branch (B, a, s, y, b)) = balance Empty k x (Branch (R, a, s, y, b)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (B, a, s, y, b)) = balance (Branch (B, va, vb, vc, vd)) k x (Branch (R, a, s, y, b)) | balance_left Empty k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Empty, k, x, a), s, y, balance b t z (paint R c)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), k, x, a), s, y, balance b t z (paint R c)) | balance_left Empty k x Empty = Empty | balance_left Empty k x (Branch (R, Empty, vb, vc, vd)) = Empty | balance_left Empty k x (Branch (R, Branch (R, ve, vf, vg, vh), vb, vc, vd)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x Empty = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Empty, vf, vg, vh)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (R, vi, vj, vk, vl), vf, vg, vh)) = Empty; fun combine Empty x = x | combine (Branch (v, va, vb, vc, vd)) Empty = Branch (v, va, vb, vc, vd) | combine (Branch (R, a, k, x, b)) (Branch (R, c, s, y, d)) = (case combine b c of Empty => Branch (R, a, k, x, Branch (R, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (R, a, k, x, b2), t, z, Branch (R, c2, s, y, d)) | Branch (B, b2, t, z, c2) => Branch (R, a, k, x, Branch (R, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, a, k, x, b)) (Branch (B, c, s, y, d)) = (case combine b c of Empty => balance_left a k x (Branch (B, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (B, a, k, x, b2), t, z, Branch (B, c2, s, y, d)) | Branch (B, b2, t, z, c2) => balance_left a k x (Branch (B, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, va, vb, vc, vd)) (Branch (R, b, k, x, c)) = Branch (R, combine (Branch (B, va, vb, vc, vd)) b, k, x, c) | combine (Branch (R, a, k, x, b)) (Branch (B, va, vb, vc, vd)) = Branch (R, a, k, x, combine b (Branch (B, va, vb, vc, vd))); fun gen_entries kvts (Branch (c, l, k, v, r)) = gen_entries (((k, v), r) :: kvts) l | gen_entries ((kv, t) :: kvts) Empty = kv :: gen_entries kvts t | gen_entries [] Empty = []; fun entries x = gen_entries [] x; fun skip_red (Branch (R, l, k, v, r)) = l | skip_red Empty = Empty | skip_red (Branch (B, va, vb, vc, vd)) = Branch (B, va, vb, vc, vd); fun rbtreeify_g n kvs = (if Arith.equal_nat n Arith.Zero_nat orelse Arith.equal_nat n Arith.one_nat then (Empty, kvs) else let val (na, r) = Arith.divmod_nat n (Arith.nat_of_num (Arith.Bit0 Arith.One)); in (if Arith.equal_nat r Arith.Zero_nat then let val (t1, (k, v) :: kvsa) = rbtreeify_g na kvs; in Product_Type.apfst (fn a => Branch (B, t1, k, v, a)) (rbtreeify_g na kvsa) end else let val (t1, (k, v) :: kvsa) = rbtreeify_f na kvs; in Product_Type.apfst (fn a => Branch (B, t1, k, v, a)) (rbtreeify_g na kvsa) end) end) and rbtreeify_f n kvs = (if Arith.equal_nat n Arith.Zero_nat then (Empty, kvs) else (if Arith.equal_nat n Arith.one_nat then let val (k, v) :: kvsa = kvs; in (Branch (R, Empty, k, v, Empty), kvsa) end else let val (na, r) = Arith.divmod_nat n (Arith.nat_of_num (Arith.Bit0 Arith.One)); in (if Arith.equal_nat r Arith.Zero_nat then let val (t1, (k, v) :: kvsa) = rbtreeify_f na kvs; in Product_Type.apfst (fn a => Branch (B, t1, k, v, a)) (rbtreeify_g na kvsa) end else let val (t1, (k, v) :: kvsa) = rbtreeify_f na kvs; in Product_Type.apfst (fn a => Branch (B, t1, k, v, a)) (rbtreeify_f na kvsa) end) end)); fun rbtreeify kvs = Product_Type.fst (rbtreeify_g (Arith.Suc (List.size_list kvs)) kvs); fun skip_black t = let val ta = skip_red t; in (case ta of Empty => ta | Branch (R, _, _, _, _) => ta | Branch (B, l, _, _, _) => l) end; fun balance_right a k x (Branch (R, b, s, y, c)) = Branch (R, a, k, x, Branch (B, b, s, y, c)) | balance_right (Branch (B, a, k, x, b)) s y Empty = balance (Branch (R, a, k, x, b)) s y Empty | balance_right (Branch (B, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) = balance (Branch (R, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z Empty = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Empty)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z (Branch (B, va, vb, vc, vd)) = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Branch (B, va, vb, vc, vd))) | balance_right Empty k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Empty)) k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Branch (R, ve, vf, vg, vh))) k x Empty = Empty | balance_right Empty k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Empty)) k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Branch (R, vi, vj, vk, vl))) k x (Branch (B, va, vb, vc, vd)) = Empty; fun compare_height sx s t tx = (case (skip_red sx, (skip_red s, (skip_red t, skip_red tx))) of (Empty, (Empty, (_, Empty))) => EQ | (Empty, (Empty, (_, Branch (_, _, _, _, _)))) => LT | (Empty, (Branch (_, _, _, _, _), (Empty, _))) => EQ | (Empty, (Branch (_, _, _, _, _), (Branch (_, _, _, _, _), Empty))) => EQ | (Empty, (Branch (_, sa, _, _, _), (Branch (_, ta, _, _, _), Branch (_, txa, _, _, _)))) => compare_height Empty sa ta (skip_black txa) | (Branch (_, _, _, _, _), (Empty, (Empty, Empty))) => GT | (Branch (_, _, _, _, _), (Empty, (Empty, Branch (_, _, _, _, _)))) => LT | (Branch (_, _, _, _, _), (Empty, (Branch (_, _, _, _, _), Empty))) => EQ | (Branch (_, _, _, _, _), (Empty, (Branch (_, _, _, _, _), Branch (_, _, _, _, _)))) => LT | (Branch (_, _, _, _, _), (Branch (_, _, _, _, _), (Empty, _))) => GT | (Branch (_, sxa, _, _, _), (Branch (_, sa, _, _, _), (Branch (_, ta, _, _, _), Empty))) => compare_height (skip_black sxa) sa ta Empty | (Branch (_, sxa, _, _, _), (Branch (_, sa, _, _, _), (Branch (_, ta, _, _, _), Branch (_, txa, _, _, _)))) => compare_height (skip_black sxa) sa ta (skip_black txa)); fun rbt_del A_ x Empty = Empty | rbt_del A_ x (Branch (c, a, y, s, b)) = (if Orderings.less A_ x y then rbt_del_from_left A_ x a y s b else (if Orderings.less A_ y x then rbt_del_from_right A_ x a y s b else combine a b)) and rbt_del_from_left A_ x (Branch (B, lt, z, v, rt)) y s b = balance_left (rbt_del A_ x (Branch (B, lt, z, v, rt))) y s b | rbt_del_from_left A_ x Empty y s b = Branch (R, rbt_del A_ x Empty, y, s, b) | rbt_del_from_left A_ x (Branch (R, va, vb, vc, vd)) y s b = Branch (R, rbt_del A_ x (Branch (R, va, vb, vc, vd)), y, s, b) and rbt_del_from_right A_ x a y s (Branch (B, lt, z, v, rt)) = balance_right a y s (rbt_del A_ x (Branch (B, lt, z, v, rt))) | rbt_del_from_right A_ x a y s Empty = Branch (R, a, y, s, rbt_del A_ x Empty) | rbt_del_from_right A_ x a y s (Branch (R, va, vb, vc, vd)) = Branch (R, a, y, s, rbt_del A_ x (Branch (R, va, vb, vc, vd))); fun rbt_ins A_ f k v Empty = Branch (R, Empty, k, v, Empty) | rbt_ins A_ f k v (Branch (B, l, x, y, r)) = (if Orderings.less A_ k x then balance (rbt_ins A_ f k v l) x y r else (if Orderings.less A_ x k then balance l x y (rbt_ins A_ f k v r) else Branch (B, l, x, f k y v, r))) | rbt_ins A_ f k v (Branch (R, l, x, y, r)) = (if Orderings.less A_ k x then Branch (R, rbt_ins A_ f k v l, x, y, r) else (if Orderings.less A_ x k then Branch (R, l, x, y, rbt_ins A_ f k v r) else Branch (R, l, x, f k y v, r))); fun rbt_insert_with_key A_ f k v t = paint B (rbt_ins A_ f k v t); fun sunion_with A_ f ((ka, va) :: asa) ((k, v) :: bs) = (if Orderings.less A_ k ka then (k, v) :: sunion_with A_ f ((ka, va) :: asa) bs else (if Orderings.less A_ ka k then (ka, va) :: sunion_with A_ f asa ((k, v) :: bs) else (ka, f ka va v) :: sunion_with A_ f asa bs)) | sunion_with A_ f [] bs = bs | sunion_with A_ f asa [] = asa; fun rbt_union_with_key A_ f t1 t2 = (case compare_height t1 t1 t2 t2 of LT => fold (rbt_insert_with_key A_ (fn k => fn v => fn w => f k w v)) t1 t2 | GT => fold (rbt_insert_with_key A_ f) t2 t1 | EQ => rbtreeify (sunion_with A_ f (entries t1) (entries t2))); fun rbt_union A_ = rbt_union_with_key A_ (fn _ => fn _ => fn rv => rv); fun rbt_delete A_ k t = paint B (rbt_del A_ k t); fun rbt_insert A_ = rbt_insert_with_key A_ (fn _ => fn _ => fn nv => nv); fun rbt_lookup A_ Empty k = NONE | rbt_lookup A_ (Branch (uu, l, x, y, r)) k = (if Orderings.less A_ k x then rbt_lookup A_ l k else (if Orderings.less A_ x k then rbt_lookup A_ r k else SOME y)); end; (*struct RBT_Impl*) structure RBT : sig type ('b, 'a) rbt val empty : 'a Orderings.linorder -> ('a, 'b) rbt val impl_of : 'b Orderings.linorder -> ('b, 'a) rbt -> ('b, 'a) RBT_Impl.rbt val union : 'a Orderings.linorder -> ('a, 'b) rbt -> ('a, 'b) rbt -> ('a, 'b) rbt val delete : 'a Orderings.linorder -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val insert : 'a Orderings.linorder -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val lookup : 'a Orderings.linorder -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype ('b, 'a) rbt = RBT of ('b, 'a) RBT_Impl.rbt; fun empty A_ = RBT RBT_Impl.Empty; fun impl_of B_ (RBT x) = x; fun union A_ xb xc = RBT (RBT_Impl.rbt_union ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) (impl_of A_ xb) (impl_of A_ xc)); fun delete A_ xb xc = RBT (RBT_Impl.rbt_delete ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xb (impl_of A_ xc)); fun insert A_ xc xd xe = RBT (RBT_Impl.rbt_insert ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xc xd (impl_of A_ xe)); fun lookup A_ x = RBT_Impl.rbt_lookup ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) (impl_of A_ x); end; (*struct RBT*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure RBT_add : sig val rm_iterateoi : ('a, 'b) RBT_Impl.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c val rm_reverse_iterateoi : ('a, 'b) RBT_Impl.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun rm_iterateoi RBT_Impl.Empty c f sigma = sigma | rm_iterateoi (RBT_Impl.Branch (col, l, k, v, r)) c f sigma = (if c sigma then let val sigmaa = rm_iterateoi l c f sigma; in (if c sigmaa then rm_iterateoi r c f (f (k, v) sigmaa) else sigmaa) end else sigma); fun rm_reverse_iterateoi RBT_Impl.Empty c f sigma = sigma | rm_reverse_iterateoi (RBT_Impl.Branch (col, l, k, v, r)) c f sigma = (if c sigma then let val sigmaa = rm_reverse_iterateoi r c f sigma; in (if c sigmaa then rm_reverse_iterateoi l c f (f (k, v) sigmaa) else sigmaa) end else sigma); end; (*struct RBT_add*) structure RBTMapImpl : sig val test_codegen : 'a Orderings.linorder -> 'c Orderings.linorder -> 'e Orderings.linorder -> 'g Orderings.linorder -> 'i Orderings.linorder -> 'k Orderings.linorder -> 'm Orderings.linorder -> 'o Orderings.linorder -> 'q Orderings.linorder -> 't Orderings.linorder -> 'w Orderings.linorder -> 'z Orderings.linorder -> 'ac Orderings.linorder -> 'ae Orderings.linorder -> 'ag Orderings.linorder -> 'ai Orderings.linorder -> 'ak Orderings.linorder -> 'am Orderings.linorder -> 'ap Orderings.linorder -> 'as Orderings.linorder -> 'au Orderings.linorder -> 'ax Orderings.linorder -> 'ba Orderings.linorder -> 'bc Orderings.linorder -> 'be Orderings.linorder -> 'bg Orderings.linorder -> 'bi Orderings.linorder -> 'bk Orderings.linorder -> 'bm Orderings.linorder -> 'bo Orderings.linorder -> 'bq Orderings.linorder -> 'bs Orderings.linorder -> (('a, 'b) RBT.rbt -> ('a, 'b) RBT.rbt -> ('a, 'b) RBT.rbt) * ((('c, 'd) RBT.rbt -> ('c, 'd) RBT.rbt -> ('c, 'd) RBT.rbt) * ((('e, 'f) RBT.rbt -> ('e * 'f -> bool) -> bool) * ((('g, 'h) RBT.rbt -> ('g * 'h -> bool) -> bool) * (('i -> ('i, 'j) RBT.rbt -> ('i, 'j) RBT.rbt) * ((unit -> ('k, 'l) RBT.rbt) * ((('m, 'n) RBT.rbt -> bool) * ((('o, 'p) RBT.rbt -> bool) * ((('q, 'r) RBT.rbt -> ('q * 'r -> 's -> 's) -> 's -> 's) * ((('t, 'u) RBT.rbt -> ('v -> bool) -> ('t * 'u -> 'v -> 'v) -> 'v -> 'v) * ((('w, 'x) RBT.rbt -> ('w * 'x -> 'y -> 'y) -> 'y -> 'y) * ((('z, 'aa) RBT.rbt -> ('ab -> bool) -> ('z * 'aa -> 'ab -> 'ab) -> 'ab -> 'ab) * ((('ac, 'ad) RBT.rbt -> (('ac * 'ad) list -> bool) -> ('ac * 'ad -> ('ac * 'ad) list -> ('ac * 'ad) list) -> ('ac * 'ad) list -> ('ac * 'ad) list) * (('ae -> ('ae, 'af) RBT.rbt -> 'af option) * ((('ag, 'ah) RBT.rbt -> ('ag * 'ah -> bool) -> ('ag * 'ah) option) * ((('ai, 'aj) RBT.rbt -> ('ai * 'aj -> bool) -> ('ai * 'aj) option) * ((('ak * 'al -> bool) -> ('ak, 'al) RBT.rbt -> ('ak, 'al) RBT.rbt) * ((('am, 'an) RBT.rbt -> ('am * 'an -> 'ao -> 'ao) -> 'ao -> 'ao) * ((('ap, 'aq) RBT.rbt -> ('ar -> bool) -> ('ap * 'aq -> 'ar -> 'ar) -> 'ar -> 'ar) * ((('as, 'at) RBT.rbt -> (('as * 'at) list -> bool) -> ('as * 'at -> ('as * 'at) list -> ('as * 'at) list) -> ('as * 'at) list -> ('as * 'at) list) * ((('au, 'av) RBT.rbt -> ('au * 'av -> 'aw -> 'aw) -> 'aw -> 'aw) * ((('ax, 'ay) RBT.rbt -> ('az -> bool) -> ('ax * 'ay -> 'az -> 'az) -> 'az -> 'az) * ((('ba, 'bb) RBT.rbt -> ('ba * 'bb -> bool) -> ('ba * 'bb) option) * ((('bc, 'bd) RBT.rbt -> Arith.nat) * ((Arith.nat -> ('be, 'bf) RBT.rbt -> Arith.nat) * (('bg -> 'bh -> ('bg, 'bh) RBT.rbt) * ((('bi, 'bj) RBT.rbt -> ('bi * 'bj) list) * ((('bk * 'bl) list -> ('bk, 'bl) RBT.rbt) * ((('bm, 'bn) RBT.rbt -> ('bm * 'bn) list) * ((('bo, 'bp) RBT.rbt -> ('bo * 'bp) list) * (('bq -> 'br -> ('bq, 'br) RBT.rbt -> ('bq, 'br) RBT.rbt) * ('bs -> 'bt -> ('bs, 'bt) RBT.rbt -> ('bs, 'bt) RBT.rbt))))))))))))))))))))))))))))))) end = struct fun rev_iterateoi_map_op_rev_list_it_rm_ops A_ s = RBT_add.rm_reverse_iterateoi (RBT.impl_of A_ s); fun iterateoi_map_op_ordered_list_it_rm_ops A_ s = RBT_add.rm_iterateoi (RBT.impl_of A_ s); fun iteratei_map_op_list_it_rm_ops A_ s = RBT_add.rm_iterateoi (RBT.impl_of A_ s); fun rev_iterateoi_bmap_op_rev_list_it_rm_basic_ops A_ s = RBT_add.rm_reverse_iterateoi (RBT.impl_of A_ s); fun g_to_sorted_list_rm_basic_ops A_ m = rev_iterateoi_bmap_op_rev_list_it_rm_basic_ops A_ m (fn _ => true) (fn a => fn b => a :: b) []; fun iterateoi_bmap_op_ordered_list_it_rm_basic_ops A_ s = RBT_add.rm_iterateoi (RBT.impl_of A_ s); fun g_to_rev_list_rm_basic_ops A_ m = iterateoi_bmap_op_ordered_list_it_rm_basic_ops A_ m (fn _ => true) (fn a => fn b => a :: b) []; fun g_list_to_map_rm_basic_ops A_ l = List.foldl (fn m => fn (k, v) => RBT.insert A_ k v m) (RBT.empty A_) (List.rev l); fun iteratei_bmap_op_list_it_rm_basic_ops A_ s = RBT_add.rm_iterateoi (RBT.impl_of A_ s); fun g_size_abort_rm_basic_ops A_ b m = iteratei_bmap_op_list_it_rm_basic_ops A_ m (fn s => Arith.less_nat s b) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_restrict_rm_basic_ops A_ p m = iteratei_bmap_op_list_it_rm_basic_ops A_ m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then RBT.insert A_ k v sigma else sigma)) (RBT.empty A_); fun g_to_list_rm_basic_ops A_ m = iteratei_bmap_op_list_it_rm_basic_ops A_ m (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_rm_basic_ops A_ m = Arith.equal_nat (g_size_abort_rm_basic_ops A_ Arith.one_nat m) Arith.Zero_nat; fun g_add_dj_rm_basic_ops A_ m1 m2 = iteratei_bmap_op_list_it_rm_basic_ops A_ m2 (fn _ => true) (fn (a, b) => RBT.insert A_ a b) m1; fun g_isSng_rm_basic_ops A_ m = Arith.equal_nat (g_size_abort_rm_basic_ops A_ (Arith.nat_of_num (Arith.Bit0 Arith.One)) m) Arith.one_nat; fun g_size_rm_basic_ops A_ m = iteratei_bmap_op_list_it_rm_basic_ops A_ m (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun g_ball_rm_basic_ops A_ m p = iteratei_bmap_op_list_it_rm_basic_ops A_ m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_rm_basic_ops A_ k v = RBT.insert A_ k v (RBT.empty A_); fun g_sel_rm_basic_ops A_ m p = iteratei_bmap_op_list_it_rm_basic_ops A_ m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_min_rm_basic_ops A_ m p = iterateoi_bmap_op_ordered_list_it_rm_basic_ops A_ m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_max_rm_basic_ops A_ m p = rev_iterateoi_bmap_op_rev_list_it_rm_basic_ops A_ m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_rm_basic_ops A_ m p = iteratei_bmap_op_list_it_rm_basic_ops A_ m not (fn kv => fn _ => p kv) false; fun test_codegen A_ C_ E_ G_ I_ K_ M_ O_ Q_ T_ W_ Z_ Ac_ Ae_ Ag_ Ai_ Ak_ Am_ Ap_ As_ Au_ Ax_ Ba_ Bc_ Be_ Bg_ Bi_ Bk_ Bm_ Bo_ Bq_ Bs_ = (RBT.union A_, (g_add_dj_rm_basic_ops C_, (g_ball_rm_basic_ops E_, (g_bex_rm_basic_ops G_, (RBT.delete I_, ((fn _ => RBT.empty K_), (g_isEmpty_rm_basic_ops M_, (g_isSng_rm_basic_ops O_, ((fn m => iteratei_map_op_list_it_rm_ops Q_ m (fn _ => true)), (iteratei_map_op_list_it_rm_ops T_, ((fn m => iterateoi_map_op_ordered_list_it_rm_ops W_ m (fn _ => true)), (iterateoi_map_op_ordered_list_it_rm_ops Z_, ((fn r => RBT_add.rm_iterateoi (RBT.impl_of Ac_ r)), ((fn k => fn m => RBT.lookup Ae_ m k), (g_max_rm_basic_ops Ag_, (g_min_rm_basic_ops Ai_, (g_restrict_rm_basic_ops Ak_, ((fn m => rev_iterateoi_map_op_rev_list_it_rm_ops Am_ m (fn _ => true)), (rev_iterateoi_map_op_rev_list_it_rm_ops Ap_, ((fn r => RBT_add.rm_reverse_iterateoi (RBT.impl_of As_ r)), ((fn m => rev_iterateoi_map_op_rev_list_it_rm_ops Au_ m (fn _ => true)), (rev_iterateoi_map_op_rev_list_it_rm_ops Ax_, (g_sel_rm_basic_ops Ba_, (g_size_rm_basic_ops Bc_, (g_size_abort_rm_basic_ops Be_, (g_sng_rm_basic_ops Bg_, (g_to_list_rm_basic_ops Bi_, (g_list_to_map_rm_basic_ops Bk_, (g_to_rev_list_rm_basic_ops Bm_, (g_to_sorted_list_rm_basic_ops Bo_, (RBT.insert Bq_, RBT.insert Bs_))))))))))))))))))))))))))))))); end; (*struct RBTMapImpl*) ### theory "Collections.RBTMapImpl" ### 2.717s elapsed time, 5.392s cpu time, 0.396s GC time Loading theory "Collections.TrieSetImpl" (required by "Collections.SetStdImpl") structure HOL : sig type 'a equal val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure List : sig val rev : 'a list -> 'a list val null : 'a list -> bool end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun null [] = true | null (x :: xs) = false; end; (*struct List*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val update : 'a HOL.equal -> 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list val delete_aux : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update_with_aux : 'b HOL.equal -> 'a -> 'b -> ('a -> 'a) -> ('b * 'a) list -> ('b * 'a) list end = struct fun update A_ k v [] = [(k, v)] | update A_ k v (p :: ps) = (if HOL.eq A_ (Product_Type.fst p) k then (k, v) :: ps else p :: update A_ k v ps); fun delete_aux A_ k [] = [] | delete_aux A_ ka ((k, v) :: xs) = (if HOL.eq A_ ka k then xs else (k, v) :: delete_aux A_ ka xs); fun update_with_aux B_ v k f [] = [(k, f v)] | update_with_aux B_ v k f (p :: ps) = (if HOL.eq B_ (Product_Type.fst p) k then (k, f (Product_Type.snd p)) :: ps else p :: update_with_aux B_ v k f ps); end; (*struct AList*) structure Trie : sig datatype ('a, 'b) trie = Trie of 'b option * ('a * ('a, 'b) trie) list val empty_trie : ('a, 'b) trie val delete_trie : 'a HOL.equal -> 'a list -> ('a, 'b) trie -> ('a, 'b) trie val lookup_trie : 'a HOL.equal -> ('a, 'b) trie -> 'a list -> 'b option val update_trie : 'a HOL.equal -> 'a list -> 'b -> ('a, 'b) trie -> ('a, 'b) trie end = struct datatype ('a, 'b) trie = Trie of 'b option * ('a * ('a, 'b) trie) list; val empty_trie : ('a, 'b) trie = Trie (NONE, []); fun is_empty_trie (Trie (v, m)) = Option.is_none v andalso List.null m; fun delete_trie A_ [] (Trie (vo, ts)) = Trie (NONE, ts) | delete_trie A_ (k :: ks) (Trie (vo, ts)) = (case Map.map_of A_ ts k of NONE => Trie (vo, ts) | SOME t => let val ta = delete_trie A_ ks t; in (if is_empty_trie ta then Trie (vo, AList.delete_aux A_ k ts) else Trie (vo, AList.update A_ k ta ts)) end); fun lookup_trie A_ (Trie (v, m)) [] = v | lookup_trie A_ (Trie (v, m)) (k :: ks) = (case Map.map_of A_ m k of NONE => NONE | SOME st => lookup_trie A_ st ks); fun update_with_trie A_ [] f (Trie (v, ps)) = Trie (SOME (f v), ps) | update_with_trie A_ (k :: ks) f (Trie (v, ps)) = Trie (v, AList.update_with_aux A_ empty_trie k (update_with_trie A_ ks f) ps); fun update_trie A_ ks v = update_with_trie A_ ks (fn _ => v); end; (*struct Trie*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Trie_Impl : sig val iteratei : ('a, 'b) Trie.trie -> ('c -> bool) -> ('a list * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun iteratei_postfixed ks (Trie.Trie (vo, ts)) c f sigma = (if c sigma then Foldi.foldli ts c (fn (k, t) => iteratei_postfixed (k :: ks) t c f) (case vo of NONE => sigma | SOME v => f (ks, v) sigma) else sigma); fun iteratei t c f sigma = iteratei_postfixed [] t c f sigma; end; (*struct Trie_Impl*) structure Trie2 : sig type ('b, 'a) trie val empty : ('a, 'b) trie val delete : 'a HOL.equal -> 'a list -> ('a, 'b) trie -> ('a, 'b) trie val lookup : 'a HOL.equal -> ('a, 'b) trie -> 'a list -> 'b option val update : 'a HOL.equal -> 'a list -> 'b -> ('a, 'b) trie -> ('a, 'b) trie val iteratei : ('a, 'b) trie -> ('c -> bool) -> ('a list * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) trie = Trie of ('b, 'a) Trie.trie; val empty : ('a, 'b) trie = Trie Trie.empty_trie; fun impl_of (Trie x) = x; fun delete A_ ks t = Trie (Trie.delete_trie A_ ks (impl_of t)); fun lookup A_ t = Trie.lookup_trie A_ (impl_of t); fun update A_ ks v t = Trie (Trie.update_trie A_ ks v (impl_of t)); fun iteratei t c f = Trie_Impl.iteratei (impl_of t) c (fn (ks, v) => f (List.rev ks, v)); end; (*struct Trie2*) structure TrieSetImpl : sig val test_codegen : 'b HOL.equal -> 'c HOL.equal -> 'd HOL.equal -> 'f HOL.equal -> 'm HOL.equal -> 'n HOL.equal -> 'o HOL.equal -> 'p HOL.equal -> 'q HOL.equal -> 'r HOL.equal -> 's HOL.equal -> 't HOL.equal -> 'u HOL.equal -> 'x HOL.equal -> (unit -> ('a, unit) Trie2.trie) * (('b list -> ('b, unit) Trie2.trie -> bool) * (('c list -> ('c, unit) Trie2.trie -> ('c, unit) Trie2.trie) * (('d list -> ('d, unit) Trie2.trie -> ('d, unit) Trie2.trie) * ((('e, unit) Trie2.trie -> (('e list) list -> bool) -> ('e list -> ('e list) list -> ('e list) list) -> ('e list) list -> ('e list) list) * (('f list -> ('f, unit) Trie2.trie) * ((('g, unit) Trie2.trie -> bool) * ((('h, unit) Trie2.trie -> bool) * ((('i, unit) Trie2.trie -> ('i list -> bool) -> bool) * ((('j, unit) Trie2.trie -> ('j list -> bool) -> bool) * ((('k, unit) Trie2.trie -> Arith.nat) * ((Arith.nat -> ('l, unit) Trie2.trie -> Arith.nat) * ((('m, unit) Trie2.trie -> ('m, unit) Trie2.trie -> ('m, unit) Trie2.trie) * ((('n, unit) Trie2.trie -> ('n, unit) Trie2.trie -> ('n, unit) Trie2.trie) * ((('o, unit) Trie2.trie -> ('o, unit) Trie2.trie -> ('o, unit) Trie2.trie) * ((('p list -> bool) -> ('p, unit) Trie2.trie -> ('p, unit) Trie2.trie) * ((('q, unit) Trie2.trie -> ('q, unit) Trie2.trie -> ('q, unit) Trie2.trie) * ((('r, unit) Trie2.trie -> ('r, unit) Trie2.trie -> bool) * ((('s, unit) Trie2.trie -> ('s, unit) Trie2.trie -> bool) * ((('t, unit) Trie2.trie -> ('t, unit) Trie2.trie -> bool) * ((('u, unit) Trie2.trie -> ('u, unit) Trie2.trie -> ('u list) option) * ((('v, unit) Trie2.trie -> ('v list -> bool) -> ('v list) option) * ((('w, unit) Trie2.trie -> ('w list) list) * (('x list) list -> ('x, unit) Trie2.trie))))))))))))))))))))))) end = struct fun iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s = (fn c => fn f => Trie2.iteratei s c (f o Product_Type.fst)); fun g_sel_dflt_basic_ops_tm_basic_ops s p = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun memb_tm_basic_ops A_ x s = not (Option.is_none (Trie2.lookup A_ s x)); fun g_disjoint_witness_dflt_basic_ops_tm_basic_ops A_ s1 s2 = g_sel_dflt_basic_ops_tm_basic_ops s1 (fn x => memb_tm_basic_ops A_ x s2); fun g_size_abort_dflt_basic_ops_tm_basic_ops m s = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.Suc) Arith.Zero_nat; fun ins_tm_basic_ops A_ x s = Trie2.update A_ x () s; fun g_from_list_aux_dflt_basic_ops_tm_basic_ops A_ accs (x :: l) = g_from_list_aux_dflt_basic_ops_tm_basic_ops A_ (ins_tm_basic_ops A_ x accs) l | g_from_list_aux_dflt_basic_ops_tm_basic_ops A_ y [] = y; fun empty_tm_basic_ops x = (fn _ => Trie2.empty) x; fun g_from_list_dflt_basic_ops_tm_basic_ops A_ l = g_from_list_aux_dflt_basic_ops_tm_basic_ops A_ (empty_tm_basic_ops ()) l; fun ins_dj_tm_basic_ops A_ x s = Trie2.update A_ x () s; fun g_union_dj_dflt_basic_ops_tm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s1 (fn _ => true) (ins_dj_tm_basic_ops A_) s2; fun g_ball_dflt_basic_ops_tm_basic_ops s p = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_dflt_basic_ops_tm_basic_ops A_ s1 s2 = g_ball_dflt_basic_ops_tm_basic_ops s1 (fn x => not (memb_tm_basic_ops A_ x s2)); fun g_to_list_dflt_basic_ops_tm_basic_ops s = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_dflt_basic_ops_tm_basic_ops s = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_dflt_basic_ops_tm_basic_ops A_ s1 s2 = g_ball_dflt_basic_ops_tm_basic_ops s1 (fn x => memb_tm_basic_ops A_ x s2); fun g_filter_dflt_basic_ops_tm_basic_ops A_ p s = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn _ => true) (fn x => fn sigma => (if p x then ins_dj_tm_basic_ops A_ x sigma else sigma)) (empty_tm_basic_ops ()); fun g_union_dflt_basic_ops_tm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s1 (fn _ => true) (ins_tm_basic_ops A_) s2; fun g_isSng_dflt_basic_ops_tm_basic_ops s = Arith.equal_nat (iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn sigma => Arith.less_nat sigma (Arith.nat_of_num (Arith.Bit0 Arith.One))) (fn _ => Arith.Suc) Arith.Zero_nat) Arith.one_nat; fun g_inter_dflt_basic_ops_tm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s1 (fn _ => true) (fn x => fn s => (if memb_tm_basic_ops A_ x s2 then ins_dj_tm_basic_ops A_ x s else s)) (empty_tm_basic_ops ()); fun g_equal_dflt_basic_ops_tm_basic_ops A_ s1 s2 = g_subset_dflt_basic_ops_tm_basic_ops A_ s1 s2 andalso g_subset_dflt_basic_ops_tm_basic_ops A_ s2 s1; fun g_size_dflt_basic_ops_tm_basic_ops s = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun delete_tm_basic_ops A_ x s = Trie2.delete A_ x s; fun g_diff_dflt_basic_ops_tm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s2 (fn _ => true) (delete_tm_basic_ops A_) s1; fun g_sng_dflt_basic_ops_tm_basic_ops A_ x = ins_tm_basic_ops A_ x (empty_tm_basic_ops ()); fun g_bex_dflt_basic_ops_tm_basic_ops s p = iteratei_bset_op_list_it_dflt_basic_ops_tm_basic_ops s not (fn x => fn _ => p x) false; fun test_codegen B_ C_ D_ F_ M_ N_ O_ P_ Q_ R_ S_ T_ U_ X_ = (empty_tm_basic_ops, (memb_tm_basic_ops B_, (ins_tm_basic_ops C_, (delete_tm_basic_ops D_, ((fn s => fn c => fn f => Trie2.iteratei s c (f o Product_Type.fst)), (g_sng_dflt_basic_ops_tm_basic_ops F_, (g_isEmpty_dflt_basic_ops_tm_basic_ops, (g_isSng_dflt_basic_ops_tm_basic_ops, (g_ball_dflt_basic_ops_tm_basic_ops, (g_bex_dflt_basic_ops_tm_basic_ops, (g_size_dflt_basic_ops_tm_basic_ops, (g_size_abort_dflt_basic_ops_tm_basic_ops, (g_union_dflt_basic_ops_tm_basic_ops M_, (g_union_dj_dflt_basic_ops_tm_basic_ops N_, (g_diff_dflt_basic_ops_tm_basic_ops O_, (g_filter_dflt_basic_ops_tm_basic_ops P_, (g_inter_dflt_basic_ops_tm_basic_ops Q_, (g_subset_dflt_basic_ops_tm_basic_ops R_, (g_equal_dflt_basic_ops_tm_basic_ops S_, (g_disjoint_dflt_basic_ops_tm_basic_ops T_, (g_disjoint_witness_dflt_basic_ops_tm_basic_ops U_, (g_sel_dflt_basic_ops_tm_basic_ops, (g_to_list_dflt_basic_ops_tm_basic_ops, g_from_list_dflt_basic_ops_tm_basic_ops X_))))))))))))))))))))))); end; (*struct TrieSetImpl*) ### theory "Collections.TrieSetImpl" ### 1.113s elapsed time, 2.228s cpu time, 0.000s GC time Loading theory "Collections.HashMap_Impl" (required by "Collections.MapStdImpl" via "Collections.HashMap") structure STArray = struct datatype 'a Cell = Invalid | Value of 'a array; exception AccessedOldVersion; type 'a array = 'a Cell Unsynchronized.ref; fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun array (size, v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun sub (Unsynchronized.ref Invalid, idx) = raise AccessedOldVersion | sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx); fun update (aref,idx,v) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( aref := Invalid; Array.update (a,idx,v); Unsynchronized.ref (Value a) ); fun length (Unsynchronized.ref Invalid) = raise AccessedOldVersion | length (Unsynchronized.ref (Value a)) = Array.length a fun grow (aref, i, x) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+i,x) in aref := Invalid; Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref Invalid) => raise AccessedOldVersion | (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( aref:=Invalid; Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); end; end; structure FArray = struct datatype 'a Cell = Value of 'a Array.array | Upd of (int*'a*'a Cell Unsynchronized.ref); type 'a array = 'a Cell Unsynchronized.ref; fun array (size,v) = Unsynchronized.ref (Value (Array.array (size,v))); fun tabulate (size, f) = Unsynchronized.ref (Value (Array.tabulate(size, f))); fun fromList l = Unsynchronized.ref (Value (Array.fromList l)); fun sub (Unsynchronized.ref (Value a), idx) = Array.sub (a,idx) | sub (Unsynchronized.ref (Upd (i,v,cr)),idx) = if i=idx then v else sub (cr,idx); fun length (Unsynchronized.ref (Value a)) = Array.length a | length (Unsynchronized.ref (Upd (i,v,cr))) = length cr; fun realize_aux (aref, v) = case aref of (Unsynchronized.ref (Value a)) => ( let val len = Array.length a; val a' = Array.array (len,v); in Array.copy {src=a, dst=a', di=0}; Unsynchronized.ref (Value a') end ) | (Unsynchronized.ref (Upd (i,v,cr))) => ( let val res=realize_aux (cr,v) in case res of (Unsynchronized.ref (Value a)) => (Array.update (a,i,v); res) end ); fun realize aref = case aref of (Unsynchronized.ref (Value _)) => aref | (Unsynchronized.ref (Upd (i,v,cr))) => realize_aux(aref,v); fun update (aref,idx,v) = case aref of (Unsynchronized.ref (Value a)) => ( let val nref=Unsynchronized.ref (Value a) in aref := Upd (idx,Array.sub(a,idx),nref); Array.update (a,idx,v); nref end ) | (Unsynchronized.ref (Upd _)) => let val ra = realize_aux(aref,v) in case ra of (Unsynchronized.ref (Value a)) => Array.update (a,idx,v); ra end ; fun grow (aref, inc, x) = case aref of (Unsynchronized.ref (Value a)) => ( let val len=Array.length a; val na = Array.array (len+inc,x) in Array.copy {src=a, dst=na, di=0}; Unsynchronized.ref (Value na) end ) | (Unsynchronized.ref (Upd _)) => ( grow (realize aref, inc, x) ); fun shrink (aref, sz) = case aref of (Unsynchronized.ref (Value a)) => ( if sz > Array.length a then raise Size else ( Unsynchronized.ref (Value (Array.tabulate (sz,fn i => Array.sub (a,i)))) ) ) | (Unsynchronized.ref (Upd _)) => ( shrink (realize aref,sz) ); structure IsabelleMapping = struct type 'a ArrayType = 'a array; fun new_array (a:'a) (n:IntInf.int) = array (IntInf.toInt n, a); fun array_length (a:'a ArrayType) = IntInf.fromInt (length a); fun array_get (a:'a ArrayType) (i:IntInf.int) = sub (a, IntInf.toInt i); fun array_set (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e); fun array_of_list (xs:'a list) = fromList xs; fun array_grow (a:'a ArrayType) (i:IntInf.int) (x:'a) = grow (a, IntInf.toInt i, x); fun array_shrink (a:'a ArrayType) (sz:IntInf.int) = shrink (a,IntInf.toInt sz); fun array_get_oo (d:'a) (a:'a ArrayType) (i:IntInf.int) = sub (a,IntInf.toInt i) handle Subscript => d fun array_set_oo (d:(unit->'a ArrayType)) (a:'a ArrayType) (i:IntInf.int) (e:'a) = update (a, IntInf.toInt i, e) handle Subscript => d () end; end; structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure Arith : sig type nat val integer_of_nat : nat -> IntInf.int val less_eq_nat : nat -> nat -> bool val less_nat : nat -> nat -> bool val ord_nat : nat Orderings.ord datatype num = One | Bit0 of num | Bit1 of num val plus_nat : nat -> nat -> nat val one_nat : nat val suc : nat -> nat val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool val minus_nat : nat -> nat -> nat val times_nat : nat -> nat -> nat end = struct datatype nat = Nat of IntInf.int; fun integer_of_nat (Nat x) = x; fun less_eq_nat m n = IntInf.<= (integer_of_nat m, integer_of_nat n); fun less_nat m n = IntInf.< (integer_of_nat m, integer_of_nat n); val ord_nat = {less_eq = less_eq_nat, less = less_nat} : nat Orderings.ord; val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype num = One | Bit0 of num | Bit1 of num; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; val zero_nat : nat = Nat (0 : IntInf.int); fun nat_of_integer k = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); fun minus_nat m n = Nat (Orderings.max ord_integer (0 : IntInf.int) (IntInf.- (integer_of_nat m, integer_of_nat n))); fun times_nat m n = Nat (IntInf.* (integer_of_nat m, integer_of_nat n)); end; (*struct Arith*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Diff_Array : sig val array_get : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a val array_set : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType val array_grow : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType val array_get_oo : 'a -> 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a val array_length : 'a FArray.IsabelleMapping.ArrayType -> Arith.nat val array_set_oo : (unit -> 'a FArray.IsabelleMapping.ArrayType) -> 'a FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a -> 'a FArray.IsabelleMapping.ArrayType end = struct fun array_get a = FArray.IsabelleMapping.array_get a o Arith.integer_of_nat; fun array_set a = FArray.IsabelleMapping.array_set a o Arith.integer_of_nat; fun array_grow a = FArray.IsabelleMapping.array_grow a o Arith.integer_of_nat; fun array_get_oo x a = FArray.IsabelleMapping.array_get_oo x a o Arith.integer_of_nat; fun array_length x = (Arith.nat_of_integer o FArray.IsabelleMapping.array_length) x; fun array_set_oo f a = FArray.IsabelleMapping.array_set_oo f a o Arith.integer_of_nat; end; (*struct Diff_Array*) structure ArrayMapImpl : sig val iam_empty : unit -> ('a option) FArray.IsabelleMapping.ArrayType val iam_delete : Arith.nat -> ('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType val iam_update : Arith.nat -> 'a -> ('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType val iam_alpha : ('a option) FArray.IsabelleMapping.ArrayType -> Arith.nat -> 'a option val iam_iterateoi : ('a option) FArray.IsabelleMapping.ArrayType -> ('b -> bool) -> (Arith.nat * 'a -> 'b -> 'b) -> 'b -> 'b val iam_update_dj : Arith.nat -> 'a -> ('a option) FArray.IsabelleMapping.ArrayType -> ('a option) FArray.IsabelleMapping.ArrayType val iam_rev_iterateoi : ('a option) FArray.IsabelleMapping.ArrayType -> ('b -> bool) -> (Arith.nat * 'a -> 'b -> 'b) -> 'b -> 'b end = struct fun iam_empty x = (fn _ => FArray.IsabelleMapping.array_of_list []) x; fun iam_delete k a = Diff_Array.array_set_oo (fn _ => a) a k NONE; fun iam_increment l idx = Orderings.max Arith.ord_nat (Arith.minus_nat (Arith.plus_nat idx Arith.one_nat) l) (Arith.plus_nat (Arith.times_nat (Arith.nat_of_integer (2 : IntInf.int)) l) (Arith.nat_of_integer (3 : IntInf.int))); fun iam_update k v a = Diff_Array.array_set_oo (fn _ => Diff_Array.array_set (Diff_Array.array_grow a (iam_increment (Diff_Array.array_length a) k) NONE) k (SOME v)) a k (SOME v); fun iam_alpha a i = Diff_Array.array_get_oo NONE a i; fun iam_iterateoi_aux i len a c f sigma = (if Arith.less_eq_nat len i orelse not (c sigma) then sigma else let val b = (case Diff_Array.array_get a i of NONE => sigma | SOME x => f (i, x) sigma); in iam_iterateoi_aux (Arith.plus_nat i Arith.one_nat) len a c f b end); fun iam_iterateoi a = iam_iterateoi_aux Arith.zero_nat (Diff_Array.array_length a) a; fun iam_update_dj x = iam_update x; fun iam_rev_iterateoi_aux v a c f sigma = (if Arith.equal_nat v Arith.zero_nat then sigma else (if c sigma then iam_rev_iterateoi_aux (Arith.minus_nat (Arith.suc (Arith.minus_nat v Arith.one_nat)) Arith.one_nat) a c f (case Diff_Array.array_get a (Arith.minus_nat (Arith.suc (Arith.minus_nat v Arith.one_nat)) Arith.one_nat) of NONE => sigma | SOME x => f (Arith.minus_nat (Arith.suc (Arith.minus_nat v Arith.one_nat)) Arith.one_nat, x) sigma) else sigma)); fun iam_rev_iterateoi a = iam_rev_iterateoi_aux (Diff_Array.array_length a) a; end; (*struct ArrayMapImpl*) structure Product_Type : sig val fst : 'a * 'b -> 'a end = struct fun fst (x1, x2) = x1; end; (*struct Product_Type*) structure ArraySetImpl : sig val test_codegen : (unit -> (unit option) FArray.IsabelleMapping.ArrayType) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat list -> bool) -> (Arith.nat -> Arith.nat list -> Arith.nat list) -> Arith.nat list -> Arith.nat list) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((Arith.nat -> bool) -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat list) * ((Arith.nat list -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat list -> bool) -> (Arith.nat -> Arith.nat list -> Arith.nat list) -> Arith.nat list -> Arith.nat list) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat list -> bool) -> (Arith.nat -> Arith.nat list -> Arith.nat list) -> Arith.nat list -> Arith.nat list) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat list) * ((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat list))))))))))))))))))))))))))))) end = struct fun iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s = (fn c => fn f => ArrayMapImpl.iam_rev_iterateoi s c (f o Product_Type.fst)); fun g_sel_dflt_basic_oops_iam_basic_ops s p = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun memb_iam_basic_ops x s = not (Option.is_none (ArrayMapImpl.iam_alpha s x)); fun g_disjoint_witness_dflt_basic_oops_iam_basic_ops s1 s2 = g_sel_dflt_basic_oops_iam_basic_ops s1 (fn x => memb_iam_basic_ops x s2); fun rev_iterateoi_bset_op_rev_list_it_dflt_basic_oops_iam_basic_ops s = (fn c => fn f => ArrayMapImpl.iam_rev_iterateoi s c (f o Product_Type.fst)); fun g_to_sorted_list_dflt_basic_oops_iam_basic_ops s = rev_iterateoi_bset_op_rev_list_it_dflt_basic_oops_iam_basic_ops s (fn _ => true) (fn a => fn b => a :: b) []; fun iterateoi_bset_op_ordered_list_it_dflt_basic_oops_iam_basic_ops s = (fn c => fn f => ArrayMapImpl.iam_iterateoi s c (f o Product_Type.fst)); fun g_to_rev_list_dflt_basic_oops_iam_basic_ops s = iterateoi_bset_op_ordered_list_it_dflt_basic_oops_iam_basic_ops s (fn _ => true) (fn a => fn b => a :: b) []; fun g_size_abort_dflt_basic_oops_iam_basic_ops m s = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.suc) Arith.zero_nat; fun ins_iam_basic_ops x s = ArrayMapImpl.iam_update x () s; fun g_from_list_aux_dflt_basic_oops_iam_basic_ops accs (x :: l) = g_from_list_aux_dflt_basic_oops_iam_basic_ops (ins_iam_basic_ops x accs) l | g_from_list_aux_dflt_basic_oops_iam_basic_ops y [] = y; fun empty_iam_basic_ops x = ArrayMapImpl.iam_empty x; fun g_from_list_dflt_basic_oops_iam_basic_ops l = g_from_list_aux_dflt_basic_oops_iam_basic_ops (empty_iam_basic_ops ()) l; fun ins_dj_iam_basic_ops x s = ArrayMapImpl.iam_update_dj x () s; fun g_union_dj_dflt_basic_oops_iam_basic_ops s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s1 (fn _ => true) ins_dj_iam_basic_ops s2; fun g_ball_dflt_basic_oops_iam_basic_ops s p = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_dflt_basic_oops_iam_basic_ops s1 s2 = g_ball_dflt_basic_oops_iam_basic_ops s1 (fn x => not (memb_iam_basic_ops x s2)); fun g_to_list_dflt_basic_oops_iam_basic_ops s = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_dflt_basic_oops_iam_basic_ops s = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_dflt_basic_oops_iam_basic_ops s1 s2 = g_ball_dflt_basic_oops_iam_basic_ops s1 (fn x => memb_iam_basic_ops x s2); fun g_filter_dflt_basic_oops_iam_basic_ops p s = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn _ => true) (fn x => fn sigma => (if p x then ins_dj_iam_basic_ops x sigma else sigma)) (empty_iam_basic_ops ()); fun g_union_dflt_basic_oops_iam_basic_ops s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s1 (fn _ => true) ins_iam_basic_ops s2; fun g_isSng_dflt_basic_oops_iam_basic_ops s = Arith.equal_nat (iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn sigma => Arith.less_nat sigma (Arith.nat_of_integer (2 : IntInf.int))) (fn _ => Arith.suc) Arith.zero_nat) Arith.one_nat; fun g_inter_dflt_basic_oops_iam_basic_ops s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s1 (fn _ => true) (fn x => fn s => (if memb_iam_basic_ops x s2 then ins_dj_iam_basic_ops x s else s)) (empty_iam_basic_ops ()); fun g_equal_dflt_basic_oops_iam_basic_ops s1 s2 = g_subset_dflt_basic_oops_iam_basic_ops s1 s2 andalso g_subset_dflt_basic_oops_iam_basic_ops s2 s1; fun g_size_dflt_basic_oops_iam_basic_ops s = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s (fn _ => true) (fn _ => Arith.suc) Arith.zero_nat; fun delete_iam_basic_ops x s = ArrayMapImpl.iam_delete x s; fun g_diff_dflt_basic_oops_iam_basic_ops s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s2 (fn _ => true) delete_iam_basic_ops s1; fun g_sng_dflt_basic_oops_iam_basic_ops x = ins_iam_basic_ops x (empty_iam_basic_ops ()); fun g_min_dflt_basic_oops_iam_basic_ops s p = iterateoi_bset_op_ordered_list_it_dflt_basic_oops_iam_basic_ops s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_max_dflt_basic_oops_iam_basic_ops s p = rev_iterateoi_bset_op_rev_list_it_dflt_basic_oops_iam_basic_ops s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_dflt_basic_oops_iam_basic_ops s p = iteratei_bset_op_list_it_dflt_basic_oops_iam_basic_ops s not (fn x => fn _ => p x) false; val test_codegen : (unit -> (unit option) FArray.IsabelleMapping.ArrayType) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat list -> bool) -> (Arith.nat -> Arith.nat list -> Arith.nat list) -> Arith.nat list -> Arith.nat list) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * ((Arith.nat -> (unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((Arith.nat -> bool) -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> bool) * (((unit option) FArray.IsabelleMapping.ArrayType -> (unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat list) * ((Arith.nat list -> (unit option) FArray.IsabelleMapping.ArrayType) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat list -> bool) -> (Arith.nat -> Arith.nat list -> Arith.nat list) -> Arith.nat list -> Arith.nat list) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat list -> bool) -> (Arith.nat -> Arith.nat list -> Arith.nat list) -> Arith.nat list -> Arith.nat list) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> (Arith.nat -> bool) -> Arith.nat option) * (((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat list) * ((unit option) FArray.IsabelleMapping.ArrayType -> Arith.nat list))))))))))))))))))))))))))))) = (empty_iam_basic_ops, (memb_iam_basic_ops, (ins_iam_basic_ops, (delete_iam_basic_ops, ((fn s => fn c => fn f => ArrayMapImpl.iam_rev_iterateoi s c (f o Product_Type.fst)), (g_sng_dflt_basic_oops_iam_basic_ops, (g_isEmpty_dflt_basic_oops_iam_basic_ops, (g_isSng_dflt_basic_oops_iam_basic_ops, (g_ball_dflt_basic_oops_iam_basic_ops, (g_bex_dflt_basic_oops_iam_basic_ops, (g_size_dflt_basic_oops_iam_basic_ops, (g_size_abort_dflt_basic_oops_iam_basic_ops, (g_union_dflt_basic_oops_iam_basic_ops, (g_union_dj_dflt_basic_oops_iam_basic_ops, (g_diff_dflt_basic_oops_iam_basic_ops, (g_filter_dflt_basic_oops_iam_basic_ops, (g_inter_dflt_basic_oops_iam_basic_ops, (g_subset_dflt_basic_oops_iam_basic_ops, (g_equal_dflt_basic_oops_iam_basic_ops, (g_disjoint_dflt_basic_oops_iam_basic_ops, (g_disjoint_witness_dflt_basic_oops_iam_basic_ops, (g_sel_dflt_basic_oops_iam_basic_ops, (g_to_list_dflt_basic_oops_iam_basic_ops, (g_from_list_dflt_basic_oops_iam_basic_ops, ((fn s => fn c => fn f => ArrayMapImpl.iam_iterateoi s c (f o Product_Type.fst)), ((fn s => fn c => fn f => ArrayMapImpl.iam_rev_iterateoi s c (f o Product_Type.fst)), (g_min_dflt_basic_oops_iam_basic_ops, (g_max_dflt_basic_oops_iam_basic_ops, (g_to_sorted_list_dflt_basic_oops_iam_basic_ops, g_to_rev_list_dflt_basic_oops_iam_basic_ops))))))))))))))))))))))))))))); end; (*struct ArraySetImpl*) ### theory "Collections.ArraySetImpl" ### 1.593s elapsed time, 3.192s cpu time, 0.000s GC time Loading theory "Collections.RBTSetImpl" (required by "Collections.SetStdImpl") ### Ignoring sort constraints in type variables(s): "'a" ### in type abbreviation "rs" ### theory "Collections.HashMap_Impl" ### 1.735s elapsed time, 3.420s cpu time, 0.472s GC time Loading theory "Collections.HashMap" (required by "Collections.MapStdImpl") structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; end; (*struct Orderings*) structure RBT_Impl : sig type color datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt val rbt_delete : 'a Orderings.ord -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_insert : 'a Orderings.ord -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_lookup : 'a Orderings.ord -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype color = R | B; datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt; fun paint c Empty = Empty | paint c (Branch (uu, l, k, v, r)) = Branch (c, l, k, v, r); fun balance (Branch (R, a, w, x, b)) s t (Branch (R, c, y, z, d)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z Empty = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (B, va, vb, vc, vd), w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Branch (B, ve, vf, vg, vh), w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Branch (B, ve, vf, vg, vh), w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance Empty w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, d)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, va, vb, vc, vd))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, ve, vf, vg, vh))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Branch (B, ve, vf, vg, vh))) | balance Empty s t Empty = Branch (B, Empty, s, t, Empty) | balance Empty s t (Branch (B, va, vb, vc, vd)) = Branch (B, Empty, s, t, Branch (B, va, vb, vc, vd)) | balance Empty s t (Branch (v, Empty, vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Empty)) | balance Empty s t (Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) | balance Empty s t (Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) | balance Empty s t (Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) | balance (Branch (B, va, vb, vc, vd)) s t Empty = Branch (B, Branch (B, va, vb, vc, vd), s, t, Empty) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (B, ve, vf, vg, vh)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (B, ve, vf, vg, vh)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (v, Empty, vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Empty), s, t, Empty) | balance (Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh))) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh)), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl))) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl)), s, t, Empty) | balance (Branch (v, Empty, vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl)), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp)), s, t, Branch (B, va, vb, vc, vd)); fun balance_left (Branch (R, a, k, x, b)) s y c = Branch (R, Branch (B, a, k, x, b), s, y, c) | balance_left Empty k x (Branch (B, a, s, y, b)) = balance Empty k x (Branch (R, a, s, y, b)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (B, a, s, y, b)) = balance (Branch (B, va, vb, vc, vd)) k x (Branch (R, a, s, y, b)) | balance_left Empty k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Empty, k, x, a), s, y, balance b t z (paint R c)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), k, x, a), s, y, balance b t z (paint R c)) | balance_left Empty k x Empty = Empty | balance_left Empty k x (Branch (R, Empty, vb, vc, vd)) = Empty | balance_left Empty k x (Branch (R, Branch (R, ve, vf, vg, vh), vb, vc, vd)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x Empty = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Empty, vf, vg, vh)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (R, vi, vj, vk, vl), vf, vg, vh)) = Empty; fun combine Empty x = x | combine (Branch (v, va, vb, vc, vd)) Empty = Branch (v, va, vb, vc, vd) | combine (Branch (R, a, k, x, b)) (Branch (R, c, s, y, d)) = (case combine b c of Empty => Branch (R, a, k, x, Branch (R, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (R, a, k, x, b2), t, z, Branch (R, c2, s, y, d)) | Branch (B, b2, t, z, c2) => Branch (R, a, k, x, Branch (R, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, a, k, x, b)) (Branch (B, c, s, y, d)) = (case combine b c of Empty => balance_left a k x (Branch (B, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (B, a, k, x, b2), t, z, Branch (B, c2, s, y, d)) | Branch (B, b2, t, z, c2) => balance_left a k x (Branch (B, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, va, vb, vc, vd)) (Branch (R, b, k, x, c)) = Branch (R, combine (Branch (B, va, vb, vc, vd)) b, k, x, c) | combine (Branch (R, a, k, x, b)) (Branch (B, va, vb, vc, vd)) = Branch (R, a, k, x, combine b (Branch (B, va, vb, vc, vd))); fun balance_right a k x (Branch (R, b, s, y, c)) = Branch (R, a, k, x, Branch (B, b, s, y, c)) | balance_right (Branch (B, a, k, x, b)) s y Empty = balance (Branch (R, a, k, x, b)) s y Empty | balance_right (Branch (B, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) = balance (Branch (R, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z Empty = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Empty)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z (Branch (B, va, vb, vc, vd)) = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Branch (B, va, vb, vc, vd))) | balance_right Empty k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Empty)) k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Branch (R, ve, vf, vg, vh))) k x Empty = Empty | balance_right Empty k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Empty)) k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Branch (R, vi, vj, vk, vl))) k x (Branch (B, va, vb, vc, vd)) = Empty; fun rbt_del A_ x Empty = Empty | rbt_del A_ x (Branch (c, a, y, s, b)) = (if Orderings.less A_ x y then rbt_del_from_left A_ x a y s b else (if Orderings.less A_ y x then rbt_del_from_right A_ x a y s b else combine a b)) and rbt_del_from_left A_ x (Branch (B, lt, z, v, rt)) y s b = balance_left (rbt_del A_ x (Branch (B, lt, z, v, rt))) y s b | rbt_del_from_left A_ x Empty y s b = Branch (R, rbt_del A_ x Empty, y, s, b) | rbt_del_from_left A_ x (Branch (R, va, vb, vc, vd)) y s b = Branch (R, rbt_del A_ x (Branch (R, va, vb, vc, vd)), y, s, b) and rbt_del_from_right A_ x a y s (Branch (B, lt, z, v, rt)) = balance_right a y s (rbt_del A_ x (Branch (B, lt, z, v, rt))) | rbt_del_from_right A_ x a y s Empty = Branch (R, a, y, s, rbt_del A_ x Empty) | rbt_del_from_right A_ x a y s (Branch (R, va, vb, vc, vd)) = Branch (R, a, y, s, rbt_del A_ x (Branch (R, va, vb, vc, vd))); fun rbt_ins A_ f k v Empty = Branch (R, Empty, k, v, Empty) | rbt_ins A_ f k v (Branch (B, l, x, y, r)) = (if Orderings.less A_ k x then balance (rbt_ins A_ f k v l) x y r else (if Orderings.less A_ x k then balance l x y (rbt_ins A_ f k v r) else Branch (B, l, x, f k y v, r))) | rbt_ins A_ f k v (Branch (R, l, x, y, r)) = (if Orderings.less A_ k x then Branch (R, rbt_ins A_ f k v l, x, y, r) else (if Orderings.less A_ x k then Branch (R, l, x, y, rbt_ins A_ f k v r) else Branch (R, l, x, f k y v, r))); fun rbt_delete A_ k t = paint B (rbt_del A_ k t); fun rbt_insert_with_key A_ f k v t = paint B (rbt_ins A_ f k v t); fun rbt_insert A_ = rbt_insert_with_key A_ (fn _ => fn _ => fn nv => nv); fun rbt_lookup A_ Empty k = NONE | rbt_lookup A_ (Branch (uu, l, x, y, r)) k = (if Orderings.less A_ k x then rbt_lookup A_ l k else (if Orderings.less A_ x k then rbt_lookup A_ r k else SOME y)); end; (*struct RBT_Impl*) structure RBT : sig type ('b, 'a) rbt val empty : 'a Orderings.linorder -> ('a, 'b) rbt val impl_of : 'b Orderings.linorder -> ('b, 'a) rbt -> ('b, 'a) RBT_Impl.rbt val delete : 'a Orderings.linorder -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val insert : 'a Orderings.linorder -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val lookup : 'a Orderings.linorder -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype ('b, 'a) rbt = RBT of ('b, 'a) RBT_Impl.rbt; fun empty A_ = RBT RBT_Impl.Empty; fun impl_of B_ (RBT x) = x; fun delete A_ xb xc = RBT (RBT_Impl.rbt_delete ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xb (impl_of A_ xc)); fun insert A_ xc xd xe = RBT (RBT_Impl.rbt_insert ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xc xd (impl_of A_ xe)); fun lookup A_ x = RBT_Impl.rbt_lookup ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) (impl_of A_ x); end; (*struct RBT*) structure Arith : sig datatype nat = Zero_nat | Suc of nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val nat_of_num : num -> nat val less_nat : nat -> nat -> bool val equal_nat : nat -> nat -> bool end = struct datatype nat = Zero_nat | Suc of nat; datatype num = One | Bit0 of num | Bit1 of num; 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 less_nat m (Suc n) = less_eq_nat m n | less_nat n Zero_nat = false and less_eq_nat (Suc m) n = less_nat m n | less_eq_nat Zero_nat n = true; fun equal_nat Zero_nat (Suc x2) = false | equal_nat (Suc x2) Zero_nat = false | equal_nat (Suc x2) (Suc y2) = equal_nat x2 y2 | equal_nat Zero_nat Zero_nat = true; end; (*struct Arith*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure RBT_add : sig val rm_iterateoi : ('a, 'b) RBT_Impl.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c val rm_reverse_iterateoi : ('a, 'b) RBT_Impl.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun rm_iterateoi RBT_Impl.Empty c f sigma = sigma | rm_iterateoi (RBT_Impl.Branch (col, l, k, v, r)) c f sigma = (if c sigma then let val sigmaa = rm_iterateoi l c f sigma; in (if c sigmaa then rm_iterateoi r c f (f (k, v) sigmaa) else sigmaa) end else sigma); fun rm_reverse_iterateoi RBT_Impl.Empty c f sigma = sigma | rm_reverse_iterateoi (RBT_Impl.Branch (col, l, k, v, r)) c f sigma = (if c sigma then let val sigmaa = rm_reverse_iterateoi r c f sigma; in (if c sigmaa then rm_reverse_iterateoi l c f (f (k, v) sigmaa) else sigmaa) end else sigma); end; (*struct RBT_add*) structure Product_Type : sig val fst : 'a * 'b -> 'a end = struct fun fst (x1, x2) = x1; end; (*struct Product_Type*) structure RBTSetImpl : sig val test_codegen : 'a Orderings.linorder -> 'b Orderings.linorder -> 'c Orderings.linorder -> 'd Orderings.linorder -> 'e Orderings.linorder -> 'f Orderings.linorder -> 'g Orderings.linorder -> 'h Orderings.linorder -> 'i Orderings.linorder -> 'j Orderings.linorder -> 'k Orderings.linorder -> 'l Orderings.linorder -> 'm Orderings.linorder -> 'n Orderings.linorder -> 'o Orderings.linorder -> 'p Orderings.linorder -> 'q Orderings.linorder -> 'r Orderings.linorder -> 's Orderings.linorder -> 't Orderings.linorder -> 'u Orderings.linorder -> 'v Orderings.linorder -> 'w Orderings.linorder -> 'x Orderings.linorder -> 'y Orderings.linorder -> 'z Orderings.linorder -> 'aa Orderings.linorder -> 'ab Orderings.linorder -> 'ac Orderings.linorder -> 'ad Orderings.linorder -> (unit -> ('a, unit) RBT.rbt) * (('b -> ('b, unit) RBT.rbt -> bool) * (('c -> ('c, unit) RBT.rbt -> ('c, unit) RBT.rbt) * (('d -> ('d, unit) RBT.rbt -> ('d, unit) RBT.rbt) * ((('e, unit) RBT.rbt -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> ('f, unit) RBT.rbt) * ((('g, unit) RBT.rbt -> bool) * ((('h, unit) RBT.rbt -> bool) * ((('i, unit) RBT.rbt -> ('i -> bool) -> bool) * ((('j, unit) RBT.rbt -> ('j -> bool) -> bool) * ((('k, unit) RBT.rbt -> Arith.nat) * ((Arith.nat -> ('l, unit) RBT.rbt -> Arith.nat) * ((('m, unit) RBT.rbt -> ('m, unit) RBT.rbt -> ('m, unit) RBT.rbt) * ((('n, unit) RBT.rbt -> ('n, unit) RBT.rbt -> ('n, unit) RBT.rbt) * ((('o, unit) RBT.rbt -> ('o, unit) RBT.rbt -> ('o, unit) RBT.rbt) * ((('p -> bool) -> ('p, unit) RBT.rbt -> ('p, unit) RBT.rbt) * ((('q, unit) RBT.rbt -> ('q, unit) RBT.rbt -> ('q, unit) RBT.rbt) * ((('r, unit) RBT.rbt -> ('r, unit) RBT.rbt -> bool) * ((('s, unit) RBT.rbt -> ('s, unit) RBT.rbt -> bool) * ((('t, unit) RBT.rbt -> ('t, unit) RBT.rbt -> bool) * ((('u, unit) RBT.rbt -> ('u, unit) RBT.rbt -> 'u option) * ((('v, unit) RBT.rbt -> ('v -> bool) -> 'v option) * ((('w, unit) RBT.rbt -> 'w list) * (('x list -> ('x, unit) RBT.rbt) * ((('y, unit) RBT.rbt -> ('y list -> bool) -> ('y -> 'y list -> 'y list) -> 'y list -> 'y list) * ((('z, unit) RBT.rbt -> ('z list -> bool) -> ('z -> 'z list -> 'z list) -> 'z list -> 'z list) * ((('aa, unit) RBT.rbt -> ('aa -> bool) -> 'aa option) * ((('ab, unit) RBT.rbt -> ('ab -> bool) -> 'ab option) * ((('ac, unit) RBT.rbt -> 'ac list) * (('ad, unit) RBT.rbt -> 'ad list))))))))))))))))))))))))))))) end = struct fun iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s = (fn c => fn f => RBT_add.rm_iterateoi (RBT.impl_of A_ s) c (f o Product_Type.fst)); fun g_sel_dflt_basic_oops_rm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun memb_rm_basic_ops A_ x s = not (Option.is_none (RBT.lookup A_ s x)); fun g_disjoint_witness_dflt_basic_oops_rm_basic_ops A_ s1 s2 = g_sel_dflt_basic_oops_rm_basic_ops A_ s1 (fn x => memb_rm_basic_ops A_ x s2); fun rev_iterateoi_bset_op_rev_list_it_dflt_basic_oops_rm_basic_ops A_ s = (fn c => fn f => RBT_add.rm_reverse_iterateoi (RBT.impl_of A_ s) c (f o Product_Type.fst)); fun g_to_sorted_list_dflt_basic_oops_rm_basic_ops A_ s = rev_iterateoi_bset_op_rev_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn _ => true) (fn a => fn b => a :: b) []; fun iterateoi_bset_op_ordered_list_it_dflt_basic_oops_rm_basic_ops A_ s = (fn c => fn f => RBT_add.rm_iterateoi (RBT.impl_of A_ s) c (f o Product_Type.fst)); fun g_to_rev_list_dflt_basic_oops_rm_basic_ops A_ s = iterateoi_bset_op_ordered_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn _ => true) (fn a => fn b => a :: b) []; fun g_size_abort_dflt_basic_oops_rm_basic_ops A_ m s = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.Suc) Arith.Zero_nat; fun ins_rm_basic_ops A_ x s = RBT.insert A_ x () s; fun g_from_list_aux_dflt_basic_oops_rm_basic_ops A_ accs (x :: l) = g_from_list_aux_dflt_basic_oops_rm_basic_ops A_ (ins_rm_basic_ops A_ x accs) l | g_from_list_aux_dflt_basic_oops_rm_basic_ops A_ y [] = y; fun empty_rm_basic_ops A_ = (fn _ => RBT.empty A_); fun g_from_list_dflt_basic_oops_rm_basic_ops A_ l = g_from_list_aux_dflt_basic_oops_rm_basic_ops A_ (empty_rm_basic_ops A_ ()) l; fun ins_dj_rm_basic_ops A_ x s = RBT.insert A_ x () s; fun g_union_dj_dflt_basic_oops_rm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s1 (fn _ => true) (ins_dj_rm_basic_ops A_) s2; fun g_ball_dflt_basic_oops_rm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_dflt_basic_oops_rm_basic_ops A_ s1 s2 = g_ball_dflt_basic_oops_rm_basic_ops A_ s1 (fn x => not (memb_rm_basic_ops A_ x s2)); fun g_to_list_dflt_basic_oops_rm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_dflt_basic_oops_rm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_dflt_basic_oops_rm_basic_ops A_ s1 s2 = g_ball_dflt_basic_oops_rm_basic_ops A_ s1 (fn x => memb_rm_basic_ops A_ x s2); fun g_filter_dflt_basic_oops_rm_basic_ops A_ p s = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn _ => true) (fn x => fn sigma => (if p x then ins_dj_rm_basic_ops A_ x sigma else sigma)) (empty_rm_basic_ops A_ ()); fun g_union_dflt_basic_oops_rm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s1 (fn _ => true) (ins_rm_basic_ops A_) s2; fun g_isSng_dflt_basic_oops_rm_basic_ops A_ s = Arith.equal_nat (iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn sigma => Arith.less_nat sigma (Arith.nat_of_num (Arith.Bit0 Arith.One))) (fn _ => Arith.Suc) Arith.Zero_nat) Arith.one_nat; fun g_inter_dflt_basic_oops_rm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s1 (fn _ => true) (fn x => fn s => (if memb_rm_basic_ops A_ x s2 then ins_dj_rm_basic_ops A_ x s else s)) (empty_rm_basic_ops A_ ()); fun g_equal_dflt_basic_oops_rm_basic_ops A_ s1 s2 = g_subset_dflt_basic_oops_rm_basic_ops A_ s1 s2 andalso g_subset_dflt_basic_oops_rm_basic_ops A_ s2 s1; fun g_size_dflt_basic_oops_rm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s (fn _ => true) (fn _ => Arith.Suc) Arith.Zero_nat; fun delete_rm_basic_ops A_ x s = RBT.delete A_ x s; fun g_diff_dflt_basic_oops_rm_basic_ops A_ s1 s2 = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s2 (fn _ => true) (delete_rm_basic_ops A_) s1; fun g_sng_dflt_basic_oops_rm_basic_ops A_ x = ins_rm_basic_ops A_ x (empty_rm_basic_ops A_ ()); fun g_min_dflt_basic_oops_rm_basic_ops A_ s p = iterateoi_bset_op_ordered_list_it_dflt_basic_oops_rm_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_max_dflt_basic_oops_rm_basic_ops A_ s p = rev_iterateoi_bset_op_rev_list_it_dflt_basic_oops_rm_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_dflt_basic_oops_rm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_oops_rm_basic_ops A_ s not (fn x => fn _ => p x) false; fun test_codegen A_ B_ C_ D_ E_ F_ G_ H_ I_ J_ K_ L_ M_ N_ O_ P_ Q_ R_ S_ T_ U_ V_ W_ X_ Y_ Z_ Aa_ Ab_ Ac_ Ad_ = (empty_rm_basic_ops A_, (memb_rm_basic_ops B_, (ins_rm_basic_ops C_, (delete_rm_basic_ops D_, ((fn s => fn c => fn f => RBT_add.rm_iterateoi (RBT.impl_of E_ s) c (f o Product_Type.fst)), (g_sng_dflt_basic_oops_rm_basic_ops F_, (g_isEmpty_dflt_basic_oops_rm_basic_ops G_, (g_isSng_dflt_basic_oops_rm_basic_ops H_, (g_ball_dflt_basic_oops_rm_basic_ops I_, (g_bex_dflt_basic_oops_rm_basic_ops J_, (g_size_dflt_basic_oops_rm_basic_ops K_, (g_size_abort_dflt_basic_oops_rm_basic_ops L_, (g_union_dflt_basic_oops_rm_basic_ops M_, (g_union_dj_dflt_basic_oops_rm_basic_ops N_, (g_diff_dflt_basic_oops_rm_basic_ops O_, (g_filter_dflt_basic_oops_rm_basic_ops P_, (g_inter_dflt_basic_oops_rm_basic_ops Q_, (g_subset_dflt_basic_oops_rm_basic_ops R_, (g_equal_dflt_basic_oops_rm_basic_ops S_, (g_disjoint_dflt_basic_oops_rm_basic_ops T_, (g_disjoint_witness_dflt_basic_oops_rm_basic_ops U_, (g_sel_dflt_basic_oops_rm_basic_ops V_, (g_to_list_dflt_basic_oops_rm_basic_ops W_, (g_from_list_dflt_basic_oops_rm_basic_ops X_, ((fn s => fn c => fn f => RBT_add.rm_iterateoi (RBT.impl_of Y_ s) c (f o Product_Type.fst)), ((fn s => fn c => fn f => RBT_add.rm_reverse_iterateoi (RBT.impl_of Z_ s) c (f o Product_Type.fst)), (g_min_dflt_basic_oops_rm_basic_ops Aa_, (g_max_dflt_basic_oops_rm_basic_ops Ab_, (g_to_sorted_list_dflt_basic_oops_rm_basic_ops Ac_, g_to_rev_list_dflt_basic_oops_rm_basic_ops Ad_))))))))))))))))))))))))))))); end; (*struct RBTSetImpl*) ### theory "Collections.RBTSetImpl" ### 2.172s elapsed time, 4.292s cpu time, 0.472s GC time (* Test that words can handle numbers between 0 and 31 *) val _ = if 5 <= Word.wordSize then () else raise (Fail ("wordSize less than 5")); structure Uint32 : sig val set_bit : Word32.word -> IntInf.int -> bool -> Word32.word val shiftl : Word32.word -> IntInf.int -> Word32.word val shiftr : Word32.word -> IntInf.int -> Word32.word val shiftr_signed : Word32.word -> IntInf.int -> Word32.word val test_bit : Word32.word -> IntInf.int -> bool end = struct fun set_bit x n b = let val mask = Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n)) in if b then Word32.orb (x, mask) else Word32.andb (x, Word32.notb mask) end fun shiftl x n = Word32.<< (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr x n = Word32.>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr_signed x n = Word32.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun test_bit x n = Word32.andb (x, Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word32.fromInt 0 end; (* struct Uint32 *) structure Bits_Integer : sig val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int val shiftl : IntInf.int -> IntInf.int -> IntInf.int val shiftr : IntInf.int -> IntInf.int -> IntInf.int val test_bit : IntInf.int -> IntInf.int -> bool end = struct val maxWord = IntInf.pow (2, Word.wordSize); fun set_bit x n b = if n < maxWord then if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))) else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); fun shiftl x n = if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun shiftr x n = if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun test_bit x n = if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0 else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); end; (*struct Bits_Integer*) structure Fun : sig val id : 'a -> 'a end = struct fun id x = (fn xa => xa) x; end; (*struct Fun*) structure HOL : sig type 'a equal type 'a itself val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; datatype 'a itself = Type; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure RBT_Impl : sig type color datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt val rbt_delete : 'a Orderings.ord -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_insert : 'a Orderings.ord -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_lookup : 'a Orderings.ord -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype color = R | B; datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt; fun paint c Empty = Empty | paint c (Branch (uu, l, k, v, r)) = Branch (c, l, k, v, r); fun balance (Branch (R, a, w, x, b)) s t (Branch (R, c, y, z, d)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z Empty = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (B, va, vb, vc, vd), w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Branch (B, ve, vf, vg, vh), w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Branch (B, ve, vf, vg, vh), w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance Empty w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, d)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, va, vb, vc, vd))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, ve, vf, vg, vh))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Branch (B, ve, vf, vg, vh))) | balance Empty s t Empty = Branch (B, Empty, s, t, Empty) | balance Empty s t (Branch (B, va, vb, vc, vd)) = Branch (B, Empty, s, t, Branch (B, va, vb, vc, vd)) | balance Empty s t (Branch (v, Empty, vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Empty)) | balance Empty s t (Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) | balance Empty s t (Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) | balance Empty s t (Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) | balance (Branch (B, va, vb, vc, vd)) s t Empty = Branch (B, Branch (B, va, vb, vc, vd), s, t, Empty) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (B, ve, vf, vg, vh)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (B, ve, vf, vg, vh)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (v, Empty, vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Empty), s, t, Empty) | balance (Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh))) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh)), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl))) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl)), s, t, Empty) | balance (Branch (v, Empty, vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl)), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp)), s, t, Branch (B, va, vb, vc, vd)); fun balance_left (Branch (R, a, k, x, b)) s y c = Branch (R, Branch (B, a, k, x, b), s, y, c) | balance_left Empty k x (Branch (B, a, s, y, b)) = balance Empty k x (Branch (R, a, s, y, b)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (B, a, s, y, b)) = balance (Branch (B, va, vb, vc, vd)) k x (Branch (R, a, s, y, b)) | balance_left Empty k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Empty, k, x, a), s, y, balance b t z (paint R c)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), k, x, a), s, y, balance b t z (paint R c)) | balance_left Empty k x Empty = Empty | balance_left Empty k x (Branch (R, Empty, vb, vc, vd)) = Empty | balance_left Empty k x (Branch (R, Branch (R, ve, vf, vg, vh), vb, vc, vd)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x Empty = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Empty, vf, vg, vh)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (R, vi, vj, vk, vl), vf, vg, vh)) = Empty; fun combine Empty x = x | combine (Branch (v, va, vb, vc, vd)) Empty = Branch (v, va, vb, vc, vd) | combine (Branch (R, a, k, x, b)) (Branch (R, c, s, y, d)) = (case combine b c of Empty => Branch (R, a, k, x, Branch (R, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (R, a, k, x, b2), t, z, Branch (R, c2, s, y, d)) | Branch (B, b2, t, z, c2) => Branch (R, a, k, x, Branch (R, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, a, k, x, b)) (Branch (B, c, s, y, d)) = (case combine b c of Empty => balance_left a k x (Branch (B, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (B, a, k, x, b2), t, z, Branch (B, c2, s, y, d)) | Branch (B, b2, t, z, c2) => balance_left a k x (Branch (B, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, va, vb, vc, vd)) (Branch (R, b, k, x, c)) = Branch (R, combine (Branch (B, va, vb, vc, vd)) b, k, x, c) | combine (Branch (R, a, k, x, b)) (Branch (B, va, vb, vc, vd)) = Branch (R, a, k, x, combine b (Branch (B, va, vb, vc, vd))); fun balance_right a k x (Branch (R, b, s, y, c)) = Branch (R, a, k, x, Branch (B, b, s, y, c)) | balance_right (Branch (B, a, k, x, b)) s y Empty = balance (Branch (R, a, k, x, b)) s y Empty | balance_right (Branch (B, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) = balance (Branch (R, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z Empty = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Empty)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z (Branch (B, va, vb, vc, vd)) = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Branch (B, va, vb, vc, vd))) | balance_right Empty k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Empty)) k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Branch (R, ve, vf, vg, vh))) k x Empty = Empty | balance_right Empty k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Empty)) k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Branch (R, vi, vj, vk, vl))) k x (Branch (B, va, vb, vc, vd)) = Empty; fun rbt_del A_ x Empty = Empty | rbt_del A_ x (Branch (c, a, y, s, b)) = (if Orderings.less A_ x y then rbt_del_from_left A_ x a y s b else (if Orderings.less A_ y x then rbt_del_from_right A_ x a y s b else combine a b)) and rbt_del_from_left A_ x (Branch (B, lt, z, v, rt)) y s b = balance_left (rbt_del A_ x (Branch (B, lt, z, v, rt))) y s b | rbt_del_from_left A_ x Empty y s b = Branch (R, rbt_del A_ x Empty, y, s, b) | rbt_del_from_left A_ x (Branch (R, va, vb, vc, vd)) y s b = Branch (R, rbt_del A_ x (Branch (R, va, vb, vc, vd)), y, s, b) and rbt_del_from_right A_ x a y s (Branch (B, lt, z, v, rt)) = balance_right a y s (rbt_del A_ x (Branch (B, lt, z, v, rt))) | rbt_del_from_right A_ x a y s Empty = Branch (R, a, y, s, rbt_del A_ x Empty) | rbt_del_from_right A_ x a y s (Branch (R, va, vb, vc, vd)) = Branch (R, a, y, s, rbt_del A_ x (Branch (R, va, vb, vc, vd))); fun rbt_ins A_ f k v Empty = Branch (R, Empty, k, v, Empty) | rbt_ins A_ f k v (Branch (B, l, x, y, r)) = (if Orderings.less A_ k x then balance (rbt_ins A_ f k v l) x y r else (if Orderings.less A_ x k then balance l x y (rbt_ins A_ f k v r) else Branch (B, l, x, f k y v, r))) | rbt_ins A_ f k v (Branch (R, l, x, y, r)) = (if Orderings.less A_ k x then Branch (R, rbt_ins A_ f k v l, x, y, r) else (if Orderings.less A_ x k then Branch (R, l, x, y, rbt_ins A_ f k v r) else Branch (R, l, x, f k y v, r))); fun rbt_delete A_ k t = paint B (rbt_del A_ k t); fun rbt_insert_with_key A_ f k v t = paint B (rbt_ins A_ f k v t); fun rbt_insert A_ = rbt_insert_with_key A_ (fn _ => fn _ => fn nv => nv); fun rbt_lookup A_ Empty k = NONE | rbt_lookup A_ (Branch (uu, l, x, y, r)) k = (if Orderings.less A_ k x then rbt_lookup A_ l k else (if Orderings.less A_ x k then rbt_lookup A_ r k else SOME y)); end; (*struct RBT_Impl*) structure RBT : sig type ('b, 'a) rbt val empty : 'a Orderings.linorder -> ('a, 'b) rbt val impl_of : 'b Orderings.linorder -> ('b, 'a) rbt -> ('b, 'a) RBT_Impl.rbt val delete : 'a Orderings.linorder -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val insert : 'a Orderings.linorder -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val lookup : 'a Orderings.linorder -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype ('b, 'a) rbt = RBT of ('b, 'a) RBT_Impl.rbt; fun empty A_ = RBT RBT_Impl.Empty; fun impl_of B_ (RBT x) = x; fun delete A_ xb xc = RBT (RBT_Impl.rbt_delete ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xb (impl_of A_ xc)); fun insert A_ xc xd xe = RBT (RBT_Impl.rbt_insert ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xc xd (impl_of A_ xe)); fun lookup A_ x = RBT_Impl.rbt_lookup ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) (impl_of A_ x); end; (*struct RBT*) structure List : sig val rev : 'a list -> 'a list val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a end = struct fun fold f (x :: xs) s = fold f xs (f x s) | fold f [] s = s; fun rev xs = fold (fn a => fn b => a :: b) xs []; fun foldl f a [] = a | foldl f a (x :: xs) = foldl f (f a x) xs; end; (*struct List*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val delete_aux : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update_with_aux : 'b HOL.equal -> 'a -> 'b -> ('a -> 'a) -> ('b * 'a) list -> ('b * 'a) list end = struct fun delete_aux A_ k [] = [] | delete_aux A_ ka ((k, v) :: xs) = (if HOL.eq A_ ka k then xs else (k, v) :: delete_aux A_ ka xs); fun update_with_aux B_ v k f [] = [(k, f v)] | update_with_aux B_ v k f (p :: ps) = (if HOL.eq B_ (Product_Type.fst p) k then (k, f (Product_Type.snd p)) :: ps else p :: update_with_aux B_ v k f ps); end; (*struct AList*) structure Arith : sig type nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val suc : nat -> nat val less_nat : nat -> nat -> bool val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool end = struct val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype nat = Nat of IntInf.int; datatype num = One | Bit0 of num | Bit1 of num; fun integer_of_nat (Nat x) = x; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; fun less_nat m n = IntInf.< (integer_of_nat m, integer_of_nat n); val zero_nat : nat = Nat (0 : IntInf.int); fun nat_of_integer k = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Assoc_List : sig type ('b, 'a) assoc_list val empty : ('a, 'b) assoc_list val delete : 'a HOL.equal -> 'a -> ('a, 'b) assoc_list -> ('a, 'b) assoc_list val lookup : 'a HOL.equal -> ('a, 'b) assoc_list -> 'a -> 'b option val update : 'a HOL.equal -> 'a -> 'b -> ('a, 'b) assoc_list -> ('a, 'b) assoc_list val iteratei : ('a, 'b) assoc_list -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) assoc_list = Assoc_List of ('b * 'a) list; val empty : ('a, 'b) assoc_list = Assoc_List []; fun impl_of (Assoc_List x) = x; fun delete A_ k al = Assoc_List (AList.delete_aux A_ k (impl_of al)); fun lookup A_ al = Map.map_of A_ (impl_of al); fun update_with A_ v k f al = Assoc_List (AList.update_with_aux A_ v k f (impl_of al)); fun update A_ k v = update_with A_ v k (fn _ => v); fun iteratei al c f = Foldi.foldli (impl_of al) c f; end; (*struct Assoc_List*) structure ListMapImpl : sig val g_isEmpty_lm_basic_ops : ('a, 'b) Assoc_List.assoc_list -> bool val iteratei_map_op_list_it_lm_ops : ('a, 'b) Assoc_List.assoc_list -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun iteratei_bmap_op_list_it_lm_basic_ops s = Assoc_List.iteratei s; fun g_size_abort_lm_basic_ops b m = iteratei_bmap_op_list_it_lm_basic_ops m (fn s => Arith.less_nat s b) (fn _ => Arith.suc) Arith.zero_nat; fun g_isEmpty_lm_basic_ops m = Arith.equal_nat (g_size_abort_lm_basic_ops Arith.one_nat m) Arith.zero_nat; fun iteratei_map_op_list_it_lm_ops s = Assoc_List.iteratei s; end; (*struct ListMapImpl*) structure RBT_add : sig val rm_iterateoi : ('a, 'b) RBT_Impl.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun rm_iterateoi RBT_Impl.Empty c f sigma = sigma | rm_iterateoi (RBT_Impl.Branch (col, l, k, v, r)) c f sigma = (if c sigma then let val sigmaa = rm_iterateoi l c f sigma; in (if c sigmaa then rm_iterateoi r c f (f (k, v) sigmaa) else sigmaa) end else sigma); end; (*struct RBT_add*) structure RBTMapImpl : sig val iteratei_map_op_list_it_rm_ops : 'a Orderings.linorder -> ('a, 'b) RBT.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun iteratei_map_op_list_it_rm_ops A_ s = RBT_add.rm_iterateoi (RBT.impl_of A_ s); end; (*struct RBTMapImpl*) structure HashCode : sig type 'a hashable val hashcode : 'a hashable -> 'a -> Word32.word val def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat end = struct type 'a hashable = {hashcode : 'a -> Word32.word, def_hashmap_size : 'a HOL.itself -> Arith.nat}; val hashcode = #hashcode : 'a hashable -> 'a -> Word32.word; val def_hashmap_size = #def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat; end; (*struct HashCode*) structure Uint32a : sig val linorder_uint32 : Word32.word Orderings.linorder end = struct val ord_uint32 = {less_eq = (fn a => fn b => Word32.<= (a, b)), less = (fn a => fn b => Word32.< (a, b))} : Word32.word Orderings.ord; val preorder_uint32 = {ord_preorder = ord_uint32} : Word32.word Orderings.preorder; val order_uint32 = {preorder_order = preorder_uint32} : Word32.word Orderings.order; val linorder_uint32 = {order_linorder = order_uint32} : Word32.word Orderings.linorder; end; (*struct Uint32a*) structure HashMap_Impl : sig val empty : 'a HashCode.hashable -> unit -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt val delete : 'a HOL.equal * 'a HashCode.hashable -> 'a -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt val lookup : 'a HOL.equal * 'a HashCode.hashable -> 'a -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt -> 'b option val update : 'a HOL.equal * 'a HashCode.hashable -> 'a -> 'b -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt val iteratei : 'a Orderings.linorder -> ('a, ('b, 'c) Assoc_List.assoc_list) RBT.rbt -> ('d -> bool) -> ('b * 'c -> 'd -> 'd) -> 'd -> 'd end = struct fun empty A_ = (fn _ => RBT.empty Uint32a.linorder_uint32); fun rm_map_entry k f m = (case RBT.lookup Uint32a.linorder_uint32 m k of NONE => (case f NONE of NONE => m | SOME v => RBT.insert Uint32a.linorder_uint32 k v m) | SOME v => (case f (SOME v) of NONE => RBT.delete Uint32a.linorder_uint32 k m | SOME va => RBT.insert Uint32a.linorder_uint32 k va m)); fun delete (A1_, A2_) k m = rm_map_entry (HashCode.hashcode A2_ k) (fn a => (case a of NONE => NONE | SOME lm => let val lma = Assoc_List.delete A1_ k lm; in (if ListMapImpl.g_isEmpty_lm_basic_ops lma then NONE else SOME lma) end)) m; fun lookup (A1_, A2_) k m = (case RBT.lookup Uint32a.linorder_uint32 m (HashCode.hashcode A2_ k) of NONE => NONE | SOME lm => Assoc_List.lookup A1_ lm k); fun update (A1_, A2_) k v m = let val hc = HashCode.hashcode A2_ k; in (case RBT.lookup Uint32a.linorder_uint32 m hc of NONE => RBT.insert Uint32a.linorder_uint32 hc (Assoc_List.update A1_ k v Assoc_List.empty) m | SOME bm => RBT.insert Uint32a.linorder_uint32 hc (Assoc_List.update A1_ k v bm) m) end; fun iteratei A_ m c f sigma_0 = RBTMapImpl.iteratei_map_op_list_it_rm_ops A_ m c (fn (_, lm) => ListMapImpl.iteratei_map_op_list_it_lm_ops lm c f) sigma_0; end; (*struct HashMap_Impl*) structure HashMap : sig type ('b, 'a) hashmap val test_codegen : 'a HOL.equal * 'a HashCode.hashable -> 'c HOL.equal * 'c HashCode.hashable -> 'e HashCode.hashable -> 'g HashCode.hashable -> 'i HOL.equal * 'i HashCode.hashable -> 'k HashCode.hashable -> 'm HashCode.hashable -> 'o HashCode.hashable -> 'q HashCode.hashable -> 't HashCode.hashable -> 'w HashCode.hashable -> 'y HOL.equal * 'y HashCode.hashable -> 'aa HOL.equal * 'aa HashCode.hashable -> 'ac HashCode.hashable -> 'ae HashCode.hashable -> 'ag HashCode.hashable -> 'ai HOL.equal * 'ai HashCode.hashable -> 'ak HashCode.hashable -> 'am HOL.equal * 'am HashCode.hashable -> 'ao HOL.equal * 'ao HashCode.hashable -> 'aq HOL.equal * 'aq HashCode.hashable -> (('a, 'b) hashmap -> ('a, 'b) hashmap -> ('a, 'b) hashmap) * ((('c, 'd) hashmap -> ('c, 'd) hashmap -> ('c, 'd) hashmap) * ((('e, 'f) hashmap -> ('e * 'f -> bool) -> bool) * ((('g, 'h) hashmap -> ('g * 'h -> bool) -> bool) * (('i -> ('i, 'j) hashmap -> ('i, 'j) hashmap) * ((unit -> ('k, 'l) hashmap) * ((('m, 'n) hashmap -> bool) * ((('o, 'p) hashmap -> bool) * ((('q, 'r) hashmap -> ('q * 'r -> 's -> 's) -> 's -> 's) * ((('t, 'u) hashmap -> ('v -> bool) -> ('t * 'u -> 'v -> 'v) -> 'v -> 'v) * ((('w, 'x) hashmap -> (('w * 'x) list -> bool) -> ('w * 'x -> ('w * 'x) list -> ('w * 'x) list) -> ('w * 'x) list -> ('w * 'x) list) * (('y -> ('y, 'z) hashmap -> 'z option) * ((('aa * 'ab -> bool) -> ('aa, 'ab) hashmap -> ('aa, 'ab) hashmap) * ((('ac, 'ad) hashmap -> ('ac * 'ad -> bool) -> ('ac * 'ad) option) * ((('ae, 'af) hashmap -> Arith.nat) * ((Arith.nat -> ('ag, 'ah) hashmap -> Arith.nat) * (('ai -> 'aj -> ('ai, 'aj) hashmap) * ((('ak, 'al) hashmap -> ('ak * 'al) list) * ((('am * 'an) list -> ('am, 'an) hashmap) * (('ao -> 'ap -> ('ao, 'ap) hashmap -> ('ao, 'ap) hashmap) * ('aq -> 'ar -> ('aq, 'ar) hashmap -> ('aq, 'ar) hashmap)))))))))))))))))))) end = struct datatype ('b, 'a) hashmap = RBT_HM of (Word32.word, ('b, 'a) Assoc_List.assoc_list) RBT.rbt; fun hm_empty_const A_ = RBT_HM (HashMap_Impl.empty A_ ()); fun hm_empty A_ = (fn _ => hm_empty_const A_); fun impl_of_RBT_HM B_ (RBT_HM x) = x; fun hm_delete (A1_, A2_) k hm = RBT_HM (HashMap_Impl.delete (A1_, A2_) k (impl_of_RBT_HM A2_ hm)); fun hm_lookup (A1_, A2_) k hm = HashMap_Impl.lookup (A1_, A2_) k (impl_of_RBT_HM A2_ hm); fun hm_update (A1_, A2_) k v hm = RBT_HM (HashMap_Impl.update (A1_, A2_) k v (impl_of_RBT_HM A2_ hm)); fun hm_iteratei A_ hm = HashMap_Impl.iteratei Uint32a.linorder_uint32 (impl_of_RBT_HM A_ hm); fun iteratei_map_op_list_it_hm_ops A_ s = hm_iteratei A_ s; fun g_list_to_map_hm_basic_ops (A1_, A2_) l = List.foldl (fn m => fn (k, v) => hm_update (A1_, A2_) k v m) (hm_empty A2_ ()) (List.rev l); fun iteratei_bmap_op_list_it_hm_basic_ops A_ s = hm_iteratei A_ s; fun g_size_abort_hm_basic_ops A_ b m = iteratei_bmap_op_list_it_hm_basic_ops A_ m (fn s => Arith.less_nat s b) (fn _ => Arith.suc) Arith.zero_nat; fun g_restrict_hm_basic_ops (A1_, A2_) p m = iteratei_bmap_op_list_it_hm_basic_ops A2_ m (fn _ => true) (fn (k, v) => fn sigma => (if p (k, v) then hm_update (A1_, A2_) k v sigma else sigma)) (hm_empty A2_ ()); fun g_to_list_hm_basic_ops A_ m = iteratei_bmap_op_list_it_hm_basic_ops A_ m (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_hm_basic_ops A_ m = Arith.equal_nat (g_size_abort_hm_basic_ops A_ Arith.one_nat m) Arith.zero_nat; fun g_add_dj_hm_basic_ops (A1_, A2_) m1 m2 = iteratei_bmap_op_list_it_hm_basic_ops A2_ m2 (fn _ => true) (fn (a, b) => hm_update (A1_, A2_) a b) m1; fun g_isSng_hm_basic_ops A_ m = Arith.equal_nat (g_size_abort_hm_basic_ops A_ (Arith.nat_of_integer (2 : IntInf.int)) m) Arith.one_nat; fun g_size_hm_basic_ops A_ m = iteratei_bmap_op_list_it_hm_basic_ops A_ m (fn _ => true) (fn _ => Arith.suc) Arith.zero_nat; fun g_ball_hm_basic_ops A_ m p = iteratei_bmap_op_list_it_hm_basic_ops A_ m Fun.id (fn kv => fn _ => p kv) true; fun g_sng_hm_basic_ops (A1_, A2_) k v = hm_update (A1_, A2_) k v (hm_empty A2_ ()); fun g_sel_hm_basic_ops A_ m p = iteratei_bmap_op_list_it_hm_basic_ops A_ m Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun g_bex_hm_basic_ops A_ m p = iteratei_bmap_op_list_it_hm_basic_ops A_ m not (fn kv => fn _ => p kv) false; fun g_add_hm_basic_ops (A1_, A2_) m1 m2 = iteratei_bmap_op_list_it_hm_basic_ops A2_ m2 (fn _ => true) (fn (a, b) => hm_update (A1_, A2_) a b) m1; fun test_codegen (A1_, A2_) (C1_, C2_) E_ G_ (I1_, I2_) K_ M_ O_ Q_ T_ W_ (Y1_, Y2_) (Aa1_, Aa2_) Ac_ Ae_ Ag_ (Ai1_, Ai2_) Ak_ (Am1_, Am2_) (Ao1_, Ao2_) (Aq1_, Aq2_) = (g_add_hm_basic_ops (A1_, A2_), (g_add_dj_hm_basic_ops (C1_, C2_), (g_ball_hm_basic_ops E_, (g_bex_hm_basic_ops G_, (hm_delete (I1_, I2_), (hm_empty K_, (g_isEmpty_hm_basic_ops M_, (g_isSng_hm_basic_ops O_, ((fn m => iteratei_map_op_list_it_hm_ops Q_ m (fn _ => true)), (iteratei_map_op_list_it_hm_ops T_, (hm_iteratei W_, (hm_lookup (Y1_, Y2_), (g_restrict_hm_basic_ops (Aa1_, Aa2_), (g_sel_hm_basic_ops Ac_, (g_size_hm_basic_ops Ae_, (g_size_abort_hm_basic_ops Ag_, (g_sng_hm_basic_ops (Ai1_, Ai2_), (g_to_list_hm_basic_ops Ak_, (g_list_to_map_hm_basic_ops (Am1_, Am2_), (hm_update (Ao1_, Ao2_), hm_update (Aq1_, Aq2_))))))))))))))))))))); end; (*struct HashMap*) ### theory "Collections.HashMap" ### 1.874s elapsed time, 3.708s cpu time, 0.436s GC time Loading theory "Collections.HashSet" (required by "Collections.SetStdImpl") Loading theory "Collections.MapStdImpl" ### Ignoring sort constraints in type variables(s): "'a" ### in type abbreviation "hs" ### theory "Collections.MapStdImpl" ### 1.645s elapsed time, 3.292s cpu time, 0.000s GC time ### Introduced fixed type variable(s): 'c in "l__" (* Test that words can handle numbers between 0 and 31 *) val _ = if 5 <= Word.wordSize then () else raise (Fail ("wordSize less than 5")); structure Uint32 : sig val set_bit : Word32.word -> IntInf.int -> bool -> Word32.word val shiftl : Word32.word -> IntInf.int -> Word32.word val shiftr : Word32.word -> IntInf.int -> Word32.word val shiftr_signed : Word32.word -> IntInf.int -> Word32.word val test_bit : Word32.word -> IntInf.int -> bool end = struct fun set_bit x n b = let val mask = Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n)) in if b then Word32.orb (x, mask) else Word32.andb (x, Word32.notb mask) end fun shiftl x n = Word32.<< (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr x n = Word32.>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun shiftr_signed x n = Word32.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) fun test_bit x n = Word32.andb (x, Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word32.fromInt 0 end; (* struct Uint32 *) structure Bits_Integer : sig val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int val shiftl : IntInf.int -> IntInf.int -> IntInf.int val shiftr : IntInf.int -> IntInf.int -> IntInf.int val test_bit : IntInf.int -> IntInf.int -> bool end = struct val maxWord = IntInf.pow (2, Word.wordSize); fun set_bit x n b = if n < maxWord then if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))) else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); fun shiftl x n = if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun shiftr x n = if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n)) else raise (Fail ("Shift operand too large: " ^ IntInf.toString n)); fun test_bit x n = if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0 else raise (Fail ("Bit index too large: " ^ IntInf.toString n)); end; (*struct Bits_Integer*) structure HOL : sig type 'a equal type 'a itself val eq : 'a equal -> 'a -> 'a -> bool end = struct type 'a equal = {equal : 'a -> 'a -> bool}; val equal = #equal : 'a equal -> 'a -> 'a -> bool; datatype 'a itself = Type; fun eq A_ a b = equal A_ a b; end; (*struct HOL*) structure Map : sig val map_of : 'a HOL.equal -> ('a * 'b) list -> 'a -> 'b option end = struct fun map_of A_ ((l, v) :: ps) k = (if HOL.eq A_ l k then SOME v else map_of A_ ps k) | map_of A_ [] k = NONE; end; (*struct Map*) structure Orderings : sig type 'a ord val less_eq : 'a ord -> 'a -> 'a -> bool val less : 'a ord -> 'a -> 'a -> bool type 'a preorder val ord_preorder : 'a preorder -> 'a ord type 'a order val preorder_order : 'a order -> 'a preorder type 'a linorder val order_linorder : 'a linorder -> 'a order val max : 'a ord -> 'a -> 'a -> 'a end = struct type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool}; val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool; val less = #less : 'a ord -> 'a -> 'a -> bool; type 'a preorder = {ord_preorder : 'a ord}; val ord_preorder = #ord_preorder : 'a preorder -> 'a ord; type 'a order = {preorder_order : 'a preorder}; val preorder_order = #preorder_order : 'a order -> 'a preorder; type 'a linorder = {order_linorder : 'a order}; val order_linorder = #order_linorder : 'a linorder -> 'a order; fun max A_ a b = (if less_eq A_ a b then b else a); end; (*struct Orderings*) structure RBT_Impl : sig type color datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt val rbt_delete : 'a Orderings.ord -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_insert : 'a Orderings.ord -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val rbt_lookup : 'a Orderings.ord -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype color = R | B; datatype ('a, 'b) rbt = Empty | Branch of color * ('a, 'b) rbt * 'a * 'b * ('a, 'b) rbt; fun paint c Empty = Empty | paint c (Branch (uu, l, k, v, r)) = Branch (c, l, k, v, r); fun balance (Branch (R, a, w, x, b)) s t (Branch (R, c, y, z, d)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z Empty = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (R, a, w, x, b), s, t, c)) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, a, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Branch (B, va, vb, vc, vd), w, x, Branch (R, b, s, t, c))) y z Empty = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (R, Empty, w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (R, Branch (B, ve, vf, vg, vh), w, x, Branch (R, b, s, t, c))) y z (Branch (B, va, vb, vc, vd)) = Branch (R, Branch (B, Branch (B, ve, vf, vg, vh), w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance Empty w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, d)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, b, s, t, Branch (R, c, y, z, d))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, d)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance Empty w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, va, vb, vc, vd))) = Branch (R, Branch (B, Empty, w, x, b), s, t, Branch (B, c, y, z, Branch (B, va, vb, vc, vd))) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Empty)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Empty)) | balance (Branch (B, va, vb, vc, vd)) w x (Branch (R, Branch (R, b, s, t, c), y, z, Branch (B, ve, vf, vg, vh))) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), w, x, b), s, t, Branch (B, c, y, z, Branch (B, ve, vf, vg, vh))) | balance Empty s t Empty = Branch (B, Empty, s, t, Empty) | balance Empty s t (Branch (B, va, vb, vc, vd)) = Branch (B, Empty, s, t, Branch (B, va, vb, vc, vd)) | balance Empty s t (Branch (v, Empty, vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Empty)) | balance Empty s t (Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vf, vg, vh), vb, vc, Empty)) | balance Empty s t (Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Empty, vb, vc, Branch (B, vf, vg, vh, vi))) | balance Empty s t (Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) = Branch (B, Empty, s, t, Branch (v, Branch (B, ve, vj, vk, vl), vb, vc, Branch (B, vf, vg, vh, vi))) | balance (Branch (B, va, vb, vc, vd)) s t Empty = Branch (B, Branch (B, va, vb, vc, vd), s, t, Empty) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (B, ve, vf, vg, vh)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (B, ve, vf, vg, vh)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vj, vk, vl), vf, vg, Empty)) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Empty, vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (B, va, vb, vc, vd)) s t (Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) = Branch (B, Branch (B, va, vb, vc, vd), s, t, Branch (v, Branch (B, vi, vn, vo, vp), vf, vg, Branch (B, vj, vk, vl, vm))) | balance (Branch (v, Empty, vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Empty), s, t, Empty) | balance (Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh))) s t Empty = Branch (B, Branch (v, Empty, vb, vc, Branch (B, ve, vf, vg, vh)), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty)) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Empty), s, t, Empty) | balance (Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl))) s t Empty = Branch (B, Branch (v, Branch (B, vf, vg, vh, vi), vb, vc, Branch (B, ve, vj, vk, vl)), s, t, Empty) | balance (Branch (v, Empty, vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Empty, vf, vg, Branch (B, vi, vj, vk, vl)), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty)) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Empty), s, t, Branch (B, va, vb, vc, vd)) | balance (Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp))) s t (Branch (B, va, vb, vc, vd)) = Branch (B, Branch (v, Branch (B, vj, vk, vl, vm), vf, vg, Branch (B, vi, vn, vo, vp)), s, t, Branch (B, va, vb, vc, vd)); fun balance_left (Branch (R, a, k, x, b)) s y c = Branch (R, Branch (B, a, k, x, b), s, y, c) | balance_left Empty k x (Branch (B, a, s, y, b)) = balance Empty k x (Branch (R, a, s, y, b)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (B, a, s, y, b)) = balance (Branch (B, va, vb, vc, vd)) k x (Branch (R, a, s, y, b)) | balance_left Empty k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Empty, k, x, a), s, y, balance b t z (paint R c)) | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (B, a, s, y, b), t, z, c)) = Branch (R, Branch (B, Branch (B, va, vb, vc, vd), k, x, a), s, y, balance b t z (paint R c)) | balance_left Empty k x Empty = Empty | balance_left Empty k x (Branch (R, Empty, vb, vc, vd)) = Empty | balance_left Empty k x (Branch (R, Branch (R, ve, vf, vg, vh), vb, vc, vd)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x Empty = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Empty, vf, vg, vh)) = Empty | balance_left (Branch (B, va, vb, vc, vd)) k x (Branch (R, Branch (R, vi, vj, vk, vl), vf, vg, vh)) = Empty; fun combine Empty x = x | combine (Branch (v, va, vb, vc, vd)) Empty = Branch (v, va, vb, vc, vd) | combine (Branch (R, a, k, x, b)) (Branch (R, c, s, y, d)) = (case combine b c of Empty => Branch (R, a, k, x, Branch (R, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (R, a, k, x, b2), t, z, Branch (R, c2, s, y, d)) | Branch (B, b2, t, z, c2) => Branch (R, a, k, x, Branch (R, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, a, k, x, b)) (Branch (B, c, s, y, d)) = (case combine b c of Empty => balance_left a k x (Branch (B, Empty, s, y, d)) | Branch (R, b2, t, z, c2) => Branch (R, Branch (B, a, k, x, b2), t, z, Branch (B, c2, s, y, d)) | Branch (B, b2, t, z, c2) => balance_left a k x (Branch (B, Branch (B, b2, t, z, c2), s, y, d))) | combine (Branch (B, va, vb, vc, vd)) (Branch (R, b, k, x, c)) = Branch (R, combine (Branch (B, va, vb, vc, vd)) b, k, x, c) | combine (Branch (R, a, k, x, b)) (Branch (B, va, vb, vc, vd)) = Branch (R, a, k, x, combine b (Branch (B, va, vb, vc, vd))); fun balance_right a k x (Branch (R, b, s, y, c)) = Branch (R, a, k, x, Branch (B, b, s, y, c)) | balance_right (Branch (B, a, k, x, b)) s y Empty = balance (Branch (R, a, k, x, b)) s y Empty | balance_right (Branch (B, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) = balance (Branch (R, a, k, x, b)) s y (Branch (B, va, vb, vc, vd)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z Empty = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Empty)) | balance_right (Branch (R, a, k, x, Branch (B, b, s, y, c))) t z (Branch (B, va, vb, vc, vd)) = Branch (R, balance (paint R a) k x b, s, y, Branch (B, c, t, z, Branch (B, va, vb, vc, vd))) | balance_right Empty k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Empty)) k x Empty = Empty | balance_right (Branch (R, va, vb, vc, Branch (R, ve, vf, vg, vh))) k x Empty = Empty | balance_right Empty k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Empty)) k x (Branch (B, va, vb, vc, vd)) = Empty | balance_right (Branch (R, ve, vf, vg, Branch (R, vi, vj, vk, vl))) k x (Branch (B, va, vb, vc, vd)) = Empty; fun rbt_del A_ x Empty = Empty | rbt_del A_ x (Branch (c, a, y, s, b)) = (if Orderings.less A_ x y then rbt_del_from_left A_ x a y s b else (if Orderings.less A_ y x then rbt_del_from_right A_ x a y s b else combine a b)) and rbt_del_from_left A_ x (Branch (B, lt, z, v, rt)) y s b = balance_left (rbt_del A_ x (Branch (B, lt, z, v, rt))) y s b | rbt_del_from_left A_ x Empty y s b = Branch (R, rbt_del A_ x Empty, y, s, b) | rbt_del_from_left A_ x (Branch (R, va, vb, vc, vd)) y s b = Branch (R, rbt_del A_ x (Branch (R, va, vb, vc, vd)), y, s, b) and rbt_del_from_right A_ x a y s (Branch (B, lt, z, v, rt)) = balance_right a y s (rbt_del A_ x (Branch (B, lt, z, v, rt))) | rbt_del_from_right A_ x a y s Empty = Branch (R, a, y, s, rbt_del A_ x Empty) | rbt_del_from_right A_ x a y s (Branch (R, va, vb, vc, vd)) = Branch (R, a, y, s, rbt_del A_ x (Branch (R, va, vb, vc, vd))); fun rbt_ins A_ f k v Empty = Branch (R, Empty, k, v, Empty) | rbt_ins A_ f k v (Branch (B, l, x, y, r)) = (if Orderings.less A_ k x then balance (rbt_ins A_ f k v l) x y r else (if Orderings.less A_ x k then balance l x y (rbt_ins A_ f k v r) else Branch (B, l, x, f k y v, r))) | rbt_ins A_ f k v (Branch (R, l, x, y, r)) = (if Orderings.less A_ k x then Branch (R, rbt_ins A_ f k v l, x, y, r) else (if Orderings.less A_ x k then Branch (R, l, x, y, rbt_ins A_ f k v r) else Branch (R, l, x, f k y v, r))); fun rbt_delete A_ k t = paint B (rbt_del A_ k t); fun rbt_insert_with_key A_ f k v t = paint B (rbt_ins A_ f k v t); fun rbt_insert A_ = rbt_insert_with_key A_ (fn _ => fn _ => fn nv => nv); fun rbt_lookup A_ Empty k = NONE | rbt_lookup A_ (Branch (uu, l, x, y, r)) k = (if Orderings.less A_ k x then rbt_lookup A_ l k else (if Orderings.less A_ x k then rbt_lookup A_ r k else SOME y)); end; (*struct RBT_Impl*) structure RBT : sig type ('b, 'a) rbt val empty : 'a Orderings.linorder -> ('a, 'b) rbt val impl_of : 'b Orderings.linorder -> ('b, 'a) rbt -> ('b, 'a) RBT_Impl.rbt val delete : 'a Orderings.linorder -> 'a -> ('a, 'b) rbt -> ('a, 'b) rbt val insert : 'a Orderings.linorder -> 'a -> 'b -> ('a, 'b) rbt -> ('a, 'b) rbt val lookup : 'a Orderings.linorder -> ('a, 'b) rbt -> 'a -> 'b option end = struct datatype ('b, 'a) rbt = RBT of ('b, 'a) RBT_Impl.rbt; fun empty A_ = RBT RBT_Impl.Empty; fun impl_of B_ (RBT x) = x; fun delete A_ xb xc = RBT (RBT_Impl.rbt_delete ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xb (impl_of A_ xc)); fun insert A_ xc xd xe = RBT (RBT_Impl.rbt_insert ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) xc xd (impl_of A_ xe)); fun lookup A_ x = RBT_Impl.rbt_lookup ((Orderings.ord_preorder o Orderings.preorder_order o Orderings.order_linorder) A_) (impl_of A_ x); end; (*struct RBT*) structure Product_Type : sig val fst : 'a * 'b -> 'a val snd : 'a * 'b -> 'b end = struct fun fst (x1, x2) = x1; fun snd (x1, x2) = x2; end; (*struct Product_Type*) structure AList : sig val delete_aux : 'a HOL.equal -> 'a -> ('a * 'b) list -> ('a * 'b) list val update_with_aux : 'b HOL.equal -> 'a -> 'b -> ('a -> 'a) -> ('b * 'a) list -> ('b * 'a) list end = struct fun delete_aux A_ k [] = [] | delete_aux A_ ka ((k, v) :: xs) = (if HOL.eq A_ ka k then xs else (k, v) :: delete_aux A_ ka xs); fun update_with_aux B_ v k f [] = [(k, f v)] | update_with_aux B_ v k f (p :: ps) = (if HOL.eq B_ (Product_Type.fst p) k then (k, f (Product_Type.snd p)) :: ps else p :: update_with_aux B_ v k f ps); end; (*struct AList*) structure Arith : sig type nat datatype num = One | Bit0 of num | Bit1 of num val one_nat : nat val suc : nat -> nat val less_nat : nat -> nat -> bool val zero_nat : nat val nat_of_integer : IntInf.int -> nat val equal_nat : nat -> nat -> bool end = struct val ord_integer = {less_eq = (fn a => fn b => IntInf.<= (a, b)), less = (fn a => fn b => IntInf.< (a, b))} : IntInf.int Orderings.ord; datatype nat = Nat of IntInf.int; datatype num = One | Bit0 of num | Bit1 of num; fun integer_of_nat (Nat x) = x; fun plus_nat m n = Nat (IntInf.+ (integer_of_nat m, integer_of_nat n)); val one_nat : nat = Nat (1 : IntInf.int); fun suc n = plus_nat n one_nat; fun less_nat m n = IntInf.< (integer_of_nat m, integer_of_nat n); val zero_nat : nat = Nat (0 : IntInf.int); fun nat_of_integer k = Nat (Orderings.max ord_integer (0 : IntInf.int) k); fun equal_nat m n = (((integer_of_nat m) : IntInf.int) = (integer_of_nat n)); end; (*struct Arith*) structure Foldi : sig val foldli : 'a list -> ('b -> bool) -> ('a -> 'b -> 'b) -> 'b -> 'b end = struct fun foldli [] c f sigma = sigma | foldli (x :: xs) c f sigma = (if c sigma then foldli xs c f (f x sigma) else sigma); end; (*struct Foldi*) structure Option : sig val is_none : 'a option -> bool end = struct fun is_none (SOME x) = false | is_none NONE = true; end; (*struct Option*) structure Assoc_List : sig type ('b, 'a) assoc_list val empty : ('a, 'b) assoc_list val delete : 'a HOL.equal -> 'a -> ('a, 'b) assoc_list -> ('a, 'b) assoc_list val lookup : 'a HOL.equal -> ('a, 'b) assoc_list -> 'a -> 'b option val update : 'a HOL.equal -> 'a -> 'b -> ('a, 'b) assoc_list -> ('a, 'b) assoc_list val iteratei : ('a, 'b) assoc_list -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) assoc_list = Assoc_List of ('b * 'a) list; val empty : ('a, 'b) assoc_list = Assoc_List []; fun impl_of (Assoc_List x) = x; fun delete A_ k al = Assoc_List (AList.delete_aux A_ k (impl_of al)); fun lookup A_ al = Map.map_of A_ (impl_of al); fun update_with A_ v k f al = Assoc_List (AList.update_with_aux A_ v k f (impl_of al)); fun update A_ k v = update_with A_ v k (fn _ => v); fun iteratei al c f = Foldi.foldli (impl_of al) c f; end; (*struct Assoc_List*) structure ListMapImpl : sig val g_isEmpty_lm_basic_ops : ('a, 'b) Assoc_List.assoc_list -> bool val iteratei_map_op_list_it_lm_ops : ('a, 'b) Assoc_List.assoc_list -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun iteratei_bmap_op_list_it_lm_basic_ops s = Assoc_List.iteratei s; fun g_size_abort_lm_basic_ops b m = iteratei_bmap_op_list_it_lm_basic_ops m (fn s => Arith.less_nat s b) (fn _ => Arith.suc) Arith.zero_nat; fun g_isEmpty_lm_basic_ops m = Arith.equal_nat (g_size_abort_lm_basic_ops Arith.one_nat m) Arith.zero_nat; fun iteratei_map_op_list_it_lm_ops s = Assoc_List.iteratei s; end; (*struct ListMapImpl*) structure RBT_add : sig val rm_iterateoi : ('a, 'b) RBT_Impl.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun rm_iterateoi RBT_Impl.Empty c f sigma = sigma | rm_iterateoi (RBT_Impl.Branch (col, l, k, v, r)) c f sigma = (if c sigma then let val sigmaa = rm_iterateoi l c f sigma; in (if c sigmaa then rm_iterateoi r c f (f (k, v) sigmaa) else sigmaa) end else sigma); end; (*struct RBT_add*) structure RBTMapImpl : sig val iteratei_map_op_list_it_rm_ops : 'a Orderings.linorder -> ('a, 'b) RBT.rbt -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct fun iteratei_map_op_list_it_rm_ops A_ s = RBT_add.rm_iterateoi (RBT.impl_of A_ s); end; (*struct RBTMapImpl*) structure HashCode : sig type 'a hashable val hashcode : 'a hashable -> 'a -> Word32.word val def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat end = struct type 'a hashable = {hashcode : 'a -> Word32.word, def_hashmap_size : 'a HOL.itself -> Arith.nat}; val hashcode = #hashcode : 'a hashable -> 'a -> Word32.word; val def_hashmap_size = #def_hashmap_size : 'a hashable -> 'a HOL.itself -> Arith.nat; end; (*struct HashCode*) structure Uint32a : sig val linorder_uint32 : Word32.word Orderings.linorder end = struct val ord_uint32 = {less_eq = (fn a => fn b => Word32.<= (a, b)), less = (fn a => fn b => Word32.< (a, b))} : Word32.word Orderings.ord; val preorder_uint32 = {ord_preorder = ord_uint32} : Word32.word Orderings.preorder; val order_uint32 = {preorder_order = preorder_uint32} : Word32.word Orderings.order; val linorder_uint32 = {order_linorder = order_uint32} : Word32.word Orderings.linorder; end; (*struct Uint32a*) structure HashMap_Impl : sig val empty : 'a HashCode.hashable -> unit -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt val delete : 'a HOL.equal * 'a HashCode.hashable -> 'a -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt val lookup : 'a HOL.equal * 'a HashCode.hashable -> 'a -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt -> 'b option val update : 'a HOL.equal * 'a HashCode.hashable -> 'a -> 'b -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt -> (Word32.word, ('a, 'b) Assoc_List.assoc_list) RBT.rbt val iteratei : 'a Orderings.linorder -> ('a, ('b, 'c) Assoc_List.assoc_list) RBT.rbt -> ('d -> bool) -> ('b * 'c -> 'd -> 'd) -> 'd -> 'd end = struct fun empty A_ = (fn _ => RBT.empty Uint32a.linorder_uint32); fun rm_map_entry k f m = (case RBT.lookup Uint32a.linorder_uint32 m k of NONE => (case f NONE of NONE => m | SOME v => RBT.insert Uint32a.linorder_uint32 k v m) | SOME v => (case f (SOME v) of NONE => RBT.delete Uint32a.linorder_uint32 k m | SOME va => RBT.insert Uint32a.linorder_uint32 k va m)); fun delete (A1_, A2_) k m = rm_map_entry (HashCode.hashcode A2_ k) (fn a => (case a of NONE => NONE | SOME lm => let val lma = Assoc_List.delete A1_ k lm; in (if ListMapImpl.g_isEmpty_lm_basic_ops lma then NONE else SOME lma) end)) m; fun lookup (A1_, A2_) k m = (case RBT.lookup Uint32a.linorder_uint32 m (HashCode.hashcode A2_ k) of NONE => NONE | SOME lm => Assoc_List.lookup A1_ lm k); fun update (A1_, A2_) k v m = let val hc = HashCode.hashcode A2_ k; in (case RBT.lookup Uint32a.linorder_uint32 m hc of NONE => RBT.insert Uint32a.linorder_uint32 hc (Assoc_List.update A1_ k v Assoc_List.empty) m | SOME bm => RBT.insert Uint32a.linorder_uint32 hc (Assoc_List.update A1_ k v bm) m) end; fun iteratei A_ m c f sigma_0 = RBTMapImpl.iteratei_map_op_list_it_rm_ops A_ m c (fn (_, lm) => ListMapImpl.iteratei_map_op_list_it_lm_ops lm c f) sigma_0; end; (*struct HashMap_Impl*) structure HashMap : sig type ('b, 'a) hashmap val hm_empty : 'a HashCode.hashable -> unit -> ('a, 'b) hashmap val hm_delete : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> ('a, 'b) hashmap val hm_lookup : 'a HOL.equal * 'a HashCode.hashable -> 'a -> ('a, 'b) hashmap -> 'b option val hm_update : 'a HOL.equal * 'a HashCode.hashable -> 'a -> 'b -> ('a, 'b) hashmap -> ('a, 'b) hashmap val hm_iteratei : 'a HashCode.hashable -> ('a, 'b) hashmap -> ('c -> bool) -> ('a * 'b -> 'c -> 'c) -> 'c -> 'c end = struct datatype ('b, 'a) hashmap = RBT_HM of (Word32.word, ('b, 'a) Assoc_List.assoc_list) RBT.rbt; fun hm_empty_const A_ = RBT_HM (HashMap_Impl.empty A_ ()); fun hm_empty A_ = (fn _ => hm_empty_const A_); fun impl_of_RBT_HM B_ (RBT_HM x) = x; fun hm_delete (A1_, A2_) k hm = RBT_HM (HashMap_Impl.delete (A1_, A2_) k (impl_of_RBT_HM A2_ hm)); fun hm_lookup (A1_, A2_) k hm = HashMap_Impl.lookup (A1_, A2_) k (impl_of_RBT_HM A2_ hm); fun hm_update (A1_, A2_) k v hm = RBT_HM (HashMap_Impl.update (A1_, A2_) k v (impl_of_RBT_HM A2_ hm)); fun hm_iteratei A_ hm = HashMap_Impl.iteratei Uint32a.linorder_uint32 (impl_of_RBT_HM A_ hm); end; (*struct HashMap*) structure HashSet : sig val test_codegen : 'a HashCode.hashable -> 'b HOL.equal * 'b HashCode.hashable -> 'c HOL.equal * 'c HashCode.hashable -> 'd HOL.equal * 'd HashCode.hashable -> 'e HashCode.hashable -> 'f HOL.equal * 'f HashCode.hashable -> 'g HashCode.hashable -> 'h HashCode.hashable -> 'i HashCode.hashable -> 'j HashCode.hashable -> 'k HashCode.hashable -> 'l HashCode.hashable -> 'm HOL.equal * 'm HashCode.hashable -> 'n HOL.equal * 'n HashCode.hashable -> 'o HOL.equal * 'o HashCode.hashable -> 'p HOL.equal * 'p HashCode.hashable -> 'q HOL.equal * 'q HashCode.hashable -> 'r HOL.equal * 'r HashCode.hashable -> 's HOL.equal * 's HashCode.hashable -> 't HOL.equal * 't HashCode.hashable -> 'u HOL.equal * 'u HashCode.hashable -> 'v HashCode.hashable -> 'w HashCode.hashable -> 'x HOL.equal * 'x HashCode.hashable -> (unit -> ('a, unit) HashMap.hashmap) * (('b -> ('b, unit) HashMap.hashmap -> bool) * (('c -> ('c, unit) HashMap.hashmap -> ('c, unit) HashMap.hashmap) * (('d -> ('d, unit) HashMap.hashmap -> ('d, unit) HashMap.hashmap) * ((('e, unit) HashMap.hashmap -> ('e list -> bool) -> ('e -> 'e list -> 'e list) -> 'e list -> 'e list) * (('f -> ('f, unit) HashMap.hashmap) * ((('g, unit) HashMap.hashmap -> bool) * ((('h, unit) HashMap.hashmap -> bool) * ((('i, unit) HashMap.hashmap -> ('i -> bool) -> bool) * ((('j, unit) HashMap.hashmap -> ('j -> bool) -> bool) * ((('k, unit) HashMap.hashmap -> Arith.nat) * ((Arith.nat -> ('l, unit) HashMap.hashmap -> Arith.nat) * ((('m, unit) HashMap.hashmap -> ('m, unit) HashMap.hashmap -> ('m, unit) HashMap.hashmap) * ((('n, unit) HashMap.hashmap -> ('n, unit) HashMap.hashmap -> ('n, unit) HashMap.hashmap) * ((('o, unit) HashMap.hashmap -> ('o, unit) HashMap.hashmap -> ('o, unit) HashMap.hashmap) * ((('p -> bool) -> ('p, unit) HashMap.hashmap -> ('p, unit) HashMap.hashmap) * ((('q, unit) HashMap.hashmap -> ('q, unit) HashMap.hashmap -> ('q, unit) HashMap.hashmap) * ((('r, unit) HashMap.hashmap -> ('r, unit) HashMap.hashmap -> bool) * ((('s, unit) HashMap.hashmap -> ('s, unit) HashMap.hashmap -> bool) * ((('t, unit) HashMap.hashmap -> ('t, unit) HashMap.hashmap -> bool) * ((('u, unit) HashMap.hashmap -> ('u, unit) HashMap.hashmap -> 'u option) * ((('v, unit) HashMap.hashmap -> ('v -> bool) -> 'v option) * ((('w, unit) HashMap.hashmap -> 'w list) * ('x list -> ('x, unit) HashMap.hashmap))))))))))))))))))))))) end = struct fun iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s = (fn c => fn f => HashMap.hm_iteratei A_ s c (f o Product_Type.fst)); fun g_sel_dflt_basic_ops_hm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s Option.is_none (fn x => fn _ => (if p x then SOME x else NONE)) NONE; fun memb_hm_basic_ops (A1_, A2_) x s = not (Option.is_none (HashMap.hm_lookup (A1_, A2_) x s)); fun g_disjoint_witness_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = g_sel_dflt_basic_ops_hm_basic_ops A2_ s1 (fn x => memb_hm_basic_ops (A1_, A2_) x s2); fun g_size_abort_dflt_basic_ops_hm_basic_ops A_ m s = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s (fn sigma => Arith.less_nat sigma m) (fn _ => Arith.suc) Arith.zero_nat; fun ins_hm_basic_ops (A1_, A2_) x s = HashMap.hm_update (A1_, A2_) x () s; fun g_from_list_aux_dflt_basic_ops_hm_basic_ops (A1_, A2_) accs (x :: l) = g_from_list_aux_dflt_basic_ops_hm_basic_ops (A1_, A2_) (ins_hm_basic_ops (A1_, A2_) x accs) l | g_from_list_aux_dflt_basic_ops_hm_basic_ops (A1_, A2_) y [] = y; fun empty_hm_basic_ops A_ = HashMap.hm_empty A_; fun g_from_list_dflt_basic_ops_hm_basic_ops (A1_, A2_) l = g_from_list_aux_dflt_basic_ops_hm_basic_ops (A1_, A2_) (empty_hm_basic_ops A2_ ()) l; fun ins_dj_hm_basic_ops (A1_, A2_) x s = HashMap.hm_update (A1_, A2_) x () s; fun g_union_dj_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A2_ s1 (fn _ => true) (ins_dj_hm_basic_ops (A1_, A2_)) s2; fun g_ball_dflt_basic_ops_hm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s (fn c => c) (fn x => fn _ => p x) true; fun g_disjoint_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = g_ball_dflt_basic_ops_hm_basic_ops A2_ s1 (fn x => not (memb_hm_basic_ops (A1_, A2_) x s2)); fun g_to_list_dflt_basic_ops_hm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s (fn _ => true) (fn a => fn b => a :: b) []; fun g_isEmpty_dflt_basic_ops_hm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s (fn c => c) (fn _ => fn _ => false) true; fun g_subset_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = g_ball_dflt_basic_ops_hm_basic_ops A2_ s1 (fn x => memb_hm_basic_ops (A1_, A2_) x s2); fun g_filter_dflt_basic_ops_hm_basic_ops (A1_, A2_) p s = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A2_ s (fn _ => true) (fn x => fn sigma => (if p x then ins_dj_hm_basic_ops (A1_, A2_) x sigma else sigma)) (empty_hm_basic_ops A2_ ()); fun g_union_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A2_ s1 (fn _ => true) (ins_hm_basic_ops (A1_, A2_)) s2; fun g_isSng_dflt_basic_ops_hm_basic_ops A_ s = Arith.equal_nat (iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s (fn sigma => Arith.less_nat sigma (Arith.nat_of_integer (2 : IntInf.int))) (fn _ => Arith.suc) Arith.zero_nat) Arith.one_nat; fun g_inter_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A2_ s1 (fn _ => true) (fn x => fn s => (if memb_hm_basic_ops (A1_, A2_) x s2 then ins_dj_hm_basic_ops (A1_, A2_) x s else s)) (empty_hm_basic_ops A2_ ()); fun g_equal_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = g_subset_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 andalso g_subset_dflt_basic_ops_hm_basic_ops (A1_, A2_) s2 s1; fun g_size_dflt_basic_ops_hm_basic_ops A_ s = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s (fn _ => true) (fn _ => Arith.suc) Arith.zero_nat; fun delete_hm_basic_ops (A1_, A2_) x s = HashMap.hm_delete (A1_, A2_) x s; fun g_diff_dflt_basic_ops_hm_basic_ops (A1_, A2_) s1 s2 = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A2_ s2 (fn _ => true) (delete_hm_basic_ops (A1_, A2_)) s1; fun g_sng_dflt_basic_ops_hm_basic_ops (A1_, A2_) x = ins_hm_basic_ops (A1_, A2_) x (empty_hm_basic_ops A2_ ()); fun g_bex_dflt_basic_ops_hm_basic_ops A_ s p = iteratei_bset_op_list_it_dflt_basic_ops_hm_basic_ops A_ s not (fn x => fn _ => p x) false; fun test_codegen A_ (B1_, B2_) (C1_, C2_) (D1_, D2_) E_ (F1_, F2_) G_ H_ I_ J_ K_ L_ (M1_, M2_) (N1_, N2_) (O1_, O2_) (P1_, P2_) (Q1_, Q2_) (R1_, R2_) (S1_, S2_) (T1_, T2_) (U1_, U2_) V_ W_ (X1_, X2_) = (empty_hm_basic_ops A_, (memb_hm_basic_ops (B1_, B2_), (ins_hm_basic_ops (C1_, C2_), (delete_hm_basic_ops (D1_, D2_), ((fn s => fn c => fn f => HashMap.hm_iteratei E_ s c (f o Product_Type.fst)), (g_sng_dflt_basic_ops_hm_basic_ops (F1_, F2_), (g_isEmpty_dflt_basic_ops_hm_basic_ops G_, (g_isSng_dflt_basic_ops_hm_basic_ops H_, (g_ball_dflt_basic_ops_hm_basic_ops I_, (g_bex_dflt_basic_ops_hm_basic_ops J_, (g_size_dflt_basic_ops_hm_basic_ops K_, (g_size_abort_dflt_basic_ops_hm_basic_ops L_, (g_union_dflt_basic_ops_hm_basic_ops (M1_, M2_), (g_union_dj_dflt_basic_ops_hm_basic_ops (N1_, N2_), (g_diff_dflt_basic_ops_hm_basic_ops (O1_, O2_), (g_filter_dflt_basic_ops_hm_basic_ops (P1_, P2_), (g_inter_dflt_basic_ops_hm_basic_ops (Q1_, Q2_), (g_subset_dflt_basic_ops_hm_basic_ops (R1_, R2_), (g_equal_dflt_basic_ops_hm_basic_ops (S1_, S2_), (g_disjoint_dflt_basic_ops_hm_basic_ops (T1_, T2_), (g_disjoint_witness_dflt_basic_ops_hm_basic_ops (U1_, U2_), (g_sel_dflt_basic_ops_hm_basic_ops V_, (g_to_list_dflt_basic_ops_hm_basic_ops W_, g_from_list_dflt_basic_ops_hm_basic_ops (X1_, X2_)))))))))))))))))))))))); end; (*struct HashSet*) ### theory "Collections.HashSet" ### 1.789s elapsed time, 3.584s cpu time, 0.000s GC time Loading theory "Collections.SetStdImpl" ### Introduced fixed type variable(s): 'c in "\__" or "c__" or "f__" ### Introduced fixed type variable(s): 'c in "\__" or "c__" or "f__" ### Rule already declared as introduction (intro) ### \?b = ?f ?x; ?x \ ?A\ \ ?b \ ?f ` ?A ### Metis: Unused theorems: "Orderings.preorder_class.order_trans", "PrioByAnnotatedList.prio_selects_one" ### Metis: Unused theorems: "Orderings.preorder_class.order_trans", "PrioByAnnotatedList.p_linear" ### Ignoring duplicate rewrite rule: ### p_min Infty ?y \ ?y ### Ignoring duplicate rewrite rule: ### p_min Infty ?y \ ?y ### theory "Collections.SetStdImpl" ### 2.930s elapsed time, 5.832s cpu time, 0.384s GC time ### Ignoring duplicate introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Metis: Unused theorems: "Map.restrict_complement_singleton_eq" ### Ignoring duplicate rewrite rule: ### finite (dom (map_of ?l1)) \ True *** Type unification failed: Clash of types "_ set" and "_ \ _" *** *** Type error in application: incompatible operand type *** *** Operator: (=) (aluprio_\ \ s) :: *** ('b \ 'c option) \ bool *** Operand: {} :: ??'a set *** *** Coercion Inference: *** *** Local coercion insertion on the operand failed: *** No coercion known for type constructors: "set" and "fun" *** At command "hence" (line 851 of "~~/afp/thys/Collections/ICF/gen_algo/PrioUniqueByAnnotatedList.thy") *** Type unification failed: Clash of types "_ set" and "_ \ _" *** *** Type error in application: incompatible operand type *** *** Operator: (\) (aluprio_\ \ s) :: *** ('b \ 'c option) \ bool *** Operand: {} :: ??'a set *** *** Coercion Inference: *** *** Local coercion insertion on the operand failed: *** No coercion known for type constructors: "set" and "fun" *** At command "assume" (line 966 of "~~/afp/thys/Collections/ICF/gen_algo/PrioUniqueByAnnotatedList.thy") ### Introduced fixed type variable(s): 'd in "uu__" ### Ignoring duplicate rewrite rule: ### t.invar ?t1 \ ci_invar (idx_build ?f1 ?t1) \ True ### Ignoring duplicate rewrite rule: ### invar ?m1 \ ### \ (update ?k1 ?v1 ?m1) \ \ ?m1(?k1 \ ?v1) ### Ignoring duplicate rewrite rule: ### invar ?m1 \ invar (update ?k1 ?v1 ?m1) \ True ### Ignoring duplicate rewrite rule: ### \ (local.empty ()) \ Map.empty ### Ignoring duplicate rewrite rule: ### invar (local.empty ()) \ True ### Ignoring duplicate rewrite rule: ### invar ?m1 \ ### \ (update ?k1 ?v1 ?m1) \ \ ?m1(?k1 \ ?v1) ### Ignoring duplicate rewrite rule: ### invar ?m1 \ invar (update ?k1 ?v1 ?m1) \ True ### Ignoring duplicate rewrite rule: ### invar ?m1 \ ### \ (update ?k1 ?v1 ?m1) \ \ ?m1(?k1 \ ?v1) ### Ignoring duplicate rewrite rule: ### invar ?m1 \ invar (update ?k1 ?v1 ?m1) \ True ### Ignoring duplicate rewrite rule: ### \ (local.empty ()) \ Map.empty ### Ignoring duplicate rewrite rule: ### invar (local.empty ()) \ True ### Ignoring duplicate rewrite rule: ### \ (local.empty ()) \ Map.empty ### Ignoring duplicate rewrite rule: ### invar (local.empty ()) \ True ### Ignoring duplicate rewrite rule: ### \invar ?m1; ?k1 \ dom (\ ?m1)\ ### \ \ (update_dj ?k1 ?v1 ?m1) \ \ ?m1 ### (?k1 \ ?v1) ### Ignoring duplicate rewrite rule: ### \invar ?m1; ?k1 \ dom (\ ?m1)\ ### \ invar (update_dj ?k1 ?v1 ?m1) \ True ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate rewrite rule: ### invar ?s1 \ ### \ (ins ?x1 ?s1) \ insert ?x1 (\ ?s1) ### Ignoring duplicate rewrite rule: ### invar ?s1 \ invar (ins ?x1 ?s1) \ True ### Ignoring duplicate rewrite rule: ### \ (local.empty ()) \ {} ### Ignoring duplicate rewrite rule: ### invar (local.empty ()) \ True ### Ignoring duplicate rewrite rule: ### invar ?s1 \ ### \ (ins ?x1 ?s1) \ insert ?x1 (\ ?s1) ### Ignoring duplicate rewrite rule: ### invar ?s1 \ invar (ins ?x1 ?s1) \ True ### Ignoring duplicate rewrite rule: ### invar ?s1 \ memb ?x1 ?s1 \ ?x1 \ \ ?s1 ### Ignoring duplicate rewrite rule: ### invar ?s1 \ ### \ (ins ?x1 ?s1) \ insert ?x1 (\ ?s1) ### Ignoring duplicate rewrite rule: ### invar ?s1 \ invar (ins ?x1 ?s1) \ True ### Ignoring duplicate rewrite rule: ### \ (local.empty ()) \ {} ### Ignoring duplicate rewrite rule: ### invar (local.empty ()) \ True ### Ignoring duplicate rewrite rule: ### invar ?s1 \ memb ?x1 ?s1 \ ?x1 \ \ ?s1 ### Ignoring duplicate rewrite rule: ### invar ?s1 \ memb ?x1 ?s1 \ ?x1 \ \ ?s1 ### Ignoring duplicate rewrite rule: ### dom (\x. Some (?f1 x)) \ UNIV ### Ignoring duplicate rewrite rule: ### dom (\x. Some (?f1 x)) \ UNIV "revg" :: "'a list \ 'a list \ 'a list" ### Ignoring duplicate rewrite rule: ### ahm_\_aux ?a1 ?k1 \ ### map_of (array_get ?a1 (bounded_hashcode_nat (array_length ?a1) ?k1)) ?k1 ### Introduced fixed type variable(s): 'c in "j__" ### Ignoring duplicate introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate rewrite rule: ### ArrayHashMap_Impl.ahm_\ (ArrayHashMap_Impl.ahm_empty ()) \ ### Map.empty ### Ignoring duplicate rewrite rule: ### ArrayHashMap_Impl.ahm_invar (ArrayHashMap_Impl.ahm_empty ()) \ True ### Ignoring duplicate rewrite rule: ### map.\ (map.empty ()) \ Map.empty ### Ignoring duplicate rewrite rule: ### map.invar (map.empty ()) \ True ### Ignoring duplicate rewrite rule: ### map.invar ?m1 \ ### map.lookup ?k1 ?m1 \ map.\ ?m1 ?k1 ### Ignoring duplicate rewrite rule: ### map.invar ?m1 \ ### map.\ (map.update ?k1 ?v1 ?m1) \ map.\ ?m1(?k1 ### \ ?v1) ### Ignoring duplicate rewrite rule: ### map.invar ?m1 \ ### map.invar (map.update ?k1 ?v1 ?m1) \ True ### Ignoring duplicate rewrite rule: ### \map.invar ?m1; ?k1 \ dom (map.\ ?m1)\ ### \ map.\ (map.update_dj ?k1 ?v1 ?m1) \ ### map.\ ?m1(?k1 \ ?v1) ### Ignoring duplicate rewrite rule: ### \map.invar ?m1; ?k1 \ dom (map.\ ?m1)\ ### \ map.invar (map.update_dj ?k1 ?v1 ?m1) \ True ### Ignoring duplicate rewrite rule: ### map.invar ?m1 \ ### map.\ (map.delete ?k1 ?m1) \ map.\ ?m1 |` (- {?k1}) ### Ignoring duplicate rewrite rule: ### map.invar ?m1 \ map.invar (map.delete ?k1 ?m1) \ True ### Rule already declared as introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g ### Ignoring duplicate introduction (intro) ### (\x. ?f x = ?g x) \ ?f = ?g (\i len a c f \. (\x. \\ (len \ i \ \ c \); x = (case array_get a i of None \ \ | Some x \ f (i, x) \)\ \ ?P (i + 1) len a c f x) \ ?P i len a c f \) \ ?P ?a0.0 ?a1.0 ?a2.0 ?a3.0 ?a4.0 ?a5.0 a_idx_it.idx_iteratei ?s = foldli (list_of_array ?s) isabelle document -d /media/data/jenkins/workspace/afp-repo-afp/browser_info/AFP/Collections/document -o pdf -n document isabelle document -d /media/data/jenkins/workspace/afp-repo-afp/browser_info/AFP/Collections/outline -o pdf -n outline -t /proof,/ML isabelle document -d /media/data/jenkins/workspace/afp-repo-afp/browser_info/AFP/Collections/userguide -o pdf -n userguide *** Latex error: *** File `ICF_Userguide.tex' not found. *** Latex error (line 55 of "/media/data/jenkins/workspace/afp-repo-afp/browser_info/AFP/Collections/userguide/root_userguide.tex"): *** Emergency stop. *** *** *** \input{ICF_Userguide} *** Latex error (line 55 of "/media/data/jenkins/workspace/afp-repo-afp/browser_info/AFP/Collections/userguide/root_userguide.tex"): *** ==> Fatal error occurred, no output PDF file produced *** Failed to build document in "/media/data/jenkins/workspace/afp-repo-afp/browser_info/AFP/Collections/userguide" *** Type unification failed: Clash of types "_ set" and "_ \ _" *** *** Type error in application: incompatible operand type *** *** Operator: (\) (aluprio_\ \ s) :: *** ('b \ 'c option) \ bool *** Operand: {} :: ??'a set *** *** Coercion Inference: *** *** Local coercion insertion on the operand failed: *** No coercion known for type constructors: "set" and "fun" *** At command "assume" (line 966 of "~~/afp/thys/Collections/ICF/gen_algo/PrioUniqueByAnnotatedList.thy") *** Type unification failed: Clash of types "_ set" and "_ \ _" *** *** Type error in application: incompatible operand type *** *** Operator: (=) (aluprio_\ \ s) :: *** ('b \ 'c option) \ bool *** Operand: {} :: ??'a set *** *** Coercion Inference: *** *** Local coercion insertion on the operand failed: *** No coercion known for type constructors: "set" and "fun" *** At command "hence" (line 851 of "~~/afp/thys/Collections/ICF/gen_algo/PrioUniqueByAnnotatedList.thy")