Mercurial > hg > Members > kono > Proof > automaton
diff agda/turing.agda @ 17:08b589172493
add pushdown and turing
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 26 Aug 2018 17:48:26 +0900 |
parents | |
children | 6ec8e933ab43 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/turing.agda Sun Aug 26 17:48:26 2018 +0900 @@ -0,0 +1,48 @@ +module turing where + +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Nat +open import Data.List +open import Data.Maybe +open import Data.Bool using ( Bool ; true ; false ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Product + + +data PushDown ( Σ : Set ) : Set where + pop : PushDown Σ + push : Σ → PushDown Σ + + +record Turing ( Q : Set ) ( Σ : Set ) + : Set where + field + tδ : Q → Σ → Q × ( PushDown Σ ) × ( PushDown Σ ) + tstart : Q + tend : Q → Bool + tz0 : Σ + tmoves : Q → List Σ → ( Q × List Σ × List Σ ) + tmoves q L = move q L [ pz0 ] + where + move : Q → ( List Σ ) → ( List Σ ) → ( Q × List Σ × List Σ ) + move q _ [] = ( q , [] ) + move q [] S = ( q , S ) + move q ( H ∷ T ) ( SH ∷ ST ) with pδ q H SH + ... | (nq , pop ) = move nq T ST + ... | (nq , push ns ) = move nq T ( ns ∷ SH ∷ ST ) + taccept : List Σ → Bool + taccept L = move pstart L [ pz0 ] + where + move : (q : Q ) ( L : List Σ ) ( L : List Σ ) → Bool + move q [] [] = true + move q _ [] = false + move q [] (_ ∷ _ ) = false + move q ( H ∷ T ) ( SH ∷ ST ) with pδ q H SH + ... | (nq , pop ) = move nq T ST + ... | (nq , push ns ) = move nq T ( ns ∷ SH ∷ ST ) + + + +