152 Implementation 6
n o t F r e e :: Int - > T e r m - > B o o l n o t F r e e n ( Var n ’) = n /= n ’ n o t F r e e n ( Not t ) = n o t F r e e n t n o t F r e e n ( L a m b d a n ’ t ) | n == n ’ = T r u e
| o t h e r w i s e = n o t F r e e n t n o t F r e e n ( t1 : / \ : t2 ) = n o t F r e e n t1 && n o t F r e e n t2 n o t F r e e n ( t1 : @ : t2 ) = n o t F r e e n t1 && n o t F r e e n t2
n o t F r e e _ _ = T r u e
I will explain the details of the evaluation later when giving the final eval-uation fuction we will use.
The function eval’ works fine for pure expression but we cannot simply add a case for impure ones. The reason is that the evaluation rule for impure expressions, i.e. expressions containing shifts, is not so much about manipu-lating the content in our data structure Term but rather about manipulating the location of a subexpression. (Recall how the reduction rule for shift cap-tured the context and plugged it into the ξ-expression, thereby transfering a part of the expression to a position above the captured context.) In order to manipulate locations, I make use of Huet’s idea of a zipper (cf. [56]) and let our evaluation function not operate on expression but on expressions with zip-per. The zipper is an idiom for traversing a data structure and manipulating locations in it in a non-destructive way. It uses the idea of storing information about the location of a substructure (a subexpression in our case) with the help of contexts. To this end, we define a data structure Contextin parallel to our definition for Term.
d a t a C o n t e x t = H o l e
| C A p p L C o n t e x t T e r m
| C A p p R T e r m C o n t e x t
| C A n d L C o n t e x t T e r m
| C A n d R T e r m C o n t e x t
| C N o t C o n t e x t
| C L a m b d a Int C o n t e x t
| C R e s e t F l a v o r C o n t e x t d e r i v i n g ( Eq , S h o w )
A list of such contexts is calledthread. A zipper is specified as a thread together with a term. The term is some subexpression tof a bigger expression t0, and the thread encodes the location of t in t0. The thread can thus be thought of as storing the path that was traversed in t0 in order to get to t’s location.
t y p e T h r e a d = [ C o n t e x t ] t y p e Z i p p e r = ( Thread , T e r m )
As an example, consider the example expression (λx.¬(fish∧x)chips):
e x a m p l e T e r m = ( L a m b d a 1 ( Not (( C o n s t " f i s h " ) : / \ : ( Var 1 ) ) ) ) : @ : ( C o n s t " c h i p s " )
6.4 Operator scope 153 Focusing on Var 1 as a subterm of exampleTerm, we can represent it as a zipper, where its location is stored in the thread.
e x a m p l e Z i p p e r = ([ C A n d R ( C o n s t " f i s h " ) Hole , C N o t Hole ,
C L a m b d a 1 Hole ,
C A p p L H o l e ( C o n s t " c h i p s " )] , Var 1)
Now we can go from a zipper to a term by unwinding the thread.
u n w i n d :: Z i p p e r - > T e r m u n w i n d ([] , t ) = t
u n w i n d (( C A p p R t _ ) : ts , t ’) = u n w i n d ( ts , t : @ : t ’) u n w i n d (( C A p p L _ t ) : ts , t ’) = u n w i n d ( ts , t ’ : @ : t ) u n w i n d (( C A n d R t _ ) : ts , t ’) = u n w i n d ( ts , t : / \ : t ’) u n w i n d (( C A n d L _ t ) : ts , t ’) = u n w i n d ( ts , t ’ : / \ : t ) u n w i n d (( C N o t _ ) : ts , t ’) = u n w i n d ( ts , Not t ’) u n w i n d (( C L a m b d a n _ ): ts , t ) = u n w i n d ( ts , L a m b d a n t ) u n w i n d (( C R e s e t f _ ) : ts , t ) = u n w i n d ( ts , R e s e t f t )
Going back to our example,unwind exampleZipperwould return the ex-pressionexampleTerm we started with. Later we will use a function unwind1 that unwinds not the whole thread but only its head (i.e. is not recursive).
u n w i n d 1 :: Z i p p e r - > Z i p p e r u n w i n d 1 z@ ([] , t ) = z
u n w i n d 1 (( C A p p R t _ ) : ts , t ’) = ( ts , t : @ : t ’) u n w i n d 1 (( C A p p L _ t ) : ts , t ’) = ( ts , t ’ : @ : t ) u n w i n d 1 (( C A n d R t _ ) : ts , t ’) = ( ts , t : / \ : t ’) u n w i n d 1 (( C A n d L _ t ) : ts , t ’) = ( ts , t ’ : / \ : t ) u n w i n d 1 (( C N o t _ ) : ts , t ’) = ( ts , Not t ’) u n w i n d 1 (( C L a m b d a n _ ): ts , t ) = ( ts , L a m b d a n t ) u n w i n d 1 (( C R e s e t f _ ) : ts , t ) = ( ts , R e s e t f t )
Now we intersperse the evaluation functioneval’from above with a zipper.
This means that the type ofevalis notTerm -> TermbutZipper -> [Zipper].
(Returning not a single zipper but a list of zippers is again a way to implement non-determinism.) Every time we move to a subexpression, we store its context and every time we move up again, we unwind this context.
e v a l :: Z i p p e r - > [ Z i p p e r ]
Constants and variables evaluate to themselves, so eval simply returns the zipper it got as input.
e v a l z@ ( _ , C o n s t _ ) = [ z ] e v a l z@ ( _ , Var _ ) = [ z ]
For lambda expressions, we evaluate the body. The only difference to the corresponding clause of eval’ above is that here we do not eta-reduce the result. We will perform eta-reduction later on the whole expression. This
154 Implementation 6 is because otherwise we would reduce (∃ λx.(P x)) to (∃ P), for example.
Interspersing the clause with the zipper (i.e. stacking the context and later unwinding it) yields the following.
e v a l ( thread , L a m b d a n t ) = map u n w i n d 1 $
e v a l (( C L a m b d a n H o l e ): thread , t ) The reduction of applications are handled by distinguishing three cases, like with eval’. The first one is the case of an expression (λx.t1 t2). This is reduced by substitutingxin t1 byt2.
e v a l ( th ,( L a m b d a n t1 ): @ : t2 ) = e v a l ( th , s u b s t i t u t e t1 n t2 ) The second case is that of stacked applications. Since we do not want to fix a certain evaluation order, the expression is evaluated twice: once from left to right and once from right to left. For pure expressions, this will always yield the same result, but for impure expressions both directions may differ (e.g.
may result in different scopings). The way the reduction itself works is parallel to the clause ineval’.
e v a l ( thread , t1@ ( _ : @ : _ ) : @ : t2 ) = ( c o n c a t $ map ( e v a l L . u n w i n d 1 ) $
e v a l (( C A p p R t1 H o l e ): thread , t2 )) ++
( c o n c a t $ map ( e v a l R . u n w i n d 1 ) $
e v a l (( C A p p L H o l e t2 ): thread , t1 )) w h e r e
e v a l L ( th , y ) = c a s e y of
( a : @ : b ) - > map u n w i n d 1 $
e v a l (( C A p p L H o l e b ): th , a ) t - > e v a l ( th , t )
e v a l R ( th , y ) = c a s e y of
( a@ ( L a m b d a _ _ ): @ : b ) - > e v a l ( th , a : @ : b ) ( a : @ : b ) - > map u n w i n d 1 $
e v a l (( C A p p R a H o l e ): th , b ) t - > e v a l ( th , t )
The third case comprises all remaining possibilities.
e v a l ( thread , t@ ( t1 : @ : t2 )) = map u n w i n d 1 $
e v a l (( C A p p R t1 H o l e ): thread , t2 ) The reduction of a negated term is straightforward.
e v a l ( thread , Not t ) = map u n w i n d 1 $
e v a l (( C N o t H o l e ): thread , t )
With conjunctions, free evaluation order can be emulated like in the case of applications, namely by executing both left-to-right and right-to-left order and collecting the results in a list.
6.4 Operator scope 155
e v a l ( thread , t1 : / \ : t2 ) = ( c o n c a t $ map ( e v a l R . u n w i n d 1 ) $ e v a l (( C A n d L H o l e t2 ): thread , t1 )) ++
( c o n c a t $ map ( e v a l L . u n w i n d 1 ) $ e v a l (( C A n d R t1 H o l e ): thread , t2 )) w h e r e
e v a l L ( th , y ) = c a s e y of
( a : / \ : b ) - > map u n w i n d 1 $
e v a l (( C A n d L H o l e b ): th , a ) t - > e v a l ( th , t )
e v a l R ( th , y ) = c a s e y of
( a : / \ : b ) - > map u n w i n d 1 $
e v a l (( C A n d R a H o l e ): th , b ) t - > e v a l ( th , t )
Our fragment will not make use of this. If we are sure that no control effects occur in either conjunct, a simpler evaluation clause could be given:
eval (th,t1 :/\: t2) = [ (th,x :/\: y) | (_,x) <- eval (th,t1), (_,y) <- eval (th,t2) ]
Now let us turn to the control operators. The reduction of a term enclosed by a reset depends on whether the term is pure or not, i.e. whether it contains shift operators of the same mode or not. (The testpurewill be defined below.) If it is pure, we simply drop the reset and evaluate the term. If it is impure, on the other hand, we keep the reset by storing it in the context and unwinding it after reducing the term.
e v a l ( thread , R e s e t f t )
| p u r e f t = e v a l ( thread , t )
| o t h e r w i s e = c o n c a t $ map ( e v a l . u n w i n d 1 ) $ e v a l (( C R e s e t f H o l e ): thread , t ) Finally, we implement the shift reduction rule as follows.
e v a l z@ ( thread , S h i f t m f n t )
| n o R e s e t s f t h r e a d = [ z ]
| o t h e r w i s e = map u n w i n d 1 $ c o n c a t
[ e v a l ( th2 , s u b s t i t u t e t n ( r e i f y f th1 )) | ( th1 , th2 ) < - f i l t e r ( a d m i s s i b l e m f ) $
s p l i t t f [] t h r e a d ] e v a l z@ ( _ , _ ) = [ z ]
The expressionsubstitute t n (reify f th1)corresponds to the body of the shifted expression where the variable bound by the operator shift (n) is replaced by the reified context. The context is every possible context th1up to an enclosing reset that matches in flavor. These contexts are determined by a function splitt that splits the thread in position of a matching reset, and
156 Implementation 6 then filtered with admissible, depending on the mode of the shift. For weak and strong shifts, only the context up to the nearest enclosing reset is allowed (for weak shifts moreover only contexts not containing other shifts), while for free shifts, all contexts are possible.
s p l i t t :: F l a v o r - > T h r e a d - > T h r e a d - > [( Thread , T h r e a d )]
s p l i t t _ _ [] = []
s p l i t t f t h r e a d ( c@ ( C R e s e t f ’ _ ): cs )
| f == f ’ = ( thread ,( c : cs )) : ( s p l i t t f ( t h r e a d ++[ c ]) cs )
| o t h e r w i s e = s p l i t t f ( t h r e a d ++[ c ]) cs
s p l i t t f t h r e a d ( c : cs ) = s p l i t t f ( t h r e a d ++[ c ]) cs a d m i s s i b l e :: M o d e - > F l a v o r - > ( Thread , T h r e a d ) - > B o o l a d m i s s i b l e W ea k f (( c : cs ) , _ ) = n o R e s e t s f cs
&& p u r e T h r e a d f cs a d m i s s i b l e S t r o n g f (( c : cs ) , _ ) = n o R e s e t s f cs
a d m i s s i b l e _ _ _ = T r u e
The functionadmissibleuses the auxiliary functionsnoResets, which re-turns true if a thread does not contain resets of a certain flavor, andpureThread, which checks whether a thread contains shifts of a certain flavor. This serves the purpose of determining whether the evaluation is skipping over a shift ex-pression that should actually be evaluated first. (For convenience,pureThread only checks arguments of applications, because these are the relevant cases for us. However, it is easy to extend the function to all other cases, if needed.) The latter uses another auxiliary function pure, which checks whether a term is pure with respect to a particular flavor.
n o R e s e t s :: F l a v o r - > T h r e a d - > B o o l
n o R e s e t s f t h r e a d = n u l l $ f i l t e r (== C R e s e t f H o l e ) t h r e a d p u r e T h r e a d :: F l a v o r - > T h r e a d - > B o o l
p u r e T h r e a d f [] = T r u e
p u r e T h r e a d f (( C A p p L c t ): cs ) = p u r e f t
&& p u r e T h r e a d f cs p u r e T h r e a d f (( C R e s e t _ c ): cs ) = p u r e T h r e a d f [ c ]
&& p u r e T h r e a d f cs p u r e T h r e a d f ( _ : cs ) = p u r e T h r e a d f cs p u r e :: F l a v o r - > T e r m - > B o o l
p u r e f ( L a m b d a _ t ) = p u r e f t
p u r e f ( t1 : @ : t2 ) = p u r e f t1 && p u r e f t2
p u r e f ( Not t ) = p u r e f t
p u r e f ( t1 : / \ : t2 ) = p u r e f t1 && p u r e f t2 p u r e f ( R e s e t _ t ) = p u r e f t
p u r e f ( S h i f t _ f ’ _ _ ) = f /= f ’
p u r e _ _ = T r u e
Reifying the context as a function is taken care of by the functionreify, defined as follows. The auxiliary functionsvariablesCandvariablestraverse
6.4 Operator scope 157 context lists and terms, respectively, in order to collect all occuring variables, from which the maximum is chosen (or zero if the list of occuring variables is empty) and added by 1. The resulting integer is a fresh variable fresh that can be used for reifying the context without risking variable clashes.
r e i f y :: F l a v o r - > T h r e a d - > T e r m r e i f y f t h r e a d = L a m b d a f r e s h
( R e s e t f ( u n w i n d ( thread , Var f r e s h ))) w h e r e f r e s h = ( m a x L i s t $ c o n c a t $ map v a r s C t h r e a d ) + 1 v a r s C :: C o n t e x t - > [ Int ]
v a r s C H o l e = []
v a r s C ( C A p p L _ t ) = v a r i a b l e s t v a r s C ( C A p p R t _ ) = v a r i a b l e s t v a r s C ( C A n d L _ t ) = v a r i a b l e s t v a r s C ( C A n d R t _ ) = v a r i a b l e s t v a r s C ( C L a m b d a n _ ) = [ n ]
v a r s C ( C N o t _ ) = []
v a r s C ( C R e s e t _ _ ) = []
v a r i a b l e s :: T e r m -> [ Int ] v a r i a b l e s ( Var n ) = [ n ]
v a r i a b l e s ( Not t ) = v a r i a b l e s t
v a r i a b l e s ( t1 : / \: t2 ) = v a r i a b l e s t1 ++ v a r i a b l e s t2 v a r i a b l e s ( t1 : @ : t2 ) = v a r i a b l e s t1 ++ v a r i a b l e s t2 v a r i a b l e s ( L a m b d a n b o d y ) = n : ( v a r i a b l e s b o d y )
v a r i a b l e s ( S h i f t _ _ n t ) = n : ( v a r i a b l e s t ) v a r i a b l e s ( R e s e t _ t ) = v a r i a b l e s t
v a r i a b l e s _ = []
m a x L i s t :: [ Int ] - > Int m a x L i s t [] = 0
m a x L i s t xs = m a x i m u m xs
Now we also define a top-level functionevaluateof typeTerm -> [Term], that evaluates the input expression by initiating eval with an empty thread, picking the resulting expression (the thread is empty after application ofeval because every time a context is appended to the thread, it is unwound after-wards), performing eta-reduction and removing duplicates.
e v a l u a t e :: T e r m - > [ T e r m ]
e v a l u a t e t = map eta $ nub $ map snd $ e v a l ([] , t ) eta :: T e r m - > T e r m
eta t@ (( Op _ ) : @ : L a m b d a _ _ ) = t eta t@ ( L a m b d a n ( t ’ : @ : ( Var n ’ ) ) )
| n == n ’ && n o t F r e e n t ’ = t ’
| o t h e r w i s e = t
eta ( t1 : @ : t2 ) = ( eta t1 ) : @ : ( eta t2 )
158 Implementation 6
eta ( t1 : / \ : t2 ) = ( eta t1 ) : / \ : ( eta t2 )
eta ( Not t ) = Not ( eta t )
eta ( R e s e t f t ) = R e s e t f ( eta t )
eta ( S h i f t m f n t ) = S h i f t m f n ( eta t )
eta t = t
The only thing that is still missing is an implementation of capture-avoiding substitution. The function substitute that achieves this is as one would expect. Here, substitute t1 n t2 means that the variable nis substituted in t1fort2.
s u b s t i t u t e :: T e r m - > Int - > T e r m - > T e r m
Constants are not substituted, and a variable is substituted if it is the input variable.
s u b s t i t u t e c@ ( C o n s t _ ) _ _ = c s u b s t i t u t e v@ ( Var n1 ) n2 t | n1 == n2 = t
| o t h e r w i s e = v
For negated terms, conjunctions, and applications, the substitution is simply passed to the subexpressions.
s u b s t i t u t e ( Not t ’) n t = Not $ s u b s t i t u t e t ’ n t s u b s t i t u t e ( t1 : / \ : t2 ) n t = ( s u b s t i t u t e t1 n t )
: / \ : ( s u b s t i t u t e t2 n t ) s u b s t i t u t e ( t1 : @ : t2 ) n t = ( s u b s t i t u t e t1 n t ) : @ : ( s u b s t i t u t e t2 n t )
In principle the same happens with lambda expressions, but it needs to be ensured that variables in the expression we are substituting do note accidentally get bound by the lambda. If this happens (which is the second case below), the variable is renamed in the lambda expression.
s u b s t i t u t e ( L a m b d a n ’ b o d y ) n t
| n ’ == n = L a m b d a n ’ b o d y
| n ’ ‘ elem ‘ ( v a r i a b l e s t ) = let
f r e s h = ( m a x i m u m ( n ’:( v a r i a b l e s b o d y ))) + 1 body ’ = s u b s t i t u t e b o d y n ’ ( Var f r e s h ) in
s u b s t i t u t e ( L a m b d a f r e s h body ’) n t
| o t h e r w i s e = L a m b d a n ’ ( s u b s t i t u t e b o d y n t )
And pretty much the same is done for expressions with a shift operator: A substitution in an expression enclosed by a reset is simply passed on, and operators can be ignored althogether because they do not contain variables.