Skip to content

Use Cases

Jump to bottom Edit New page
gasche edited this page Mar 7, 2013 · 12 revisions

Optional analysis/processing tool

Most of these tools (including the compiler itself) benefit from occasional annotations to locally modify the behavior out of the default. Comments are currently used for this purpose (or coarser-grained command-line options or, in the case of mascot, a separate configuration file that annotates precise locations with information).

Bisect

let f x =
  match List.map foo [x; a x; b x] with
  | [y1; y2; y3] -> tata
  | _ -> (*BISECT-VISIT*) assert false

(*BISECT-IGNORE-BEGIN*)
let unused = ()
(*BISECT-IGNORE-END*)

Of course, ocamldoc could also seen as such a tool. The way it attaches documentation comments to specific part of code right now is not robust enough and a source of problems for pre-processed code, so having a formal annotation mechanism where meaningful documentation comments are semantically attached to the relevant AST nodes would be a huge plus.

val stats : ('a, 'b) t -> statistics
(** [Hashtbl.stats tbl] returns statistics about the table [tbl]:
   number of buckets, size of the biggest bucket, distribution of
   buckets by size.
   @since 4.00.0 *)

(** {6 Functorial interface} *)

module type HashedType =
  sig
    type t
      (** The type of the hashtable keys. *)
    val equal : t -> t -> bool
      (** The equality predicate used to compare keys. *)
  end

Boilerplate code generation

Barista

BARISTA_ERROR =
| O -> "o"
| A of (x : int) -> Printf.sprintf "%d" x
| B of (y : float) * (z : string) * (t : char)-> Printf.sprintf "%f %S %C" y z t

type-conv (bin_prot, sexplib...)
deriving

type t = {
  x : int with default(42);
  y : int with default(3), sexp_drop_default;
  z : int with default(3), sexp_drop_if(z_test);
} with sexp

type r1 = {
  r1_l1 : int;
  r1_l2 : int;
} deriving (Dump, Eq, Show, Typeable, Pickle, Functor)

Lexifi's attribute system

type my_type @@ [with_xml] =
  | A of int
  | B of string @@ {xml=base64}
  | C @@ {xml=ignore}

Camlp4 map/fold generators

type variable = string
 and term =
  | Var of variable
  | Lam of variable * term
  | App of term * term


class map = Camlp4Filters.GenerateMap.generated

Code generation based on module signatures: ocaml-rpc

(* Example IDL *)

type return_record = {
  result : string;
  metadata : (int * int) list;
}

type variant =
  | Foo of string list
  | Bar
  | Baz of float

external rpc1 : arg1:string -> int -> return_record = ""
external rpc2 : ?opt:string -> variant -> unit = ""
external rpc3 : int64 -> int64 = ""

module SubModule = struct
  external rpc4 : int64 -> int64 = ""
end

OCaml syntax extensions

local open (now in the language)

let open M in foo

pa_monad

perform
  a <-- [1; 2; 3];
  b <-- [3; 4; 5];
  return (a + b)

pa_lwt

lwt x = start_thread foo in
and y = start_other_thread foo in
try_lwt
  for_lwt (x, y) in waiting_threads do
    compute blah
  done
with Killed -> bar

Bolt

let funct n =
  LOG "funct(%d)" n LEVEL DEBUG;
  for i = 1 to n do
    print_endline "..."
  done

pure-polyrecord

let r = {| x = 1; y = ref None |}   (* x and y are immutable, but y is a ref which is mutable *)
let () = r..y <- Some 2             (* update the ref at y *)

orakuda

"variable123"
  |! $/^[0-9]+$/ as v -> `Int (int_of_string v#_0)
  |  $/^[a-z][A-Za-z0-9_]*$/ as v -> `Variable v#_0
  |  _ -> failwith "parse error";;

Bitstring

let bits = Bitstring.bitstring_of_file "/bin/ls" in
bitmatch bits with
| { 0x7f : 8; "ELF" : 24 : string; (* ELF magic number *)
    e_ident : 12*8 : bitstring;    (* ELF identifier *)
    e_type : 16 : littleendian;    (* object file type *)
    e_machine : 16 : littleendian  (* architecture *)
  } ->
  printf "This is an ELF binary, type %d, arch %d\n"
    e_type e_machine;

sedlex

let '0'..'9' as digit = SEDLEX.regexp
let (Plus digit) as number = SEDLEX.regexp

let rec token buf =
  let ('a'..'z'|'A'..'Z') as letter = SEDLEX.regexp in
  match SEDLEX buf with
  | number -> Printf.printf "Number %s\n" (Sedlexing.Latin1.lexeme buf); token buf
  | letter, Star ('A'..'Z' | 'a'..'z' | digit) -> Printf.printf "Ident %s\n" (Sedlexing.Latin1.lexeme buf); token buf
  | Plus xml_blank -> token buf
  | Plus (Chars "+*-/") -> Printf.printf "Op %s\n" (Sedlexing.Latin1.lexeme buf); token buf
  | Range(128,255) -> print_endline "Non ASCII"
  | eof -> print_endline "EOF"
  | _ -> failwith "Unexpected character"

