hw02.ps

Postfix.hs

{-# LANGUAGE RankNTypes #-}
module Postfix where

import qualified Stack as Stack

type Cmd s s' = forall a. s -> (s' -> a) -> a

post :: (s -> s') -> Cmd s s'
post f s = next (f s)

next :: s -> (s -> a) -> a
next s k = k s

type Cmd1 x s s' =
    forall a. s -> x -> (s' -> a) -> a

post1 :: (x -> s -> s') -> Cmd1 x s s'
post1 f s x = next (f x s)

pop = post Stack.pop

add = post Stack.add

dup = post Stack.dup

exch = post Stack.exch

sub = post Stack.sub

mul = post Stack.mul

eq = post Stack.eq

lt = post Stack.lt

push = post1 Stack.push

apply = post1 Stack.smap
apply2 = post1 Stack.smap2
begin = next Stack.Empty

end = Stack.only

Procedural.hs

{-# LANGUAGE RankNTypes #-}
module Procedural where

import qualified Stack as Stack

type Cmd s s' = forall s0 a. (s0 -> s) -> ((s0 -> s') -> a) -> a

post :: (s -> s') -> Cmd s s'
post f ss = next (f . ss)

next :: s -> (s -> a) -> a
next s k = k s

type Cmd1 x s s' =
    forall s0 a. (s0 -> s) -> x -> ((s0 -> s') -> a) -> a

post1 :: (x -> s -> s') -> Cmd1 x s s'
post1 f ss x = next (f x . ss)

pop = post Stack.pop

add = post Stack.add

dup = post Stack.dup

exch = post Stack.exch

sub = post Stack.sub

mul = post Stack.mul

eq = post Stack.eq

lt = post Stack.lt

push = post1 Stack.push

apply = post1 Stack.smap
apply2 = post1 Stack.smap2

begin = next id

end ss = Stack.only (ss Stack.Empty)


begindef = next id

enddef = post

incr = begindef
         push 1
         add
       enddef

RPN.hs

module RPN where

begin :: ([Int] -> a) -> a
begin k = k []

push :: [Int] -> Int -> ([Int] -> a) -> a
push s x k = k (x:s)

add :: [Int] -> ([Int] -> a) -> a
add (x:y:s) k = k (y + x : s)

end :: [Int] -> Int
end [x] = x

test1 =
    begin
      push 1
      push 2
      add
    end

test2 = begin push 5 push 6 push 7 add add end

Stack.hs

module Stack where

data Empty = Empty

push :: a -> s -> (s, a)
push a s = (s, a)

pop :: (s, a) -> s
pop (s, a) = s

dup :: (s, a) -> ((s, a), a)
dup (s, a) = ((s, a), a)

exch :: ((s, a), b) -> ((s, b), a)
exch ((s, a), b) = ((s, b), a)

add :: ((s, Int), Int) -> (s, Int)
add ((s, a), b) = (s, a + b)

sub :: ((s, Int), Int) -> (s, Int)
sub ((s, a), b) = (s, b - a)

mul :: ((s, Int), Int) -> (s, Int)
mul ((s, a), b) = (s, a * b)

eq :: ((s, Int), Int) -> (s, Bool)
eq ((s, a), b) = (s, a == b)

lt :: ((s, Int), Int) -> (s, Bool)
lt ((s, a), b) = (s, a <= b)

nil :: s -> (s, [a])
nil s = (s, [])

cons :: ((s, a), [a]) -> (s, [a])
cons ((s, a), as) = (s, a:as)

only :: (Empty, a) -> a
only (Empty, a) = a

begin = Empty

end = only

smap :: (a -> b) -> (s, a) -> (s, b)
smap f (s, a) = (s, f a)

smap2 :: (a -> b ->c) -> ((s, a), b) -> (s, c)
smap2 f ((s, a), b) = (s, f a b)