Skip to content
Snippets Groups Projects
  • Erwan Jahier's avatar
    cdb52a14
    The structure and array expanser was buggy in presence of polymorphic · cdb52a14
    Erwan Jahier authored
    nodes (e.g., map<<+,2>>). While fixing  that, I put all the functions
    that deals with polymorphism into a new (Eponymous) dedicated module.
    
    The idea to be able to expand polymorphic node is basically the same,
    as the one for printing polymorphic  nodes: we need to wait until the
    type is instanciated (in GetEff).  That delay is implemented by using
    a stack of nodes.
    cdb52a14
    History
    The structure and array expanser was buggy in presence of polymorphic
    Erwan Jahier authored
    nodes (e.g., map<<+,2>>). While fixing  that, I put all the functions
    that deals with polymorphism into a new (Eponymous) dedicated module.
    
    The idea to be able to expand polymorphic node is basically the same,
    as the one for printing polymorphic  nodes: we need to wait until the
    type is instanciated (in GetEff).  That delay is implemented by using
    a stack of nodes.
polymorphism.ml 1.26 KiB

open Eff

(* exported *)
exception Exc

let type_ref = ref None

(* exported *)
let get_type () = 
  match !type_ref with
    | None -> raise Exc
    | Some t -> t


let (set_type : Eff.type_ -> unit) = 
  fun t -> 
    type_ref := Some t

(* exported *)
let (reset_type : unit -> unit) = (* To be called in order to avoid silent bugs *)
  fun () -> 
    type_ref := None


(******************************************************************************)

let polymorphic_node_stack : (Eff.id_solver * Eff.local_env * Eff.node_exp) Stack.t = Stack.create ()

(* exported *)
let (push_on_polymorphic_node_stack : Eff.id_solver * Eff.local_env * Eff.node_exp -> unit) =
  fun n -> 
    Stack.push n polymorphic_node_stack 

(* exported *)
let (unstack_polymorphic_nodes : 
       (Eff.id_solver -> Eff.local_env -> Eff.node_exp -> Eff.node_exp) -> 
	 Eff.type_ -> (Eff.id_solver * Eff.local_env * Eff.node_exp) list) =
  fun expand t -> 
    let rec aux l = 
      if Stack.is_empty polymorphic_node_stack 
      then 
	l 
      else
	let id_solver, nenv, node = Stack.pop polymorphic_node_stack in
	let node = 
	  if !Global.expand_structs  then expand id_solver nenv node else node
	in
	  (id_solver, nenv,node)::(aux l)
    in
    let _ = set_type t in
    let res = aux [] in
      res