utop ******* Basics ******* 3 + 4;; sqrt 9;; sqrt 9.;; (* let expression for var *) let x = 3 + 4;; (* function def *) let square x = x * x;; (* show type inference *) square 3;; square square 3;; (* error, because implicit left associativity *) square (square 3);; (* function with multiple arguments *) let ratio x y = Float.of_int x /. Float.of_int y ;; ratio 4 7;; (* show currying type *) ******* Higher-order functions ******* let sum_if_true test first second = (if test first then first else 0) + (if test second then second else 0) ;; (* show type inference, type of argument *) sum_if_true (fun x -> x=1) 1 2;; ******* Type annotations vs. type inference ******* let sum_if_true (test : int -> bool) (x : int) (y : int) : int = (if test x then x else 0) + (if test y then y else 0) ;; let sum_if_true (test : int -> bool) x y : int = (if test x then x else 0) + (if test y then y else 0) ;; (* partial annotation *) ******* Parametric polymorphism ******* (* generic type annotation, type inference. here x,y may not be numbers. *) let first_if_true test x y = if test x then x else y ;; (* result: val first_if_true : ('a -> bool) -> 'a -> 'a -> 'a = *) (* 'a is a \emph{type variable} *) first_if_true (fun x -> x=1) 1 3;; first_if_true (fun x -> x=1.) 1. 3.;; first_if_true (fun x -> x=1.) 1. 3;; (* type error, need type(x)=type(y)=type(test[0]) *) ******* Tuples ******* let a_tuple = (3,"three");; (* result: val a_tuple : int * string = (3, "three"). Note the '*' type *) (* ***pattern matching*** *) let (x,y) = a_tuple;; (* *** pattern matching in function declarations*** *) let complexsum (a1,a2) (b1,b2) = (a1+b1,a2+b2) ;; Multiple argument to function without currying: let tsum ((a1,a2),(b1,b2)): (int*int)*(int*int) -> int*int ******* Lists ******* let fruits = ["Apple"; "Kiwi"; "Banana"];; ["Apple"; 1; 2.];; (* error, unlike tuple types, it's impossible to mix *) "Melon" :: fruits;; fruits :: "Melon";; (* type error, append only at the beginning) ["Apple", "Kiwi", "Banana"];; (* note difference between , and ; --- this expression creates a list of tuples *) [1;2;3] @ [4;5;6];; (* concatenation *) ******* Recursion, pattern matching ******* let rec length lst = match lst with | [] -> 0 | x :: xs -> length xs + 1 ;; (* show parametric polymorphism, type list[a] *) (* matching errors *) let rec length lst = match lst with | x :: xs -> length xs + 1 ;; (* gives warning. if ignored, raises an Exception for "Match failure" and prints stack trace) (* more complicated pattern matching *) let rec seqdumrem list = match list with | [] -> [] | hd1 :: hd2 :: tl -> if hd1 = hd2 then seqdumrem (hd2 :: tl) else hd1 :: seqdumrem (hd2 :: tl) ;; (* Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: _::[] --- list with one element, doesn't matter which *) let rec seqdumrem list = match list with | [] -> [] | [hd] -> [hd] | hd1 :: hd2 :: tl -> if hd1 = hd2 then seqdumrem (hd2 :: tl) else hd1 :: seqdumrem (hd2 :: tl) ;; seqdumrem [1;1;2;2;3;2;3;];; ******* Options ******* let divide x y = if y = 0 then None else (x/y);; (* type error *) let divide x y = if y = 0 then None else Some (x/y);; match divide 2 0 with | None -> -99 | _ -> 1 ;; match divide 2 1 with | None -> -99 | _ -> 1 ;; (* also legal: *) if ((divide 2 0) = None) then -99 else 1;; (* rich type system helps avoid common infuriating bugs (NullPointerException *) ******* Records ******* type point2d = {a: float; b: float};; (* fields names and their types are significant, type equivalence by name but structure type equivalence problematic with type inference *) let p = {a = 1.; b=1.;};; p.a;; (* function pattern matching record fields to params *) let mag {a = a_p; b = b_p} = a_p ** 2. +. b_p ** 2.;; (* more concise *) let mag {a; b} = a ** 2. +. b ** 2.;; (* functional update. no actual state mutation! *) let x = {p with a = 2.};; ******* Variants ******* type complex_cartesian = {x: float; y: float} type complex_polar = {r: float; t: float};; type complex = | Cartesian of complex_cartesian | Polar of complex_polar;; let mag z = match z with | Cartesian {x;y} -> x ** 2. +. y ** 2. | Polar {r;_} -> r ** 2. ;; mag (Cartesian {x=3.;y=4.});; mag (Polar {r=3.;t=4.});; mag (Cartesian {r=3.;t=4.});; (* error - field names significant *) mag (Polar {x=3.;y=4.});; (* error - field names significant *) (* alternative with tuples instead of records *) type complex = Cartesian of float * float | Polar of float * float let mag z = match z with | Cartesian (x,y) -> x ** 2. +. y ** 2. | Polar (r,_) -> r ** 2. ;; mag (Cartesian (3.,4.));; mag (Polar (3.,4.));; ******* Misc. ******* (* optional arguments *) let concat ?sep x y = let sep = match sep with None -> "" | Some x -> x in x ^ sep ^ y ;; val concat : ?sep:string -> string -> string -> string = concat "a" "b";; concat ~sep="." "a" "b";; (* default values *) let foo ?z:(z=0) x y = (x + y) > z;; (* exception handling *) raise Exception try with | -> | -> ... (* closing resources - finally block *) let load_reminders filename = let inc = In_channel.create filename in protect ~f:(fun () -> reminders_of_sexp (Sexp.input_sexp inc)) ~finally:(fun () -> In_channel.close inc) ;;