//Inlines a constructor call, method is called from TryOptimizeConstructor
private void CompileConstructorCall(string prefix, string name, ElaJuxtaposition juxta, LabelMap map, ScopeVar sv, ScopeVar sv2)
{
var len = juxta.Parameters.Count;
//For optimization purposes we use a simplified creation algorythm for constructors
//with 1 and 2 parameters
if (len == 1)
{
CompileExpression(juxta.Parameters[0], map, Hints.None, juxta);
TypeCheckIf(prefix, name, 0);
}
else if (len == 2)
{
CompileExpression(juxta.Parameters[0], map, Hints.None, juxta);
TypeCheckIf(prefix, name, 0);
CompileExpression(juxta.Parameters[1], map, Hints.None, juxta);
TypeCheckIf(prefix, name, 1);
}
else
CompileConstructorParameters(prefix, name, juxta, map);
PushVar(sv);
PushVar(sv2);
if (len == 1)
cw.Emit(Op.Newtype1);
else if (len == 2)
cw.Emit(Op.Newtype2);
else
cw.Emit(Op.Newtype);
}
private ElaExpression GetPrefixFun(ElaExpression funexp, ElaExpression par, bool flip)
{
var fc = new ElaJuxtaposition(t) { Target = funexp };
fc.Parameters.Add(par);
fc.FlipParameters = flip;
return fc;
}
//Compiles constructor parameters. This method is called from CompileContructorCall, it is used
//when inlining constructor and when constructor has >2 arguments.
private void CompileConstructorParameters(string prefix, string name, ElaJuxtaposition juxta, LabelMap map)
{
var pars = juxta.Parameters;
cw.Emit(Op.Newtup, pars.Count);
for (var i = 0; i < pars.Count; i++)
{
CompileExpression(pars[i], map, Hints.None, juxta);
TypeCheckIf(prefix, name, i);
cw.Emit(Op.Tupcons, i);
}
}
//A generic case of constructor pattern
private void CompileConstructorPattern(int sysVar, ElaJuxtaposition call, Label failLab, bool allowBang)
{
var n = String.Empty;
PushVar(sysVar);
//We have a qualified name here, in such case we don't just check
//the presence of a constructor but ensure that this constructor originates
//from a given module
if (call.Target.Type == ElaNodeType.FieldReference)
{
var fr = (ElaFieldReference)call.Target;
n = fr.FieldName;
var alias = fr.TargetObject.GetName();
if (fr.TargetObject.Type != ElaNodeType.NameReference)
AddError(ElaCompilerError.InvalidPattern, fr, FormatNode(fr));
else
EmitSpecName(alias, "$$$$" + n, fr, ElaCompilerError.UndefinedName);
}
else
{
//Here we simply check that a constructor symbol is defined
n = call.Target.GetName();
EmitSpecName(null, "$$$$" + n, call.Target, ElaCompilerError.UndefinedName);
}
//This op codes skips one offset if an expression
//on the top of the stack has a specified tag.
cw.Emit(Op.Skiptag);
cw.Emit(Op.Br, failLab); //We will skip this if tags are equal
for (var i = 0; i < call.Parameters.Count; i++)
{
PushVar(sysVar);
cw.Emit(Op.Untag, i); //Unwrap it
//Now we need to create a new system variable to hold
//an unwrapped value.
var sysVar2 = -1;
var p = call.Parameters[i];
//Don't do redundant bindings for simple patterns
if (!IsSimplePattern(p))
{
sysVar2 = AddVariable();
PopVar(sysVar2);
}
CompilePattern(sysVar2, p, failLab, allowBang, false /*forceStrict*/);
}
}
private ElaExpression GetOperatorFun(string op, ElaExpression left, ElaExpression right)
{
var fc = new ElaJuxtaposition(t) {
Target = new ElaNameReference(t) { Name = op }
};
if (left != null)
fc.Parameters.Add(left);
else
fc.FlipParameters = true;
if (right != null)
fc.Parameters.Add(right);
return fc;
}
//Currently this method only compiles head/tail pattern which is processed by parser
//as function application. However it can be extended to support custom 'infix' patterns in future.
private void CompileComplexPattern(int sysVar, ElaJuxtaposition call, Label failLab, bool allowBang)
{
if (call.Target == null)
CompileHeadTail(sysVar, call, failLab, allowBang);
else if (call.Target.Type == ElaNodeType.NameReference)
{
var targetName = call.Target.GetName();
var sv = GetVariable(call.Target.GetName(), CurrentScope, GetFlags.NoError, call.Target.Line, call.Target.Column);
//The head symbol corresponds to a constructor, this is a special case of pattern
if ((sv.VariableFlags & ElaVariableFlags.Builtin) == ElaVariableFlags.Builtin && (ElaBuiltinKind)sv.Data == ElaBuiltinKind.Cons)
CompileHeadTail(sysVar, call, failLab, allowBang);
else
CompileConstructorPattern(sysVar, call, failLab, allowBang);
}
else if (call.Target.Type == ElaNodeType.FieldReference)
CompileConstructorPattern(sysVar, call, failLab, allowBang);
else
{
//We don't yet support other cases
AddError(ElaCompilerError.InvalidPattern, call.Target, FormatNode(call.Target));
return;
}
}
//Here we check if a function application is actually a constructor application.
//The latter case can be inlined. We support both direct reference and a qualified reference.
//Only constructors without type constraints can be inlined.
private bool TryOptimizeConstructor(ElaJuxtaposition juxta, LabelMap map)
{
if (juxta.Target.Type == ElaNodeType.NameReference)
{
var nr = (ElaNameReference)juxta.Target;
if (nr.Uppercase || Format.IsSymbolic(nr.Name))
{
var sv = GetGlobalVariable("$-" + nr.Name, GetFlags.NoError, 0, 0);
if (!sv.IsEmpty() && sv.Data == juxta.Parameters.Count)
{
var sv2 = GetGlobalVariable("$--" + nr.Name, GetFlags.None, juxta.Line, juxta.Column);
CompileConstructorCall(null, nr.Name, juxta, map, sv, sv2);
return true;
}
}
}
else if (juxta.Target.Type == ElaNodeType.FieldReference)
{
var fr = (ElaFieldReference)juxta.Target;
if (fr.TargetObject.Type == ElaNodeType.NameReference)
{
var prefix = fr.TargetObject.GetName();
CodeFrame _;
var sv = FindByPrefix(prefix, "$-" + fr.FieldName, out _);
if (!sv.IsEmpty() && sv.Data == juxta.Parameters.Count)
{
var sv2 = FindByPrefix(prefix, "$--" + fr.FieldName, out _);
CompileConstructorCall(prefix, fr.FieldName, juxta, map, sv, sv2);
return true;
}
}
}
return false;
}
//Compile a given expression as a pattern. If match fails proceed to failLab.
private void CompilePattern(int sysVar, ElaExpression exp, Label failLab, bool allowBang, bool forceStrict)
{
AddLinePragma(exp);
switch (exp.Type)
{
case ElaNodeType.LazyLiteral:
{
var n = (ElaLazyLiteral)exp;
//Normally this flag is set when everything is already compiled as lazy.
if (forceStrict)
CompilePattern(sysVar, n.Expression, failLab, allowBang, forceStrict);
else
CompileLazyPattern(sysVar, exp, allowBang);
}
break;
case ElaNodeType.FieldReference:
{
//We treat this expression as a constructor with a module alias
var n = (ElaFieldReference)exp;
var fn = n.FieldName;
var alias = n.TargetObject.GetName();
PushVar(sysVar);
if (n.TargetObject.Type != ElaNodeType.NameReference)
AddError(ElaCompilerError.InvalidPattern, n, FormatNode(n));
else
EmitSpecName(alias, "$$$$" + fn, n, ElaCompilerError.UndefinedName);
cw.Emit(Op.Skiptag);
cw.Emit(Op.Br, failLab);
}
break;
case ElaNodeType.NameReference:
{
//Irrefutable pattern, always binds expression to a name, unless it is
//a constructor pattern
var n = (ElaNameReference)exp;
//Bang pattern are only allowed in constructors and functions
if (n.Bang && !allowBang)
{
AddError(ElaCompilerError.BangPatternNotValid, exp, FormatNode(exp));
AddHint(ElaCompilerHint.BangsOnlyFunctions, exp);
}
if (n.Uppercase) //This is a constructor
{
if (sysVar != -1)
PushVar(sysVar);
EmitSpecName(null, "$$$$" + n.Name, n, ElaCompilerError.UndefinedName);
//This op codes skips one offset if an expression
//on the top of the stack has a specified tag.
cw.Emit(Op.Skiptag);
cw.Emit(Op.Br, failLab);
}
else
{
var newV = false;
var addr = AddMatchVariable(n.Name, n, out newV);
//This is a valid situation, it means that the value is
//already on the top of the stack.
if (sysVar > -1 && newV)
PushVar(sysVar);
if (n.Bang)
cw.Emit(Op.Force);
//The binding is already done, so just idle.
if (newV)
PopVar(addr);
}
}
break;
case ElaNodeType.UnitLiteral:
{
//Unit pattern is redundant, it is essentially the same as checking
//the type of an expression which is what we do here.
PushVar(sysVar);
cw.Emit(Op.Force);
cw.Emit(Op.PushI4, (Int32)ElaTypeCode.Unit);
cw.Emit(Op.Ctype);
//Types are not equal, proceed to fail.
cw.Emit(Op.Brfalse, failLab);
}
break;
case ElaNodeType.Primitive:
{
var n = (ElaPrimitive)exp;
//Compare a given value with a primitive
PushVar(sysVar);
PushPrimitive(n.Value);
cw.Emit(Op.Cneq);
//Values not equal, proceed to fail.
cw.Emit(Op.Brtrue, failLab);
}
break;
case ElaNodeType.As:
{
var n = (ElaAs)exp;
CompilePattern(sysVar, n.Expression, failLab, allowBang, false /*forceStrict*/);
var newV = false;
var addr = AddMatchVariable(n.Name, n, out newV);
PushVar(sysVar);
PopVar(addr);
}
break;
case ElaNodeType.Placeholder:
//This is a valid situation, it means that the value is
//already on the top of the stack. Otherwise - nothing have to be done.
if (sysVar == -1)
cw.Emit(Op.Pop);
break;
case ElaNodeType.RecordLiteral:
{
var n = (ElaRecordLiteral)exp;
CompileRecordPattern(sysVar, n, failLab, allowBang);
}
break;
case ElaNodeType.TupleLiteral:
{
var n = (ElaTupleLiteral)exp;
CompileTuplePattern(sysVar, n, failLab, allowBang);
}
break;
case ElaNodeType.Juxtaposition:
{
//An infix pattern, currently the only case is head/tail pattern.
var n = (ElaJuxtaposition)exp;
CompileComplexPattern(sysVar, n, failLab, allowBang);
}
break;
case ElaNodeType.ListLiteral:
{
var n = (ElaListLiteral)exp;
//We a have a nil pattern '[]'
if (!n.HasValues())
{
PushVar(sysVar);
cw.Emit(Op.Isnil);
cw.Emit(Op.Brfalse, failLab);
}
else
{
//We don't want to write the same compilation logic twice,
//so here we transform a list literal into a chain of function calls, e.g.
//[1,2,3] goes to 1::2::3::[] with a mandatory nil at the end.
var len = n.Values.Count;
ElaExpression last = ElaListLiteral.Empty;
var fc = default(ElaJuxtaposition);
//Loops through all elements in literal backwards
for (var i = 0; i < len; i++)
{
var nn = n.Values[len - i - 1];
fc = new ElaJuxtaposition();
fc.SetLinePragma(nn.Line, nn.Column);
fc.Parameters.Add(nn);
fc.Parameters.Add(last);
last = fc;
}
//Now we can compile it as head/tail pattern
CompilePattern(sysVar, fc, failLab, allowBang, false /*forceStrict*/);
}
}
break;
default:
AddError(ElaCompilerError.InvalidPattern, exp, FormatNode(exp));
break;
}
}
//Compiles a special case of constructor pattern - head/tail pattern.
private void CompileHeadTail(int sysVar, ElaJuxtaposition call, Label failLab, bool allowBang)
{
var fst = call.Parameters[0];
var snd = call.Parameters[1];
//Now check if a list is nil. If this is the case proceed to fail.
PushVar(sysVar);
cw.Emit(Op.Isnil);
cw.Emit(Op.Brtrue, failLab);
//Take a head of a list
PushVar(sysVar);
cw.Emit(Op.Head);
var sysVar2 = -1;
//For a case of a simple pattern we don't need to create to additional system
//variable - these patterns are aware that they might accept -1 and it means that
//the value is already on the top of the stack.
if (!IsSimplePattern(fst))
{
sysVar2 = AddVariable();
PopVar(sysVar2);
}
CompilePattern(sysVar2, fst, failLab, allowBang, false /*forceStrict*/);
//Take a tail of a list
PushVar(sysVar);
cw.Emit(Op.Tail);
sysVar2 = -1;
//Again, don't do redundant bindings for simple patterns
if (!IsSimplePattern(snd))
{
sysVar2 = AddVariable();
PopVar(sysVar2);
}
CompilePattern(sysVar2, snd, failLab, allowBang, false /*forceStrict*/);
}
//Used to compile an anonymous function (lambda). This function returns a number of parameters
//in compiled lambda.
private int CompileLambda(ElaEquation bid)
{
var fc = new ElaJuxtaposition();
//Lambda is parsed as a an application of a lambda operator, e.g.
//expr -> expr, therefore it needs to be transformed in order to be
//able to use existing match compilation logic.
if (bid.Left.Type == ElaNodeType.Juxtaposition
&& !bid.Left.Parens) //Parens flag is added if an expression is in parens and
//therefore should be qualified as a pattern.
{
var f = (ElaJuxtaposition)bid.Left;
fc.Parameters.Add(f.Target);
fc.Parameters.AddRange(f.Parameters);
}
else
fc.Parameters.Add(bid.Left);
bid.Left = fc;
var parLen = fc.Parameters.Count;
StartFun(null, parLen);
var funSkipLabel = cw.DefineLabel();
var map = new LabelMap();
cw.Emit(Op.Br, funSkipLabel);
//We start a real (VM based) lexical scope for a function.
StartScope(true, bid.Right.Line, bid.Right.Column);
StartSection();
var address = cw.Offset;
CompileFunctionMatch(parLen, bid, map, Hints.Scope | Hints.Tail);
var funHandle = frame.Layouts.Count;
var ss = EndFun(funHandle);
frame.Layouts.Add(new MemoryLayout(currentCounter, ss, address));
EndScope();
EndSection();
cw.Emit(Op.Ret);
cw.MarkLabel(funSkipLabel);
AddLinePragma(bid);
//Function is constructed
cw.Emit(Op.PushI4, parLen);
cw.Emit(Op.Newfun, funHandle);
return parLen;
}
void InfixExpr(out ElaExpression exp)
{
exp = null;
var ot = t;
var funexp = default(ElaExpression);
if (StartOf(16)) {
OpExpr10(out exp);
while (la.kind == 60) {
var cexp = default(ElaExpression);
ot = t;
Get();
OpExpr11(out funexp);
Expect(60);
if (StartOf(16)) {
OpExpr10(out cexp);
}
var fc = new ElaJuxtaposition(ot) {
Target = funexp
};
fc.Parameters.Add(exp);
if (cexp != null)
fc.Parameters.Add(cexp);
exp = fc;
}
} else if (la.kind == 60) {
Get();
OpExpr10(out funexp);
Expect(60);
if (StartOf(16)) {
OpExpr10(out exp);
exp = GetPrefixFun(funexp, exp, true);
}
if (exp == null)
exp = funexp;
} else SynErr(88);
}
void DoBlock(out ElaExpression exp)
{
scanner.InjectBlock();
var skip = false;
ElaExpression eqt = new ElaJuxtaposition(t) { Spec = true };
exp = eqt;
while (!(la.kind == 0 || la.kind == 66)) {SynErr(98); Get();}
Expect(66);
if (la.kind == 50) {
EndBlock();
skip=true;
}
scanner.InjectBlock();
DoBlockStmt(ref eqt);
if (RequireEndBlock())
EndBlock();
while (StartOf(3)) {
scanner.InjectBlock();
DoBlockStmt(ref eqt);
if (RequireEndBlock())
EndBlock();
}
exp = ValidateDoBlock(exp);
if (!skip)
EndBlock();
}
void Application(out ElaExpression exp)
{
exp = null;
AccessExpr(out exp);
var ot = t;
var mi = default(ElaJuxtaposition);
var cexp = default(ElaExpression);
if (exp.Type == ElaNodeType.Juxtaposition)
mi = (ElaJuxtaposition)exp;
while (StartOf(19)) {
AccessExpr(out cexp);
if (mi == null)
{
mi = new ElaJuxtaposition(ot) { Target = exp };
exp = mi;
}
else
mi.Parens = false;
if (mi != null)
mi.Parameters.Add(cexp);
}
if (la.kind == 61) {
Get();
var ctx = new ElaContext(t) { Expression = exp };
var cexp2 = default(ElaExpression);
AccessExpr(out cexp2);
ctx.Context = cexp2;
exp = ctx;
}
}
//Compiling a regular function call.
private ExprData CompileFunctionCall(ElaJuxtaposition v, LabelMap map, Hints hints)
{
var ed = ExprData.Empty;
var bf = default(ElaNameReference);
var sv = default(ScopeVar);
if (!map.HasContext && TryOptimizeConstructor(v, map))
return ed;
if (!map.HasContext && v.Target.Type == ElaNodeType.NameReference)
{
bf = (ElaNameReference)v.Target;
sv = GetVariable(bf.Name, bf.Line, bf.Column);
//If the target is one of the built-in application function we need to transform this
//to a regular function call, e.g. 'x |> f' is translated into 'f x' by manually creating
//an appropriates AST node. This is done to simplify compilation - so that all optimization
//of a regular function call would be applied to pipes as well.
if ((sv.Flags & ElaVariableFlags.Builtin) == ElaVariableFlags.Builtin)
{
var k = (ElaBuiltinKind)sv.Data;
if (v.Parameters.Count == 2)
{
if (k == ElaBuiltinKind.BackwardPipe)
{
var fc = new ElaJuxtaposition { Target = v.Parameters[0] };
fc.SetLinePragma(v.Line, v.Column);
fc.Parameters.Add(v.Parameters[1]);
return CompileFunctionCall(fc, map, hints);
}
else if (k == ElaBuiltinKind.ForwardPipe)
{
var fc = new ElaJuxtaposition { Target = v.Parameters[1] };
fc.SetLinePragma(v.Line, v.Column);
fc.Parameters.Add(v.Parameters[0]);
return CompileFunctionCall(fc, map, hints);
}
else if (k == ElaBuiltinKind.LogicalOr)
{
CompileLogicalOr(v, v.Parameters[0], v.Parameters[1], map, hints);
return ed;
}
else if (k == ElaBuiltinKind.LogicalAnd)
{
CompileLogicalAnd(v, v.Parameters[0], v.Parameters[1], map, hints);
return ed;
}
else if (k == ElaBuiltinKind.Seq)
{
CompileSeq(v, v.Parameters[0], v.Parameters[1], map, hints);
return ed;
}
}
}
}
//We can't apply tail call optimization for the context bound call
var tail = (hints & Hints.Tail) == Hints.Tail && !map.HasContext;
var len = v.Parameters.Count;
//Compile arguments to which a function is applied
for (var i = 0; i < len; i++)
CompileExpression(v.Parameters[len - i - 1], map, Hints.None, v);
//If this a tail call and we effectively call the same function we are currently in,
//than do not emit an actual function call, just do a goto. (Tail recursion optimization).
if (tail && map.FunctionName != null && map.FunctionName == v.GetName() &&
map.FunctionParameters == len && map.FunctionScope == GetScope(map.FunctionName)
&& (sv.Flags & ElaVariableFlags.ClassFun) != ElaVariableFlags.ClassFun)
{
AddLinePragma(v);
cw.Emit(Op.Br, map.FunStart);
return ed;
}
if (bf != null)
{
if (v.Parameters[0].Type == ElaNodeType.Primitive &&
bf.Line == v.Parameters[0].Line && bf.Column + bf.Name.Length == v.Parameters[0].Column &&
((ElaPrimitive)v.Parameters[0]).Value.IsNegative())
{
var par = ((ElaPrimitive)v.Parameters[0]).Value.ToString();
AddWarning(ElaCompilerWarning.NegationAmbiguity, v, bf.Name, par);
AddHint(ElaCompilerHint.AddSpaceApplication, v, bf.Name, par, par.TrimStart('-'));
}
//The target is one of built-in functions and therefore can be inlined for optimization.
if ((sv.Flags & ElaVariableFlags.Builtin) == ElaVariableFlags.Builtin)
{
var kind = (ElaBuiltinKind)sv.Data;
var pars = BuiltinParams(kind);
//We inline built-ins only when all arguments are provided
//If this is not the case a built-in is compiled into a function in-place
//and than called.
if (len != pars)
{
AddLinePragma(bf);
CompileBuiltin(kind, v.Target, map, bf.Name);
if (v.FlipParameters)
cw.Emit(Op.Flip);
for (var i = 0; i < len; i++)
cw.Emit(Op.Call);
}
else
CompileBuiltinInline(kind, v.Target, map, hints);
return ed;
}
else
{
//Regular situation, just push a target name
AddLinePragma(v.Target);
PushVar(sv);
if ((sv.VariableFlags & ElaVariableFlags.Function) == ElaVariableFlags.Function)
ed = new ExprData(DataKind.FunParams, sv.Data);
else if ((sv.VariableFlags & ElaVariableFlags.ObjectLiteral) == ElaVariableFlags.ObjectLiteral)
ed = new ExprData(DataKind.VarType, (Int32)ElaVariableFlags.ObjectLiteral);
}
}
else
ed = CompileExpression(v.Target, map, Hints.None, v);
//Why it comes from AST? Because parser do not save the difference between pre-, post- and infix applications.
//However Ela does support left and right sections for operators - and for such cases an additional flag is used
//to signal about a section.
if (v.FlipParameters)
cw.Emit(Op.Flip);
//It means that we are trying to call "not a function". Ela is a dynamic language, still it's worth to generate
//a warning in such a case.
if (ed.Type == DataKind.VarType)
AddWarning(ElaCompilerWarning.FunctionInvalidType, v.Target, FormatNode(v.Target));
AddLinePragma(v);
for (var i = 0; i < len; i++)
{
var last = i == v.Parameters.Count - 1;
//Use a tail call if this function call is a tail expression and optimizations are enabled.
if (last && tail && opt)
cw.Emit(Op.Callt);
else
cw.Emit(Op.Call);
}
return ed;
}
private ElaExpression ValidateDoBlock(ElaExpression exp)
{
if (exp.Type == ElaNodeType.Juxtaposition && ((ElaJuxtaposition)exp).Parameters[0] == null)
{
var ext = ((ElaJuxtaposition)exp).Parameters[1];
var ctx = default(ElaContext);
if (ext.Type == ElaNodeType.Context)
{
ctx = (ElaContext)ext;
ext = ctx.Expression;
}
var eqt = new ElaJuxtaposition { Spec = true };
eqt.SetLinePragma(exp.Line, exp.Column);
eqt.Target = new ElaNameReference(t) { Name = ">>=" };
eqt.Parameters.Add(ext);
var jux = new ElaJuxtaposition();
jux.SetLinePragma(exp.Line, exp.Column);
jux.Target = new ElaNameReference { Name = "point" };
jux.Parameters.Add(new ElaUnitLiteral());
eqt.Parameters.Add(new ElaLambda { Left = new ElaPlaceholder(), Right = jux });
if (ctx != null)
{
ctx.Expression = eqt;
exp = ctx;
}
else
exp = eqt;
}
var root = exp;
while (true)
{
if (exp.Type == ElaNodeType.Juxtaposition)
{
var juxta = (ElaJuxtaposition)exp;
if (juxta.Parameters.Count == 2)
{
juxta.Parameters[0] = Reduce(juxta.Parameters[0], juxta);
juxta.Parameters[1] = Reduce(juxta.Parameters[1], juxta);
exp = juxta.Parameters[1];
}
else
break;
}
else if (exp.Type == ElaNodeType.LetBinding)
{
var lb = (ElaLetBinding)exp;
lb.Expression = Reduce(lb.Expression, lb);
exp = lb.Expression;
}
else if (exp.Type == ElaNodeType.Lambda)
{
var lb = (ElaLambda)exp;
lb.Right = Reduce(lb.Right, lb);
if (lb.Left.Type != ElaNodeType.NameReference &&
lb.Left.Type != ElaNodeType.Placeholder)
{
var em = new ElaMatch();
em.SetLinePragma(lb.Left.Line, lb.Left.Column);
em.Expression = new ElaNameReference { Name = "$x01" };
em.Entries = new ElaEquationSet();
var eq1 = new ElaEquation();
eq1.SetLinePragma(lb.Left.Line, lb.Left.Column);
eq1.Left = lb.Left;
eq1.Right = lb.Right;
em.Entries.Equations.Add(eq1);
var eq2 = new ElaEquation();
eq2.SetLinePragma(lb.Left.Line, lb.Left.Column);
eq2.Left = new ElaNameReference { Name = "$x02" };
var errExp = new ElaJuxtaposition();
errExp.SetLinePragma(lb.Left.Line, lb.Left.Column);
errExp.Target = new ElaNameReference { Name = "failure" };
errExp.Parameters.Add(new ElaNameReference { Name = "$x02" });
eq2.Right = errExp;
em.Entries.Equations.Add(eq2);
lb.Left = new ElaNameReference { Name = "$x01" };
lb.Right = em;
exp = lb;
}
else
exp = lb.Right;
}
else
break;
}
var ret = new ElaLazyLiteral { Expression = root };
ret.SetLinePragma(root.Line, root.Column);
return ret;
}
private void ProcessDoBlock(ElaExpression cexp1, ElaExpression cexp2, ref ElaExpression rootExp)
{
var eqt = default(ElaJuxtaposition);
var lam = default(ElaLambda);
var letb = default(ElaLetBinding);
if (cexp2 == null)
{
cexp2 = cexp1;
cexp1 = new ElaPlaceholder();
}
if (rootExp.Type == ElaNodeType.Juxtaposition)
eqt = (ElaJuxtaposition)rootExp;
else if (rootExp.Type == ElaNodeType.Lambda)
{
lam = (ElaLambda)rootExp;
eqt = lam.Right as ElaJuxtaposition;
}
else if (rootExp.Type == ElaNodeType.LetBinding)
{
letb = (ElaLetBinding)rootExp;
eqt = letb.Expression as ElaJuxtaposition;
}
else if (rootExp.Type != ElaNodeType.None)
{
eqt = new ElaJuxtaposition { Spec = true };
eqt.SetLinePragma(cexp1.Line, cexp1.Column);
eqt.Parameters.Add(null);
eqt.Parameters.Add(rootExp);
}
if (eqt != null && !eqt.Spec)
{
var eqt2 = new ElaJuxtaposition();
eqt2.SetLinePragma(eqt.Line, eqt.Column);
eqt2.Target = new ElaNameReference(t) { Name = ">>-" };
eqt2.Parameters.Add(null);
eqt2.Parameters.Add(eqt);
eqt = eqt2;
}
if (eqt != null && eqt.Parameters.Count == 2)
{
if (eqt.Parameters[0] == null)
{
eqt.Target = new ElaNameReference(t) { Name = ">>=" };
var lambda = new ElaLambda();
lambda.SetLinePragma(cexp2.Line, cexp2.Column);
lambda.Left = new ElaPlaceholder();
var lambda2 = new ElaLambda();
lambda2.SetLinePragma(cexp2.Line, cexp2.Column);
lambda2.Left = cexp1;
var eqt1 = new ElaJuxtaposition { Spec = true };
eqt1.SetLinePragma(cexp2.Line, cexp2.Column);
eqt1.Target = new ElaNameReference(t) { Name = ">>=" };
eqt1.Parameters.Add(cexp2);
eqt1.Parameters.Add(lambda2);
lambda.Right = eqt1;
eqt.Parameters[0] = eqt.Parameters[1];
eqt.Parameters[1] = lambda;
rootExp = lambda2;
}
else
{
throw new Exception("Unable to process do-notation.");
}
}
else
{
if (eqt == null)
{
eqt = new ElaJuxtaposition { Spec = true };
eqt.SetLinePragma(cexp1.Line, cexp1.Column);
if (lam != null)
lam.Right = eqt;
else if (letb != null)
letb.Expression = eqt;
}
eqt.Target = new ElaNameReference(t) { Name = ">>=" };
eqt.Parameters.Add(cexp2);
var lambda = new ElaLambda();
lambda.SetLinePragma(cexp2.Line, cexp2.Column);
lambda.Left = cexp1;
eqt.Parameters.Add(lambda);
rootExp = lambda;
}
}
//Compiles a type constructor
private void CompileConstructorFunction(string typeName, string name, ElaJuxtaposition juxta, int sca, ElaVariableFlags flags, int typeModuleId)
{
Label funSkipLabel;
int address;
LabelMap newMap;
var pars = new List<String>();
var len = juxta.Parameters.Count;
AddLinePragma(juxta);
CompileFunctionProlog(name, len, juxta.Line, juxta.Column, out funSkipLabel, out address, out newMap);
var sys = new int[len];
var types = new ScopeVar[len];
var bangs = new bool[len];
//Here we have to validate all constructor parameters
for (var i = 0; i < len; i++)
{
var ce = juxta.Parameters[i];
sys[i] = AddVariable();
if (bangs[i] = IsBang(ce))
cw.Emit(Op.Force);
PopVar(sys[i]);
//This can be type a type constraint so we should compile here type check logic
if (ce.Type == ElaNodeType.Juxtaposition)
{
var jc = (ElaJuxtaposition)ce;
//First we check if a constraint is actually valid
if (IsInvalidConstructorParameterConstaint(jc))
AddError(ElaCompilerError.InvalidConstructorParameter, juxta, FormatNode(ce), name);
else if (jc.Target.Type == ElaNodeType.NameReference)
{
//A simple direct type reference
var nt = (ElaNameReference)jc.Target;
PushVar(sys[i]);
types[i] = TypeCheckConstructor(name, null, nt.Name, nt, false);
pars.Add(jc.Parameters[0].GetName());
}
else if (jc.Target.Type == ElaNodeType.FieldReference)
{
//A type is qualified with a module alias
var fr = (ElaFieldReference)jc.Target;
PushVar(sys[i]);
types[i] = TypeCheckConstructor(name, fr.TargetObject.GetName(), fr.FieldName, fr, false);
pars.Add(jc.Parameters[0].GetName());
}
}
else if (ce.Type == ElaNodeType.NameReference && !IsInvalidConstructorParameter(ce))
{
pars.Add(ce.GetName());
types[i] = ScopeVar.Empty;
}
else
AddError(ElaCompilerError.InvalidConstructorParameter, juxta, FormatNode(ce), name);
}
frame.InternalConstructors.Add(new ConstructorData
{
TypeName = typeName,
Name = name,
Code = -1,
Parameters = pars,
TypeModuleId = typeModuleId
});
//For optimization purposes we use a simplified creation algorythm for constructors
//with 1 and 2 parameters
if (len == 1)
PushVar(sys[0]);
else if (len == 2)
{
PushVar(sys[0]);
PushVar(sys[1]);
}
else
{
cw.Emit(Op.Newtup, len);
for (var i = 0; i < len; i++)
{
PushVar(sys[i]);
cw.Emit(Op.Tupcons, i);
}
}
var ctid = frame.InternalConstructors.Count - 1;
cw.Emit(Op.Ctorid, ctid);
//Refering to captured name, need to recode its address
PushVar((Byte.MaxValue & sca) + 1 | (sca << 8) >> 8);
if (len == 1)
cw.Emit(Op.Newtype1);
else if (len == 2)
cw.Emit(Op.Newtype2);
else
cw.Emit(Op.Newtype);
CompileFunctionEpilog(name, len, address, funSkipLabel);
var a = AddVariable(name, juxta, ElaVariableFlags.TypeFun|ElaVariableFlags.Function|flags, len);
PopVar(a);
//We need to add special variable that would indicate that a constructor parameter
//should be strictly evaluated. Used when inlining constructors. This variable is for
//metadata only, it is never initialized.
for (var i = 0; i < bangs.Length; i++)
{
if (bangs[i])
{
CurrentScope.Locals.Remove("$-!" + i + name); //To prevent redundant errors
AddVariable("$-!" + i + name, juxta, ElaVariableFlags.None, -1);
}
}
//We need to add special variable that would store type check information.
//This information is used when inlining constructors.
for (var i = 0; i < types.Length; i++)
{
var sv = types[i];
//There is a type constraint, we have to memoize it for inlining
if (!sv.IsEmpty())
{
CurrentScope.Locals.Remove("$-" + i + name); //To prevent redundant errors
var av = AddVariable("$-" + i + name, juxta, ElaVariableFlags.None, -1);
//This ScopeVar was obtained in a different scope, we have to patch it here
if ((sv.Flags & ElaVariableFlags.External) == ElaVariableFlags.External)
PushVar(sv); //No need to patch an external
else
{
//Roll up one scope
sv.Address = ((sv.Address & Byte.MaxValue) - 1) | (sv.Address >> 8) << 8;
PushVar(sv);
}
PopVar(av);
}
}
//To prevent redundant errors
CurrentScope.Locals.Remove("$-" + name);
CurrentScope.Locals.Remove("$--" + name);
//We add special variables that can be used lately to inline this constructor call.
var consVar = AddVariable("$-" + name, juxta, flags, len);
var typeVar = AddVariable("$--" + name, juxta, flags, len);
cw.Emit(Op.Ctorid, ctid);
PopVar(consVar);
PushVar(sca);
PopVar(typeVar);
}
//Checks if a constructor parameter type constraint is invalid
private bool IsInvalidConstructorParameterConstaint(ElaJuxtaposition n)
{
if (n.Parameters.Count != 1)
return true;
if (IsInvalidConstructorParameter(n.Parameters[0]))
return true;
if (n.Target.Type == ElaNodeType.NameReference)
return !((ElaNameReference)n.Target).Uppercase;
else if (n.Target.Type == ElaNodeType.FieldReference)
{
var f = (ElaFieldReference)n.Target;
return f.TargetObject.Type != ElaNodeType.NameReference || !Char.IsUpper(f.FieldName[0]);
}
return true;
}