data ExprType = IntType | BoolType | StringType repr : ExprType -> Type repr IntType = Int repr BoolType = Bool repr StringType = String data Op = Add | Subtract | Multiply | Divide data Expr = IntLit Int | BoolLit Bool | StringLit String | BinOp Op Expr Expr data SafeExpr : ExprType -> Type where IntLiteral : Int -> SafeExpr IntType BoolLiteral : Bool -> SafeExpr BoolType StringLiteral : String -> SafeExpr StringType BinOperation : (repr a -> repr b -> repr c) -> SafeExpr a -> SafeExpr b -> SafeExpr c typecheckOp : Op -> (a : ExprType) -> (b : ExprType) -> Either String (c : ExprType ** repr a -> repr b -> repr c) typecheckOp Add IntType IntType = Right (IntType ** (+)) typecheckOp Subtract IntType IntType = Right (IntType ** (-)) typecheckOp Multiply IntType IntType = Right (IntType ** (*)) typecheckOp Divide IntType IntType = Right (IntType ** div) typecheckOp _ _ _ = Left "Invalid binary operator application" typecheck : Expr -> Either String (n : ExprType ** SafeExpr n) typecheck (IntLit i) = Right (_ ** IntLiteral i) typecheck (BoolLit b) = Right (_ ** BoolLiteral b) typecheck (StringLit s) = Right (_ ** StringLiteral s) typecheck (BinOp o l r) = do (lt ** le) <- typecheck l (rt ** re) <- typecheck r (ot ** f) <- typecheckOp o lt rt pure (_ ** BinOperation f le re) eval : SafeExpr t -> repr t eval (IntLiteral i) = i eval (BoolLiteral b) = b eval (StringLiteral s) = s eval (BinOperation f l r) = f (eval l) (eval r) resultStr : {t : ExprType} -> repr t -> String resultStr {t=IntType} i = show i resultStr {t=BoolType} b = show b resultStr {t=StringType} s = show s tryEval : Expr -> String tryEval ex = case typecheck ex of Left err => "Type error: " ++ err Right (t ** e) => resultStr $ eval {t} e main : IO () main = putStrLn $ tryEval $ BinOp Add (IntLit 6) (BinOp Multiply (IntLit 160) (IntLit 2))