|
295 | 295 | :requires ((($dt_find_cycle t (@list s)) true))
|
296 | 296 | :conclusion (= (= s t) false)
|
297 | 297 | )
|
| 298 | + |
| 299 | +;;;;; ProofRewriteRule::DT_COLLAPSE_UPDATER |
| 300 | + |
| 301 | +; program: $mk_dt_collapse_updater_rhs |
| 302 | +; args: |
| 303 | +; - c U: The remaining term to process. |
| 304 | +; - a T: The value to replace as an argument of t. |
| 305 | +; - n Int: The argument position (from the end) which a should replace. |
| 306 | +; return: > |
| 307 | +; The result of updating the n^th argument from the end in t. |
| 308 | +(program $dt_collapse_updater_rhs ((U Type) (T Type) (f (-> T U)) (x T) (a T) (n Int)) |
| 309 | + (U T Int) U |
| 310 | + ( |
| 311 | + (($dt_collapse_updater_rhs (f x) a 0) (f a)) |
| 312 | + (($dt_collapse_updater_rhs (f x) a n) (_ ($dt_collapse_updater_rhs f a (eo::add n -1)) x)) |
| 313 | + ) |
| 314 | +) |
| 315 | + |
| 316 | +; program: $tuple_collapse_updater_rhs |
| 317 | +; args: |
| 318 | +; - c U: The remaining tuple term to process. |
| 319 | +; - a T: The value to replace as an argument of t. |
| 320 | +; - n Int: The argument position which a should replace. |
| 321 | +; return: > |
| 322 | +; The result of updating the n^th argument in t. |
| 323 | +(program $tuple_collapse_updater_rhs ((U Type) (T Type) (W Type) (f (-> T U)) (x T) (a T) (b T) (n Int) (ts W :list)) |
| 324 | + (U T Int) U |
| 325 | + ( |
| 326 | + (($tuple_collapse_updater_rhs (tuple b ts) a 0) (tuple a ts)) |
| 327 | + (($tuple_collapse_updater_rhs (tuple b ts) a n) (eo::cons tuple b ($tuple_collapse_updater_rhs ts a (eo::add n -1)))) |
| 328 | + (($tuple_collapse_updater_rhs tuple.unit a n) tuple.unit) |
| 329 | + ) |
| 330 | +) |
| 331 | + |
| 332 | +; program: $mk_dt_collapse_updater_rhs |
| 333 | +; args: |
| 334 | +; - c U: The update term to process, expected to be an updater applied to a constructor application. |
| 335 | +; return: > |
| 336 | +; The result of collasping the update term. |
| 337 | +(program $mk_dt_collapse_updater_rhs ((D Type) (T Type) (W Type) (s (-> D T)) (t D) (a T) (tr D) (n Int)) |
| 338 | + (D) Bool |
| 339 | + ( |
| 340 | + (($mk_dt_collapse_updater_rhs (update s t a)) (eo::define ((c ($get_fun t))) |
| 341 | + (eo::define ((ss ($dt_get_selectors (eo::typeof t) c))) |
| 342 | + (eo::define ((index (eo::list_find eo::List::cons ss s))) |
| 343 | + (eo::ite (eo::is_neg index) |
| 344 | + t ; unchanged if not correct constructor |
| 345 | + ($dt_collapse_updater_rhs t a (eo::add (eo::len ss) index -1))))))) |
| 346 | + (($mk_dt_collapse_updater_rhs (tuple.update n t a)) ($tuple_collapse_updater_rhs t a n)) |
| 347 | + ) |
| 348 | +) |
| 349 | + |
| 350 | +; rule: dt-collapse-updater |
| 351 | +; implements: ProofRewriteRule::DT_COLLAPSE_UPDATER |
| 352 | +; args: |
| 353 | +; - eq Bool: The equality to prove. |
| 354 | +; requires: > |
| 355 | +; We require that the index^th argument of the term t we are selecting from |
| 356 | +; is the right hand side of the equality, where index is the index of the |
| 357 | +; selector in the constructor of t. |
| 358 | +; conclusion: The given equality. |
| 359 | +(declare-rule dt-collapse-updater ((D Type) (t D) (s D)) |
| 360 | + :args ((= t s)) |
| 361 | + :requires ((($mk_dt_collapse_updater_rhs t) s)) |
| 362 | + :conclusion (= t s) |
| 363 | +) |
| 364 | + |
| 365 | +;;;;; ProofRewriteRule::DT_UPDATER_ELIM |
| 366 | + |
| 367 | +; program: $dt_updater_elim_rhs |
| 368 | +; args: |
| 369 | +; - s (-> D T): the selector specifying the argument. |
| 370 | +; - D t: The datatype term we are updating. |
| 371 | +; - a T: The value to replace at the s argument of t. |
| 372 | +; - ss eo::List: The remaining selector arguments to process. |
| 373 | +; - c U: The result of updating t we have accumulated so far. |
| 374 | +; return: > |
| 375 | +; The result of updating the argument specified by s in t. |
| 376 | +(program $dt_updater_elim_rhs ((D Type) (T Type) (U Type) (s (-> D T)) (s1 (-> D T)) (t D) (a T) (ss eo::List :list) (c U)) |
| 377 | + ((-> D T) D T eo::List U) D |
| 378 | + ( |
| 379 | + (($dt_updater_elim_rhs s t a (eo::List::cons s ss) c) ($dt_updater_elim_rhs s t a ss (c a))) |
| 380 | + (($dt_updater_elim_rhs s t a (eo::List::cons s1 ss) c) ($dt_updater_elim_rhs s t a ss (c (s1 t)))) |
| 381 | + (($dt_updater_elim_rhs s t a eo::List::nil c) c) |
| 382 | + ) |
| 383 | +) |
| 384 | + |
| 385 | +; program: $tuple_updater_elim_rhs |
| 386 | +; args: |
| 387 | +; - n Int: the index specifying the argument. |
| 388 | +; - D t: The tuple term we are updating. |
| 389 | +; - a T: The value to replace at the n^th argument of t. |
| 390 | +; - ss eo::List: The remaining selector arguments to process. |
| 391 | +; return: > |
| 392 | +; The result of updating the argument specified by s in t. |
| 393 | +(program $tuple_updater_elim_rhs ((D Type) (T Type) (U Type) (n Int) (s (-> D T)) (t D) (a T) (ss eo::List :list) (c U)) |
| 394 | + (Int D T eo::List) D |
| 395 | + ( |
| 396 | + (($tuple_updater_elim_rhs n t a (eo::List::cons (tuple.select n) ss)) (eo::cons tuple a ($tuple_updater_elim_rhs n t a ss))) |
| 397 | + (($tuple_updater_elim_rhs n t a (eo::List::cons s ss)) (eo::cons tuple (s t) ($tuple_updater_elim_rhs n t a ss))) |
| 398 | + (($tuple_updater_elim_rhs n t a eo::List::nil) tuple.unit) |
| 399 | + ) |
| 400 | +) |
| 401 | + |
| 402 | +; program: $mk_dt_updater_elim_rhs |
| 403 | +; args: |
| 404 | +; - s D: The update term. |
| 405 | +; - ss eo::List: The list of selectors for the type of s. |
| 406 | +; return: > |
| 407 | +; The right hand side is obtained by updating the proper argument of t. |
| 408 | +(program $mk_dt_updater_elim_rhs ((D Type) (T Type) (U Type) (s (-> D T)) (t D) (a T) (tr D) (c U) (n Int) (ss eo::List)) |
| 409 | + (D U eo::List) Bool |
| 410 | + ( |
| 411 | + (($mk_dt_updater_elim_rhs (update s t a) c ss) ($dt_updater_elim_rhs s t a ss ($dt_inst_cons_of (eo::typeof t) c))) ; ensure the constructor is annotated |
| 412 | + (($mk_dt_updater_elim_rhs (tuple.update n t a) tuple ss) ($tuple_updater_elim_rhs n t a ss)) |
| 413 | + ) |
| 414 | +) |
| 415 | + |
| 416 | +; rule: dt-updater-elim |
| 417 | +; implements: ProofRewriteRule::DT_UPDATER_ELIM |
| 418 | +; args: |
| 419 | +; - eq Bool: The equality to prove. |
| 420 | +; requires: > |
| 421 | +; We require that the right hand side is an ITE where the then branch is |
| 422 | +; obtained by updating the proper argument of t, as implemented by $is_dt_updater_elim. |
| 423 | +; conclusion: The given equality. |
| 424 | +(declare-rule dt-updater-elim ((D Type) (S Type) (T Type) (C Type) (s S) (t D) (a T) (u (-> S D T D)) (tu D) (c C)) |
| 425 | + :args ((= (u s t a) (ite (is c t) tu t))) |
| 426 | + :requires ((($mk_dt_updater_elim_rhs (u s t a) c ($dt_get_selectors (eo::typeof t) c)) tu)) |
| 427 | + :conclusion (= (u s t a) (ite (is c t) tu t)) |
| 428 | +) |
0 commit comments