Playing With Type Systems:: Automated Assistance in The Design of Programming Languages
Playing With Type Systems:: Automated Assistance in The Design of Programming Languages
Tim Sheard
Portland State University
[email protected]
Abstract guage Ωmega. This paper reports on our experience using the lan-
We introduce the programming language Ωmega, and illustrate how guage Ωmega[29, 30, 31, 32] as just such a meta-language. In this
it can be used as a general purpose meta-language. Ωmega has a paper we show that:
sophisticated type system built on top of Generalized Algebraic • Much of the work of exploring the nuances of a type system
Datatypes and an extensible kind system. It allows users to en- for a new language can be assisted by using mechanized tools –
code object-level types in the meta-level data structures that rep- a generic meta-language. We call this exploration playing with
resent object-level terms. We show Ωmega can be used to explore type systems.
language designs interactively, by constructing both static and dy-
• Such tools need not be much more complicated than your fa-
namic semantics as Ωmega programs. These programs can be seen
as partially checked proofs of soundness of the system under ex- vorite functional language (Haskell), and are thus within the
ploration. As a large example we present a new type system for reach most language researchers. After all playing should be
MetaML, that is simpler than previous type systems. child’s work.
• The automation helps language designers visualize the conse-
quences of their design choices quickly, and thus helps speed
1. Introduction. the design process.
It has become common practice when designing a new language • The artifacts created by this exploration, while not quite proofs
to create both a static semantics (type system) and a dynamic se- in the full sense, are checked by machine, and are hence less
mantics and to prove the soundness of the type system with respect subject to error than pencil and paper proofs constructed by
to the dynamic semantics. This process is often exploratory. The hand.
designer has an idea, the approach is analyzed, and hopefully the
consequences of the approach are quickly discovered. Automated In addition to the broad goals about meta-language design, the
aid in this process would be a great boon. author has also devoted much energy to searching for a simple
The ultimate goal of this exploratory process is a type system, a elegant type system for a multi-stage language such as MetaML.
semantics, and a proof. The proof witnesses the fact that well-typed Such a system should not throw away too many good programs[18,
programs do not go wrong [17] for the language under considera- 40, 36] (thus losing much of its usefulness) or be overly complex[3,
tion. Approaches include a subject reduction proof in the style of 37, 35]. After many attempts, the search has been fruitful. Thus,
Wright and Felleisen[43] on a small step semantics, or by using this paper has two purposes. First, it demonstrates the efficacy of
denotational approaches. In either case, proofs require an amazing the language Ωmega as a first step towards the design of a general
amount of detail and are most often carried out by hand, and are purpose meta-language. Second, it illustrates that a simple elegant
thus subject to all the foils of human endeavors. It has long been type system for a multi-stage language is possible. The approach
a personal goal of the author to develop a generic meta-language is so general, that we believe it can be applied to any multistage
that could be used for exploring the static and dynamic seman- language, and as such is of wide spread interest to the program
tics for new object-languages[21, 28] that could aid in the gen- generation community.
eration of such proofs. Many others have had similar desires and The paper is divided into three parts. First, in Section 2 we in-
the development of systems like Twelf[23] and Coq[41] attest to troduce the language Ωmega. Second, in Section 3 we discuss the
the broad appeal of these ideas. But, while the author owes much multi-staged language MetaML, and explain why it is so hard to de-
to these systems for inspiration, he has always desired a system velop a sound type system for a staged language. In this section we
whose use was closer in style to the use of a programming lan- provide several small programs that illustrate the multiple causes
guage than existing systems. Hence the development of the lan- of soundness errors in a staged language. Third, in Section 4 we
play with type systems. In this section we introduce our static and
dynamic semantics for a multi-stage language as an Ωmega pro-
gram. We demonstrate that the ability to explore issues is greatly
enhanced by the machine assistance supplied by Ωmega, and that
Permission to make digital or hard copies of all or part of this work for personal or the artifacts produced consist of machine checked proofs.
classroom use is granted without fee provided that copies are not made or distributed
for profit or commercial advantage and that copies bear this notice and the full citation
on the first page. To copy otherwise, to republish, to post on servers or to redistribute 2. The Ωmega meta-programming language.
to lists, requires prior specific permission and/or a fee.
Haskell makes a fair meta-language. Its support for abstraction
Copyright
c ACM [to be supplied]. . . $5.00. and first class functions make it an excellent tool for defining
object-language programs as Haskell data, and for defining meta-
language manipulations as Haskell functions. Unfortunately, its fact the type constructor Tree can be applied to any type what-
type system is too weak to be a true generic meta-programming sys- soever. Note how the constructor functions (Fork, Node) and con-
tem. In particular Haskell lacks the facilities to define and enforce stants (Tip) are given polymorphic types.
type-systems for object-language programs represented as meta-
language data. To overcome this deficiency we have defined the Fork :: forall a . Tree a -> Tree a -> Tree a
language Ωmega. Node :: forall a . a -> Tree a
Tip :: forall a . Tree a
• Ωmega is based on Haskell so that it is easy for Haskell
programmers to learn. When we define a parameterized algebraic datatype, the syntac-
tic formation rules of the data declaration enforce the following
• We started by adding some features and removing others. To
restriction: The range of every constructor function, and the type of
make our first attempt simple we have removed the class system every constructor constant must be a polymorphic instance of the
of Haskell, and made Ωmega strict but pure. We have tried hard new type constructor being defined. Notice how the constructors
to keep all the other features of Haskell not affected by these for Tree all have range (Tree a) with a polymorphic type variable
choices intact. a. We can remove this restriction semantically by strengthening
• We added small (backward compatible) features that support the type system of the language. The restriction is syntactically re-
programs that use a form of refinement or dependent types. We moved by the following mechanism. In a data declaration, Rather
tried hard not to disturb the functional programming style – than supplying the type arguments to the type being defined, the
in particular the phase distinction between values and types. user supplys an explicit kind declaration; and rather than leaving
The features we added are Generalized Algebraic Datatypes the range of the constructor functions implicit, the user replaces the
(GADTs) and an extensible kind system. enumeration of the constructors and the type of their domains with
• We built a non-trivial implementation and have programmed up a full explicit typing of each constructor. The only restriction being
a wide array of examples from the literature. that the range must be some instance of the type being defined. For
example we could define the Tree type as follows using the new
2.1 Generalized Algebraic Datatypes syntax.
The key to this style of programming is the use of General- data Tree:: *0 ~> *0 where
ized Algebraic Datatypes (GADTs), a generalization of the nor- Fork:: Tree a -> Tree a -> Tree a
mal Algebraic Datatypes (ADT) available in functional program- Node:: a -> Tree a
ming languages such as Haskell, ML, and O’Caml. Implement- Tip:: Tree a
ing GADTs in a functional language requires only a small, back-
ward compatible, change to the ADT notion and is easily un- It is not necessary to use the new syntax, since Tree meets the
derstood by functional programmers. A language with GADTs restriction. As we will see below, there exist many useful types that
can support several closely related concepts such Refinement do not. Removing the restriction requires new type checking rules
Types[11, 46, 8], Guarded Recursive Datatype Constructors[44], that are beyond the scope of this paper, but which have been well
Inductive Families[7, 10], First-class phantom types[5], Silly Type studied[13, 44, 5].
Families[1], and Equality Qualified Types[29, 32]. There are
2.2 Representing Object-Programs with Types as Data
many examples of the usefulness of such concepts in the recent
literature[2, 4, 12, 20, 24, 26, 45]. This simple extension allows us to build datatypes representing
ADTs generalize other forms of structuring data such as enu- object-programs, whose meta-level types encode the object-level
merations, records, and tagged variants. For example, in Ωmega (and types of the programs represented. A very simple object-language
in Haskell) we write: example with types is:
Here the universal domain is not necessary, and the tagless inter-
preter has the structure of a denotational semantics. Because the The Nat declaration introduces the kind Nat and two new type
eval function is total and well-typed at the meta-level, it also im- constructors Z and S which encode the natural numbers at the type
plies that the object-level semantics (defined by eval) is also well- level. The type Z has kind Nat, and S has kind Nat ~> Nat. The
typed. As long as eval is total, every well-typed object level term type S is a type constructor, so it has a higher-order kind. We
evaluates to a well-formed value. indicate this using the classifies relation as follows:
While we worked hard to make this look like Haskell program-
ming, there are some key differences. First, the prototype declara- Z :: Nat
tion (eval :: Term a -> a) is required, not optional. Functions S :: Nat ~> Nat
which pattern match over GADTs can be type checked, but type Nat :: *1
inference is much harder (see [33] for work on how this might The classification Nat::*1 indicates that Nat is a kind classi-
be done). Functions that don’t pattern match over GADTs can fied by the sort *1. Both Nat and *0 are kinds at the same “level”
have Hindley-Milner types inferred for them (see [13] for how this — they are both classified by *1.
mixture of type-checking and type-inference is done). Requiring
prototypes for only some functions should be familiar to Haskell kind Row (x :: *1) = RNil | RCons x (Row x)
programmers because polymorphic-recursive functions already re-
quire prototypes[14]. Rows are list like structures at the type level, which are constructed
by the type constructors RNil and RCons. For example (RCons
2.3 Values, Types, Kinds, and Sorts Int (RCons Bool RNil)) and (RCons Z RNil). Such types
are kinded by Row. The kind Row is a higher order kind, and is
In Haskell, values are classified by types. In a similar fashion, types
classified by (*1 ~> *1). Thus Row must be applied to a kind to
can be classified by kinds, and kinds can be classified by sorts. We
be well formed (the argument indicates the kind of the types stored
indicate clasification as a relation using the infix symbol(::). We
in the row). For example if we classify the examples above we get:
say (::) is overloaded because the same notation can be used in all
three contexts: value::type, and type::kind, and kind::sort. (RCons Int (RCons Bool RNil)):: Row *0
Some concrete examples at the value level include: 5::Int, (RCons Z RNil):: Row Nat
and [True]::[Bool]. We say 5 is classified by Int. At the type
level: Int::*0 , Term:: *0 ~> *0. We say Int is classified Both *1 and (*1 ~> *1) are kinds classified by the sort *2.
by star-zero, and Tree is classified by star-zero to star-zero. *0, We illustrate the relationship between values, types, kinds, and
and *0 ~> *0 are kinds. At the kind level both: *0:: *1 and sorts by example in a table found in Figure 1. Note that the table has
(*O ~> *0):: *1. Here, *1 is a sort. empty slots. Not all types classify values. For example, there are no
The kind *0 is interesting because it classifies all types that values of type [] (list) or Z, but there are values of type [Int].
classify values (things we actually can compute). For example, The same holds at the kind level. Not all kinds classify types. For
Int:: *0, and [Int]:: *0, but not Tree:: *0, because there example, there are no types classified by Row, but RNil could be
are no values of type Tree (but there are values of type Tree Int). classified by (Row Int). Note the different kinds of arrows (→
New kinds are introduced by the kind declaration that also in- and ). The first is used to classify functions at the value level. The
troduces the type constructors that produce types classified by that second is used to classify type constructors. In Ωmega programs
kind, just as new types are introduced by the data declaration along we write -> for →, and ~> for .
with the value constructors that produce values classified by that
2.4 Singleton Types
type. The data and kind declarations introduce similar structures,
but at different levels in the type hierarchy. Two interesting kind It is sometimes useful to build representations of types at the value
declarations, of interest in this paper follow: level. Such representations are called singleton types if they are
encoded by a type constructor whose argument indicates the type
kind Nat = Z | S Nat being represented. For example consider:
data Nat’:: Nat ~> *0 where RecNil :: Rec RNil
Z:: Nat’ Z RecCons:: Label s -> t ->
S:: (Nat’ x) -> Nat’ (S x) Rec r ->
Rec (RCons (Has s t) r)
Values classified by the type (Nat’ a) are reflections of the types
classified by the kind Nat. The value constructors of the data dec- We can construct records by using the constructor functions
laration for Nat’ mirror the type constructors in the kind decla- RecNil and RecCons. Such values have types (Rec r) where r
ration of Nat, and the type index of Nat’ is equal to the type re- is classified by (Row HasType). For example, consider
flected. For example, the value S(S(S Z)) is classified by the type
Nat’(S(S(S Z))). We say that Nat’ is a singleton type because r1 :: Rec(RCons (Has ‘x Int)
there is only one element of any singleton type. For example, only (RCons (Has ‘a Bool) RNil))
S (S Z) inhabits the type Nat’ (S (S Z)). As discussed in Fig- r1 = RecCons ‘x 5 (RecCons ‘a True RecNil)
ure 1, we exploit the separate name spaces for value and types by
using the same names for the type constructors of kind Nat (S and r2:: Rec u -> Rec(RCons (Has ‘x Int)
Z) and the constructor functions of data type Nat’ (S and Z) to (RCons (Has ‘a Bool) u))
emphasize the close relationship between Nat and Nat’. r2 x = RecCons ‘x 5 (RecCons ‘a True x)
We will find natural numbers at the type level (and their Nat’
reflections at the value level) to be so useful we introduce some syn- It is interesting to note that we have managed to express a simple
tactic sugar for constructing such types (or values). For example, #0 form of Wand’s (or Remy’s) row-polymorphism[42, 27] in Ωmega
= Z, and #1 = (S Z), and #2 = (S (S Z)) etc. We also support just by using kinds. We have found Row and HasType so useful
the syntax #(n + x) = (S1 (S2 ... (Sn x))). This syntactic we have built special syntactic sugar for printing them. For exam-
sugar is analogous to the use of square brackets to describe lists in ple, Rec(RCons (Has ‘x Int) (RCons (Has ‘a Bool) RNil))
addition to the use of the constructor (:). prints as Rec {‘x:Int,‘a:Bool}. The syntactic sugar for Row
and HasType replaces RCons and RNil with squiggly brackets,
2.5 Tags and Labels and replaces Has with colon. A type classified by Row whose (ul-
timate) tail is not RNil (i.e. a type variable) prints with a trailing
Many object languages have a notion of name. To make represent- semi-colon. For example,
ing names in the type system easy we introduce the notion of Tags Rec(RCons (Has ‘x Int) (RCons (Has ‘a Bool) w)) prints
and Labels. As a first approximation, consider the finite kind Tag as Rec {‘x:Int,‘a:Bool; w}.
and its singleton type Label:
kind Tag = A | B | C 2.7 An Object Language with Binding.
Rows and records allow us to define object-languages with binding
data Label:: Tag ~> *0 where structures that track their free variables in their meta-level types.
A:: Label A The object-language (Lam env t) represents the simply typed
B:: Label B lambda calculus.
C:: Label C
data Lam:: Row HasType ~> *0 ~> *0 where
Here, we again deliberately use the value/type name space over- Var :: Label s -> Lam (RCons (Has s t) env) t
loading first discussed in Figure 1. The names A, B, and C are de- Shift :: Lam env t ->
fined in both the value and type name spaces. They name different, Lam (RCons (Has s q) env) t
but related objects in each space. At the value level every Label has Abstract :: Label a ->
a type index that reflects its value. I.e. A::Label A, and B::Label Lam (RCons (Has a s) env) t ->
B, and C::Label C. Now consider a countably infinite set of tags Lam env (s -> t)
and labels. We can’t define this explicitly, but we can build such a Apply :: Lam env (s -> t) ->
type as a primitive inside of Ωmega. At the type level, every legal Lam env s -> Lam env t
identifier whose name is preceded by a back-tick (‘) is a type clas-
sified by the kind Tag. For example, the type ‘abc is classified by The first index to Lam, env is a Row tracking its variables,
Tag. At the value level, every such symbol ‘x is classified by the and the second index, t tracks the object-level type of the term.
type (Label ‘x). For example, a term with variables x and y might have type
Lam {‘x:Int, ‘y:Bool; u} Int. This is made possible by the
2.6 Rows, Records, and HasType. use of Row and HasType in the GADT representing lambda terms.
The kind Row classifies list-like data structures at the type level. The key to this approach is the typing of the object-language
The kind HasType classifies pairs at the type level. constructor functions for variables and lambda expressions. Con-
sider the Var constructor function. To construct a variable we sim-
kind HasType = Has Tag *0 ply apply Var to a label, and its type reflects this. For example, here
It aggregates a Tag and any type classified by *0. For exam- is the output from a short interactive session with the Ωmega inter-
ple, (Has ‘a Int)::HasType. We can construct lists (at the type preter.
level) of such pairs using the type constructors of Row. For example, prompt> Var ‘name
(RCons (Has ‘a Int) (RCons (Has ‘b Bool) RNil)) (Var ‘name)::
::Row HasType forall a (u:Row HasType) . Lam {‘name:a; u} a
Note, (RCons (Has ‘a Int) (RCons (Has ‘b Bool) RNil)) prompt> Var ‘age
is a type, and that (Row HasType) is a kind. Such a type can be (Var ‘age)::
thought of as classifying records at the value level. We can define forall a (u:Row HasType) . Lam {‘age:a; u} a
such records within Ωmega as follows:
Variables behave like Bruijn indices. Variables created with
data Rec:: Row HasType ~> *0 where Var are like the natural number 0. A variable can be lifted to
the next natural number by the successor operator Shift. To 2.8 The bottom line.
understand why this is useful consider that the two examples The ability to define GADTs, and the ability to define new kinds,
have different names in the same index position. The two vari- creates a rich playground for those wishing to explore the design
ables would clash if they were both used in the same lambda of new languages. These features, along with the use of rank-N
term. To shift the position of variable to a different index, we use polymorphism (which we will illustrate by example later in the
the Shift:: Lam u a -> Lam {v:b; u} a constructor. Rather paper) make Ωmega a better meta-language than Haskell. In order
than counting with natural numbers (as is done with de Bruijn in- to explore the design of a new language one can proceed as follows:
dices) we “count” with rows, recording both its symbolic name and
its type. Here is how we could define two variables x and y for use • First, represent the object-language as a type indexed GADT.
in the same environment. The indexes correspond to static properties of the program.
• The indexes can have arbitrary structure, because they are in-
x :: Lam {‘x:a; u} a
x = Var ‘x troduced as the type constructors of new kinds.
• The typed constructor functions of the object-language GADT
y :: Lam {u:a,‘y:b; v} b define a static semantics for the object language.
y = (Shift (Var ‘y)) • Meta programs written in Ωmega, manipulate object-language
represented as data, and check and maintain the properties cap-
The type system now tracks the variables in an expressions. tured in the type indexes by using the meta-language type sys-
tem. This lets us build and test type systems interactively.
z :: Lam {‘x:a -> b,‘y:a; u} b
• A dynamic semantics for the language can be defined by (1)
z = (Apply (Var ‘x) (Shift (Var ‘y)))
writing either a denotational semantics in the form of an in-
Finally, and of great interest, we can build a well-typed evalua- terpreter or evaluation function, or by (2) writing a small step
tor for the GADT Lam. semantics in terms of substitution over the term language. In ei-
ther case, the type system of the meta-language guarantees that
evalLam :: Lam env t -> Rec env -> t these meta-level programs maintain object level type-safety.
evalLam (Var _) (RecCons _ y _) = y
evalLam (Shift x) (RecCons _ _ rs) = evalLam x rs
evalLam (Abstract l _ body) rs = 3. The MetaML language.
\ x -> evalLam body (RecCons l x rs) MetaML is a homogeneous, manually annotated, run-time code
evalLam (Apply f x) rs = generation system. In MetaML we use angle brackets (< >) as quo-
(evalLam f rs) (evalLam x rs) tations, and tilde (~ ) as the anti-quotation. We call the object-level
We declare that the type of our evaluation function is as follows: code inside a pair of angle brackets, along with its anti-quoted
(Lam env t -> Rec env -> t). We can interpret this to mean holes a template, because its stands for a computation that will
that every well typed Lam term with type t under an environment build an object-code fragment with the shape of the quoted code. In
with shape env, can be given meaning as a function from a record MetaML the angle brackets, the escapes, the lifts, and the run op-
with shape env to t. The function evalLam is a denotational erator are staging annotations. They indicate the boundaries within
semantics. It provides a meaning for every well formed lambda a MetaML program where the program text moves from meta-
term. program to object-program. The staging annotations in MetaML
In essence, the well-typing of the evaluation function is one of are placed manually by the programmer and are considered part
three parts that comprise a proof of soundness of the type system of the language. In MetaML the staging annotations have seman-
with respect to the semantics. The other two parts are proofs of tic meaning, they are part of the language definition, not just hints
totality and compositionality. or directions to language preprocessors. A simple example using
templates follows:
• Totality. To ensure that every term is mapped to a well-typed
value, we must ensure that evalLam is total. That is, it termi- -| val x = <3 + 2> ;
val x = <3 %+ 2> : <int>
nates for every well-typed lambda term. Every well-typed Lam
term matches one of the clauses of evalLam, and every recur- -| val code = <show ~x> ;
sive call of evalLam is called on a smaller subterm of the orig- val code = <%show (3 %+ 2)> : <string>
inal argument, so every call will terminate with a value if the
input term is finite and the meta-language (in this case Ωmega) In this example we construct the object-program fragment x
is strongly normalizing. Note that the input to evalLam is a and use the anti-quotation mechanism to splice it into the object-
meta-language term, so if the meta-language is strongly nor- program fragment code. Note how the definition of code uses a
malizing no infinite inputs are possible. The key is a strongly template with a hole (the escaped expression ~x). MetaML also
normalizing meta-language. statically scopes free variable occurrences in code templates. This
• Compositionality. The meaning of every term is composed is called cross-stage persistence. Variables defined in earlier stages
only from the meaning of its subterms. are available for use in later stages.
-| fun id x = x; None of the problems associated with this example would occur.
val id = Fn : ’a -> ’a So the challenge is to come up with a type system that rejects the
original program but not this one. In our opinion, this is a superior
-| <fn x => ~(id x) - 4>; solution to complicating the implementation to accommodate the
Error: The term: x Variable bound in stage 1 original program (which we believe no one would ever deliberately
used too early in stage 0 write).
In the above example x is a stage 1 variable, but because of 4. MetaML as an Ωmega program.
the anti-quotation it is used at stage 0. This is semantically
meaningless and should be reported as a type error. In this section we play with types. We explore, in Ωmega, several
different formulations for a MetaML type system. We will discard
• Running code with free variables. In MetaML we use run to several of our attempts, as our exploration points out their defi-
move from one stage to the next. Because it is legal to use the ciencies. This section is meant to illustrate how Ωmega is useful
for exploring language design issues. Those interested in the final
MetaML type system may skip ahead to Section 5. data Lam:: Nat ~> Row HasT ~> *0 ~> *0 where
We will develop a type system for an abstraction of MetaML Var :: Label s -> Nat’ n ->
that includes all of MetaML’s important features. It has a stan- Lam n (RCons (H3 s n t) env) t
dard lambda calculus fragment, and a staging fragment. The Abstract :: Label a ->
staging fragment includes brackets, escape, run, and cross-stage- Lam n (RCons (H3 a n s) env) t ->
persistence. Lam n env (s -> t)
As we did in Section 2.7 with the Lam GADT, we represent the Shift :: Lam n env t ->
lambda fragment with tagged de Bruijn style variables. The staging Lam n (RCons (H3 s m q) env) t
fragment is more problematic. How do we deal with the multiple
levels in a staged expression? The standard solution[37, 36] is to When a variable is used, it must be applied to a singleton (Nat’
use a level-indexed family of expressions. In Ωmega we would n) to indicate at what level it was defined. Consider again the type
extend the Lam GADT as follows: of the example term (adjusted to include level information on the
variables).
data Lam:: Nat ~> Row HasType ~> *0 ~> *0 where
Var :: Label s -> Bracket (Apply (Var ‘f #0) (Shift (Var ‘x #0)))
Lam n (RCons (Has s t) env) t :: Lam #1 {‘f^#0:(a -> b), ‘x^#0:a; u} (Code b)
Shift :: Lam n env t ->
Lam n (RCons (Has s q) env) t We have (again) introduced some syntactic sugar. When dis-
Abstract :: Label a -> playing a type of kind HasT, we display (H3 ‘tag #n typ) as
Lam n (RCons (Has a s) env) t -> (‘tag^#n:typ). A new problem arises if the two variables come
Lam n env (s -> t) from two different stages. Assume ‘f comes from stage 0, and ‘x
Apply :: Lam n env (s -> t) -> from stage 1, as it might in the MetaML term (fn f => <fn x => f x>).
Lam n env s -> This makes ‘f a cross stage persistent value. We replace (Var ‘x
Lam n env t #0) with (Var ‘x #1). Observe the types of f and x, and the
Bracket :: Lam n env t -> Lam (S n) env t constructor Apply:
Escape :: Lam (S n) env t -> Lam n env t
Var ‘f #0 :: Lam #0 {‘f^#0:a; u} a
Note, how a natural number index is added to Lam, and that how Var ‘x #1 :: Lam #1 {‘x^#1:a; u} a
the constructor for bracket lifts the index of a term, and how Apply :: Lam u v (a -> b) -> Lam u v a -> Lam u v b
the constructor for escape drops the index of a term. It is at this
point in the design exploration that the automation inherent that As we intended, the levels of the two terms now differ. The term
the meta-language begins to payoff. A well-typed term built with f is at level 0, and the term x is at level 1. The application of f
the constructors of Lam is a derivation of the type of that term. to x (Apply (Var ‘f #0) (Shift (Var ‘x #1))) will be ill-
By entering simple expressions at the Ωmega prompt we get the typed, because Apply requires that the level of the two terms be the
Ωmega type system to check the well-formedness of the deriva- same. The problem here is similar to the problem of constructing a
tion, and to display the type of the term. For example, by typ- term with two different variables with different names but with the
ing: Bracket (Apply (Var ‘f) (Shift (Var ‘x))) we get same de Bruijn indices. We solved that problem be introducing the
the following result: Shift operator. We can solve the level problem by similar means.
Lam #(1+u) {‘f:a -> b,‘x:a; v} b Introduce a new constructor of Lam terms that raises the level of
a term. We call this constructor Cross, because it used when we
want cross-stage persistence.
Right away, an error becomes obvious in our formulation. Shouldn’t
an expression that is bracketed have a code type? We need typing Cross :: Lam n env t -> Lam (S n) env t
rules some thing like the following for escape and bracket.
Using Cross on f, the term is now well typed:
Bracket :: Lam n env t -> Lam (S n) env (Code t)
Escape :: Lam (S n) env (Code t) -> Lam n env t Apply (Cross (Shift (Var ‘f #0))) (Var ‘x #1)
But, what then is Code? Some thought leads to the following :: Lam #1 {‘x^#1:a, ‘f^#0:(a -> b); u} (Code b)
definition.
The term is a second level term. This is indicated in the level index
data Code t = exists env . Code (Lam Z env t) (#1). It mentions two variables f defined at level #0 with type (a
-> b), and x defined at level #1 with type b. The type of the term
Code is just a Lam term at level zero (Z) which can be typed in some
is (Code b). We have succeeded in describing well-formed object-
environment1 . Now, let’s observe the type of the same term: level terms using the type system of the meta-language!
Bracket (Apply (Var ‘f) (Shift (Var ‘x))) Unfortunately, while an interesting exercise, this particular path
:: Lam #(1+u) {‘f:a -> b,‘x:a; v} (Code b) is hard to extend. The problem comes from having variables from
all levels in a single environment. Rhetorically, should it be neces-
Almost, but the environment index, {‘f:a -> b,‘x:a; v}, does sary for the variables f and x to have different deBruijn indices?
not indicate the stage at which a variable is bound. This can be While executing in the second stage, the environment including the
fixed by making the environment be a row of triples (rather than binding for f (as well as the need for f) will be long gone. The sin-
pairs). We introduce the kind HasT to encode triples, and adjust the gle environment approach also causes many problems when doing
definition of Var, Shift, and Abstract. proofs. It is necessary to construct lemmas which talk about projec-
kind HasT = H3 Tag Nat *0 tions over environments. A projection projects only those variables
defined a single stage. The key to a simple and elegant type sys-
1 Which environment actually matters, but will discuss this in more detail tem for a staged language is to break from tradition. Do not use an
later. level-indexed term, and do not use a single environment.
Exp p n f t
past present future
bd :: Env a z -> Exp a n f t -> Exp z n f t the evaluation of a Run term, where the eval function is called
bd env (Const n) = Const n twice.
bd env (V z) = V z
eval (Run e) env = case eval e env of
bd env (App x y) = App (bd env x) (bd env y)
Cd x -> eval x RecNil
bd env (Abs a e) = Abs a (bd env e)
bd env (Pair x y) = Pair (bd env x) (bd env y) The second call to eval is on a term that is not a subterm of the
bd env (Br e) = Br(bd (EnvS env) e) original term. Note if evaluating e from a term (Run e) causes an
bd env (Run e) = Run(bd env e) infinite sequence of Run subterms, the evaluator would not be total.
bd (EnvZ env) (Esc e) = Can we argue the non-compositional evaluator is sound? I.e.
case eval e env of that every well-typed term is mapped to a meta-level value with
Cd x -> x that type. To show this we must answer the question: What’s a
bd (EnvS r) (Esc e) = well-typed term in MetaML? In MetaML only level 0 terms can
case bd r e of be evaluated i.e. As discussed in Section 4, level 0 terms have no
Br x -> x escapes at level 0, and a term is at level 0, if and only if, its is
y -> Esc y polymorphic in its past. Thus we need argue soundness for terms
bd (EnvZ env) (Csp e) = Const(eval e env) polymorphic in their past.
bd (EnvS r) (Csp e) = Csp(bd r e) Showing totality is problematic for two reasons. The first is the
possibility of evaluation leading to an infinite sequence of Runs
Not all escapes or cross-stage persistent can be removed. Those inside Runs. We are currently working on a solution in which the
embedded inside more than the original surrounding brackets re- nesting level of Run is encoded as an additional type index to Exp.
fer to values available when the code being built will be run. We hope to report on this in the final paper.
For example, when evaluating a term like <f ~x <g ~y>> we The second cause of non-totality is non-exhaustiveness. The
rebuild the term (f ~x <g ~y>). Only the first level escape ~x function eval is not defined on terms built with the Esc or Csp
should be evaluated and then spliced in the rebuilding process. In constructors. Fortunately, code polymorphic in its past cannot con-
order to know which escapes (and cross-stage persistent terms) tain either Esc or Csp at level 0. This leads us to the following
to process, brackets must be counted as bd crawls over a term. strategy, first define a version of eval, called eval0, that can only
Counting brackets is the role of the Env parameter to bd. The be applied to terms polymorphic in their past.
number of brackets inside the original pair (that was removed
in the Br case of eval) can be determined by the number of eval0 :: (forall p . Exp p now future t) ->
EnvS constructors wrapped around the current environment. Thus Rec now -> t
(EnvS (EnvS (EnvZ env))) means the bd is processing a sub- eval0 exp env = eval exp env
term inside of two additional sets of brackets., while (EnvZ env) where eval::Exp past now future t -> Rec now -> t
means zero additional sets of brackets. eval (Const n) env = n
The only interesting cases inside bd are the (Br e), (Esc ...
e), and (Csp e) cases. For the (Br e) case simply rebuild the eval (Run e) env =
subterm, but wrap an extra EnvS term around the environment to case eval e env of
record the fact. For the (Esc e) case, if the environment is (EnvZ Cd x -> eval0 x RecNil
env) then the subterm e should be evaluated, and the resulting code
term spliced in. If the environment is (EnvS env) then at least bd::Env a z -> Exp a n f t -> Exp z n f t
one extra pair of brackets surrounds this term. Simply rebuild it bd env (Const n) = Const n
(remembering to count down by one by removing the EnvS) and ...
wrap an Esc around the result. An optimization is possible here.
By defining eval and bd as local functions of eval0 It is impos-
Consider a subterm inside a bracketed term like ~<e>, this could be
sible to apply eval to terms not polymorphic in their past, since
replaced by e. We recognize this by comparing the rebuilt subterm.
all access to eval is through eval0 which requires polymorphic
If it is itself a bracketed term, then we can apply the rule, and don’t
terms. All recursive calls to eval and Bd (except the second one in
need to wrap the extra escape around the returned result. The cases
the Run case in eval) are applied to strict subterms of the original
for Csp are almost identical except we use Const to lift a value into
term, so if the original terms was polymorphic, so must all these
a piece of code when the environment count is zero.
sub-terms be polymorphic. The problematic second call to eval in
the Run case which is applied to the return result of applying eval
5.3 Well-typed MetaML programs do not go wrong to a subterm, can be replaced with eval0, because expressions in-
In Section 2.7 we showed that a denotational semantics for the side the Cd constructor must also be level 0 terms. Thus both eval
lambda calculus was sound by showing that it was well-typed, total, and eval0 are total, in that they will never be called on a term for
and compositional. which they are not defined. While not a complete proof, we have
Showing that well-typed programs do not go wrong for MetaML made subtantial progress. In the next section we demonstrate that
is more complicated. First, our evaluator is not a denotational se- the type system distinguishes the subtle staging errors discussed in
mantics, because it is not compositional. The problematic case is Section 3.
6. Evaluating the type system. <fn a => ~((fn x => <x>)(fn y => <a>)) 0>;
Section 3 introduced three programs that highlight subtle typing -| val puzzle2 =
issues for multi-stage programs. We now evaluate the novel multi- <fn a => ~(<fn y => <a>>) 0>;
stage type system discussed in the previous section based on how We argued that (run puzzle1) should cause a type error, but
it performs on these issues. (run puzzle2) shouldn’t.
The Ωmega encoding behaves in exactly this way. Consider
• Correct use of variables. The following program exhibits a
the type of the Ωmega translation of puzzle1.
level-mismatch error, and is incorrect.
Br (Abs ‘a
<fn x => ~(id x)>;
(App (Esc (App (Abs ‘x (Br (Csp (V ‘x))))
This program makes use of the variable x at a stage prior to the (Abs ‘y (Br (V ‘a)))))
stage in which it is bound. What about the Ωmega encoding of (Const 0) ))
this program? :: Exp a u (Rec v,b)
(Cd v b (c -> Cd {‘a:c; v} b c))
Br (Abs ‘x (Esc (App (Abs ‘y (V ‘y)) (V ‘x))))
It appears polymorphic enough. Note the current context is
The interpreter gives this term the following type:
typed by the type variable v inside the Cd type. But further
Exp a {‘x:Cd {‘x:b; u} c d; v} inspection shows that this type variable v also appears in the
(Rec u,c) type of the code returned (c -> Cd {‘a:c; v} b c). Thus
(Cd u c (b -> d))) it isn’t really polymorphic at all.
The variable ‘x shows up in two different environments -| run puzzle1
at two different stages. Each environment in the sliding band Error: puzzle1 isn’t polymorphic enough
of type contexts is a separate name space, so the two occur- Expected Type:
rences of ‘x in the Ωmega encoding aren’t the same variable, (forall v. Exp a u (Rec v,b)
as they are in the MetaML program. So while this is a “type (Cd v b c))
correct” program in the Ωmega encoding, it isn’t an encoding Found Type: Exp a u (Rec v,b)
of <fn x => ~(id x)>. (Cd v b (c -> Cd {‘a:c; v}
This brings up an important point. The cross-stage persis- b c)))
tence construct does not appear in MetaML, so there must
The type given to puzzle1 illustrates of the problem. The
be some syntactic sugar in the parsing stage which translates environment v is needed even after the function is applied.
MetaML syntax into the Exp data-structures. This preprocess- But if the user performs the beta-reduction manually, then the
ing step counts brackets, and assigns to every variable a static problem does not occur.
level at its point of definition. At each point of use, a number of
cross-stage persistent annotations (Csp) are inserted. The cor- -| puzzle2
rect number is the difference between the level at which a vari- Br (Abs ‘a (App (Esc (Br (Abs ‘y (Br (V ‘a)))))
(Const 0)))
able is defined, and the level at which it is used. If this num- :: Exp a u (Rec v,(Rec {‘a:b; w},c))
ber is negative, the program is ill-typed. So this kind of error (Cd v (Rec {‘a:b; w},c)
is actually caught before type checking in the syntactic sugar (d -> Cd {‘a:b; w} c b))
pre-processing phase. -| Run puzzle2
Run (Br (Abs ‘a (App (Esc (Br (Abs ‘y (Br (V ‘a)))))
• Running code with free variables. The following program (Const 0))))
should be rejected because the run will force the evaluation :: Exp a u (Rec {‘a:b; v},c)
of the not-yet-bound variable x. (d -> Cd {‘a:b; v} c b)
val bad = <fn x => ~(run <x>) + 4>; The Ωmega function eval shows that if we disallow puzzle1
How does this program hold up in our Ωmega encoding? we can use a very simple implementation, yet still remain safe.