Esempio n. 1
0
/*
 * Copy an expression, but replace all occurences of a given variable with a
 * given expression.
 */
Exp *replace(Exp *body, int bind, Exp *arg) { // :-) YOU CAN DO IT!!!
    if(isApp(body)) {
        return newApp(replace(appFun(body), bind, arg),
                replace(appArg(body), bind, arg));
    }
    else if(isAbs(body)) {
        return newAbs(replace(absBody(body), bind + 1, arg));
    }
    else if(isVar(body)) {
        if(varBind(body) == bind) {
            return copyExp(arg);
        }
        else {
            return copyExp(body);
        }
    }
    else if(isCon(body) || isOpn(body)) {
        return copyExp(body);
    }
    else {
        printf("Error - unrecognised expression type in replace()\n");
        assert(false);
        return NULL;
    }
}
Esempio n. 2
0
/*
 * Determine whether or not two expressions are equal.
 */
bool expEqual(Exp *e1, Exp *e2) {
    if(isApp(e1)) {
        if(!isApp(e2)) {
            return false;
        }
        else {
            return expEqual(appFun(e1), appFun(e2))
                && expEqual(appArg(e1), appArg(e2));
        }
    }
    else if(isAbs(e1)) {
        if(!isAbs(e2)) {
            return false;
        }
        else {
            return expEqual(absBody(e1), absBody(e2));
        }
    }
    else if(isVar(e1)) {
        if(!isVar(e2)) {
            return false;
        }
        else {
            return varBind(e1) == varBind(e2);
        }
    }
    else if(isCon(e1)) {
        if(!isCon(e2)) {
            return false;
        }
        else {
            return (conVal(e1) == conVal(e2)) && (conTy(e1) == conTy(e2));
        }
    }
    else if(isOpn(e1)) {
        if(!isOpn(e2)) {
            return false;
        }
        else {
            return opnType(e1) == opnType(e2);
        }
    }
    else {
        printf("Error - unrecognised expression type in expEqual()\n");
        assert(false);
    }
}
Esempio n. 3
0
obj compare(int op, obj lt, obj rt){
	if(op==EQ) return Int( equal(lt, rt));
	if(op==NE) return Int(!equal(lt, rt));
	obj (*fn)(obj, obj);
	ValueType lty=lt->type, rty=rt->type;
	switch(op){
	case '>': 	fn = ccgt;	break;
	case '<': 	fn = cclt; 	break;
	case GE: 	fn = ccge; 	break;
	case LE: 	fn = ccle; 	break;
	default: 	assert(0);  return nil;
	}
	obj rr = fn(lt, rt);
	if(rr) return rr;
	// vector
	curr_operator = op;
	if(isCon(lty) && isCon(rty)) return applyCC(compare0, lt,rt);
	if(isCon(lty)) return applyCS(compare0, lt,rt);
	if(isCon(rty)) return applySC(compare0, lt,rt);
	error("compare: type undefined.");
	return nil;
}
Esempio n. 4
0
obj call_fn(obj (*func)(obj, obj), obj lt, obj rt){
	obj rr = func(lt,rt);
	if(rr) return rr;
	if(isCon(type(lt)) && isCon(type(rt))) return applyCC(func, lt,rt);
	if(isCon(type(rt))) return applySC(func, lt,rt);
	if(isCon(type(lt))) return applyCS(func, lt,rt);
	// user defined operations
	if(func==add){
		static obj symadd = Symbol("add");
		rr = udef_op2(symadd, lt,rt);
	} else if(func==mult){
		static obj symmul = Symbol("mul");
		rr = udef_op2(symmul, lt,rt);
	} else if(func==divide){
		static obj symdiv = Symbol("div");
		rr = udef_op2(symdiv, lt,rt);
	} else if(func==power){
		static obj sympow = Symbol("pow");
		rr = udef_op2(sympow, lt,rt);
	} else assert(0);
	if(!rr) error(": operation not defined");
	return rr;
}
Esempio n. 5
0
/*
 * Copy an expression, return a pointer to the newly allocated expression.
 */
Exp *copyExp(Exp *exp) {
    if(isApp(exp)) {
        return newApp(copyExp(appFun(exp)), copyExp(appArg(exp)));
    }
    else if(isAbs(exp)) {
        return newAbs(copyExp(absBody(exp)));
    }
    else if(isVar(exp)) {
        return newVar(varBind(exp));
    }
    else if(isCon(exp)) {
        return newCon(conTy(exp), conVal(exp));
    }
    else if(isOpn(exp)) {
        return newOpn(opnType(exp));
    }
    else {
        printf("Error - unrecognised expression type in copyExp()\n");
        assert(false);
    }
}
Esempio n. 6
0
/*
 * Perform at least one reduction step on the given template.
 */
