Artifact Content
Not logged in

Artifact f1d2e31afdaaee9dd578647f659a84937dba4577


/**
 * Authors: k.inaba
 * License: NYSL 0.9982 http://www.kmonos.net/nysl/
 *
 * Runtime data structures for Polemy programming language.
 */
module polemy.value;
import polemy._common;
import polemy.failure;
import polemy.ast;

/// Runtime values of Polemy

abstract class Value
{
}

///
class IntValue : Value
{
	BigInt data;

	mixin SimpleClass;
	override string toString() const { return std.bigint.toDecimalString(cast(BigInt)data); }
}

///
class StrValue : Value
{
	string data;

	mixin SimpleClass;
	override string toString() const { return data; }
}

///
class FunValue : Value
{
	Value delegate(immutable LexPosition pos, string lay, Value[]) data;

	mixin SimpleConstructor;
	alias data call;
	override string toString() const { return sprintf!"(function:%s:%s)"(data.ptr,data.funcptr); }
}

///
class UndValue : Value
{
	mixin SimpleClass;
	override string toString() const { return "<undefined>"; }
}

/// Named Constructor for FunValue

FunValue nativef(Value delegate(immutable LexPosition pos, Layer lay, Value[] args) dg)
{
	return new FunValue(dg);
}

/// Named Constructor for FunValue

FunValue native(R,T...)(R delegate (T) dg)
{
	return nativef( delegate Value(immutable LexPosition pos, Layer lay, Value[] args) {
		if( lay != "@v" )
			throw genex!RuntimeException(pos, "only @v layer can call native function");
		if( T.length != args.length )
			throw genex!RuntimeException(pos, "argument number mismatch!");
		T typed_args;
		foreach(i, Ti; T)
		{
			typed_args[i] = cast(Ti) args[i];
			if( typed_args[i] is null )
				throw genex!RuntimeException(pos, sprintf!"type mismatch on the argument %d"(i+1));
		}
		try {
			return dg(typed_args);
		} catch( RuntimeException e ) {
			throw e.pos is null ? new RuntimeException(pos, e.msg, e.file, e.line) : e;
		}
	});
}

/// Layer ID

alias string Layer;

/// Context (variable environment)
/// Simlar to prototype chain of ECMAScript etc.
/// But extended with the notion of "Layer"

class Table : Value
{
	enum Kind {PropagateSet, NotPropagateSet};

	this( Table proto=null, Kind k = Kind.PropagateSet )
		{ this.prototype = proto; this.kind = k; }

	void set(string i, Layer lay, Value v, in LexPosition pos=null)
	{
		if( setIfExist(i, lay, v) )
			return;
		data[i][lay] = v;
	}

	bool has(string i, Layer lay, in LexPosition pos=null)
	{
		if( i in data ) {
			if( lay !in data[i] )
				return false;
			return true;
		}
		if( prototype is null )
			return false;
		return prototype.has(i, lay, pos);
	}
	
	Value get(string i, Layer lay, in LexPosition pos=null)
	{
		if( i in data ) {
			// [TODO] consider forwarding to proto also in this case
			if( lay !in data[i] )
				throw genex!RuntimeException(pos, sprintf!"variable %s is not set in layer %s"(i,lay));
			return data[i][lay];
		}
		if( prototype is null )
			throw new RuntimeException(pos, sprintf!"variable %s not found"(i));
		return prototype.get(i, lay, pos);
	}

	T access(T,S...)( Layer lay, string path, S rest )
	{
		static if( rest.length == 0 )
		{
			if( this.has(path, lay) )
				return cast(T) this.get(path, lay);
		}
		else
		{
			if(auto next = this.access!Table(lay,path))
				return next.access!T(lay,rest);
		}
		return null;
	}

	string toStringWithoutParen() const
	{
		string result;
		bool first = true;
		foreach(k, l2d; data)
			foreach(l,d; l2d)
			{
				if(first) first=false; else result~=", ";
				result ~= k;
				result ~= l;
				result ~= ":";
				result ~= text(cast(Value)d);
			}
		if( prototype !is null )
		{
			result ~= " / ";
			result ~= prototype.toStringWithoutParen();
		}
		return result;
	}
	
