desug.ml 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293
  1. open Ast
  2. open Util
  3. let rec flatten = function
  4. | [] -> []
  5. | Statements (nodes, _) :: t -> (flatten nodes) @ (flatten t)
  6. | h :: t -> h :: (flatten t)
  7. let rec var_init = function
  8. (* Split local variable initialisations in declaration and assignment *)
  9. | FunDef (export, ret_type, name, params, body, loc) ->
  10. let move_inits body =
  11. let rec trav inits node = match node with
  12. (* translate scalar array initialisation to ArrayScalar node,
  13. * for easy replacement later on *)
  14. | VarDec (ArrayDef (_, _) as vtype, name, Some ((BoolConst (_, l)) as v), loc) :: t
  15. | VarDec (ArrayDef (_, _) as vtype, name, Some ((FloatConst (_, l)) as v), loc) :: t
  16. | VarDec (ArrayDef (_, _) as vtype, name, Some ((IntConst (_, l)) as v), loc) :: t ->
  17. trav inits (VarDec (vtype, name, Some (ArrayScalar (v, l)), loc) :: t)
  18. | VarDec (ctype, name, init, loc) :: t ->
  19. (* array definition: create __allocate statement *)
  20. let alloc = match ctype with
  21. | ArrayDef (_, dims) -> [Allocate (name, dims, noloc)]
  22. | _ -> []
  23. in
  24. (* variable initialisation: create assign statement *)
  25. let stats = match init with
  26. | Some value -> alloc @ [Assign (name, value, loc)]
  27. | None -> alloc
  28. in
  29. VarDec (ctype, name, None, loc) :: (trav (inits @ stats) t)
  30. (* initialisations need to be placed after local functions *)
  31. | (FunDef (_, _, _, _, _, _) as h) :: t ->
  32. (var_init h) :: (trav inits t)
  33. (* rest of function body: recurse *)
  34. | rest -> inits @ (List.map var_init rest)
  35. in trav [] body
  36. in
  37. FunDef (export, ret_type, name, params, move_inits body, loc)
  38. (* Move global variable initialisations to exported __init function *)
  39. | GlobalDef (export, ctype, name, Some init, loc) ->
  40. Statements ([GlobalDef (export, ctype, name, None, loc);
  41. Assign (name, init, locof init)], loc)
  42. (* Move global initialisations to __init function *)
  43. | Program (decls, loc) ->
  44. let decls = flatten (List.map var_init decls) in
  45. let rec trav assigns = function
  46. | [] -> (assigns, [])
  47. | (Assign (_, _, _) as h) :: t -> trav (assigns @ [h]) t
  48. | h :: t ->
  49. let (assigns, decls) = trav assigns t in
  50. (assigns, (h :: decls))
  51. in
  52. let (assigns, decls) = trav [] decls in
  53. (match assigns with
  54. | [] -> Program (decls, loc)
  55. | assigns ->
  56. let init_func = FunDef (true, Void, "__init", [], assigns, noloc) in
  57. Program (init_func :: decls, loc)
  58. )
  59. | node -> transform var_init node
  60. (*
  61. let rec array_init = function
  62. (* transform scalar assignment into nested for loops *)
  63. | Assign (name, ArrayScalar (value)) ->
  64. let rec add_loop indices = function
  65. | [] ->
  66. Assign (Deref (name, indices), value)
  67. | dim :: rest ->
  68. let counter = fresh_var "counter" in
  69. let ind = (indices @ [Var counter]) in
  70. For (counter, IntConst 0, dim, IntConst 1, add_loop ind rest)
  71. in
  72. add_loop [] dims
  73. | Assign (name, ArrayConst (dims)) -> Statements []
  74. | node -> transform array_init node
  75. *)
  76. let rec phase repr =
  77. let _ = print_endline "- Var init" in
  78. match repr with
  79. | Node (node, verbose) ->
  80. Node (var_init node, verbose)
  81. | _ -> failwith "invalid input for this phase"