modified sedlex (imaginary, following as per the wg-camlp4 discussions)

let rec token buf =
  (:sedlex
    let%regexp letter = ('a'..'z'|'A'..'Z') in
    match%lexer buf with
    | number -> Printf.printf "Number %s\n" (Sedlexing.Latin1.lexeme buf); token buf
    | letter, Star ('A'..'Z' | 'a'..'z' | digit) -> Printf.printf "Ident %s\n" (Sedlexing.Latin1.lexeme buf); token buf
    | Plus xml_blank -> token buf
    | Plus (Chars "+*-/") -> Printf.printf "Op %s\n" (Sedlexing.Latin1.lexeme buf); token buf
    | Range(128,255) -> print_endline "Non ASCII"
    | eof -> print_endline "EOF"
    | _ -> failwith "Unexpected character"
  )

cppo

#ifdef DEBUG
#define debug(s) Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s
#else
#define debug(s) ()
#endif

debug("test")

micmatch

# RE pair = "(" space* (digit+ as x : int) space* ","
                space* (digit+ as y : int) space* ")";;
# let get_objlist = COLLECTOBJ pair;;
val get_objlist : ?pos:int -> string -> < x : int; y : int > list = <fun>
# let objlist = get_objlist "(123,456): (a,2) ( 5, 34) (0, 0)";;
val objlist : < x : int; y : int > list = [<obj>; <obj>; <obj>]

Embeddings of foreign languages

PG'OCaml

let fetch_users dbh =
  PGSQL(dbh) "select id, name from users"

Macaque

let names view = <:view< {name = t.name} | t in $view$ >>

Melt

let listing = display

let todo x = "{par}{huge "{textbf "TODO:"} {x}"}{par}"

let doc = ("
{tableofcontents}
{newpage}
")

Cass

let button = <:css< 
   .button {
     $Css.gradient ~low:color2 ~high:color1$;
     color: white;
     $Css.top_rounded$;
 >>

Camlp4/Fan

<:patt< Func($str:x$, $t$) >>

Quotation in Fan

Quotations in Fan mainly refer to

  1. Delimited Language Extensions
  2. QuasiQuotation (the same as Lisp)

Examples: First class lexer(toplevel support)

let rec token enc =  {:lex|
    "<utf8>" -> begin enc := Ulexing.Utf8; token enc lexbuf end
   | "<latin1>" -> begin enc := Ulexing.Latin1; token enc lexbuf end
   | xml_letter+ -> Printf.sprintf "word(%s)" (Ulexing.utf8_lexeme lexbuf)
   | number -> "number"
   | eof -> exit 0
   | [1234-1246] -> "bla"
   | "(" ->  begin
       Ulexing.rollback lexbuf; (* Puts the lexeme back into the buffer *)
       {| "(" [^ '(']* ")" -> Ulexing.utf8_lexeme lexbuf |} lexbuf
       (* Note the use of an inline lexer *)
   end
   | "(*" -> begin comment lexbuf; "comment" end
   | ' ' -> "whitespace"
   | _ -> "???" |}
and comment = {:lex|
    "*)" -> ()
   | eof -> failwith "comment"
   | _ -> let _lexeme = Ulexing.lexeme lexbuf in
     comment lexbuf |}

First class Grammar

{:extend.create|Gram expr_eoi expr|};
{:extend|
  expr:
  {"minus" LA
    [S{x};"-";S{y} -> x -. y
    |S{x};"+";S{y} -> x +. y]
  "times" LA
    [S{x};"*";S{y} -> x *. y
    |S{x};"/";S{y} -> x /. y]  
   "power" RA
    [S{x};"**";S{y} -> x ** y]
   "simple"
    ["("; S{x}; ")" -> x
    | `INT(x,_) -> float_of_int x ] }
  expr_eoi:  [expr{x};`EOI -> x ]  
|}

First class program as data

(* namespace Fan.Lang.Meta *)
{:expr|
let a = b + c 
|}

deriving mechanism in Fan

{:ocaml|
type u = A of int
|}
(*namespace Fan.Lang.Derive*)
{:derive| (Print,Eq,OPrint,OEq,MetaExpr,MetaPatt)|}

Convenient writing of arithmetic expressions

let rec fac n =
  Num.(if n = 0 then 1 else n * fac(n-1))
Int64.(float(q * of_int n - (s * s) lsr 3)) /. float n
Complex.(log(z + 2I) = I / u)
Add a custom footer
Add a custom sidebar
Clone this wiki locally