	string toString() const
	{
		return "{" ~ toStringWithoutParen() ~ "}";
	}

private:
	Table                prototype;
	Kind                 kind;
	Value[Layer][string] data;

	bool setIfExist(string i, Layer lay, Value v)
	{
		if( i in data )
		{
			data[i][lay] = v;
			return true;
		}
		if( kind==Kind.PropagateSet && prototype !is null )
			return prototype.setIfExist(i, lay, v);
		return false;
	}
}

unittest
{
	Table c0 = new Table;
	Table c01 = new Table(c0, Table.Kind.NotPropagateSet);
	Table c012 = new Table(c01, Table.Kind.PropagateSet);
	Table c013 = new Table(c01, Table.Kind.PropagateSet);

	assert_nothrow( c012.set("x", "@v", new IntValue(BigInt(12))) );
	assert_throw!RuntimeException( c013.get("x", "@v") );
	assert_nothrow( c013.set("x", "@v", new IntValue(BigInt(13))) );
	assert_eq( c013.get("x", "@v"), new IntValue(BigInt(13)) );
	assert_eq( c012.get("x", "@v"), new IntValue(BigInt(12)) );
	assert_throw!RuntimeException( c01.get("x", "@v") );

	assert_nothrow( c01.set("y", "@v", new IntValue(BigInt(1))) );
	assert_eq( c013.get("y", "@v"), new IntValue(BigInt(1)) );
	assert_eq( c012.get("y", "@v"), new IntValue(BigInt(1)) );
	assert_eq( c01.get("y", "@v"), new IntValue(BigInt(1)) );

	assert_nothrow( c0.set("z", "@v", new IntValue(BigInt(0))) );
	assert_eq( c013.get("z", "@v"), new IntValue(BigInt(0)) );
	assert_eq( c012.get("z", "@v"), new IntValue(BigInt(0)) );
	assert_eq( c01.get("z", "@v"), new IntValue(BigInt(0)) );
	assert_eq( c0.get("z", "@v"), new IntValue(BigInt(0)) );

	assert_nothrow( c012.set("y", "@v", new IntValue(BigInt(444))) );
	assert_eq( c013.get("y", "@v"), new IntValue(BigInt(444)) );
	assert_eq( c012.get("y", "@v"), new IntValue(BigInt(444)) );
	assert_eq( c01.get("y", "@v"), new IntValue(BigInt(444)) );

	assert_nothrow( c012.set("z", "@v", new IntValue(BigInt(555))) );
	assert_eq( c013.get("z", "@v"), new IntValue(BigInt(0)) );
	assert_eq( c012.get("z", "@v"), new IntValue(BigInt(555)) );
	assert_eq( c01.get("z", "@v"), new IntValue(BigInt(0)) );
	assert_eq( c0.get("z", "@v"), new IntValue(BigInt(0)) );

	// [TODO] define the semantics and test @layers
}

immutable(LexPosition) extractPos( Table t )
{
	Layer theLayer = "@v";
	if(auto tt = t.access!Table(theLayer, "pos"))
	{
		auto fn = tt.access!StrValue(theLayer, "filename");
		auto ln = tt.access!IntValue(theLayer, "lineno");
		auto cl = tt.access!IntValue(theLayer, "column");
		if(fn !is null && ln !is null && cl !is null)
			return new immutable(LexPosition)(fn.data,cast(int)ln.data.toInt,cast(int)cl.data.toInt);
	}
	return null;
}

Value[] tableAsConsList( Layer theLayer, Table t )
{
	Value[] result;
	while(t)
		if(auto v  = t.access!Value(theLayer, "car"))
		{
			result ~= v;
			t = t.access!Table(theLayer, "cdr");
		}
		else
			break;
	return result;
}

