}
int nArgs = basicOpExpressions.getNArguments ();
if (nArgs < 0) {
throw new CodeGenerationException ("Internal Coding Error: Invalid basic operator arity");
}
if (op == PrimOps.PRIMOP_CAL_VALUE_TO_OBJECT) {
//Prelude.calValueToObject is non-strict in its first argument.
gp.code (schemeC (basicOpExpressions.getArgument(0), p, d));
gp.code (instruction);
} else
{
for (int i = 0; i < nArgs; ++i) {
gp.code (schemeE (basicOpExpressions.getArgument(i), p, d + i));
}
gp.code (instruction);
}
appendUpdateCode(gp, d);
return gp;
}
// Is e an application of a saturated constructor?
if (ConstructorOpTuple.isConstructorOp(e, true) != null) {
// Unpack the basic op into subexpressions
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " basic:");
}
ConstructorOpTuple constructorOpExpressions = ConstructorOpTuple.isConstructorOp(e, false);
DataConstructor dc = constructorOpExpressions.getDataConstructor ();
Instruction instruction = Instruction.I_PackCons.makePackCons(dc);
int nArgs = constructorOpExpressions.getNArguments ();
if (nArgs < 0) {
throw new CodeGenerationException ("Internal Coding Error: Invalid constructor operator arity");
}
for (int i = 0; i < nArgs; ++i) {
gp.code (schemeC (constructorOpExpressions.getArgument(nArgs - i - 1), p, d + i));
}
// Force the evaluation of any strict arguments.
if (dc.hasStrictArgs()) {
for (int i = 0; i < dc.getArity(); ++i) {
if (dc.isArgStrict(i)) {
gp.code(new Instruction.I_Push(i));
gp.code(Instruction.I_Eval);
gp.code(new Instruction.I_Pop(1));
}
}
}
gp.code (instruction);
appendUpdateCode (gp, d);
return gp;
}
// Is e a variable?
Expression.Var var = e.asVar();
if (var != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " Var:");
}
// e is a variable, possible addressing modes are:
// Push <k> for an argument
// PushGlobal <l> for a label (e.g. supercombinator)
// Code an Push <k> if we find it's an argument
gp.code (schemeC (e, p, d));
appendUpdateCode(gp, d);
Integer ei = p.get(var.getName());
if (CODEGEN_DIAG) {
if (ei == null) {
MACHINE_LOGGER.log(Level.FINE, " Global:");
} else {
MACHINE_LOGGER.log(Level.FINE, " local:");
}
}
return gp;
}
// Is e a conditional op (if <cond expr> <then expr> <else expr>)?
CondTuple conditionExpressions = CondTuple.isCondOp(e);
if (conditionExpressions != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " condition:");
}
// This is a conditional op. The conditionExpressions tuple holds (kCond, kThen, kElse) expressions
// Generate the code for kThen and kElse, as arguments to a new I_Cond instruction
gp.code (schemeE (conditionExpressions.getConditionExpression(), p, d));
InstructionList thenPart = schemeR (conditionExpressions.getThenExpression(), p, d);
InstructionList elsePart = schemeR (conditionExpressions.getElseExpression(), p, d);
Instruction i = new Instruction.I_Cond (new Code (thenPart), new Code(elsePart));
gp.code (i);
return gp;
}
// Is e a switch?
Expression.Switch sw = e.asSwitch();
if (sw != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " switch:");
}
gp.code (schemeE (sw.getSwitchExpr (), p, d));
// Get the alternatives
Expression.Switch.SwitchAlt[] alts = sw.getAlts();
Map<Object, Code> altTagToCodeMap = new HashMap<Object, Code>();
ModuleName moduleName = currentMachineFunction.getQualifiedName().getModuleName();
// Build the code for each branch, save the variable requirement of each
// branch as an alternative in gp, for later resolution
for (final SwitchAlt alt : alts) {
// For now, generate code for each tag.
for (final Object altTag : alt.getAltTags()) {
String[] vars = getVars(alt, altTag);
Map<QualifiedName, Integer> newEnv = argOffset (0, p);
for (int j = 0; j < vars.length; ++j) {
QualifiedName qn = QualifiedName.make(moduleName, vars [j]);
newEnv.put (qn, Integer.valueOf(d + 1 + j));
}
// i_split: takes a dc object, tells it to push all (vars.length) fields onto the stack
InstructionList altGP = new InstructionList ();
altGP.code (new Instruction.I_Split (vars.length));
altGP.code (schemeR(alt.getAltExpr(), newEnv, d + vars.length));
Code code = new Code(altGP);
altTagToCodeMap.put(altTag, code);
}
}
ErrorInfo errorInfo = sw.getErrorInfo() == null ? null : toRuntimeErrorInfo(sw.getErrorInfo());
gp.code (new Instruction.I_Switch (altTagToCodeMap, errorInfo));
return gp;
}
// Is e a data constructor field selection?
Expression.DataConsSelection dataConsSelection = e.asDataConsSelection();
if (dataConsSelection != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " selectDC:");
}
gp.code (schemeC(dataConsSelection.getDCValueExpr(), p, d));
gp.code (new Instruction.I_LazySelectDCField(dataConsSelection.getDataConstructor(),
dataConsSelection.getFieldIndex(),
toRuntimeErrorInfo (dataConsSelection.getErrorInfo())));
// // Evaluate the code for the dc-valued expr.
//gp.code (schemeE (dataConsSelection.getDCValueExpr(), p, d));
// // Extract the field value onto the stack.
// int fieldIndex = dataConsSelection.getFieldIndex();
// ErrorInfo errorInfo = dataConsSelection.getErrorInfo() == null ? null : new ErrorInfo(dataConsSelection.getErrorInfo());
// gp.code (new Instruction.I_SelectDCField (dataConsSelection.getDataConstructor(), fieldIndex, errorInfo));
// // Add a var to the env, and generate code for that var.
// Expression.Var varName = dataConsSelection.getVarName();
// QualifiedName varQualifiedName = varName.getName();
// Map newEnv = argOffset (0, p);
// newEnv.put (varQualifiedName, JavaPrimitives.makeInteger (d + 1));
// gp.code (schemeR(varName, newEnv, d + 1));
appendUpdateCode (gp, d);
return gp;
}
// Is e a let expression?
Expression.Let let = e.asLet();
if (let != null) {
// Currently the compiler doesn't differentialte between let and letrec scenarios.
// As such we have to treat all lets as letrecs.
Expression.Let.LetDefn[] defs = let.getDefns();
EnvAndDepth ead = schemeXr (defs, p, d);
InstructionList gprecs = schemeCLetrec (defs, ead.env, ead.depth);
gp.code (gprecs);
gp.code (schemeR (let.getBody (), ead.env, ead.depth));
return gp;
}
// Is e a tail recursive call?
if (e.asTailRecursiveCall() != null) {
// The g-machine doesn't have a specific optimization for tail recursive calls
// so we simply handle it as the original fully saturated application and let
// the general tail call optimization handle it.
return schemeR (e.asTailRecursiveCall().getApplForm(), p, d);
}
// Is e an application?
Expression.Appl appl = e.asAppl();
if (appl != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " Application:");
}
InstructionList il = schemeRS (e, p, d, 0);
if (il != null) {
gp.code (il);
return gp;
}
gp.code (schemeC (e, p, d));
appendUpdateCode(gp, d);
return gp;
}
// Is e a record update
// e is a record update
Expression.RecordUpdate recordUpdate = e.asRecordUpdate();
if (recordUpdate != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " Record update:");
}
gp.code (schemeE (e, p, d));
appendUpdateCode (gp, d);
return gp;
}
// Is e a record extension
// e is a record extension
Expression.RecordExtension recordExtension = e.asRecordExtension();
if (recordExtension != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " Record extension:");
}
gp.code (schemeE (e, p, d));
appendUpdateCode (gp, d);
return gp;
}
// e is a record selection
Expression.RecordSelection recordSelection = e.asRecordSelection();
if (recordSelection != null) {
if (CODEGEN_DIAG) {
MACHINE_LOGGER.log(Level.FINE, " Record selection:");
}
gp.code (schemeE (e, p, d));
appendUpdateCode (gp, d);
return gp;
}
// e is a record case
Expression.RecordCase recordCase = e.asRecordCase();
if (recordCase != null) {
// Strictly compile the condition expression
Expression conditionExpr = recordCase.getConditionExpr();
gp.code (schemeE (conditionExpr, p, d));
Map<QualifiedName, Integer> newEnv = argOffset (0, p);
QualifiedName recordName = QualifiedName.make(currentMachineFunction.getQualifiedName().getModuleName(), "$recordCase");
newEnv.put (recordName, Integer.valueOf(++d));
//FieldName -> String
SortedMap<FieldName, String> fieldBindingVarMap = recordCase.getFieldBindingVarMap();
int recordPos = 0;
// This creates, if necessary, a record equivalent to the original record minus the bound fields.
String baseRecordPatternVarName = recordCase.getBaseRecordPatternVarName();
if (baseRecordPatternVarName != null &&
!baseRecordPatternVarName.equals(Expression.RecordCase.WILDCARD_VAR)) {
recordPos++;
// Create a new record that is the original record minus the bound fields.
QualifiedName qn = QualifiedName.make(currentMachineFunction.getQualifiedName().getModuleName(), baseRecordPatternVarName);
newEnv.put (qn, Integer.valueOf(++d));
// push the original record
gp.code (new Instruction.I_Push(0));
// consume the record on top of the stack and replace with an extended version
gp.code (new Instruction.I_ExtendRecord());
// Now remove fields from the record as appropriate.
for (final FieldName fieldName : fieldBindingVarMap.keySet()) {
gp.code (new Instruction.I_RemoveRecordField(fieldName.getCalSourceForm()));
}
}
// Now push the values for the bound fields onto the stack.
for (final Map.Entry<FieldName, String> entry : fieldBindingVarMap.entrySet()) {
FieldName fieldName = entry.getKey();
String bindingVarName = entry.getValue();
//ignore anonymous pattern variables. These are guaranteed not to be used
//by the result expression, and so don't need to be extracted from the condition record.
if (!bindingVarName.equals(Expression.RecordCase.WILDCARD_VAR)) {
QualifiedName qn = QualifiedName.make(currentMachineFunction.getQualifiedName().getModuleName(), bindingVarName);
newEnv.put(qn, Integer.valueOf(++d));
gp.code (new Instruction.I_Push (recordPos));
gp.code (new Instruction.I_RecordSelection (fieldName.getCalSourceForm()));
recordPos++;
}
}
//encode the result expression in the context of the extended variable scope.
Expression resultExpr = recordCase.getResultExpr();
gp.code (schemeR (resultExpr, newEnv, d));
appendUpdateCode(gp, d);
return gp;
}
Expression.Cast cast = e.asCast();
if (cast != null) {
gp.code (schemeE(cast.getVarToCast(), p, d));
gp.code (new Instruction.I_Cast(getCastType(cast)));
appendUpdateCode(gp, d);
return gp;
}
MACHINE_LOGGER.log(Level.FINE,
"\nCodeGen: Bad exit of R compilation scheme with intermediate code:\n"
+ e);
logEnvironment(p);
throw new CodeGenerationException ("Internal Coding Error: unrecognized expression " + e +".");
}