93 val Bool = Predicate_Compile_Aux.Bool |
93 val Bool = Predicate_Compile_Aux.Bool |
94 val iio = Fun (Input, Fun (Input, Fun (Output, Bool))) |
94 val iio = Fun (Input, Fun (Input, Fun (Output, Bool))) |
95 val ioi = Fun (Input, Fun (Output, Fun (Input, Bool))) |
95 val ioi = Fun (Input, Fun (Output, Fun (Input, Bool))) |
96 val oii = Fun (Output, Fun (Input, Fun (Input, Bool))) |
96 val oii = Fun (Output, Fun (Input, Fun (Input, Bool))) |
97 val ooi = Fun (Output, Fun (Output, Fun (Input, Bool))) |
97 val ooi = Fun (Output, Fun (Output, Fun (Input, Bool))) |
98 val plus_nat = Core_Data.functional_compilation @{const_name plus} iio |
98 val plus_nat = Core_Data.functional_compilation \<^const_name>\<open>plus\<close> iio |
99 val minus_nat = Core_Data.functional_compilation @{const_name "minus"} iio |
99 val minus_nat = Core_Data.functional_compilation \<^const_name>\<open>minus\<close> iio |
100 fun subtract_nat compfuns (_ : typ) = |
100 fun subtract_nat compfuns (_ : typ) = |
101 let |
101 let |
102 val T = Predicate_Compile_Aux.mk_monadT compfuns @{typ nat} |
102 val T = Predicate_Compile_Aux.mk_monadT compfuns \<^typ>\<open>nat\<close> |
103 in |
103 in |
104 absdummy @{typ nat} (absdummy @{typ nat} |
104 absdummy \<^typ>\<open>nat\<close> (absdummy \<^typ>\<open>nat\<close> |
105 (Const (@{const_name "If"}, @{typ bool} --> T --> T --> T) $ |
105 (Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $ |
106 (@{term "(>) :: nat => nat => bool"} $ Bound 1 $ Bound 0) $ |
106 (\<^term>\<open>(>) :: nat => nat => bool\<close> $ Bound 1 $ Bound 0) $ |
107 Predicate_Compile_Aux.mk_empty compfuns @{typ nat} $ |
107 Predicate_Compile_Aux.mk_empty compfuns \<^typ>\<open>nat\<close> $ |
108 Predicate_Compile_Aux.mk_single compfuns |
108 Predicate_Compile_Aux.mk_single compfuns |
109 (@{term "(-) :: nat => nat => nat"} $ Bound 0 $ Bound 1))) |
109 (\<^term>\<open>(-) :: nat => nat => nat\<close> $ Bound 0 $ Bound 1))) |
110 end |
110 end |
111 fun enumerate_addups_nat compfuns (_ : typ) = |
111 fun enumerate_addups_nat compfuns (_ : typ) = |
112 absdummy @{typ nat} (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ "nat * nat"} |
112 absdummy \<^typ>\<open>nat\<close> (Predicate_Compile_Aux.mk_iterate_upto compfuns \<^typ>\<open>nat * nat\<close> |
113 (absdummy @{typ natural} (@{term "Pair :: nat => nat => nat * nat"} $ |
113 (absdummy \<^typ>\<open>natural\<close> (\<^term>\<open>Pair :: nat => nat => nat * nat\<close> $ |
114 (@{term "nat_of_natural"} $ Bound 0) $ |
114 (\<^term>\<open>nat_of_natural\<close> $ Bound 0) $ |
115 (@{term "(-) :: nat => nat => nat"} $ Bound 1 $ (@{term "nat_of_natural"} $ Bound 0))), |
115 (\<^term>\<open>(-) :: nat => nat => nat\<close> $ Bound 1 $ (\<^term>\<open>nat_of_natural\<close> $ Bound 0))), |
116 @{term "0 :: natural"}, @{term "natural_of_nat"} $ Bound 0)) |
116 \<^term>\<open>0 :: natural\<close>, \<^term>\<open>natural_of_nat\<close> $ Bound 0)) |
117 fun enumerate_nats compfuns (_ : typ) = |
117 fun enumerate_nats compfuns (_ : typ) = |
118 let |
118 let |
119 val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns @{term "0 :: nat"}) |
119 val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns \<^term>\<open>0 :: nat\<close>) |
120 val T = Predicate_Compile_Aux.mk_monadT compfuns @{typ nat} |
120 val T = Predicate_Compile_Aux.mk_monadT compfuns \<^typ>\<open>nat\<close> |
121 in |
121 in |
122 absdummy @{typ nat} (absdummy @{typ nat} |
122 absdummy \<^typ>\<open>nat\<close> (absdummy \<^typ>\<open>nat\<close> |
123 (Const (@{const_name If}, @{typ bool} --> T --> T --> T) $ |
123 (Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $ |
124 (@{term "(=) :: nat => nat => bool"} $ Bound 0 $ @{term "0::nat"}) $ |
124 (\<^term>\<open>(=) :: nat => nat => bool\<close> $ Bound 0 $ \<^term>\<open>0::nat\<close>) $ |
125 (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ nat} (@{term "nat_of_natural"}, |
125 (Predicate_Compile_Aux.mk_iterate_upto compfuns \<^typ>\<open>nat\<close> (\<^term>\<open>nat_of_natural\<close>, |
126 @{term "0::natural"}, @{term "natural_of_nat"} $ Bound 1)) $ |
126 \<^term>\<open>0::natural\<close>, \<^term>\<open>natural_of_nat\<close> $ Bound 1)) $ |
127 (single_const $ (@{term "(+) :: nat => nat => nat"} $ Bound 1 $ Bound 0)))) |
127 (single_const $ (\<^term>\<open>(+) :: nat => nat => nat\<close> $ Bound 1 $ Bound 0)))) |
128 end |
128 end |
129 in |
129 in |
130 Core_Data.force_modes_and_compilations @{const_name plus_eq_nat} |
130 Core_Data.force_modes_and_compilations \<^const_name>\<open>plus_eq_nat\<close> |
131 [(iio, (plus_nat, false)), (oii, (subtract_nat, false)), (ioi, (subtract_nat, false)), |
131 [(iio, (plus_nat, false)), (oii, (subtract_nat, false)), (ioi, (subtract_nat, false)), |
132 (ooi, (enumerate_addups_nat, false))] |
132 (ooi, (enumerate_addups_nat, false))] |
133 #> Predicate_Compile_Fun.add_function_predicate_translation |
133 #> Predicate_Compile_Fun.add_function_predicate_translation |
134 (@{term "plus :: nat => nat => nat"}, @{term "plus_eq_nat"}) |
134 (\<^term>\<open>plus :: nat => nat => nat\<close>, \<^term>\<open>plus_eq_nat\<close>) |
135 #> Core_Data.force_modes_and_compilations @{const_name minus_eq_nat} |
135 #> Core_Data.force_modes_and_compilations \<^const_name>\<open>minus_eq_nat\<close> |
136 [(iio, (minus_nat, false)), (oii, (enumerate_nats, false))] |
136 [(iio, (minus_nat, false)), (oii, (enumerate_nats, false))] |
137 #> Predicate_Compile_Fun.add_function_predicate_translation |
137 #> Predicate_Compile_Fun.add_function_predicate_translation |
138 (@{term "minus :: nat => nat => nat"}, @{term "minus_eq_nat"}) |
138 (\<^term>\<open>minus :: nat => nat => nat\<close>, \<^term>\<open>minus_eq_nat\<close>) |
139 #> Core_Data.force_modes_and_functions @{const_name plus_eq_int} |
139 #> Core_Data.force_modes_and_functions \<^const_name>\<open>plus_eq_int\<close> |
140 [(iio, (@{const_name plus}, false)), (ioi, (@{const_name subtract}, false)), |
140 [(iio, (\<^const_name>\<open>plus\<close>, false)), (ioi, (\<^const_name>\<open>subtract\<close>, false)), |
141 (oii, (@{const_name subtract}, false))] |
141 (oii, (\<^const_name>\<open>subtract\<close>, false))] |
142 #> Predicate_Compile_Fun.add_function_predicate_translation |
142 #> Predicate_Compile_Fun.add_function_predicate_translation |
143 (@{term "plus :: int => int => int"}, @{term "plus_eq_int"}) |
143 (\<^term>\<open>plus :: int => int => int\<close>, \<^term>\<open>plus_eq_int\<close>) |
144 #> Core_Data.force_modes_and_functions @{const_name minus_eq_int} |
144 #> Core_Data.force_modes_and_functions \<^const_name>\<open>minus_eq_int\<close> |
145 [(iio, (@{const_name minus}, false)), (oii, (@{const_name plus}, false)), |
145 [(iio, (\<^const_name>\<open>minus\<close>, false)), (oii, (\<^const_name>\<open>plus\<close>, false)), |
146 (ioi, (@{const_name minus}, false))] |
146 (ioi, (\<^const_name>\<open>minus\<close>, false))] |
147 #> Predicate_Compile_Fun.add_function_predicate_translation |
147 #> Predicate_Compile_Fun.add_function_predicate_translation |
148 (@{term "minus :: int => int => int"}, @{term "minus_eq_int"}) |
148 (\<^term>\<open>minus :: int => int => int\<close>, \<^term>\<open>minus_eq_int\<close>) |
149 end |
149 end |
150 \<close> |
150 \<close> |
151 |
151 |
152 subsection \<open>Inductive definitions for ordering on naturals\<close> |
152 subsection \<open>Inductive definitions for ordering on naturals\<close> |
153 |
153 |