Mercurial > hg > GearsTemplate
changeset 161:db647f7ed2f6
Prove simple lemma in stack.agda
author | atton |
---|---|
date | Thu, 17 Nov 2016 18:23:56 +0000 |
parents | f2c77b0761fc |
children | efc68eca8463 |
files | src/parallel_execution/stack.agda |
diffstat | 1 files changed, 69 insertions(+), 34 deletions(-) [+] |
line wrap: on
line diff
--- a/src/parallel_execution/stack.agda Wed Nov 16 21:29:01 2016 +0900 +++ b/src/parallel_execution/stack.agda Thu Nov 17 18:23:56 2016 +0000 @@ -1,51 +1,86 @@ module stack where -record Stack {a : Set} (stackImpl : Set a) where - stack : stackImpl - push : stackImpl -> a -> (stackImpl -> T) -> T - pop : stackImpl -> (stackImpl -> maybe a -> T) -> T +open import Relation.Binary.PropositionalEquality + +data Bool : Set where + True : Bool + False : Bool +data Maybe (a : Set) : Set where + Nothing : Maybe a + Just : a -> Maybe a + +record Stack {a t : Set} (stackImpl : Set) : Set where + field + stack : stackImpl + push : stackImpl -> a -> (stackImpl -> t) -> t + pop : stackImpl -> (stackImpl -> Maybe a -> t) -> t -createSingleLinkedStack : Stack (SingleLinkedStack {a}) -createSingleLinkedStack = record { - stack = record { top = nothing;} - push = pushSingleLinkedStack; - pop = popSingleLinkedStack; -} +data Element (a : Set) : Set where + cons : a -> Maybe (Element a) -> Element a + +datum : {a : Set} -> Element a -> a +datum (cons a _) = a + +next : {a : Set} -> Element a -> Maybe (Element a) +next (cons _ n) = n + + +{- +record Element {l : Level} (a : Set l) : Set (suc l) where + field + datum : a + next : Maybe (Element a) +-} -record Element {a : Set} : Set where - data : a - next : Maybe (Element a) + +record SingleLinkedStack (a : Set) : Set where + field + top : Maybe (Element a) +open SingleLinkedStack -record SingleLinkedStack {a : Set} : Set where - top : Maybe (Element a) +pushSingleLinkedStack : {Data t : Set} -> SingleLinkedStack Data -> Data -> (Code : SingleLinkedStack Data -> t) -> t +pushSingleLinkedStack stack datum next = next stack1 + where + element = cons datum (top stack) +-- element = record {next = top stack; datum = datum} + stack1 = record {top = Just element} + -pushSingleLinkedStack : Stack -> Data -> (Code : Stack -> T) -> T -pushSingleLinkedStack stack data next = next stack1 +popSingleLinkedStack : {a t : Set} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> t) -> t +popSingleLinkedStack stack cs with (top stack) +... | Nothing = cs stack Nothing +... | Just d = cs stack1 (Just data1) where - element = record {next = top stack; data = data} - stack1 = record {top = just element} + data1 = datum d + stack1 = record { top = (next d) } -popSingleLinkedStack : {a : Set} -> Stack -> (Code : Stack -> (Maybe a) -> T) -> T -popSingleLinkedStack stack next with (top stack) = - ... | nothing = next stack nothing - ... | just d = next stack1 data1 - where - data1 = data d - stack1 = record { top = (next d)} +emptySingleLinkedStack : {a : Set} -> SingleLinkedStack a +emptySingleLinkedStack = record {top = Nothing} + +createSingleLinkedStack : {a b : Set} -> Stack {a} {b} (SingleLinkedStack a) +createSingleLinkedStack = record { stack = emptySingleLinkedStack + ; push = pushSingleLinkedStack + ; pop = popSingleLinkedStack + } + -test01 : Stack -> Maybe a -> T -test01 stack nothing = false -test01 stack (just _) = true +test01 : {a : Set} -> SingleLinkedStack a -> Maybe a -> Bool +test01 stack _ with (top stack) +... | (Just _) = True +... | Nothing = False + -test02 : Stack -> T -test02 stack = (pop stack) test01 +test02 : {a : Set} -> SingleLinkedStack a -> Bool +test02 stack = (popSingleLinkedStack stack) test01 -test03 : T -test03 = push createSingleLinkedStack true test02 +test03 : Bool +test03 = pushSingleLinkedStack emptySingleLinkedStack (cons True Nothing) test02 +--test03 = pushSingleLinkedStack emptySingleLinkedStack (False) test02 -lemma : test01 == false + +lemma : test03 ≡ False lemma = refl