she-0.1: examples/Binding.lhs

> {-# OPTIONS_GHC -F -pgmF she #-}
> {-# LANGUAGE GADTs, KindSignatures, TypeOperators, TypeFamilies #-}

> module Binding where

> import Control.Applicative

> import ShePrelude

> data Tm
>   = V Int
>   | L Tm
>   | Tm :$ Tm
>   deriving Show

> infixl 6 :$

> data Va
>   = F (Va -> Va)
>   | [Va] :- Int    -- backwards

> ($$) :: Va -> Va -> Va
> F f $$ v = f v
> (vs :- p) $$ v = (v : vs) :- p

> ev :: Tm -> [Va] -> Va
> ev (V i)     g = g !! i
> ev (L t)     g = F (\ v -> ev t (v : g))
> ev (f :$ s)  g = (|ev f $$ ev s|) g

> qu :: Int -> Va -> Tm
> qu i (F f)     = L (qu (i + 1) (f ([] :- i)))
> qu i (vs :- j) = foldr (flip (:$)) (V (i - j - 1)) (map (qu i) vs)

> zz :: Tm
> zz = L [.f. L [.x. V x]]
> ss :: Tm
> ss = L [.n. L [.f. L [.x. V f :$ (V n :$ V f :$ V x)]]]

> test3 :: Va
> test3 = ev [.zz.ss. V ss :$ (V ss :$ (V ss :$ V zz))] [ev ss [],ev zz []]

> norm :: Tm -> Tm
> norm t = qu 0 (ev t [])