Objective Caml    up http://caml.inria.fr
  similar languages: ML   Haskell   Gofer   Hope   Miranda  
  Description:

Objective Caml, in short OCaml, is an object-orientated, functional language, which additionally supports the imperative programming style.

OCaml has it's origin in Caml. Both are member of the ML (MetaLanguage) family.

Two OCaml programs won the first and second price at the ICFP programming contest (http://www.cs.cornell.edu/icfp/).

OCaml is strict-evaluating, has mutable datastructures, loops, classes, generic classes, modules, lazy streams.

OCaml's Garbage Collector: Generational with two generations (old and new). Stop & Copy on new generation (minor GC), incremental Mark & Sweep on old generation (major GC). Compact memory (complete reordering; generate one large piece of free memeory instead of many small) if no more enough free memory is available.



  Factorial (1)   Michael Neumann
let rec fac n =
  if n > 1 then n * fac (n-1)
  else 1
;;


print_int fac(6);;
Calculates the factorial. Results 720.


  Factorial (2)   Michael Neumann
(* with pattern matching *)

let rec fac n =
  match n with
    0 -> 1
  | n -> n * fac (n-1)
;;


print_int fac(6);;
Calculates the factorial. Results 720.


  gcd   Michael Neumann
let rec ggt p q =
  let r = p mod q in
    if r != 0 then ggt q r
    else q
;;
Greatest common divisor


 Hello World   Michael Neumann
(* Hello World in Objective Caml *)

print_string("Hello World\n");;
Prints "Hello World" onto the screen.


 InsertionSort   Michael Neumann
(* insert e into ordered list lst *)
let rec insert e lst =
  match lst with
    [] -> [e]
  | x :: xs -> if e < x
               then e :: lst
               else x :: (insert e xs) ;;

let insertionSort =
  let insert' a b = insert b a in List.fold_left insert' [] ;;
Sortieren durch Einfuegen


  Length of a list   Michael Neumann
let rec length l =
  match l with
    []           -> 0
  | head :: tail -> 1 + length tail
;;
The length of a list is calculated.


 Squares (functional)   Michael Neumann
List.map(function n -> n * n) [1;2;3;4;5;6;7;8;9;10];;
Outputs the squares from 1 to 10.


 Squares (imperative)   Michael Neumann
for i=1 to 10 do
  print_int (i*i); print_string " ";  
done;;
Outputs the squares from 1 to 10.


 Squares (recursive)   Michael Neumann
let rec iter (a, b) =
   if a <= b then (
      print_int(a*a); 
      print_string(" ");
      iter(a+1, b); )
   else print_newline();;


iter(1,10);;
Outputs the squares from 1 to 10.


 XML-RPC parser   Michael Neumann
(*
 * Copyright (c) 2001 by Michael Neumann
 *
 * this program parses a XML-RPC document
 *
 * $Id: parser.ml,v 1.1 2001/07/26 08:56:40 michael Exp $
 *)


open Pxp_yacc;;
open Pxp_types;;
open Pxp_document;;


(* XML file to load *)
let filename = "methodresponse.xml";;
(*let filename = "methodcall.xml";;*)


type xmlrpc_value =
    X_String  of string
  | X_Integer of int
  | X_Boolean of bool
  | X_Double  of float
  | X_Base64  of string
  | X_Array   of xmlrpc_value list
  | X_Struct  of (string * xmlrpc_value) list
  | X_DateTime_iso8601 of string
;;

type xmlrpc_valtype = XV_Value | XV_Fault ;;
type xmlrpc_type    = XT_Call  | XT_Response | XT_None ;;


exception Wrong_boolean;;
exception Wrong_struct;;



(* returns the #PCDATA string of the child of node `n` *)
let get_sub_data n =
  let children = n # sub_nodes in
    (List.hd children) # data
;;


(* 
 * applies function `fct` on all elements in list `lst`
 * and give the result of that call as parameter of the
 * next call to the next element of the list and so on. 
 *)
let rec apply_children lst fct value =
  match lst with
    hd :: tl -> apply_children tl fct (fct hd value)
  | []       -> value
;;



(* parses the node `node` *)
let rec parse node (typ, valtype, name, params) =

  match node # node_type with

    T_element "methodCall" ->
      let children = node # sub_nodes in
        apply_children children parse (XT_Call, XV_Value, name, params)


  | T_element "methodResponse" ->
      let children = node # sub_nodes in
        apply_children children parse (XT_Response, XV_Value, name, params)


  | T_element "fault" ->
      let children = node # sub_nodes in
        apply_children children parse (typ, XV_Fault, name, params)


  | T_element ("methodName" | "name") ->
      (typ, valtype, get_sub_data node, params)

  | T_element "string" ->
      (typ, valtype, name, params @ [X_String (get_sub_data node)])

  | T_element ("int" | "i4") ->
      (typ, valtype, name, params @ [X_Integer (int_of_string (get_sub_data node))])

  | T_element "boolean" ->
    let boolean = int_of_string (get_sub_data node) in (
      match boolean with
        0 | 1 -> (typ, valtype, name, params @ [X_Boolean (boolean=1)])
      | n     -> raise Wrong_boolean
    )

  | T_element "double" ->
      (typ, valtype, name, params @ [X_Double (float_of_string (get_sub_data node))])

  | T_element "base64" ->
      (typ, valtype, name, params @ [X_Base64 (get_sub_data node)])
      (* TODO: decode *)

   | T_element "dateTime.iso8601" ->
      (typ, valtype, name, params @ [X_DateTime_iso8601 (get_sub_data node)])
      (* TODO: decode *)


  | T_element "array" ->
     let children = node # sub_nodes in
     let (_,_,_,arr)  = apply_children children parse (typ,valtype,"", []) in
       (typ, valtype, name, params @ [X_Array arr])


  | T_element "struct" ->
     let children = node # sub_nodes in
     (* important because element can also be #PCDATA when in non-validating mode! *)
     let mem_children = List.filter (fun e -> match e # node_type with T_element "member" -> true | _ -> false) children in
     let members = List.map (fun ele ->
       let (_,_,name,value) = parse ele (typ,valtype,"",[]) in
         match value with
           value::[] -> (name,value)
         | _         -> raise Wrong_struct
     ) mem_children in
       (typ, valtype, name, params @ [X_Struct members])

  | T_data ->
    let t = (typ, valtype, name, params) in
    (match node # parent # node_type with
      T_element "value" ->
       if List.length (node # parent # sub_nodes) = 1 then
         (typ, valtype, name, params @ [X_String (node # data)])
       else t
    | _ -> t)


  | _ ->
      let children = node # sub_nodes in
        apply_children children parse (typ, valtype, name, params)

;;


(* outputs a value of type `xmlrpc_value` *)
let rec output_argument ele =
  match ele with
    X_String  s  ->  print_endline s
  | X_Integer i  ->  print_int i; print_newline ()
  | X_Boolean b  ->  if b then print_endline "true" else print_endline "false"
  | X_Double  d  ->  print_float d; print_newline ()
  | X_Base64  s  ->  print_endline s
  | X_Array   a  ->  List.iter (fun v -> print_string "  "; output_argument v) a
  | X_Struct  s  ->  List.iter (fun (n,v) -> print_string ("  " ^ n ^ " ==> "); output_argument v) s
  | X_DateTime_iso8601 d -> print_endline d
;;

(*let xmlrpc_parse filename*)

let d = parse_document_entity default_config (from_file filename) default_spec in
let (typ, valtype, name, args) = parse (d # root) (XT_None, XV_Value, "", []) in
  print_endline ("methName: " ^ name);
  List.iter output_argument args
;;
Parses a XML-RPC method call or method response. See http://www.xmlrpc.com for more informations.