OCaml

test.ml

type typ = 
   Int |
   String |
   Bool |
   Func of (typ * typ) |
   Unknown |
   UnitT

type expr =  
  Plus of expr * expr
  | Minus of expr * expr 
  | Times of expr * expr 
  | Divide of expr * expr 
  | StringValue of string
  | IntValue of int
  | Unit
  | Ref of string
  | If of expr * expr * expr
  | Apply of expr * (expr list) (* args *)

module Env = Map.Make(String)

let rec tostring_expr = function
  | Plus (a, b) -> tostring_expr(a) ^ "+" ^ tostring_expr(b)
  | Minus (a, b) -> tostring_expr(a) ^ "-" ^ tostring_expr(a)
  | Times (a, b) -> tostring_expr(a) ^ "*" ^ tostring_expr(a)
  | Divide (a, b) -> tostring_expr(a) ^ "/" ^ tostring_expr(a)
  | StringValue str -> str
  | IntValue n -> string_of_int n
  | Ref id -> id
  | If (condition, a ,b) -> "if " ^ tostring_expr(condition) ^ "then" ^ tostring_expr(a) ^ "else" ^ tostring_expr(b)
  | Unit -> "unit"
  | Apply (e, args) -> 
    tostring_expr(e) ^ "(" ^ (String.concat "," (List.map tostring_expr args)) ^ ")"

let rec tostring_type = function
  | Int -> "int"
  | String -> "string"
  | Bool -> "bool"
  | UnitT -> "unit"
  | Func (arg, return_type) -> (tostring_type arg) ^ "->" ^ (tostring_type return_type)
  | Unknown -> "unknown"

let rec to_type: typ Env.t -> expr -> typ = fun env -> function
  | Plus (a, b) -> 
    (
      match (to_type env a, to_type env b) with 
        | Int, Int -> Int
        | String, String -> String
        | _, _ -> Unknown
    )
  | Minus (a, b) -> 
    (
      match (to_type env a, to_type env b) with 
        | (Int, Int) -> Int
        | (_, _) -> Unknown
    )
  | Times (a, b) -> 
    (
      match (to_type env a, to_type env b) with 
        | (Int, Int) -> Int
        | (_, _) -> Unknown
    )
  | Divide (a, b) -> 
    (
      match (to_type env a, to_type env b) with 
        | (Int, Int) -> Int
        | (_, _) -> Unknown
    )
  | StringValue str -> String
  | IntValue n -> Int
  | Ref id -> (
      try 
        Env.find id env
      with 
        Not_found -> Unknown
    )
  | Unit -> UnitT
  | If (cond, a, b) -> 
    let f = to_type env in
    (match (f cond, f a, f b) with 
      | (Bool, a_ty, b_ty) -> 
        if a_ty = b_ty then a_ty else Unknown
      | _ -> Unknown
    )
  | Apply (e, args) -> 
    match to_type env e with
     | Func (arg, ret) as ft -> 
      let args_typ = List.map (to_type env) args in
      if arg = UnitT && args_typ = [] then ret
      else let f rt b = match rt with
        | Func(xa, xr) -> 
          if b = xa then xr
          else Unknown
        | xa -> 
          if b = xa then xa
          else Unknown
        in List.fold_left f ft args_typ
     | _ -> Unknown
and print_type env e =
  let str = tostring_type (to_type env e) in 
  print_string(str);
  print_newline()
  
let print_expr e =
  let str = tostring_expr(e) in 
  print_string(str);
  print_newline()
 

(* let () = 
  let e = Plus(IntValue 2, IntValue 3) in
  print_expr(e)

let () = 
  let e = FunctionCall("println", [IntValue 2; IntValue 3]) in
  print_expr(e)
  
let () = 
  let e = FunctionCall("println", []) in
  print_expr(e) *)


(* let () = 
  let e = Plus(StringValue "string", IntValue 3) in
  print_type Env.empty e *)

(* let () = 
  let e = FunctionCall("println", [IntValue 2; IntValue 3]) in
  print_type Env.empty e *)
  
let () = 
  let e = Apply(Ref "println", []) in
  let env = Env.add "println" (Func(UnitT, UnitT)) Env.empty in
  print_type env e (* expect unit *)

let () = 
  let e = Apply(Ref "println", []) in
  let env = Env.add "println" (Func(UnitT, String)) Env.empty in
  print_type env e (* expect string *)

let () = 
  let e = Apply(Ref "println", [StringValue "a"]) in
  let env = Env.add "println" (Func(String, String)) Env.empty in
  print_type env e (* expect string *)

let () = 
    let e = Apply(Ref "println", [Apply(Ref "string_of_int", [IntValue 1])]) in
    let env = Env.add "println" (Func(String, String)) Env.empty in
    let env = Env.add "string_of_int" (Func(Int, String)) env in
    print_type env e (* expect string *)

let () = 
  let e = Ref "println" in
  let env = Env.add "println" (Func(UnitT, String)) Env.empty in
  print_type env e (* expect unit -> string *)

let () = 
    let e = Apply(Ref "hoge", []) in
    let env = Env.add "hoge" (Func(UnitT, Func(Int, String))) Env.empty in
    print_type env e (* expect int -> string *)