Exp *reduceTemplate(Exp *exp) {

    // Conditionals
    if(isApp(exp)
            && isApp(appFun(exp))
            && isApp(appFun(appFun(exp)))
            && isOpn(appFun(appFun(appFun(exp))))
            && (opnType(appFun(appFun(appFun(exp)))) == O_Cond)) {

        Exp *guard  = appArg(appFun(appFun(exp)));
        Exp *truExp = appArg(appFun(exp));
        Exp *falExp = appArg(exp);

        // If the guard is true, return the true expression.
        if(isCon(guard) && (conVal(guard) == true)) {
            return copyExp(truExp);
        }
        // If the guard is false, return the false expression.
        else if(isCon(guard) && (conVal(guard) == false)) {
            return copyExp(falExp);
        }
        // If the guard is not reduced, reduce it.
        else {
            return newApp(newApp(newApp(
                            newOpn(O_Cond), reduceTemplate(guard)),
                        copyExp(truExp)), copyExp(falExp));
        }
    }
    // End of conditional case

    // Binary operations
    else if(isApp(exp)
            && isApp(appFun(exp))
            && isBinaryOpn(appFun(appFun(exp)))) {

        OpTy opn  = opnType(appFun(appFun(exp)));
        Exp *arg1 = appArg(appFun(exp));
        Exp *arg2 = appArg(exp);

        // Handle equality differently because it is polymorphic.
        if(opn == O_Equ) {
            Exp *redA1 = reduceTemplateNorm(arg1);
            Exp *redA2 = reduceTemplateNorm(arg2);
            bool same = expEqual(redA1, redA2);
            freeExp(redA1);
            freeExp(redA2);
            return newCon(C_Bool, same);
        }
        else if(isApp(arg1) || isAbs(arg1) || isVar(arg1) || isOpn(arg1)) {
            return newApp(
                    newApp(
                        newOpn(opn),
                        reduceTemplate(arg1)),
                    copyExp(arg2));
        }
        else if(isApp(arg2) || isAbs(arg2) || isVar(arg2) || isOpn(arg2)) {
            return newApp(
                    newApp(
                        newOpn(opn),
                        copyExp(arg1)),
                    reduceTemplate(arg2));
        }
        else {
            assert(isCon(arg1));
            assert(isCon(arg2));

            if(opn == O_Add) {
                return newCon(C_Int, conVal(arg1) + conVal(arg2));
            }
            else if(opn == O_Sub) {
                return newCon(C_Int, conVal(arg1) - conVal(arg2));
            }
            else if(opn == O_Mul) {
                return newCon(C_Int, conVal(arg1) * conVal(arg2));
            }
            else if(opn == O_Div) {
                return newCon(C_Int, conVal(arg1) / conVal(arg2));
            }
            else if(opn == O_Mod) {
                return newCon(C_Int, conVal(arg1) % conVal(arg2));
            }
            else if(opn == O_Lss) {
                return newCon(C_Bool, conVal(arg1) < conVal(arg2));
            }
            else if(opn == O_LsE) {
                return newCon(C_Bool, conVal(arg1) <= conVal(arg2));
            }
            else if(opn == O_NEq) {
                return newCon(C_Bool, conVal(arg1) != conVal(arg2));
            }
            else if(opn == O_Gtr) {
                return newCon(C_Bool, conVal(arg1) > conVal(arg2));
            }
            else if(opn == O_GtE) {
                return newCon(C_Bool, conVal(arg1) >= conVal(arg2));
            }
            else if(opn == O_Xor) {
                return newCon(C_Bool, (!conVal(arg1)) != (!conVal(arg2)));
            }
            else if(opn == O_And) {
                return newCon(C_Bool, conVal(arg1) && conVal(arg2));
            }
            else if(opn == O_Or ) {
                return newCon(C_Bool, conVal(arg1) || conVal(arg2));
            }
            else {
                printf("Error reducing binary operation - unrecognised "
                        "operation\n");
                assert(false);
            }
        }
    }
    // End of binary operations case

    // iszero & not unary operations
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && (opnType(appFun(exp)) == O_Not
            || opnType(appFun(exp)) == O_IsZ)) {

        OpTy opn = opnType(appFun(exp));
        Exp *arg = appArg(exp);

        if(isApp(arg) || isAbs(arg) || isVar(arg) || isOpn(arg)) {
            return newApp(newOpn(opn), reduceTemplate(arg));
        }
        else {
            if(opn == O_Not)  {
                return newCon(C_Bool, !(conVal(arg)));
            }
            else {
                assert(opn == O_IsZ);
                return newCon(C_Bool, conVal(arg) == 0);
            }
        }
    }
    // End iszero & not unary operations case

    // Polymorphic unary operations
    // Null
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && (opnType(appFun(exp)) == O_Null)) {

        Exp *arg = appArg(exp);
        Exp *reducedArg = reduceTemplateNorm(arg);

        if(isOpn(reducedArg) && (opnType(reducedArg) == O_Empty)) {
            freeExp(reducedArg);
            return newCon(C_Bool, true);
        }
        else {
            freeExp(reducedArg);
            return newCon(C_Bool, false);
        }
    }
    // End Null

    // Head and Tail
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && ((opnType(appFun(exp)) == O_Head)
            || (opnType(appFun(exp)) == O_Tail))) {

        OpTy opn = opnType(appFun(exp));
        Exp *arg = appArg(exp);

        if(isApp(arg)
                && isApp(appFun(arg))
                && isOpn(appFun(appFun(arg)))
                && (opnType(appFun(appFun(arg)))) == O_Cons) {
            
            Exp *head = appArg(appFun(arg));
            Exp *tail = appArg(arg);

            if(opn == O_Head) {
                return copyExp(head);
            }
            else {
                assert(opn == O_Tail);
                return copyExp(tail);
            }
        }
        else {
            return newApp(newOpn(opn), reduceTemplate(arg));
        }
    }
    // End Head and Tail

    // Cons
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && (opnType(appFun(exp)) == O_Cons)) {

        Exp *consArg = appArg(exp);

        return newApp(newOpn(O_Cons), reduceTemplate(consArg));
    }
    // End Cons
    
    // Sum operations
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && ((opnType(appFun(exp)) == O_RemL)
            || (opnType(appFun(exp)) == O_RemR))) {

        OpTy opn = opnType(appFun(exp));
        Exp *arg = appArg(exp);

        if(isApp(arg)
                && isOpn(appFun(arg))
                && ((opnType(appFun(arg)) == O_InjL)
                || (opnType(appFun(arg)) == O_InjR))) {

            OpTy innerOpn = opnType(appFun(arg));
            Exp *innerArg = appArg(arg);

            if(((opn == O_RemL) && (innerOpn == O_InjL))
                    || ((opn == O_RemR) && (innerOpn == O_InjR))) {
                
                return copyExp(innerArg);
            }
            else {
                printf("Error - removed value from a non-sum expression or "
                        "wrong side of sum expression\n");
                assert(false);
            }
        }
        else {
            return newApp(newOpn(opn), reduceTemplate(arg));
        }
    }
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && ((opnType(appFun(exp)) == O_InjL)
            || (opnType(appFun(exp)) == O_InjR))) {

        OpTy opn = opnType(appFun(exp));
        Exp *arg = appArg(exp);

        return newApp(newOpn(opn), reduceTemplate(arg));
    }
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && (opnType(appFun(exp)) == O_IsLeft)) {

        Exp *arg = appArg(exp);

        if(isApp(arg)
                && isOpn(appFun(arg))
                && ((opnType(appFun(arg)) == O_InjL)
                || (opnType(appFun(arg)) == O_InjR))) {

            OpTy injOpn = opnType(appFun(arg));
            return newCon(C_Bool, injOpn == O_InjL);
        }
        else {
            return newApp(newOpn(O_IsLeft), reduceTemplate(arg));
        }
    }
    // End sum operations
    
    // Tuple operations
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && ((opnType(appFun(exp)) == O_Fst)
            || (opnType(appFun(exp)) == O_Snd))) {

        OpTy opn = opnType(appFun(exp));
        Exp *arg = appArg(exp);

        if(isApp(arg)
                && isApp(appFun(arg))
                && isOpn(appFun(appFun(arg)))
                && (opnType(appFun(appFun(arg))) == O_Tuple)) {

            Exp *fst = appArg(appFun(arg));
            Exp *snd = appArg(arg);

            return copyExp((opn == O_Fst) ? fst : snd);
        }
        else {
            return newApp(newOpn(opn), reduceTemplate(arg));
        }
    }
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && (opnType(appFun(exp)) == O_Tuple)) {

        Exp *arg = appArg(exp);

        return newApp(newOpn(O_Tuple), reduceTemplate(arg));
    }
    // End Tuple operations

    // Fixed point combinator
    else if(isApp(exp)
            && isOpn(appFun(exp))
            && (opnType(appFun(exp)) == O_Fix)) {

        return newApp(copyExp(appArg(exp)), copyExp(exp));
    }
    // End fixed point combinator
    // End polymorphic unary operations

    // Lambda abstractions
    else if(isApp(exp)
            && isAbs(appFun(exp))) {

        Exp *abs = appFun(exp);
        Exp *arg = appArg(exp);

        return replace(absBody(abs), 0, arg);
    }
    // End lambda abstractions

    // Function calls
    else if(isApp(exp)
            && isVar(appFun(exp))) {

        Exp *var = appFun(exp);
        Exp *arg = appArg(exp);
        int bind = varBind(var);

        if(hasFunc(bind)) {
            return newApp(instantiate(bind), copyExp(arg));
        }
        else {
            return newApp(copyExp(var), reduceTemplate(arg));
        }
    }
    else if(isVar(exp)
            && hasFunc(varBind(exp))) {

        return instantiate(varBind(exp));
    }
    // End function calls

    // Catch-all application case
    else if(isApp(exp)) {
        Exp *fun = appFun(exp);
        Exp *arg = appArg(exp);

        return newApp(reduceTemplate(fun), reduceTemplate(arg));
    }
    // End catch-all application case

    // If there are no reductions to make, return a copy of the given template.
    else {
        return copyExp(exp);
    }
}
Esempio n. 7
0
/*
 * Print an expression to stdout.
 */
