Lambda Calculus in OBJ3


The following OBJ code specifies the lambda calculus in several stages; the code is executable, and a number of examples are given. I only spent a little more than one evening on this, so there may be some bugs in it; please let me know if you find any.
obj LIST[X :: TRIV] is sort List .
  subsort Elt < List .
  op nil : -> List .
  op __ : List List -> List [assoc id: nil].
  op _in_ : Elt List -> Bool .
  vars E E' : Elt .  var L : List .
  eq E in nil = false .
  eq E in E' = E == E' .
  eq E in (E' L) = E == E' or E in L .
endo  

obj VAR is sorts Lxp Var .
  subsort Var < Lxp .
  ops a b c d e f g u v w x y z : -> Var .
  ops ERROR : -> Lxp .
  ops ERROR NOT-VAR-ERROR FREE-ERROR : Var -> Lxp .
  pr LIST[Lxp].
  op var_ : Lxp -> Bool .
  var M : Lxp .
  eq var(M) = M in (a b c d e f g u v w x y z).
endo

red var u .
red var ERROR .

obj LAMBDA is pr VAR .
  op .\_._ : Var Lxp -> Lxp [prec 2].
  op [__] : Lxp Lxp -> Lxp .
      *** could have been __, but [__] makes it easier to read expressions
  vars X Y Z : Var .  vars L M N : Lxp .   

  op _free in_  : Var Lxp -> Bool .
  eq X free in Y = X == Y .
  eq X free in (.\ X . M) = false .
  cq X free in (.\ Y . M) = X free in M  if X =/= Y .
  eq X free in [M N]      = X free in M or X free in N .

  op sub_for_in_ : Lxp Var Lxp -> Lxp .
  eq sub L for Y in Y = L .
  cq sub L for Y in Z = Z  if Y =/= Z .
  cq sub L for Y in (.\ Y . M) = (.\ L .(sub L for Y in M)) if var L .
  cq sub L for Y in (.\ Y . M) = NOT-VAR-ERROR(L)  if not var L .
  cq sub L for Y in (.\ Z . M) = (.\ Z .(sub L for Y in M)) if Y =/= Z .
  eq sub L for Y in [M N]      = [(sub L for Y in M) (sub L for Y in N)] .
endo

red x free in x .
red x free in y .
red x free in (.\ x . .\ y . x).
red x free in (.\ y . .\ x . x).
red x free in (.\ y . .\ z . x).
red x free in [(.\ y . .\ z . z) x].
red x free in [(.\ y . .\ z . y) x].
red x free in [(.\ x . .\ z . x) (.\ x . x)].
red x free in [(.\ x . .\ z . x) (.\ y . x)].
red x free in [(.\ y . [(.\ x . x) y]) (.\ y . x)].

red sub x for y in x .
red sub x for y in y .
red sub x for y in z .
red sub x for y in (.\ x . .\ y . x).
red sub x for y in (.\ z . .\ w . x).
red sub x for y in (.\ z . .\ w . y).
red sub x for y in (.\ z . .\ w . [y z]).
red sub x for y in (.\ z . .\ y . [y z]).

obj ALPHA is pr LAMBDA .
  op alpha_for_in_ : Var Var Lxp -> Lxp .
  vars-of .
  cq alpha Y for X in(.\ X . M) = .\ Y .(sub Y for X in M) if not Y free in M .
  cq alpha Y for X in(.\ Z . M) = FREE-ERROR(Y) if Y free in M or X =/= Z .
  eq alpha Y for X in Z = ERROR(Y) .
  eq alpha Y for X in [M N] = ERROR .
endo

***> test alpha reduction:
red alpha y for x in x .                 *** should be ERROR
red alpha y for x in (.\ x . x ).
red alpha y for x in (.\ x . .\ y . x).  *** maybe should be ERROR (but isnt)
red alpha y for x in (.\ x . .\ z . x).
red alpha y for x in (.\ y . .\ x . y).  *** should be ERROR
red alpha y for x in (.\ y . .\ x . x).  *** should be ERROR
red alpha y for x in (.\ y . .\ x . z).  *** should be ERROR
red alpha y for x in [(.\ x . x) c].     *** should be ERROR

obj BETA is pr ALPHA .
  vars-of .
  cq [(.\ X . M) N] = sub N for X in M if not X free in N .
  cq [(.\ X . X) N] = FREE-ERROR(X) if X free in N .
endo

***> test beta reduction:
red [(.\ x . x) c].
red [(.\ x . y) c].
red [(.\ y .(.\ z .[z y])) c].
red [[(.\ y .(.\ z .[z y])) c] (.\ x . x)] .
red [[(.\ x .(.\ y .[x y])) (.\ z . x)] c].
red [[(.\ x .(.\ y . x)) c] [(.\ z . [f z]) b]].
red [[(.\ x .(.\ y .[x y])) (.\ z . z)] c].
red [(.\ y .(.\ z .[z y])) (.\ z . [z z])].
red [(.\ y .(.\ z .[z y])) (.\ z . [y z])].
red [[(.\ x .(.\ y .(.\ x .[x [x y]]))) (.\ z . [[f x] z])] [g x]].
red [[(.\ x .(.\ y .[x y])) (.\ z . y)] c].

openr .
let I  = (.\ x . x).
let K  = (.\ u .(.\ v . u)).
let S  = (.\ x .(.\ y .(.\ z . [[x z][y z]]))).
let XX = (.\ x .[x x]).
close

red [K z].
red [[[S K] K] w] == [I w].
red [[[S K] K] w].
red [[S K] K] == I .
red [[S K] K] .
***> red [XX XX].  *** fails to terminate!
***> yields "Error: Value stack overflow."

obj BETA-ETA is pr BETA .
  vars-of .
  cq [(.\ X . M) X] = M if not X free in M .
endo

red [K z].
red [[[S K] K] w] == [I w].
red [[[S K] K] w].
red [[S K] K] == I .
red [[S K] K] .
***> red [XX XX].  *** fails to terminate!

obj ARITH is pr BETA .
  vars-of .
  let T = (.\ x . .\ y . x).
  let F = (.\ x . .\ y . y).
  op IF[_,_,_] : Lxp Lxp Lxp -> Lxp .
  op Pair[_,_] : Lxp Lxp -> Lxp .
  ops (First[_]) (Rest[_]) : Lxp -> Lxp .
  op Zero : -> Lxp .
  ops (Succ[_]) (IsZero[_]) (Pred[_]) : Lxp -> Lxp .

  eq IF[L,M,N] = [[L M] N].
  eq Pair[L,M] = (.\ u . IF[u,L,M]). *** wont work with x instead of u
  eq First[M]  = [M T].
  eq Rest[M]   = [M F].
  eq Zero      = (.\ v . v).
  eq Succ[M]   = Pair[F,M].
  eq IsZero[M] = First[M].
  eq Pred[M]   = Rest[M].
endo

red IF[T,a,b].
red IF[F,a,b].
red First[Pair[a,b]].
red Rest[Pair[a,b]].
red IsZero[Zero] == T .
red IsZero[Zero].
red IsZero[Succ[Zero]] == T .
red IsZero[Succ[Zero]].  ***> this needs an alpha reduction
red Pred[Succ[Zero]] == Zero .
red Pred[Succ[Zero]].

Click here to see the OBJ3 output from this example.
Back to CSE 230 homepage
Maintained by Joseph Goguen
Last modified March 1999