AST[] tableToASTList( Layer theLayer, Table t )
{
	AST[] result;
	foreach(v; tableAsConsList(theLayer, t))
		if(auto t = cast(Table)v)
			result ~= tableToAST(theLayer,t);
		else
			throw genex!RuntimeException(cast(LexPosition)null, "Invalid AST (non-table in cons-list)");
	return result;
}

AST tableToAST( Layer theLayer, Value vvvv )
{
	Table t = cast(Table)vvvv;
	if( t is null )
		throw genex!RuntimeException(cast(LexPosition)null, "Invalid AST (not a table)");

	auto nodeType = t.access!StrValue(theLayer, "is");
	if( nodeType is null )
		throw genex!RuntimeException(cast(LexPosition)null, "Invalid AST {is:(not string)}");
	auto pos = extractPos(t);
	switch(nodeType.data)
	{
	case "int":
		if(auto v = t.access!IntValue(theLayer, "data"))
			return new IntLiteral(pos, v.data);
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"int", data:(not int)}`);
	case "str":
		if(auto v = t.access!StrValue(theLayer, "data"))
			return new StrLiteral(pos, v.data);
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"str", data:(not string)}`);
	case "var":
		if(auto v = t.access!StrValue(theLayer, "name"))
			return new VarExpression(pos, v.data);
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"var", name:(not string)}`);
	case "lay":
		if(auto v = t.access!StrValue(theLayer, "layer"))
			if(auto e = t.access!Table(theLayer, "expr"))
				return new LayeredExpression(pos, v.data, tableToAST(theLayer,e));
			else
				throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"lay", expr:(not table)}`);
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"lay", layer:(not string)}`);
	case "let":
		if(auto n = t.access!StrValue(theLayer, "name"))
		if(auto e = t.access!Table(theLayer, "init"))
		if(auto b = t.access!Table(theLayer, "expr"))
		{
			string nn = n.data;
			auto ee = tableToAST(theLayer, e);
			auto bb = tableToAST(theLayer, b);
			Layer lay="";
			if(auto l = t.access!StrValue(theLayer, "layer"))
				lay = l.data;
			return new LetExpression(pos, nn, lay, ee, bb);
		}
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"let", name:"???", init:"???", expr:"???"}`);
	case "app":
		if(auto f = t.access!Table(theLayer, "fun"))
		if(auto a = t.access!Table(theLayer, "arg"))
			return new FuncallExpression(pos, tableToAST(theLayer,f), tableToASTList(theLayer,a));
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"app", fun:???, arg:???}`);
	case "fun":
		if(auto p = t.access!Table(theLayer, "param"))
		if(auto b = t.access!Table(theLayer, "body"))
		{
			Parameter[] ps;
			foreach(v; tableAsConsList(theLayer, p))
			{
				if(auto tt = cast(Table)v)
				if(auto ss = tt.access!StrValue(theLayer, "name"))
				if(auto ll = tt.access!Table(theLayer, "layer"))
				{
					Layer[] ls;
					foreach(lll; tableAsConsList(theLayer, ll))
						if(auto l = cast(StrValue)lll)
							ls ~= l.data;
						else
							throw genex!RuntimeException(cast(LexPosition)null, sprintf!`Invalid AST {bad fun params %s}`(lll));
					ps ~= new Parameter(ss.data, ls);
					continue;
				}
				else
				{
					Layer[] emp;
					ps ~= new Parameter(ss.data, emp);
					continue;
				}
				throw genex!RuntimeException(cast(LexPosition)null, sprintf!`Invalid AST {bad fun params %s}`(v));
			}
			auto bb = tableToAST(theLayer, b);
			return new FunLiteral(pos,ps,bb);
		}
		throw genex!RuntimeException(cast(LexPosition)null, `Invalid AST {is:"fun", param:???, body:???}`);
	default:
		throw genex!RuntimeException(cast(LexPosition)null, sprintf!`Invalid AST {is: "%s"} unknown`(nodeType.data));
	}
}