Artifact e50284fdcde212f791567715c0dd81f4b558f14c

• File sample/type.pmy
  • 2010-11-27 23:46:51 - part of checkin [576c494e53] on branch trunk - fixed: literal "..." is now lifted in user-defined layers (user: kinaba) [annotate]

# Lift to types
@@type (x)
{
	if _isint(x): "int"
	else if _isstr(x): "str"
	else if _isbot(x): "RE"
	else if _istbl(x):
		if x.?car && x.?cdr:
			let xa = x.car in let xd = x.cdr in
				mergeType( {list: @type(xa)}, @type(xd) )
		else
			{list: "RE"} # tenuki
	else ...
};

# unify two types
def mergeType(a, b)
{
	if a == "RE": b
	else if b == "RE": a
	else if _istbl(a) && _istbl(b):
		if  a.?list && b.?list:
			let rt = mergeType(a.list, b.list) in
				if rt=="TE" || rt=="RE" then rt else {list: rt}
		else:
			"TE" # type error
	else if a == b: a
	else "TE"  # type error
};

# helper function
def Tuni(t1, t0)
{
	fun(x) {@value(
		if @type(x)=="RE": "RE"
		else if @type(x)=="TE": "TE"
		else if @type(x)==t1: t0
		else "TE"
	)}
};
def Tuniany(t0)
{
	fun(x) {@value(
		if @type(x)=="RE": "RE"
		else if @type(x)=="TE": "TE"
		else t0
	)}
};
def Tbin(t1, t2, t0)
{
	fun(x,y) {@value(
		if @type(x)=="RE" || @type(y)=="RE": "RE"
		else if @type(x)=="TE" || @type(y)=="TE": "TE"
		else if @type(x)==t1 && @type(y)==t2: t0
		else "TE"
	)}
};
def Tbinany(t0)
{
	fun(x,y){@value(
		if @type(x)=="RE" || @type(y)=="RE": "RE"
		else if @type(x)=="TE" || @type(y)=="TE": "TE"
		else t0
	)}
};

# type annotation for built-in ops
@type "+" = Tbin("int", "int", "int");
@type "-" = Tbin("int", "int", "int");
@type "*" = Tbin("int", "int", "int");
@type "/" = Tbin("int", "int", "int");
@type "%" = Tbin("int", "int", "int");
@type "&&" = Tbin("int", "int", "int");
@type "||" = Tbin("int", "int", "int");
@type print = fun(x){x};
@type gensym = fun(){"str"};
@type argv = {list: "str"};
@type rand = Tuni("int","int");
@type "~" = Tbinany("str");
@type "<" = Tbinany("int");
@type "<=" = Tbinany("int");
@type ">" = Tbinany("int");
@type ">=" = Tbinany("int");
@type "==" = Tbinany("int");
@type "!=" = Tbinany("int");
@type "if" (c,t,e) {@value(
	if @type(c)=="RE": "RE"
	else if @type(c)!="int": "TE"
	else mergeType( @type(t()), @type(e()) );
)};
@type _isint = Tuniany("int");
@type _isstr = Tuniany("int");
@type _isfun = Tuniany("int");
@type _istbl = Tuniany("int");
@type _isbot = Tuniany("int");

###################################

# for lists
@type "{}"() {@value( {list: "RE"} )};
@type ".?"(t, s) {@value(
	if @type(t)=="RE": "RE"
	else if @type(t)=="TE": "TE"
	else if _istbl( @type(t) ): "int"
	else "TE"
)};
@type ".="(t, s@value, v) {@value(
	var tt = @type(t);
	if tt == "TE": "TE"
	else if tt == "RE": "RE"
	else if _istbl(tt) && tt.?list:
		if s == "car":
			mergeType(tt, {list: @type(v)})
		else if s == "cdr":
			mergeType(tt, @type(v))
		else:
			tt
	else:
		"TE"
)};
@type "."(t, s@value) {@value(
	var tt = @type(t);
	if tt == "TE": "TE"
	else if tt == "RE": "RE"
	else if _istbl(tt) && tt.?list:
		if s == "car":
			tt.list
		else if s == "cdr":
			tt
		else:
			"TE"
	else:
		"TE"
)};

###################################

def fib(x) { if x < 2 then 1 else fib(x-1) + fib(x-2) };
def fibE1(x) { if "true!" then 1 else fib(x-1) + fib(x-2) };
def fibE2(x) { if x<2 then "ichi" else fib(x-1) + fib(x-2) };
def fibE3(x) { if x<2 then 1 else fib(x-1) ~ fib(x-2) };
def fibS(x) { if x<2 then "1" else fib(x-1) ~ fib(x-2) };
def fibBadButTypeIsOK(x) { if x < "2" then 1 else fib(x-1) + fib(x-2) };

print( @type(fib(999)) );
print( @type(fibE1(999)) );
print( @type(fibE2(999)) );
print( @type(fibE3(999)) );
print( @type(fibS(999)) );
print( @type(fibBadButTypeIsOK(999)) );

###################################

def nil = {};
def cons(a, d) { {car: a, cdr: d} };

print( @type(nil) );
print( @type(cons(1,nil)) );
print( @type(cons("foo",nil)) );
print( @type(cons(123, cons("foo",nil))) ); # TE

def rev(xs) {
	def revi(xs, ys) {
		case xs
			when {car: x, cdr: xs}: revi(xs, cons(x,ys))
			when {}: ys
	};
	revi(xs, {})
};

var xs = cons(1, cons(2, cons(3, nil)));
print( @type( rev(xs) ) );