hw7/ 40755 256 60 0 6501655572 6401 5 ustar fp hw7/type.sig 100664 256 60 1267 6501650307 10162 0 ustar fp signature TYPE =
sig
type var = int
datatype tp = (* A ::= *)
Var of int (* 'n, n >= 1 *)
| Tensor of tp * tp (* A1 # A2 *)
| One (* 1 *)
| Lolli of tp * tp (* A1 -o A2 *)
| With of tp * tp (* A1 & A2 *)
| Top (* T *)
| Plus of tp * tp (* A1 + A2 *)
| Zero (* 0 *)
| Arrow of tp * tp (* A1 -> A2 *)
| Bang of tp (* !A *)
| Mu of tp (* mu 'a. A *)
(* eq(A,A') = true iff A = A' *)
val eq : tp * tp -> bool
(* subst(A,B) = [A/'a]B, where 'a represents the free de Bruijn *)
(* index '1. A must be closed and B must have exactly one free variable *)
val subst : tp * tp -> tp
end; (* signature TYPE *)
hw7/type.fun 100664 256 60 3221 6501652515 10163 0 ustar fp structure Type :> TYPE =
struct
type var = int
datatype tp = (* A ::= *)
Var of var (* 'n, n >= 1 *)
| Tensor of tp * tp (* A1 # A2 *)
| One (* 1 *)
| Lolli of tp * tp (* A1 -o A2 *)
| With of tp * tp (* A1 & A2 *)
| Top (* T *)
| Plus of tp * tp (* A1 + A2 *)
| Zero (* 0 *)
| Arrow of tp * tp (* A1 -> A2 *)
| Bang of tp (* !A *)
| Mu of tp (* mu 'a. A *)
(* val eq : tp * tp -> bool *)
fun eq (Var (j), Var (k)) = (j = k)
| eq (Tensor (A1, A2), Tensor (B1, B2)) = eq (A1, B1) andalso eq (A2, B2)
| eq (One, One) = true
| eq (Lolli (A1, A2), Lolli (B1, B2)) = eq (A1, B1) andalso eq (A2, B2)
| eq (With (A1, A2), With (B1, B2)) = eq (A1, B1) andalso eq (A2, B2)
| eq (Top, Top) = true
| eq (Plus (A1, A2), Plus (B1, B2)) = eq (A1, B1) andalso eq (A2, B2)
| eq (Zero, Zero) = true
| eq (Arrow (A1, A2), Arrow (B1, B2)) = eq (A1, B1) andalso eq (A2, B2)
| eq (Bang (A1), Bang (B1)) = eq (A1, B1)
| eq (Mu (A1), Mu (B1)) = eq (A1, B1)
| eq (_, _) = false
fun subst (A, B) =
let
fun sb (i, B as Var(j)) = if i = j then A else B
| sb (i, Tensor (B1,B2)) = Tensor (sb (i, B1), sb (i, B2))
| sb (i, One) = One
| sb (i, Lolli (B1, B2)) = Lolli (sb (i, B1), sb (i, B2))
| sb (i, With (B1, B2)) = With (sb (i, B1), sb (i, B2))
| sb (i, Top) = Top
| sb (i, Plus (B1, B2)) = Plus (sb (i, B1), sb (i, B2))
| sb (i, Zero) = Zero
| sb (i, Arrow (B1, B2)) = Arrow (sb (i, B1), sb (i, B2))
| sb (i, Bang (B1)) = Bang (sb (i, B1))
| sb (i, Mu (B1)) = Mu (sb (i+1, B1))
in
sb (1, B)
end
end; (* structure Type *)
hw7/check.sig 100664 256 60 360 6501651305 10226 0 ustar fp signature CHECK =
sig
structure Type : TYPE
structure LTerm : LTERM
sharing LTerm.Type = Type
exception Error of string
val check : LTerm.term * Type.tp -> unit
val infer : LTerm.term -> Type.tp
end; (* signature CHECK *)
hw7/eval.sig 100664 256 60 551 6501651141 10100 0 ustar fp signature EVAL =
sig
structure LTerm : LTERM
type value (* abstract *)
(* eval M = V iff M ==> v *)
(* May assume that M has passed the type checker, so there *)
(* should be no explicit raising and handling of errors *)
val eval : LTerm.term -> value
val print : value -> unit (* prints observable values *)
end; (* signature EVAL *)
hw7/sources.cm 100644 256 60 172 6501557062 10455 0 ustar fp Group is
ctx.sig
type.sig
lterm.sig
check.sig
eval.sig
ctx.fun
type.fun
lterm.fun
check.fun
eval.fun
hw7/ctx.fun 100644 256 60 553 6501557153 7765 0 ustar fp (* Polymorphic Contexts *)
functor Ctx () :> CTX =
struct
datatype 'a ctx =
Null
| $ of 'a ctx * 'a
infix $
fun nth (G $ A, 1) = A
| nth (G $ A, n) = nth (G, n-1)
| nth (Null, n) = raise Subscript
fun member (x, G) =
let fun mbr (Null) = false
| mbr (G $ y) = (x = y) orelse mbr G
in mbr G end
end; (* functor Ctx *)
hw7/eval.fun 100664 256 60 1044 6501652651 10133 0 ustar fp functor Eval (structure LTerm' : LTERM)
:> EVAL where type LTerm.term = LTerm'.term =
struct
structure LTerm = LTerm'
exception Error of string
(* values could be terms, or more complex including closures *)
type value = LTerm.term
(* eval M = V iff M ==> v *)
(* May assume that M has passed the type checker, so there *)
(* should be no explicit raising and handling of errors *)
fun eval M = raise Error ("Not yet implemented.")
fun print V = raise Error ("Not yet implemented.")
end; (* structure Eval *)
hw7/ctx.sig 100644 256 60 442 6501557134 7753 0 ustar fp (* Polymorphic Contexts *)
signature CTX =
sig
datatype 'a ctx =
Null
| $ of 'a ctx * 'a
(* infix $ *)
(* nth (Null $ xk $ ... $ x1, n) = xn *)
(* raises Subscript if n > k *)
val nth : 'a ctx * int -> 'a
val member : ''a * ''a ctx -> bool
end; (* signature CTX *)
hw7/lterm.sig 100664 256 60 2357 6501650522 10324 0 ustar fp (* Lambda Terms *)
signature LTERM =
sig
structure Type : TYPE
datatype term =
Var of int (* w or u, as de Bruijn index 'n, n >= 1 *)
| Tensor of term * term (* M1 # M2 *)
| LetTensor of term * term (* let u1 # u2 = M in N *)
| Star (* * *)
| LetStar of term * term (* let * = M in N *)
| LLam of term (* llam w. M *)
| LApp of term * term (* M ^ N *)
| Pair of term * term (*
15-816 Linear Logic
In this homework we implement the core of a linear functional programming language. This implementation may later be used to check derivations produced by our automated theorem prover. You are encouraged to collaborate in groups up to 3 students and hand in one joint implementation.
Type Representation in ML mu a. 1 + a Mu (Plus (One, Var 1)) mu a.mu b.1 + a * b Mu (Mu (Plus (One, Tensor (Var 2, Var 1))))
This representation requires that substitution keeps track of variables, which is quite tricky in general. Fortunately, we only need to substitute closed types for type variables (and later closed terms for term variables), which is much easier than the general case. Still, we need to count how many abstractions we have traversed in order to make sure we are substituting for the right variable. The substitution function for types is provided as an example.
lam u. let w1 # w2 = u in w2 # w1 # uwould be represented as
ULam (LetTensor (Var 1, Tensor (Var 1, Tensor (Var 2, Var 3))))
An additional simplification in the representation is afforded by the omission of types in most places (see type checking below), and the addition of a new construct, let name u : A = M in N. Here are the typing and evaluation rules.
G ; . |- M : A (G,u:A) ; D |- N : C -------------------------------------- G ; D |- let name u : A = M in N : C [M/u] N ==> v --------------------------------- let name u : A = M in N ==> v
It is remarkable that this simple strategy allows us to type check any normal form with minimal type annotations: we only need the types of the variables in the environment, but no labels on abstractions or injections, for example. For terms which are not in normal form, we introduce explicit definitions and label the name of the defined variable. This is the purpose of the let name construct. It is also possible to define a corresponding linear definition construct. The fixpoint construct in this context is viewed as an introduction construct, which means its type label may be omitted as well, while let name u:A = M in N is considered atomic if N is atomic and M in normal.
In the signature top level, we have specifications
exception Error of string val check : Lambda.term * Type.tp -> unit val infer : Lambda.term -> Type.tp
which check a normal term against a type or infer the type of an atomic term, starting from the empty context. Errors during type checking are signalled by raising the Error exception. The kinds of errors which may arise are:
Your function print should only print legal values and then only whatever should be observable. For example, values of functional type or additive pairs should only be shown as an underscore or in the form lam _ and <_,_>, respectively.