void printExp(Exp *exp) {
    if(isApp(exp)) {
        printf("(");
        printExp(appFun(exp));
        printf(" ");
        printExp(appArg(exp));
        printf(")");
    }
    else if(isAbs(exp)) {
        printf("(\\ ");
        printExp(absBody(exp));
        printf(")");
    }
    else if(isVar(exp)) {
        if(varBind(exp) >= 0) {
            printf("V%d", varBind(exp));
        }
        else {
            printf("F%d", -varBind(exp));
        }
    }
    else if(isCon(exp) && (conTy(exp) == C_Bool) && (conVal(exp) == true)) {
        printf("true");
    }
    else if(isCon(exp) && (conTy(exp) == C_Bool) && (conVal(exp) == false)) {
        printf("false");
    }
    else if(isCon(exp) && (conTy(exp) == C_Char)) {
        printf("\'%c\'", conVal(exp));
    }
    else if(isCon(exp)/* && (conTy(exp) == C_Int)*/) {
        printf("%d", conVal(exp));
    }
    else if(isOpn(exp)) {
        switch(opnType(exp)) {
            case O_Cond   : printf("cond")   ;  break;
            case O_Add    : printf("+")      ;  break;
            case O_Sub    : printf("-")      ;  break;
            case O_Mul    : printf("*")      ;  break;
            case O_Div    : printf("/")      ;  break;
            case O_Mod    : printf("%%")     ;  break;
            case O_Lss    : printf("<")      ;  break;
            case O_LsE    : printf("<=")     ;  break;
            case O_NEq    : printf("/=")     ;  break;
            case O_Gtr    : printf(">")      ;  break;
            case O_GtE    : printf(">=")     ;  break;
            case O_Equ    : printf("==")     ;  break;
            case O_And    : printf("and")    ;  break;
            case O_Or     : printf("or")     ;  break;
            case O_Xor    : printf("xor")    ;  break;
            case O_Not    : printf("not")    ;  break;
            case O_IsZ    : printf("iszero") ;  break;
            case O_Empty  : printf("[]")     ;  break;
            case O_Cons   : printf(":")      ;  break;
            case O_Null   : printf("null")   ;  break;
            case O_Head   : printf("head")   ;  break;
            case O_Tail   : printf("tail")   ;  break;
            case O_Fix    : printf("fix")    ;  break;
            case O_InjL   : printf("injl")   ;  break;
            case O_InjR   : printf("injr")   ;  break;
            case O_RemL   : printf("reml")   ;  break;
            case O_RemR   : printf("remr")   ;  break;
            case O_IsLeft : printf("isleft") ;  break;
            case O_Tuple  : printf("tuple")  ;  break;
            case O_Fst    : printf("fst")    ;  break;
            case O_Snd    : printf("snd")    ;  break;
        }
    }
    else {
        printf("Error - unrecognised expression type in printExp()\n");
        assert(false);
    }
}