/* Example: a type-system for mini-ML */
/*          file ML_TS.pl             */

/* 
Grammar for mini-ML expressions: 

   Exp ::= Ide                         (identifier)
         | (Exp Exp)                   (application)
         | fn Ide => Exp               (abstraction)
         | fn (Ide,Ide) => Exp         (abs. on pair)
         | (Exp,Exp)                   (pair)

   
Grammar for types: 

  Type ::= Tvar                        (type variable)
         | Type -> Type                (functional type)
         | Type * Type                 (cartesian product)

Representation in Prolog: 

Expressions: 

- Identifiers will be represented as constants:   x, y, z etc.
- An application will be represented as a term of the form   app(e1,e2)
- An abstraction will be represented as a term of the form   fn(x,e)
- An abs. on pair will be represented as a term of the form  fn((x1,x2),e)
- A pair will be represented as a term of the form   (e1,e2)

Types: 

- Type variables will be represented by constants when doing type-checking, 
  and by logical variables when doing type-inference
- A functional type will be represented as a term  t1 -> t2
- A cartesian product will be represented as a term  t1 * t2

The type system will consist of clauses defining a predicate of the form 

  type(E,T,R)

meaning: "the expression E has type T in the static environment R"

The environment will be represented as a list of pairs (X,T) where 
X is an identifier and T a type. The presence of such pair in the 
list R will be interpred as "X is associated to T in R". 

In order to simplify the program, we will deal with R as a list instead 
than a stack. This means that we don't consider the possibility of 
multiple associations for the same identifier (which usually would be 
dealt with by using a stack-like discipline). In other words, the 
program is expected to work well only when the identifiers used in the 
abstractions are all distinct.

The rules for the predicate "type" are simply the Prolog reformulation 
of the inference rules of the System (see LN of Lecture on Types). The 
reformulation is very easy and immediate thanks to the nature of 
Logic Programming: a clause *is* an inference rule.

*/

/* The next two definition simply redefine -> and * 
   (which otherwise are special system predicates) 
   to be uninterpreted infix operators, with the following properties:
   -> is right associative,
   *  is left associative,
   *  has priority wrt ->    
*/

redefine_system_predicate(200,->,xfy).
redefine_system_predicate(100,*, yfx).

/* The type system */
 
type(X,A,R) :- occurs((X,A),R).                         /* identifier */

type(fn(X,E),A->B,R) :- type(E,B,[(X,A)|R]).            /* abstraction */

type(fn((X1,X2),E),A1*A2->B,R) :- type(E,B,[(X1,A1),(X2,A2)|R]). /* abs pair */

type((E1,E2),A1*A2,R) :- type(E1,A1,R), type(E2,A2,R).  /* pair */

type(app(E1,E2),B,R) :- type(E1,A->B,R), type(E2,A,R).  /* application */

/* this last case, for app, relies on the full power of unification, 
   and could not be written in ML (at least, not in such simple way)   */


/* Definition of the predicate occurs(X,L) (X is an element of L) */

occurs(X,[X|_]).

occurs(X,[_|L]) :- occurs(X,L).


/* ------------------------------------------------------------------------- */
/* Example of session


137> pl
Welcome to SWI-Prolog (Version 2.9.9)
Copyright (c) 1993-1997 University of Amsterdam.  All rights reserved.
 
For help, use ?- help(Topic). or ?- apropos(Word).
 
?- consult('ML_TS.pl').
ML_TS.pl compiled, 0.01 sec, 0 bytes.
 
Yes

****USING THE SYSTEM FOR TYPE-CHECKING

?- type(fn(x,x), alpha -> alpha, []).
 
Yes

?- type(fn(x,fn(y,(x,y))), alpha -> beta -> alpha * beta, []).
 
Yes

**** USING THE SYSTEM FOR TYPE INFERENCE

?- type(fn(x,fn(y,app(x,y))),T,[]).
 
T = (_G376->_G377)->_G376->_G377 ;
 
No

?- type(fn(x,fn(y,fn(z,app(app(x,y),z)))),T,[]).
 
T = (_G472->_G481->_G482)->_G472->_G481->_G482 ;
 
No

**** NOTE: we now invert the functionality, i.e. we give queries of the form 
?-type(E,t,[]), where t is a given type, and E is a variable. 
This corresponds to ask the system to generate all the expressions
(ML programs) E which have type t. 
Note that if a type is "inhabited" (i.e. there exists an expression with 
that type) then there are infinitely many expressions with that type. 

For certain types, the program will loop due to the clause for app.
(It's a very powerful clause, but it introduces a lot of nondeterminism)
In particular it will loop for all the types which are not inhabited, like 
alpha -> beta.

Note that in order to be inhabited, a type must be a (intuitionistically)
valid logical formula. For instance, alpha -> alpha (alpha implies alpha)
is valid, and it's inhabited. On the contrary, alpha -> beta (alpha 
implies beta) is not valid, and it's not inhabited. This connection 
between logic formulas and types (and proofs and programs) is called 
"Curry-Howard isomorphism" from the name of the famous mathematician (Curry)
who worked here in State College, and it's a really fashinating subject. 
Please feel free to come and see me if you want to know more about this.


?- type(E,alpha->alpha,[]).
 
E = fn(_G301, _G301) ;
 
E = fn(_G301, app(fn(_G316, _G316), _G301)) ;
 
E = fn(_G301, app(fn(_G316, _G316), app(fn(_G334, _G334), _G301))) ;
 
E = fn(_G301, app(fn(_G316, _G316), app(fn(_G334, _G334), app(fn(_G352, _G352), _G301)))) 
 
Yes

?- type(E, alpha -> alpha * alpha, []).
 
E = fn(_G382, (_G382, _G382)) ;
 
E = fn(_G382, (_G382, app(fn(_G403, _G403), _G382))) ;
 
E = fn(_G382, (_G382, app(fn(_G403, _G403), app(fn(_G421, _G421), _G382)))) 
 
Yes

?- type(E, (alpha -> beta) -> alpha -> alpha -> beta * beta, []).
 
E = fn(_G565, fn(_G574, fn(_G583, (app(_G565, _G583), app(_G565, _G583))))) ;
 
E = fn(_G565, fn(_G574, fn(_G583, (app(_G565, _G583), app(_G565, _G574))))) ;
 
E = fn(_G565, fn(_G574, fn(_G583, (app(_G565, _G583), app(_G565, app(fn(_G622, _G622), _G583)))))) ;
 
E = fn(_G565, fn(_G574, fn(_G583, (app(_G565, _G583), app(_G565, app(fn(_G622, _G622), _G574)))))) ;
 
E = fn(_G565, fn(_G574, fn(_G583, (app(_G565, _G583), app(_G565, app(fn(_G622, _G622), app(fn(_G640, _G640), _G583))))))) 
 
Yes

*/
