(* Dynamic OCaml: OCaml as Scheme *)
(* This is a simple illustration of Robert Harper's thesis that a statically
typed language embeds a dynamically typed one.
We show how to express in OCaml characteristic Scheme features:
intentionally polymorphic functions; polymorphic lists;
functions with a variable number of polymorphic arguments;
fix-point and self-application (\x.x x) combinators not
normally expressible in ML; higher-order polymorphic polyvariadic
functions (e.g., iterator over multiple lists in parallel)
The code takes the fullest advantage of latent typing, with
no type annotations whatsoever.
All the code below is trivial -- and that is the point. Defining and
using the Universal type in a statically typed language is indeed
embarrassingly easy.
Please see scheme-ml.txt in this directory for more discussion.
*)
(* The key to the dynamic typing is the Universal type *)
(* We limit ourselves to a pure-functional subset of Scheme. References
and first-class continuations can be easily supported too.
`Scheme' procedures are expressed in a higher-order syntax.
As in real Scheme, the embedded Scheme procedures take a list of arguments.
*)
type scm = False | True | Void
| Char of char
| Str of string
| Int of int
| Flo of float
| List of scm list
| Vec of scm array
| Proc of (scm list -> scm)
let s_apply (Proc f) args = f args;; (* procedure application *)
(* We start by defining a few standard Scheme procedures *)
(* intentionally polymorphic subtraction *)
(* The pattern-match below is deliberately non-exhaustive; applying
the s_sub procedure to the wrong number of arguments or to arguments
of wrong types should raise a run-time exception -- just as it does
in Scheme.
*)
let s_sub [x;y] = match (x,y) with
(Int xn, Int yn) -> Int (xn - yn)
| (Flo xn, Flo yn) -> Flo (xn -. yn)
| (Flo xn, Int yn) -> Flo (xn -. float yn)
| (Int xn, Flo yn) -> Flo (float xn -. yn)
;;
(* polymorphic multiplication *)
let s_mul2 [x;y] = match (x,y) with
(Int xn, Int yn) -> Int (xn * yn)
| (Flo xn, Flo yn) -> Flo (xn *. yn)
| (Flo xn, Int yn) -> Flo (xn *. float yn)
| (Int xn, Flo yn) -> Flo (float xn *. yn)
;;
(* polymorphic multiplication of an arbitrary number of arguments *)
let s_mul (x::rest) = List.fold_left (fun acc e -> s_mul2 [acc;e]) x rest
;;
(* intentionally polymorphic `display' function *)
let rec display = function
[True] -> print_string "#t"; Void
| [False] -> print_string "#f"; Void
| [Void] -> Void
| [Char c] -> print_char c; Void
| [Int n] -> print_int n; Void
| [Flo n] -> print_float n; Void
| [Str str] -> print_string str; Void
| [List lst] -> let rec print_lst = function
[] -> Void
| [el] -> display [el]
| el::rest -> display [el]; print_string " ";
print_lst rest
in
print_string "("; print_lst lst;
print_string ")"; Void
| [Proc _] -> print_string "#"; Void
;;
(* This was the regular OCaml code, with no type annotations. They
are redundant: almost everything is of the type scm anyway. We get
error detection and reporting with no extra coding, since pattern-match
failures are reported automatically.
*)
(* The example of using polymorphic, nested lists *)
display [Str "\nTesting polymorphic lists and polymorphic display\n"];;
display [List [Int 1; True; False; List [];
s_mul [Int 2; Flo 4.2]; Proc display;
List [Int 1; Int 2; False]]];;
(* The output:
(1 #t #f () 8.4 # (1 2 #f))
*)
(* Granted, the notation like List [Int 1; Int 2] isn't pretty, comparing
to Scheme's '(1 2). OTH, we can consider "List" to mean Scheme's
"quote". Square brackets here seem to play the role of the round ones
in Scheme.
*)
display [Str "\nTesting multiplication of the variable number of args\n"];;
(display [s_mul [Int 1; Int 2; Int 3; Flo 4.0]]);;
(* printed result: 24. *)
(* Self-application and fixpoint *)
(* We attempt to embed the following Scheme code
(define (u f) (f f)) ; The U fixpoint combinator
(define (fact1 self)
(lambda (n) (if (zero? n) 1 ( * n ((self self) (- n 1))))))
((u fact1) 5) ==> 120
The U combinator as it is cannot be expressed in ML directly. The naive
expression "let u f = f f" is untypeable without resorting to
equi-recursive types, which are normally not permitted. And yet we can
easily write the self-application `in Scheme'... Neither u_fixpt nor
fact1 are recursive.
*)
let u_fixpt [f] = s_apply f [f];;
(*
(define (fact1 self)
(lambda (n) (if (zero? n) 1 ( * n ((self self) (- n 1))))))
The OCaml code below looks quite like the Scheme code above, modulo
the shape of the parentheses.
*)
let fact1 [self] = Proc(function
[Int 0] -> Int 1
| [x] -> (s_mul [x;
(s_apply (s_apply self [self]) [s_sub [x; Int 1]])])
);;
display [Str "\nComputing a factorial via a fixpoint combinator"];;
display [Str "\nFact 1: "];;
display [ s_apply (u_fixpt [Proc fact1]) [Int 1] ] ;;
display [Str "\nFact 5: "];;
display [s_apply (u_fixpt [Proc fact1]) [Int 5] ];;
(* Parallel loop -- simultaneous iteration over the arbitrary number of lists
-- as an example of a higher-order function with a
variable number of variably (intentionally) typed arguments.
We could have used List.iter. The following code is written, however,
to match the implementation of for-each from a real Scheme system
(Gambit-C 3.0).
*)
let rec for_each ((Proc f)::args) =
let rec cars = function
[List (el::_)] -> [el]
| (List (el::_))::rest -> el::(cars rest)
and cdrs = function
[List (_::rest)] -> [List rest]
| (List (_::rest1))::rest -> (List rest1)::cdrs rest
in
match args with
(List [])::_ -> Void
| x -> f (cars x); for_each ((Proc f)::(cdrs x))
;;
let s_list x = List x;; (* Scheme 'list' function *)
display [Str "\ntesting for-each"];
display [Str "\nDisplaying one list: "];
for_each [Proc display; List [Int 1; Int 2; Int 3]];
display [Str "\nDisplaying one list of singletons: "];
for_each [Proc (fun x -> display [s_list x]);
List [Int 1; Int 2; Int 3]];
display [Str "\nDisplaying two lists in parallel: "];;
(* in Scheme: (for-each (lambda x (display x))
'(1 2 3) '("one" "two" "three"))
*)
for_each [Proc (fun x -> display [s_list x]);
List [Int 1; Int 2; Int 3];
List [Str "one"; Str "two"; Str "three"]
];;
(* The output is:
(1 one)(2 two)(3 three)
*)