fork(1) download
copy 
  1. exception DoesntCheck
  2.  
  3. fun datatype_by_constructor(datatypes, constructor_name) =
  4. 	case (List.find (fn (cons, dname, t) => cons=constructor_name) datatypes) of
  5. 		NONE => NONE
  6. 		| SOME (c,d,t) => SOME d
  7.  
  8.  
  9. fun get_pattern_type ds p =
  10. 	let fun get_tuple_type(t) =
  11. 		map (fn p => get_pattern_type ds p) t
  12. 	in
  13. 		case p of 
  14. 			UnitP => UnitT
  15. 			| ConstP _ => IntT
  16. 			| Wildcard => Anything
  17. 			| Variable name => Anything
  18. 			| TupleP ps => TupleT (get_tuple_type(ps))
  19. 			| ConstructorP(name,v) => case datatype_by_constructor(ds, name) of SOME name => Datatype name | NONE => raise DoesntCheck
  20. 	end
  21.  
  22. fun get_common_type(t1, t2) = 
  23.  
  24. 	let fun get_common_tuple_type(ts1, ts2) = 
  25. 		map (fn (t1,t2) => get_common_type(t1,t2)) (ListPair.zip(ts1, ts2))
  26. 	in
  27. 		case (t1, t2) of
  28. 			(UnitT, UnitT) => UnitT
  29. 			| (IntT, IntT) => IntT
  30. 			| (Anything, x) => x
  31. 			| (x, Anything) => x
  32. 			| (Datatype name1, Datatype name2) => if name1=name2 then Datatype name1 else raise DoesntCheck
  33. 			| (TupleT ts1, TupleT ts2) => TupleT(get_common_tuple_type(ts1, ts2))
  34. 			| _ => raise DoesntCheck
  35. 	end
  36.  
  37. fun typecheck_patterns (datatypes, patterns) =
  38. 	let 
  39. 		val ptype = get_pattern_type datatypes
  40. 		fun find_common_type(head, tail) = 
  41. 			foldl (fn (p, acc) => get_common_type(ptype(p), acc)) (ptype(head)) tail
  42. 	in
  43. 		case patterns of
  44. 			[] => NONE
  45. 			| h::t => (SOME (find_common_type(h, t))) handle DoesntCheck => NONE
  46. 	end
  47.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
File "prog.ml", line 3, characters 0-3:
Syntax error
stdout
copy 
Standard output is empty
https://ideone.com/yfqEXM
language:
OCaml (ocamlopt 4.05.0)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!