public Relation FxnTypeToRelation(CatFxnType ft)
{
Vector cons = TypeVectorToConstraintVector(ft.GetCons());
Vector prod = TypeVectorToConstraintVector(ft.GetProd());
Relation r = new Relation(cons, prod);
return r;
}
public static CatFxnType Create(string sType)
{
if (sType.Length == 0)
{
return(null);
}
Peg.Parser p = new Peg.Parser(sType);
try {
if (!p.Parse(CatGrammar.FxnType()))
{
throw new Exception("no additional information");
}
} catch (Exception e) {
throw new Exception(sType + " is not a valid function type ", e);
}
Peg.PegAstNode ast = p.GetAst();
if (ast.GetNumChildren() != 1)
{
throw new Exception("invalid number of children in abstract syntax tree");
}
AstFxnType node = new AstFxnType(ast.GetChild(0));
CatFxnType ret = new CatFxnType(node);
return(ret);
}
/// <summary>
/// This function modifies the function
/// </summary>
public void RemoveImplicitRhoVariables(CatFxnType ft)
{
foreach (CatKind k in ft.GetChildKinds())
{
if (k is CatFxnType)
{
RemoveImplicitRhoVariables(k as CatFxnType);
}
}
if (!ft.GetCons().IsEmpty() && !ft.GetProd().IsEmpty())
{
CatKind k1 = ft.GetCons().GetBottom();
CatKind k2 = ft.GetProd().GetBottom();
// Does both consumption and production share the same
// stack variable at the bottom, if so, then we might have
// an implicit Rho variables
if (k1 is CatStackVar && k1.Equals(k2))
{
// try removing the stack variable
ft.GetCons().GetKinds().RemoveAt(0);
ft.GetProd().GetKinds().RemoveAt(0);
// is the variable used anywhere else?
// if so, then we have to restore it
// otherwise we leave it taken away
if (DoesVarExist(k1))
{
ft.GetCons().GetKinds().Insert(0, k1);
ft.GetProd().GetKinds().Insert(0, k2);
}
}
}
}
/// <summary>
/// Compares two function types, by first normalizing so that they each have
/// names of variables that correspond to the locations in the function
/// </summary>
public static bool CompareFxnTypes(CatFxnType f, CatFxnType g)
{
CatFxnType f2 = CatVarRenamer.RenameVars(f.AddImplicitRhoVariables());
CatFxnType g2 = CatVarRenamer.RenameVars(g.AddImplicitRhoVariables());
return(f2.IsSubtypeOf(g2));
}
public AstMacroStackVar(PegAstNode node)
: base(node)
{
if (node.GetNumChildren() < 1)
{
throw new Exception("invalid macro stack variable");
}
if (node.GetNumChildren() > 2)
{
throw new Exception("invalid macro stack variable");
}
msName = node.GetChild(0).ToString();
if (node.GetNumChildren() == 2)
{
AstFxnType typeNode = new AstFxnType(node.GetChild(1));
mType = CatFxnType.Create(typeNode) as CatFxnType;
if (mType == null)
{
throw new Exception("expected function type " + typeNode.ToString());
}
}
CheckLabel(AstLabel.MacroStackVar);
}
public PushValue(T x)
{
mValue = new CatMetaValue <T>(x);
msName = mValue.GetData().ToString();
msValueType = CatKind.TypeNameFromObject(x);
mpFxnType = CatFxnType.Create("( -> " + msValueType + ")");
}
public QuotedFunction(CatExpr children, CatFxnType pFxnType)
{
mSubFxns = new CatExpr(children.ToArray());
msDesc = "anonymous function";
msName = "_anonymous_";
mpFxnType = new CatQuotedType(pFxnType);
}
public void Add(string s, CatFxnType ft)
{
if (HasScope(s, ft))
{
return;
}
base.Add(new CatVarScope(s, ft));
}
public CatFxnType Rename(CatFxnType f)
{
if (f == null)
{
throw new Exception("Invalid null parameter to rename function");
}
return(new CatFxnType(Rename(f.GetCons()), Rename(f.GetProd()), f.HasSideEffects()));
}
public Relation FxnTypeToRelation(CatFxnType ft)
{
Vector cons = TypeVectorToConstraintVector(ft.GetCons());
Vector prod = TypeVectorToConstraintVector(ft.GetProd());
Relation r = new Relation(cons, prod);
return(r);
}
public QuotedFunction GetQuotedFxn()
{
// An important optimization: this can be very slow.
if (mQF == null)
{
mQF = new QuotedFunction(mSubFxns, CatFxnType.Unquote(mpFxnType));
}
return(mQF);
}
public CatFxnType GetFxnType()
{
if (mpFxnType == null)
{
mpFxnType = CatTypeReconstructor.Infer(this);
}
Trace.Assert(mpFxnType != null);
return(mpFxnType);
}
public Method(Object o, MethodInfo mi)
: base(mi.Name, "undocumented method from CLR")
{
mMethod = mi;
mObject = o;
string sType = MethodToTypeString(mi);
mpFxnType = CatFxnType.Create(sType);
mpFxnType = CatVarRenamer.RenameVars(mpFxnType);
}
/// <summary>
/// This is a raw equivalency check: no normalization is done.
/// To comparse function type normally you would use CompareFxnTypes,
/// which in turn calls this function.
/// </summary>
public override bool Equals(CatKind k)
{
if (!(k is CatFxnType))
{
return(false);
}
CatFxnType f = k as CatFxnType;
return(GetCons().Equals(f.GetCons()) && GetProd().Equals(f.GetProd()) &&
HasSideEffects() == f.HasSideEffects());
}
public bool IsValidChildFxn(List <string> varNames, CatFxnType ft)
{
foreach (CatKind k in ft.GetCons().GetKinds())
{
if (k.IsKindVar())
{
varNames.Add(k.ToString());
}
}
return(IsValidProduction(varNames, ft.GetProd()));
}
public static CatFxnType ComposeTypes(CatFxnType left, CatFxnType right)
{
if (!Config.gbTypeChecking)
{
return(null);
}
CatTypeReconstructor inferer = new CatTypeReconstructor();
return(inferer.LocalComposeTypes(left, right));
}
public bool HasScope(string s, CatFxnType ft)
{
foreach (CatVarScope vs in this)
{
if (vs.mName.Equals(s) && vs.mScope == ft)
{
return(true);
}
}
return(false);
}
public static bool DoesVarOccurIn(CatKind k, CatFxnType ft, CatFxnType except)
{
if (!k.IsKindVar())
{
return(false);
}
if (k == except)
{
return(false);
}
return(DoesVarOccurIn(k, ft.GetCons(), except) || DoesVarOccurIn(k, ft.GetProd(), except));
}
public bool DescendentOf(CatFxnType ft)
{
if (this == ft)
{
return(true);
}
if (mpParent == null)
{
return(false);
}
return(mpParent.DescendentOf(ft));
}
private void SetChildFxnParents()
{
foreach (CatKind k in GetChildKinds())
{
if (k is CatFxnType)
{
CatFxnType ft = k as CatFxnType;
ft.SetChildFxnParents();
ft.SetParent(this);
}
}
}
public static CatFxnType Unquote(CatFxnType ft)
{
if (ft == null)
return null;
if (ft.GetCons().GetKinds().Count > 0)
throw new Exception("Can't unquote a function type with a consumption size greater than zero");
if (ft.GetProd().GetKinds().Count != 1)
throw new Exception("Can't unquote a function type which does not produce a single function");
CatKind k = ft.GetProd().GetKinds()[0];
if (!(k is CatFxnType))
throw new Exception("Can't unquote a function type which does not produce a single function");
return k as CatFxnType;
}
public void GetConsVarNames(List <string> varNames, CatFxnType ft)
{
foreach (CatKind k in ft.GetCons().GetKinds())
{
if (k.IsKindVar())
{
varNames.Add(k.ToString());
}
if (k is CatFxnType)
{
GetConsVarNames(varNames, k as CatFxnType);
}
}
}
public bool IsFreeVar(CatFxnType context, CatKind k)
{
// Is it contained in a function outside of the context?
// Find all scopes associated with the kind
if (!k.IsKindVar())
{
return(false);
}
foreach (CatFxnType tmp in GetAssociatedScopes(k))
{
if (!tmp.DescendentOf(context))
{
return(false);
}
}
return(true);
}
public override void Eval(Executor exec)
{
QuotedFunction f = exec.TypedPeek <QuotedFunction>();
bool bVerbose = Config.gbVerboseInference;
bool bInfer = Config.gbTypeChecking;
Config.gbVerboseInference = true;
Config.gbTypeChecking = true;
try {
CatFxnType ft = CatTypeReconstructor.Infer(f.GetSubFxns());
if (ft == null)
{
Output.WriteLine("type could not be inferred");
}
} finally {
Config.gbVerboseInference = bVerbose;
Config.gbTypeChecking = bInfer;
}
}
public static bool DoesVarOccurIn(CatKind k, CatTypeVector vec, CatFxnType except)
{
foreach (CatKind tmp in vec.GetKinds())
{
if (tmp.IsKindVar() && tmp.Equals(k))
{
return(true);
}
if (tmp is CatFxnType)
{
if (DoesVarOccurIn(k, tmp as CatFxnType, except))
{
return(true);
}
}
}
return(false);
}
public static string ToPrettyString(CatFxnType ft, Dictionary <string, string> dic)
{
// remove rho variables
ft = ft.Clone();
ft.RemoveImplicitRhoVariables();
string s = ToPrettyString(ft.GetCons(), dic);
if (ft.HasSideEffects())
{
s += " ~> ";
}
else
{
s += " -> ";
}
s += ToPrettyString(ft.GetProd(), dic);
return(s);
}
public static CatFxnType RenameFreeVars(CatFxnType left, CatFxnType right, CatFxnType ft)
{
CatTypeVarList vars = ft.GetAllVars();
foreach (string s in vars.Keys)
{
CatKind k = vars[s];
if (IsFreeVar(k, left, right, ft))
{
if (k is CatTypeVar)
{
vars[s] = CatTypeVar.CreateUnique();
}
else
{
vars[s] = CatStackVar.CreateUnique();
}
}
}
return(RenameVars(ft, vars));
}
public PushFunction(CatExpr children)
{
mSubFxns = children.GetRange(0, children.Count);
msDesc = "pushes an anonymous function onto the stack";
msName = "_function_";
if (Config.gbTypeChecking)
{
if (Config.gbVerboseInference)
{
Output.WriteLine("inferring type of quoted function " + msName);
}
try
{
// Quotations can be unclear?
CatFxnType childType = CatTypeReconstructor.Infer(mSubFxns);
// Honestly this should never be true.
if (childType == null)
{
throw new Exception("unknown type error");
}
mpFxnType = new CatQuotedType(childType);
mpFxnType = CatVarRenamer.RenameVars(mpFxnType);
}
catch (Exception e)
{
Output.WriteLine("Could not type quotation: " + msName);
Output.WriteLine("Type error: " + e.Message);
mpFxnType = null;
}
}
else
{
mpFxnType = null;
}
}
/* TODO: LOWPRI: remove
* private CatTypeVarList GetVarsExcept(CatFxnType except)
* {
* CatTypeVarList ret = new CatTypeVarList();
* GetVarsExcept(except, ret);
* return ret;
* }
*
* private void GetVarsExcept(CatFxnType except, CatTypeVarList vars)
* {
* foreach (CatKind k in GetChildKinds())
* {
* if (k is CatFxnType)
* {
* CatFxnType ft = k as CatFxnType;
* if (ft != except)
* ft.GetVarsExcept(except, vars);
* }
* else
* {
* if (k.IsKindVar())
* vars.Add(k);
* }
* }
* }
*/
/// <summary>
/// Every kind variable has a scope in which it is free.
/// This allows us to compute whether a variable is free or bound.
/// The purpose of figuring whether a variable is free or bound, is so
/// that when we copy a function, we can make sure that any free variables
/// are given new unique names. Basically we want to make new names,
/// but we can't always do that.
/// </summary>
/// <param name="scopes"></param>
private void ComputeVarScopes(CatVarScopes scopes, Stack <CatFxnType> visited)
{
if (visited.Contains(this))
{
return;
}
foreach (CatKind k in GetChildKinds())
{
if (k.IsKindVar())
{
scopes.Add(k, this);
}
else if (k is CatFxnType)
{
CatFxnType ft = k as CatFxnType;
visited.Push(ft);
ft.ComputeVarScopes(scopes, visited);
visited.Pop();
}
}
}
public static CatFxnType Unquote(CatFxnType ft)
{
if (ft == null)
{
return(null);
}
if (ft.GetCons().GetKinds().Count > 0)
{
throw new Exception("Can't unquote a function type with a consumption size greater than zero");
}
if (ft.GetProd().GetKinds().Count != 1)
{
throw new Exception("Can't unquote a function type which does not produce a single function");
}
CatKind k = ft.GetProd().GetKinds()[0];
if (!(k is CatFxnType))
{
throw new Exception("Can't unquote a function type which does not produce a single function");
}
return(k as CatFxnType);
}
public override bool IsSubtypeOf(CatKind k)
{
if (k.IsAny() || k.IsDynFxn())
{
return(IsRuntimePolymorphic());
}
if (k is CatTypeVar)
{
return(true);
}
if (!(k is CatFxnType))
{
return(false);
}
CatFxnType f = k as CatFxnType;
bool ret = GetCons().IsSubtypeOf(f.GetCons()) && GetProd().IsSubtypeOf(f.GetProd());
if (HasSideEffects())
{
ret = ret && f.HasSideEffects();
}
return(ret);
}
public static CatFxnType Create(string sType)
{
if (sType.Length == 0)
return null;
Peg.Parser p = new Peg.Parser(sType);
try
{
if (!p.Parse(CatGrammar.FxnType()))
throw new Exception("no additional information");
}
catch (Exception e)
{
throw new Exception(sType + " is not a valid function type ", e);
}
Peg.PegAstNode ast = p.GetAst();
if (ast.GetNumChildren() != 1)
throw new Exception("invalid number of children in abstract syntax tree");
AstFxnType node = new AstFxnType(ast.GetChild(0));
CatFxnType ret = new CatFxnType(node);
return ret;
}
public static CatFxnType RenameVars(CatFxnType ft)
{
return (new CatVarRenamer()).Rename(ft);
}
/// <summary>
/// Compares two function types, by first normalizing so that they each have
/// names of variables that correspond to the locations in the function
/// </summary>
public static bool CompareFxnTypes(CatFxnType f, CatFxnType g)
{
CatFxnType f2 = CatVarRenamer.RenameVars(f.AddImplicitRhoVariables());
CatFxnType g2 = CatVarRenamer.RenameVars(g.AddImplicitRhoVariables());
return f2.IsSubtypeOf(g2);
}
public static CatFxnType ComposeFxnTypes(CatFxnType f, CatFxnType g)
{
CatFxnType ft = CatTypeReconstructor.ComposeTypes(f, g);
return ft;
}
public AstMacroStackVar(PegAstNode node)
: base(node)
{
if (node.GetNumChildren() < 1)
throw new Exception("invalid macro stack variable");
if (node.GetNumChildren() > 2)
throw new Exception("invalid macro stack variable");
msName = node.GetChild(0).ToString();
if (node.GetNumChildren() == 2)
{
AstFxnType typeNode = new AstFxnType(node.GetChild(1));
mType = CatFxnType.Create(typeNode) as CatFxnType;
if (mType == null) throw new Exception("expected function type " + typeNode.ToString());
}
CheckLabel(AstLabel.MacroStackVar);
}
public CatFxnType LocalComposeTypes(CatFxnType left, CatFxnType right)
{
// Make sure that the variables on the left function and the variables
// on the right function are different
CatVarRenamer renamer = new CatVarRenamer();
left = renamer.Rename(left.AddImplicitRhoVariables());
renamer.ResetNames();
right = renamer.Rename(right.AddImplicitRhoVariables());
Log("==");
Log("Composing : " + left.ToString());
Log("with : " + right.ToString());
Log("Adding constraints");
Relation rLeft = FxnTypeToRelation(left);
Relation rRight = FxnTypeToRelation(right);
//TODO: remove
//rLeft.UnrollRecursiveRelations();
//rRight.UnrollRecursiveRelations();
Relation result = new Relation(rLeft.GetLeft(), rRight.GetRight());
AddTopLevelConstraints(rLeft.GetRight(), rRight.GetLeft());
AddConstraint(CreateVar("result$"), result);
Log("Constraints");
ComputeConstraintLists();
LogConstraints();
Log("Unifiers");
ComputeUnifiers();
foreach (string sVar in GetConstrainedVars())
{
Constraint u = GetUnifierFor(sVar);
Log("var: " + sVar + " = " + u);
}
Log("Composed Type");
Constraint c = GetResolvedUnifierFor("result$");
if (!(c is Relation))
throw new Exception("Resolved type is not a relation");
// TODO: remove
// Relation r = c as Relation;
// r.RollupRecursiveRelations();
CatKind k = ConstraintToCatKind(c);
CatFxnType ft = k as CatFxnType;
Log("raw type : " + ft.ToString());
Log("pretty type : " + ft.ToPrettyString());
Log("==");
CheckConstraintQueueEmpty();
// Check if the relation was valid, and thus the function type
if (!ft.IsValid())
throw new Exception("invalid function type: " + ft.ToString());
return ft;
}
public void GetConsVarNames(List<string> varNames, CatFxnType ft)
{
foreach (CatKind k in ft.GetCons().GetKinds())
{
if (k.IsKindVar())
varNames.Add(k.ToString());
if (k is CatFxnType)
GetConsVarNames(varNames, k as CatFxnType);
}
}
public bool IsValidChildFxn(List<string> varNames, CatFxnType ft)
{
foreach (CatKind k in ft.GetCons().GetKinds())
{
if (k.IsKindVar())
varNames.Add(k.ToString());
}
return IsValidProduction(varNames, ft.GetProd());
}
/// <summary>
/// This function modifies the function
/// </summary>
public void RemoveImplicitRhoVariables(CatFxnType ft)
{
foreach (CatKind k in ft.GetChildKinds())
if (k is CatFxnType)
RemoveImplicitRhoVariables(k as CatFxnType);
if (!ft.GetCons().IsEmpty() && !ft.GetProd().IsEmpty())
{
CatKind k1 = ft.GetCons().GetBottom();
CatKind k2 = ft.GetProd().GetBottom();
// Does both consumption and production share the same
// stack variable at the bottom, if so, then we might have
// an implicit Rho variables
if (k1 is CatStackVar && k1.Equals(k2))
{
// try removing the stack variable
ft.GetCons().GetKinds().RemoveAt(0);
ft.GetProd().GetKinds().RemoveAt(0);
// is the variable used anywhere else?
// if so, then we have to restore it
// otherwise we leave it taken away
if (DoesVarExist(k1))
{
ft.GetCons().GetKinds().Insert(0, k1);
ft.GetProd().GetKinds().Insert(0, k2);
}
}
}
}
public static void OutputInferredType(CatFxnType ft)
{
Log("After rewriting");
Log(ft.ToPrettyString());
Log("");
}
public static bool DoesVarOccurIn(CatKind k, CatTypeVector vec, CatFxnType except)
{
foreach (CatKind tmp in vec.GetKinds())
{
if (tmp.IsKindVar() && tmp.Equals(k))
return true;
if (tmp is CatFxnType)
if (DoesVarOccurIn(k, tmp as CatFxnType, except))
return true;
}
return false;
}
public static CatFxnType RenameFreeVars(CatFxnType left, CatFxnType right, CatFxnType ft)
{
CatTypeVarList vars = ft.GetAllVars();
foreach (string s in vars.Keys)
{
CatKind k = vars[s];
if (IsFreeVar(k, left, right, ft))
{
if (k is CatTypeVar)
vars[s] = CatTypeVar.CreateUnique();
else
vars[s] = CatStackVar.CreateUnique();
}
}
return RenameVars(ft, vars);
}
public static CatFxnType ComposeTypes(CatFxnType left, CatFxnType right)
{
if (!Config.gbTypeChecking)
return null;
CatTypeReconstructor inferer = new CatTypeReconstructor();
return inferer.LocalComposeTypes(left, right);
}
public static string ToPrettyString(CatFxnType ft, Dictionary<string, string> dic)
{
// remove rho variables
ft = ft.Clone();
ft.RemoveImplicitRhoVariables();
string s = ToPrettyString(ft.GetCons(), dic);
if (ft.HasSideEffects())
s += " ~> ";
else
s += " -> ";
s += ToPrettyString(ft.GetProd(), dic);
return s;
}
static CatFxnType RenameVars(CatFxnType ft, CatTypeVarList vars)
{
return new CatFxnType(RenameVars(ft.GetCons(), vars), RenameVars(ft.GetProd(), vars), ft.HasSideEffects());
}
public static bool DoesVarOccurIn(CatKind k, CatFxnType ft, CatFxnType except)
{
if (!k.IsKindVar()) return false;
if (k == except) return false;
return DoesVarOccurIn(k, ft.GetCons(), except) || DoesVarOccurIn(k, ft.GetProd(), except);
}
public CatFxnType Rename(CatFxnType f)
{
if (f == null)
throw new Exception("Invalid null parameter to rename function");
return new CatFxnType(Rename(f.GetCons()), Rename(f.GetProd()), f.HasSideEffects());
}
public bool DescendentOf(CatFxnType ft)
{
if (this == ft)
return true;
if (mpParent == null)
return false;
return mpParent.DescendentOf(ft);
}
public static bool IsFreeVar(CatKind k, CatFxnType left, CatFxnType right, CatFxnType except)
{
return !DoesVarOccurIn(k, left, except) && !DoesVarOccurIn(k, right, except);
}
public SelfFunction(string name)
: base(name)
{
mpFxnType = CatFxnType.Create("('A -> 'B)");
}
public void SetParent(CatFxnType parent)
{
mpParent = parent;
}
