Skip to content

Commit

Permalink
New definition of rows_of for PureLang
Browse files Browse the repository at this point in the history
Progress towards #58
  • Loading branch information
hrutvik committed Jan 24, 2024
1 parent 657f8f2 commit a1f96a8
Showing 1 changed file with 12 additions and 24 deletions.
36 changes: 12 additions & 24 deletions compiler/backend/languages/semantics/pureLangScript.sml
Original file line number Diff line number Diff line change
Expand Up @@ -14,16 +14,12 @@ Definition Disj_def:
Disj v ((cn,l)::xs) = If (IsEq cn l T (Var v)) True (Disj v xs)
End

Definition lets_for_def:
lets_for cn v [] b = b ∧
lets_for cn v ((n,w)::ws) b = Let w (Proj cn n (Var v)) (lets_for cn v ws b)
End

Definition rows_of_def:
rows_of v k [] = k ∧
rows_of v k ((cn,vs,b)::rest) =
If (IsEq cn (LENGTH vs) T (Var v))
(lets_for cn v (MAPi (λi v. (i,v)) vs) b) (rows_of v k rest)
(Apps (Lams vs b) $ GENLIST (λi. Proj cn i $ Var v) (LENGTH vs))
(rows_of v k rest)
End

Definition patguards_def:
Expand Down Expand Up @@ -73,14 +69,9 @@ Definition exp_of_def:
k = (case eopt of
| NONE => Fail
| SOME (a,e) => IfDisj v a (exp_of e)) ;
caseexp =
Let (explode v) (exp_of x)
in Let (explode v) (exp_of x)
(rows_of (explode v) k
(MAP (λ(c,vs,x). (explode c,MAP explode vs,exp_of x)) rs))
in if MEM v (FLAT (MAP (FST o SND) rs)) then
Seq Fail caseexp
else
caseexp) ∧
(MAP (λ(c,vs,x). (explode c,MAP explode vs,exp_of x)) rs))) ∧
exp_of (NestedCase d g gv p e pes) =
Let (explode gv) (exp_of g)
(nested_rows (Var (explode gv))
Expand Down Expand Up @@ -146,24 +137,21 @@ Proof
rw[EXTENSION] >> eq_tac >> rw[] >> simp[]
QED

Theorem allvars_lets_for:
allvars (lets_for cn v ws b) =
(if ws = [] then {} else {v}) ∪ set (MAP SND ws) ∪ allvars b
Proof
Induct_on `ws` >> rw[lets_for_def, allvars_def] >>
PairCases_on `h` >> rw[lets_for_def, EXTENSION] >> eq_tac >> rw[] >> gvs[]
QED

Theorem allvars_rows_of:
allvars (rows_of v k css) =
(if css = [] then {} else {v}) ∪
allvars k ∪
BIGUNION (set (MAP (λ(cn,vs,b). set vs ∪ allvars b) css))
Proof
Induct_on `css` >> rw[rows_of_def] >> PairCases_on `h` >> rw[rows_of_def] >>
simp[allvars_lets_for, combinTheory.o_DEF] >>
Cases_on `h1` >> gvs[] >> rw[EXTENSION] >> eq_tac >> rw[] >>
gvs[MEM_MAP, EXISTS_PROD, PULL_EXISTS] >> metis_tac[]
gvs[allvars_Apps, allvars_Lams]
>- (
gvs[LIST_TO_SET_GENLIST, BIGUNION_IMAGE] >>
rw[EXTENSION] >> eq_tac >> rw[] >> gvs[MEM_MAP, MEM_GENLIST]
) >>
simp[MAP_GENLIST, combinTheory.o_DEF, LIST_TO_SET_GENLIST, BIGUNION_IMAGE] >>
rw[EXTENSION] >> eq_tac >> rw[] >> gvs[] >>
gvs[MEM_MAP, PULL_EXISTS, EXISTS_PROD] >> metis_tac[]
QED

Theorem allvars_of:
Expand Down

0 comments on commit a1f96a8

Please sign in to comment.