module examples::untypedFun::Checker

rascal-0.34.0

typepal-0.8.10

Usage

import examples::untypedFun::Checker;

Source code

http://github.com/usethesource/typepal/src/examples/untypedFun/Checker.rsc

Dependencies

import examples::untypedFun::Syntax;
extend analysis::typepal::TypePal;

data AType

data AType  
     = intType()
     | boolType()
     | strType()
     | functionType(AType from, AType to)
     ;

function prettyAType

str prettyAType(intType()) = "int";

str prettyAType(boolType()) = "bool";

str prettyAType(strType()) = "str";

str prettyAType(functionType(AType from, AType to)) = "fun <prettyAType(from)> -\> <prettyAType(to)>";

function collect

void collect(current: (Expression) `fun <Id arg> { <Expression body> }`, Collector c) {
    c.enterScope(current);  
        tau1 = c.newTypeVar(arg); 
        tau2 = c.newTypeVar(body);
        c.fact(current, functionType(tau1, tau2));
        c.define("<arg>", variableId(), arg, defType(tau1));
        collect(body, c);
     c.leaveScope(current);
}

void collect(current: (Expression) `<Expression exp1>(<Expression exp2>)`, Collector c) { 
     tau1 = c.newTypeVar(exp1); 
     tau2 = c.newTypeVar(exp2); 
  
     c.calculateEager("application", current, [exp1, exp2],
        AType (Solver s) { 
              s.requireUnify(functionType(tau1, tau2), exp1, error(exp1, "Function type expected, found %t", exp1));
              s.requireUnify(tau1, exp2, error(exp2, "Incorrect type of actual parameter"));             
              return tau2;
            });
      collect(exp1, exp2, c);
}

void collect(current: (Expression) `let <Id name> = <Expression exp1> in <Expression exp2> end`, Collector c) { 
    c.enterScope(current); 
        c.define("<name>", variableId(), name, defType(exp1));
        c.fact(current, exp2);
        collect(exp1, exp2, c);
    c.leaveScope(current);
}

void collect(current: (Expression) `if <Expression cond> then <Expression thenPart> else <Expression elsePart> fi`, Collector c){
     c.calculate("if", current, [cond, thenPart, elsePart],
        AType (Solver s) { 
            s.requireUnify(cond, boolType(), error(cond, "Condition"));
            s.requireUnify(thenPart, elsePart, error(current, "thenPart and elsePart should have same type"));
            return s.getType(thenPart); 
        }); 
     collect(cond, thenPart, elsePart, c);
}

void collect(current: (Expression) `<Expression lhs> + <Expression rhs>`, Collector c){
     c.calculateEager("addition", current, [lhs,rhs],
         AType (Solver s) { 
            targs = atypeList([s.getType(lhs), s.getType(rhs)]);
            if(s.unify(targs, atypeList([intType(), intType()]))) return intType();
            if(s.unify(targs, atypeList([strType(), strType()]))) return strType();
            s.report(error(current, "No version of + is applicable for %t and %t", lhs, rhs));
            return intType();
        });
     collect(lhs, rhs, c); 
}

void collect(current: (Expression) `<Expression lhs> && <Expression rhs>`, Collector c){
     c.calculateEager("and", current, [lhs, rhs],
        AType (Solver s) {
            s.requireUnify(lhs, boolType(), error(lhs, "Expected `bool`, found %t", lhs));
            s.requireUnify(rhs, boolType(), error(rhs, "Expected `bool`, found %t", rhs));
            return boolType();
        });
    collect(lhs, rhs, c);
}

void collect(current: (Expression) `( <Expression exp> )`, Collector c){
    c.fact(current, exp);
    collect(exp, c);
}

void collect(current: (Expression) `<Id name>`, Collector c){
     c.use(name, {variableId()});
}

void collect(current: (Expression) `<Boolean boolcon>`, Collector c){
     c.fact(current, boolType());
}

void collect(current: (Expression) `<Integer intcon>`, Collector c){
     c.fact(current, intType());
}

void collect(current: (Expression) `<String strcon>`, Collector c){
     c.fact(current, strType());
}