From 0d0d8de69677529b8d72a9015ca531694289d879 Mon Sep 17 00:00:00 2001 From: Greg Brown Date: Thu, 3 Mar 2022 17:15:01 +0000 Subject: Add function to eliminate all calls in expressions --- src/Helium/Data/Pseudocode/Manipulate.agda | 263 +++++++++++++++++++++++++++++ 1 file changed, 263 insertions(+) diff --git a/src/Helium/Data/Pseudocode/Manipulate.agda b/src/Helium/Data/Pseudocode/Manipulate.agda index 1ea5302..0ca5194 100644 --- a/src/Helium/Data/Pseudocode/Manipulate.agda +++ b/src/Helium/Data/Pseudocode/Manipulate.agda @@ -1289,3 +1289,266 @@ inlineFunction-lowers-callDepth (_∙return_ s {stateless} e) args = begin (_ , _ , s) (toWitnessFalse stateless) e + +elimFunctions : Expression Γ t → ∃ λ (e : Expression Γ t) → callDepth e ≡ 0 +elimFunctions {Γ = Γ} = Wf.All.wfRec relWf _ pred helper ∘ (_ ,_) + where + index : Expression Γ t → ℕ + index′ : All (Expression Γ) Δ → ℕ + + index (Code.lit x) = 0 + index (Code.state i) = 0 + index (Code.var i) = 0 + index (Code.abort e) = suc (index e) + index (e Code.≟ e₁) = 1 ℕ.+ index e ℕ.+ index e₁ + index (e Code.> x) = suc (index e) + index (Code.rnd e) = suc (index e) + index (Code.fin x e) = suc (index e) + index (Code.asInt e) = suc (index e) + index Code.nil = 0 + index (Code.cons e e₁) = 1 ℕ.+ index e ℕ.+ index e₁ + index (Code.head e) = suc (index e) + index (Code.tail e) = suc (index e) + index (Code.call f es) = index′ es + index (Code.if e then e₁ else e₂) = 1 ℕ.+ index e ℕ.+ index e₁ ℕ.+ index e₂ + + index′ [] = 1 + index′ (e ∷ es) = index e ℕ.+ index′ es + + pred : ∃ (Expression Γ) → Set + pred (t , e) = ∃ λ (e : Expression Γ t) → callDepth e ≡ 0 + + pred′ : All (Expression Γ) Δ → Set + pred′ {Δ = Δ} _ = ∃ λ (es : All (Expression Γ) Δ) → callDepth′ es ≡ 0 + + rel = Lex.×-Lex _≡_ ℕ._<_ ℕ._<_ on < callDepth ∘ proj₂ , index ∘ proj₂ > + + data _<′₁_ : ∃ (Expression Γ) → All (Expression Γ) Δ → Set where + inj₁ : {e : Expression Γ t} {es : All (Expression Γ) Δ} → callDepth e ℕ.< callDepth′ es → (t , e) <′₁ es + inj₂ : {e : Expression Γ t} {es : All (Expression Γ) Δ} → callDepth e ≡ callDepth′ es → index e ℕ.< index′ es → (t , e) <′₁ es + + data _<′₂_ : ∀ {n ts} → All (Expression Γ) {n} ts → All (Expression Γ) Δ → Set where + inj₁ : ∀ {n ts} {es′ : All (Expression Γ) {n} ts} {es : All (Expression Γ) Δ} → callDepth′ es′ ℕ.< callDepth′ es → es′ <′₂ es + inj₂ : ∀ {n ts} {es′ : All (Expression Γ) {n} ts} {es : All (Expression Γ) Δ} → callDepth′ es′ ≡ callDepth′ es → index′ es′ ℕ.≤ index′ es → es′ <′₂ es + + <′₁-<′₂-trans : ∀ {n ts} {e : Expression Γ t} {es : All (Expression Γ) Δ} {es′ : All (Expression Γ) {n} ts} → + (t , e) <′₁ es → es <′₂ es′ → (t , e) <′₁ es′ + <′₁-<′₂-trans (inj₁ <₁) (inj₁ <₂) = inj₁ (ℕₚ.<-trans <₁ <₂) + <′₁-<′₂-trans (inj₁ <₁) (inj₂ ≡₂ _) = inj₁ (ℕₚ.<-transˡ <₁ (ℕₚ.≤-reflexive ≡₂)) + <′₁-<′₂-trans (inj₂ ≡₁ _) (inj₁ <₂) = inj₁ (ℕₚ.<-transʳ (ℕₚ.≤-reflexive ≡₁) <₂) + <′₁-<′₂-trans (inj₂ ≡₁ <₁) (inj₂ ≡₂ ≤₂) = inj₂ (trans ≡₁ ≡₂) (ℕₚ.<-transˡ <₁ ≤₂) + + <′₂-trans : ∀ {m n ts ts′} {es : All (Expression Γ) Δ} {es′ : All (Expression Γ) {n} ts} {es′′ : All (Expression Γ) {m} ts′} → + es <′₂ es′ → es′ <′₂ es′′ → es <′₂ es′′ + <′₂-trans (inj₁ <₁) (inj₁ <₂) = inj₁ (ℕₚ.<-trans <₁ <₂) + <′₂-trans (inj₁ <₁) (inj₂ ≡₂ _) = inj₁ (ℕₚ.<-transˡ <₁ (ℕₚ.≤-reflexive ≡₂)) + <′₂-trans (inj₂ ≡₁ _) (inj₁ <₂) = inj₁ (ℕₚ.<-transʳ (ℕₚ.≤-reflexive ≡₁) <₂) + <′₂-trans (inj₂ ≡₁ ≤₁) (inj₂ ≡₂ ≤₂) = inj₂ (trans ≡₁ ≡₂) (ℕₚ.≤-trans ≤₁ ≤₂) + + index′>0 : ∀ (es : All (Expression Γ) Δ) → index′ es ℕ.> 0 + index′>0 [] = ℕₚ.≤-refl + index′>0 (e ∷ es) = ℕₚ.<-transˡ (index′>0 es) (ℕₚ.m≤n+m (index′ es) (index e)) + + e<′₁es⇒e0 es) + + e<′₁e∷es : ∀ e (es : All (Expression Γ) Δ) → (t , e) <′₁ (e ∷ es) + e<′₁e∷es e es with callDepth e in eq₁ | callDepth′ es in eq₂ | ℕ.compare (callDepth e) (callDepth′ es) + ... | _ | _ | ℕ.less m k = inj₁ + (begin + suc (callDepth e) ≡⟨ cong suc eq₁ ⟩ + suc m ≤⟨ ℕₚ.m≤m+n (suc m) k ⟩ + suc m ℕ.+ k ≤⟨ ℕₚ.m≤n⊔m m (suc m ℕ.+ k) ⟩ + m ⊔ (suc m ℕ.+ k) ≡˘⟨ cong₂ _⊔_ eq₁ eq₂ ⟩ + callDepth e ⊔ callDepth′ es ∎) + ... | _ | _ | ℕ.equal m = inj₂ + (begin-equality + callDepth e ≡⟨ eq₁ ⟩ + m ≡˘⟨ ℕₚ.⊔-idem m ⟩ + m ⊔ m ≡˘⟨ cong₂ _⊔_ eq₁ eq₂ ⟩ + callDepth e ⊔ callDepth′ es ∎) + (e<ᵢe∷es e es) + ... | _ | _ | ℕ.greater n k = inj₂ + (sym (ℕₚ.m≥n⇒m⊔n≡m (begin + callDepth′ es ≡⟨ eq₂ ⟩ + n ≤⟨ ℕₚ.n≤1+n n ⟩ + suc n ≤⟨ ℕₚ.m≤m+n (suc n) k ⟩ + suc n ℕ.+ k ≡˘⟨ eq₁ ⟩ + callDepth e ∎))) + (e<ᵢe∷es e es) + + es<′₂e∷es : ∀ (e : Expression Γ t) (es : All (Expression Γ) Δ) → es <′₂ (e ∷ es) + es<′₂e∷es e es with callDepth e in eq₁ | callDepth′ es in eq₂ | ℕ.compare (callDepth e) (callDepth′ es) + ... | _ | _ | ℕ.less m k = inj₂ + (sym (ℕₚ.m≤n⇒m⊔n≡n (begin + callDepth e ≡⟨ eq₁ ⟩ + m ≤⟨ ℕₚ.n≤1+n m ⟩ + suc m ≤⟨ ℕₚ.m≤m+n (suc m) k ⟩ + suc m ℕ.+ k ≡˘⟨ eq₂ ⟩ + callDepth′ es ∎))) + (ℕₚ.m≤n+m (index′ es) (index e)) + ... | _ | _ | ℕ.equal m = inj₂ + (begin-equality + callDepth′ es ≡⟨ eq₂ ⟩ + m ≡˘⟨ ℕₚ.⊔-idem m ⟩ + m ⊔ m ≡˘⟨ cong₂ _⊔_ eq₁ eq₂ ⟩ + callDepth e ⊔ callDepth′ es ∎) + (ℕₚ.m≤n+m (index′ es) (index e)) + ... | _ | _ | ℕ.greater n k = inj₁ + (begin + suc (callDepth′ es) ≡⟨ cong suc eq₂ ⟩ + suc n ≤⟨ ℕₚ.m≤m+n (suc n) k ⟩ + suc n ℕ.+ k ≤⟨ ℕₚ.m≤m⊔n (suc n ℕ.+ k) n ⟩ + suc n ℕ.+ k ⊔ n ≡˘⟨ cong₂ _⊔_ eq₁ eq₂ ⟩ + callDepth e ⊔ callDepth′ es ∎) + + relWf = On.wellFounded < callDepth ∘ proj₂ , index ∘ proj₂ > (Lex.×-wellFounded ℕᵢ.<-wellFounded ℕᵢ.<-wellFounded) + + wf′₁ : ∀ f (es : All (Expression Γ) Δ) → Wf.WfRec rel pred (t , call f es) → + ∀ t,e → t,e <′₁ es → pred t,e + wf′₁ f _ rec (_ , e) r = rec (_ , e) (e<′₁es⇒e> x) acc = rec₁ (_>> x) refl refl e acc + helper (_ , Code.rnd e) acc = rec₁ rnd refl refl e acc + helper (_ , Code.fin x e) acc = rec₁ (fin x) refl refl e acc + helper (_ , Code.asInt e) acc = rec₁ asInt refl refl e acc + helper (_ , Code.nil) acc = nil , refl + helper (_ , Code.cons e e₁) acc = rec₂ cons refl refl e e₁ acc + helper (_ , Code.head e) acc = rec₁ head refl refl e acc + helper (_ , Code.tail e) acc = rec₁ tail refl refl e acc + helper (_ , Code.call f es) acc = + acc + (_ , inlineFunction f (proj₁ inner)) + (inj₁ (begin-strict + callDepth (inlineFunction f (proj₁ inner)) ≤⟨ inlineFunction-lowers-callDepth f (proj₁ inner) ⟩ + funCallDepth f ⊔ callDepth′ (proj₁ inner) ≡⟨ cong (funCallDepth f ⊔_) (proj₂ inner) ⟩ + funCallDepth f ⊔ 0 ≡⟨ ℕₚ.⊔-identityʳ (funCallDepth f) ⟩ + funCallDepth f <⟨ ℕₚ.n<1+n (funCallDepth f) ⟩ + suc (funCallDepth f) ≤⟨ ℕₚ.m≤m⊔n (suc (funCallDepth f)) (callDepth′ es) ⟩ + suc (funCallDepth f) ⊔ callDepth′ es ∎)) + where inner = helper′ es (wf′₁ f es acc) (wf′₂ f es acc) + helper (_ , (Code.if e then e₁ else e₂)) acc = rec₃ if_then_else_ refl refl e e₁ e₂ acc + + proj₁ (helper′ [] acc acc′) = [] + proj₁ (helper′ (e ∷ es) acc acc′) = proj₁ (acc (_ , e) (e<′₁e∷es e es)) ∷ proj₁ (acc′ es (es<′₂e∷es e es)) + proj₂ (helper′ [] acc acc′) = refl + proj₂ (helper′ (e ∷ es) acc acc′) = cong₂ _⊔_ (proj₂ (acc (_ , e) (e<′₁e∷es e es))) (proj₂ (acc′ es (es<′₂e∷es e es))) -- cgit v1.2.3