let average x y = (x + y) / 2;; average 10 20;; average 10 "20";; (* Error *) print_string (average 10 20);; (* Error *) average 10 (int_of_string "20");; let pair x y = (x,y);; let me = pair "Jacques" 38;; let append l1 l2 = l1 @ l2;; let l = append [1;2] [3;4];; let l' = append [1;2] ["Jacques"];; (* Error *) let first arr = arr.(0);; let foldl2 = List.fold_left2;; let scalar v1 v2 = foldl2 (fun r x y -> r +. x *. y) 0. v1 v2;; let scalar' ~plus ~mult ~zero v1 v2 = List.fold_left2 (fun r x y -> mult x y) 0. v1 v2;; let scalar' ~plus ~mult ~zero v1 v2 = List.fold_left2 (fun r x y -> plus r (mult x y)) zero v1 v2 let scalar_float = scalar' ~plus:(+.) ~mult:( *.) ~zero:0. let scalar'' ~ops v1 v2 = List.fold_left2 (fun r x y -> ops#plus r (ops#mult x y)) ops#zero v1 v2 class float_ops = object method plus x y = x +. y method mult x y = x *. y method zero = 0. end let scalar_float = scalar'' ~ops:(new float_ops) module type PseudoRing = sig type t val plus : t -> t -> t val neg : t -> t val zero : t val mult : t -> t -> t end module Vector (Ops : PseudoRing) = struct type t = Ops.t list let plus : t -> t -> t = List.map2 Ops.plus let scalar = foldl2 (fun r x y -> Ops.plus r (Ops.mult x y)) Ops.zero end type expr = Num of int | Var of string | Plus of expr * expr | Mult of expr * expr let map_expr f e = match e with | Num _ | Var _ -> e | Plus (e1, e2) -> Plus (f e1, f e2) | Mult (e1, e2) -> Mult (f e1, f e2) let rec subst env = function | Var x when List.mem_assoc x env -> List.assoc x env | e -> map_expr (subst env) e let rec eval e = match map_expr eval e with | Plus (Num x, Num y) -> Num (x + y) | Mult (Num x, Num y) -> Num (x * y) | e' -> e' let e = subst ["x", Num 3; "y", Var "x"] (Plus (Var "y", Mult (Var "x", Num 2)));; let e' = eval e;; let rec print_expr ?(prio=0) ppf e = let printf fmt = Format.fprintf ppf fmt in match e with | Num x -> printf "%d" x | Var x -> printf "%s" x | Mult (e1, e2) -> printf "@[%a *@ %a@]" (print_expr ~prio:1) e1 (print_expr ~prio:1) e2 | Plus (e1, e2) as e -> if prio > 0 then (printf "(%a)") print_expr e else (printf "@[%a +@ %a@]") print_expr e1 print_expr e2 let print_expr' ppf = print_expr ppf;; #install_printer print_expr';; e;; #load"dynlink.cma";; #load"camlp4o.cma";; open Genlex;; let lexer = Genlex.make_lexer ["+";"*";"(";")"] ;; let s = lexer (Stream.of_string "1 2 3 4");; (parser [< ' x >] -> x) s ;; (parser [< 'Int 1 >] -> "ok") s ;; (parser [< 'Int 1 >] -> "one" | [< 'Int 2 >] -> "two") s ;; let rec accumulate parse accu = parser | [< e = parse accu; s >] -> accumulate parse e s | [< >] -> accu let left_assoc parse op wrap = let parse' accu = parser [< 'Kwd k when k = op; s >] -> wrap accu (parse s) in parser [< e1 = parse; e2 = accumulate parse' e1 >] -> e2 let rec parse_simple = parser | [< 'Int n >] -> Num n | [< 'Ident x >] -> Var x | [< 'Kwd"("; e = parse_expr; 'Kwd")" >] -> e and parse_mult s = left_assoc parse_simple "*" (fun e1 e2 -> Mult(e1,e2)) s and parse_expr s = left_assoc parse_mult "+" (fun e1 e2 -> Plus(e1,e2)) s let parse_string s = parse_expr (lexer (Stream.of_string s));; #remove_printer print_expr';; let e = parse_string "5+x*(4+x)";;