Objective Caml    hoch http://caml.inria.fr
  ähnliche Sprachen: ML   Haskell   Gofer   Hope   Miranda  
  Beschreibung:

Objective Caml, kurz OCaml, ist eine objekt-orientierte, funktionale Sprache die auch den imperativen Programmierstil unterstützt.

OCaml stammt von Caml ab. Beide gehören zur ML-Familie (MetaLanguage).

Zwei OCaml Programme gewannen den ersten und zweiten Preis beim ICFP Programmierwettbewerb (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.



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


print_int fac(6);;
Berechnet die Fakultät. Ergibt 720.


  Fakultät (2)   Michael Neumann
(* mit Pattern-Matching *)

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


print_int fac(6);;
Berechnet die Fakultät. Ergibt 720.


  GgT   Michael Neumann
let rec ggt p q =
  let r = p mod q in
    if r != 0 then ggt q r
    else q
;;
Größter gemeinsamer Teiler


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

print_string("Hello World\n");;
Gibt "Hello World" auf dem Bildschirm aus.


 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


  Länge einer Liste   Michael Neumann
let rec length l =
  match l with
    []           -> 0
  | head :: tail -> 1 + length tail
;;
Die Länge einer beliebigen Liste wird berechnet.


 Squares (funktional)   Michael Neumann
List.map(function n -> n * n) [1;2;3;4;5;6;7;8;9;10];;
Gibt die Quadrate von 1 bis 10 aus.


 Squares (imperativ)   Michael Neumann
for i=1 to 10 do
  print_int (i*i); print_string " ";  
done;;
Gibt die Quadrate von 1 bis 10 aus.


 Squares (rekursiv)   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);;
Gibt die Quadrate von 1 bis 10 aus.


 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
;;
Parst ein XML-RPC Dokument. Mehr Informationen unter: http://www.xmlrpc.com.