Simple Value Environment

(* Example 1 *)
let main() =
  let v_env = [("kalle", 3); ("anka", 4)] in
  let key = "sds" in
  let v = List.assoc key v_env in
  print_string ("key = " ^ key ^ " -> value " ^ string_of_int v);
;;

main ();;

Simple Value Environment with Exception Handling

(* Example 2 *)
let main() =
  let v_env = [("kalle", 3); ("anka", 4)] in
  try
    let key = "kae" in
    let v = List.assoc key v_env in
    print_string ("key = " ^ key ^ " -> value " ^ string_of_int v ^ "\n");
  with
  | Not_found -> print_string "Not_found exception caught\n";
;;

main ();;

Simple Type Environment

type pType =
  | Int
  | Char
  
let to_string = function    
  | Int  -> "Int"
  | Char -> "Char"
  
let main() =
  let t_env = [("kalle", Int); ("anka", Char)] in 
  try
    let key1 = "kalle" in
    let key2 = "anka" in
    
    let t1 = List.assoc key1 t_env in
    print_string ("key1 = " ^ key1 ^ " -> type " ^ to_string t1 ^ "\n");
    let t2 = List.assoc key2 t_env in
    print_string ("key2 = " ^ key2 ^ " -> type " ^ to_string t2 ^ "\n");
    
  with
  | Not_found -> print_string "Not_found exception caught\n";
;;

main ();;

Simple Type Unification, with custom Exception

(* Example 3 *) 
exception TypeError

type pType =
  | Int
  | Char
  
let to_string = function    
  | Int  -> "Int"
  | Char -> "Char"

let unify t1 t2 = 
  if t1 == t2 then t1
  else
    raise (TypeError)
    
let main() =
  let t_env = [("kalle", Int); ("anka", Int)] in 
  try
    let key1 = "kalle" in
    let key2 = "anka" in
    
    let t1 = List.assoc key1 t_env in
    print_string ("key1 = " ^ key1 ^ " -> type " ^ to_string t1 ^ "\n");
    let t2 = List.assoc key2 t_env in
    print_string ("key2 = " ^ key2 ^ " -> type " ^ to_string t2 ^ "\n");
    
    let t = unify t1 t2 in
    print_string ("type OK, evaluates to type " ^ to_string t ^ "\n");
  with
  | Not_found -> print_string "Not_found exception caught\n";
  | TypeError -> print_string "TypeError exception caught\n";
;;

main ();;

Simple Type Checking (of single binary operation)

(* Example 4 *)
exception TypeError

type pType =
  | Int
  | Char
  | Bool
  
let to_string = function    
  | Int  -> "Int"
  | Char -> "Char"
  | Bool -> "Bool"

type op =
  | OpPlus 
  | OpAnd   

let unify t1 t2 = 
  if t1 == t2 then t1
  else
    raise (TypeError)

let to_type id t_env =
  List.assoc id t_env    
        
let well_op op o1 o2 t_env =
  let t1 = to_type o1 t_env in
  let t2 = to_type o2 t_env in
  let rt = unify t1 t2 in
  match op with
  | OpPlus -> if (rt == Int) then true else raise (TypeError)
  | OpAnd  -> if (rt == Bool) then true else raise (TypeError)
  
let main() =
  let t_env = [("kalle", Int); ("anka", Int); ("kajsa", Bool); ("joakim", Bool) ] in 
  try
    (*
    if (well_op OpPlus "kalle" "anka" t_env) then print_string "OK!\n";
    if (well_op OpPlus "kall" "anka" t_env) then print_string "OK!\n";
    if (well_op OpPlus "joakim" "kajsa" t_env) then print_string "OK!\n";
    *)
    if (well_op OpAnd "joakim" "kajsa" t_env) then print_string "OK!\n";
    
  with
  | Not_found -> print_string "Not_found exception caught\n";
  | TypeError -> print_string "TypeError exception caught\n";
;;

main ();;

Type Checking of Nested Expression

(* Example 5 *)
exception TypeError

type pType =
  | Int
  | Char
  | Bool
  
let to_string = function    
  | Int  -> "Int"
  | Char -> "Char"
  | Bool -> "Bool"

type op =
  | OpPlus 
  | OpAnd   

type exp =
  | ExpId     of string
  | ExpOp     of op * exp * exp
  | ExpInt    of int
  | ExpChar   of char
  | ExpBool   of bool   
  
let unify t1 t2 = 
  if t1 == t2 then t1
  else
    raise (TypeError)

let to_type id t_env =
  List.assoc id t_env    
        
let rec well_op op o1 o2 t_env =
  let t1 = well_exp o1 t_env in
  let t2 = well_exp o2 t_env in
  let rt = unify t1 t2 in
  match op with
  | OpPlus -> if (rt == Int) then rt else raise (TypeError)
  | OpAnd  -> if (rt == Bool) then rt else raise (TypeError)

and well_exp e t_env = match e with
  | ExpId (id)         -> to_type id t_env
  | ExpOp (op, o1, o2) -> well_op op o1 o2 t_env
  | ExpInt (i)         -> Int
  | ExpChar (c)        -> Char
  | ExpBool (b)        -> Bool
      
let main() =
  let t_env = [("kalle", Int); ("anka", Int); ("kajsa", Bool); ("joakim", Bool) ] in 
  try
    let test e = print_string ("OK, type is " ^ to_string (well_exp e t_env) ^ "\n") in
    (*
    test (ExpInt(2)); 
    test (ExpChar('c'));
    test (ExpChar('b'));
    test (ExpId("kalle"));
    test (ExpId("joakim"));
    test (ExpOp (OpPlus, ExpInt(2), ExpInt(2)));
    test (ExpOp (OpPlus, (ExpOp (OpPlus, ExpInt(2), ExpInt(2))), ExpInt(2)));
    test (ExpOp (OpPlus, (ExpOp (OpPlus, ExpInt(2), ExpId("kalle"))), ExpInt(2)));
    test (ExpOp (OpPlus, (ExpOp (OpPlus, ExpId("anka"), ExpId("kalle"))), ExpInt(2)));
    test (ExpOp (OpPlus, (ExpOp (OpAnd, ExpId("anka"), ExpId("kalle"))), ExpInt(2)));
    *)
    test (ExpOp (OpAnd, (ExpOp (OpAnd, ExpId("joakim"), ExpId("kajsa"))), ExpBool(true)));

    with
  | Not_found -> print_string "Not_found exception caught\n";
  | TypeError -> print_string "TypeError exception caught\n";
;;

main ();;



That's it, from zero to hero!

Last edited Sep 25, 2014 at 11:27 PM by RTFMPerLindgren, version 2