5.56. Expression unraveller

Start ocaml section to src/flx_unravel.mli[1 /1 ]
     1: # 4 "./lpsrc/flx_unravel.ipk"
     2: open Flx_types
     3: open Flx_mtypes2
     4: 
     5: val unravel:
     6:   sym_state_t ->
     7:   fully_bound_symbol_table_t ->
     8:   tbexpr_t ->
     9:   (tbexpr_t * string) list *
    10:   tbexpr_t
    11: 
End ocaml section to src/flx_unravel.mli[1]
Start ocaml section to src/flx_unravel.ml[1 /1 ]
     1: # 16 "./lpsrc/flx_unravel.ipk"
     2: open Flx_types
     3: open Flx_mtypes1
     4: open Flx_mtypes2
     5: open List
     6: open Flx_maps
     7: open Flx_util
     8: open Flx_print
     9: 
    10: let rec eassoc x l = match l with
    11:   | [] -> raise Not_found
    12:   | (a,b) ::t ->
    13:     if Flx_typing.cmp_tbexpr x a then b else eassoc x t
    14: 
    15: (* Unravel an expression into 'three address code',
    16:   at the same time eliminating common sub-expressions.
    17:   Note primitive applications are regarded as unary operators.
    18: *)
    19: let unravel syms bbdfns e =
    20:   let urn = 4 in
    21:   let sube = ref [] in
    22:   let get e =
    23:     try eassoc e !sube
    24:     with Not_found ->
    25:       let n = !(syms.counter) in incr (syms.counter);
    26:       let name = "_tmp" ^ si n in
    27:       sube := (e,name) :: !sube;
    28:       name
    29: 
    30:   in
    31:   let refer ((_,t) as e) =
    32:     `BEXPR_expr (get e,t),t
    33:   in
    34:   let idt t = t in
    35:   let e' =
    36:     let rec aux n e =
    37:       let n = n - 1 in
    38:       match e with
    39:       | `BEXPR_apply ((`BEXPR_name _,_) as f, b),t ->
    40:         refer (`BEXPR_apply (f, aux urn b),t)
    41: 
    42:       (*
    43:       (* no unravelling of primitives *)
    44:       | `BEXPR_apply_prim (i,ts,b),t  when n > 0 ->
    45:         `BEXPR_apply_prim (i, ts, aux n b),t
    46:       *)
    47: 
    48:       | `BEXPR_apply_direct (i,ts,b),t
    49:       | `BEXPR_apply ((`BEXPR_closure (i,ts),_), b),t ->
    50: 
    51:         let id,parent,sr,entry = Hashtbl.find bbdfns i in
    52:         begin match entry with
    53:         | `BBDCL_regmatch _
    54:         | `BBDCL_reglex _
    55:         | `BBDCL_struct _
    56:         | `BBDCL_fun _ -> `BEXPR_apply_direct (i, ts, aux n b),t
    57:         | `BBDCL_function _ -> refer (`BEXPR_apply_direct (i,ts, aux urn b),t)
    58: 
    59:         | _ -> assert false
    60:         end
    61: 
    62:       | `BEXPR_apply (f,b),t -> refer (`BEXPR_apply(aux urn f, aux urn b),t)
    63:       | `BEXPR_tuple ls,t -> (`BEXPR_tuple (map (aux n) ls),t)
    64:       | (`BEXPR_name _,t) as x -> x
    65:       | (`BEXPR_literal (`AST_int _ )),t as x -> x
    66:       | (`BEXPR_literal (`AST_float _ )),t as x -> x
    67:       | x -> refer x
    68:     in
    69:       aux urn e
    70:   in
    71:   let sube = rev !sube in
    72:   (*
    73:   print_endline
    74:   (
    75:     "Unravelled " ^ sbe syms.dfns e ^ "-->" ^ sbe syms.dfns e' ^
    76:     " where:\n" ^
    77:     catmap ""
    78:     (fun (x,s) ->
    79:       s ^ " = "^sbe syms.dfns x ^";\n"
    80:     )
    81:     sube
    82:   );
    83:   *)
    84:   sube,e'
End ocaml section to src/flx_unravel.ml[1]