132 lines
3.4 KiB
OCaml
132 lines
3.4 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Lucid Synchrone *)
|
|
(* *)
|
|
(* Author : Marc Pouzet *)
|
|
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
(* $Id: caml_aux.ml,v 1.1.1.1 2005-11-03 15:45:23 pouzet Exp $ *)
|
|
|
|
(* file caml-aux.ml *)
|
|
(* auxiliary functions for caml expressions *)
|
|
(* free variables *)
|
|
|
|
open Misc;;
|
|
open Caml;;
|
|
open Declarative;;
|
|
|
|
(* convertions from declarative structures to caml ones *)
|
|
(* immediates *)
|
|
let caml_of_declarative_immediate = function
|
|
| Dbool b -> if b then Ftrue else Ffalse
|
|
| Dint i -> Fint i
|
|
| Dfloat f -> Ffloat f
|
|
| Dchar c -> Fchar c
|
|
| Dstring s -> Fstring s
|
|
|
|
(* globals *)
|
|
let string_of_global g =
|
|
let pref = g.dqualid.dqual in
|
|
(if (pref <> "") && (pref <> "Lucy_pervasives") then
|
|
g.dqualid.dqual^"."
|
|
else "") ^ g.dqualid.did
|
|
|
|
(* pat_desc *)
|
|
let rec caml_pattern_of_pat_desc = function
|
|
| Dvarpat i -> Fvarpat ("x__"^(string_of_int i))
|
|
| Dconstantpat i -> Fimpat (caml_of_declarative_immediate i)
|
|
| Dtuplepat pl -> Ftuplepat (List.map caml_of_declarative_pattern pl)
|
|
| Dconstruct0pat g -> Fconstruct0pat (string_of_global g)
|
|
| Dconstruct1pat (g,p) -> Fconstruct1pat (string_of_global g,
|
|
caml_of_declarative_pattern p)
|
|
| Drecordpat gpl -> Frecordpat (List.map
|
|
(fun (x,y) ->
|
|
(string_of_global x,
|
|
caml_of_declarative_pattern y))
|
|
gpl)
|
|
(* patterns *)
|
|
and caml_of_declarative_pattern p = caml_pattern_of_pat_desc p.dp_desc
|
|
(* ---- end of convertions *)
|
|
|
|
let rec flat_exp_of_pattern = function
|
|
| Fpunit -> Fim Funit
|
|
| Fimpat i -> Fim i
|
|
| Fvarpat v -> Fvar { cvar_name=v; cvar_imported=false }
|
|
| Fconstruct0pat c -> Fconstruct0 c
|
|
| Fconstruct1pat (c,p) -> Fconstruct1 (c, flat_exp_of_pattern p)
|
|
| Ftuplepat pl -> Ftuple (List.map flat_exp_of_pattern pl)
|
|
| Frecordpat cpl ->
|
|
Frecord (List.map (fun (x,y) -> (x,flat_exp_of_pattern y)) cpl)
|
|
|
|
(* small functions manipulating lists *)
|
|
let union x1 x2 =
|
|
let rec rec_union l = function
|
|
[] -> l
|
|
| h::t -> if List.mem h l then (rec_union l t) else (rec_union (h::l) t)
|
|
in
|
|
rec_union x1 x2
|
|
|
|
let subtract x1 x2 =
|
|
let rec sub l = function
|
|
[] -> l
|
|
| h::t -> if List.mem h x2 then (sub l t) else (sub (h::l) t)
|
|
in
|
|
sub [] x1
|
|
|
|
let flat l =
|
|
let rec f ac = function
|
|
[] -> ac
|
|
| t::q -> f (ac@t) q
|
|
in
|
|
f [] l
|
|
|
|
let intersect x1 x2 =
|
|
let rec inter l = function
|
|
[] -> l
|
|
| h::t -> if List.mem h x1 then (inter (h::l) t) else (inter l t)
|
|
in
|
|
inter [] x2
|
|
|
|
(* make a variable *)
|
|
let make_var n = Fvar {cvar_name = n;cvar_imported = false}
|
|
and make_imported_var n b = Fvar {cvar_name = n;cvar_imported = b}
|
|
|
|
let nil_ident = "Lucy__nil"
|
|
let state_ident = "Lucy__state"
|
|
|
|
(* makes a conditional *)
|
|
let ifthenelse(c,e1,e2) =
|
|
match c with
|
|
Fim(Ftrue) -> e1
|
|
| Fim(Ffalse) -> e2
|
|
| _ -> Fifthenelse(c,e1,e2)
|
|
|
|
(* makes a list of conditionnals *)
|
|
let ifseq l =
|
|
let rec ifs l =
|
|
let (c,e)::t = l in
|
|
if t = [] then
|
|
e
|
|
else
|
|
ifthenelse (c, e, ifs t)
|
|
in
|
|
ifs l
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|