daily pastebin goal
77%
SHARE
TWEET

Untitled

a guest Feb 16th, 2019 66 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. commit ab6554328b00bc8a844ed4c09f7a0a8af66bad82
  2. Author: Jon Ludlam <jonathan.ludlam@eu.citrix.com>
  3. Date:   Tue Jul 30 21:19:37 2013 +0100
  4.  
  5.     Add the quit_after command line switches (PR#6102)
  6.  
  7. diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
  8. index 40f7daf..9bfa9ac 100644
  9. --- a/asmcomp/asmgen.ml
  10. +++ b/asmcomp/asmgen.ml
  11. @@ -38,6 +38,9 @@ let pass_dump_linear_if ppf flag message phrase =
  12.  let clambda_dump_if ppf ulambda =
  13.    if !dump_clambda then Printclambda.clambda ppf ulambda; ulambda
  14.  
  15. +let quit_if flag cmm =
  16. +  if !flag then exit 0 else cmm
  17. +
  18.  let rec regalloc ppf round fd =
  19.    if round > 50 then
  20.      fatal_error(fd.Mach.fun_name ^
  21. @@ -108,6 +111,7 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) =
  22.      Closure.intro size lam
  23.      ++ clambda_dump_if ppf
  24.      ++ Cmmgen.compunit size
  25. +    ++ quit_if Clflags.quit_after_cmm
  26.      ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
  27.      (match toplevel with None -> () | Some f -> compile_genfuns ppf f);
  28.  
  29. diff --git a/driver/compile.ml b/driver/compile.ml
  30. index 2e5b405..66d3d52 100644
  31. --- a/driver/compile.ml
  32. +++ b/driver/compile.ml
  33. @@ -60,6 +60,9 @@ let print_if ppf flag printer arg =
  34.    if !flag then fprintf ppf "%a@." printer arg;
  35.    arg
  36.  
  37. +let quit_if flag arg =
  38. +  if !flag then (Warnings.check_fatal (); exit 0) else arg
  39. +
  40.  let (++) x f = f x
  41.  
  42.  let implementation ppf sourcefile outputprefix =
  43. @@ -76,9 +79,11 @@ let implementation ppf sourcefile outputprefix =
  44.        Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  45.        ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  46.        ++ print_if ppf Clflags.dump_source Pprintast.structure
  47. +      ++ quit_if Clflags.quit_after_parse
  48.        ++ Typemod.type_implementation sourcefile outputprefix modulename env
  49.        ++ print_if ppf Clflags.dump_typedtree
  50. -           Printtyped.implementation_with_coercion);
  51. +           Printtyped.implementation_with_coercion
  52. +      ++ quit_if Clflags.quit_after_typing);
  53.        Warnings.check_fatal ();
  54.        Pparse.remove_preprocessed inputfile;
  55.        Stypes.dump (Some (outputprefix ^ ".annot"));
  56. @@ -93,15 +98,20 @@ let implementation ppf sourcefile outputprefix =
  57.        Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  58.        ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  59.        ++ print_if ppf Clflags.dump_source Pprintast.structure
  60. +      ++ quit_if Clflags.quit_after_parse
  61.        ++ Typemod.type_implementation sourcefile outputprefix modulename env
  62.        ++ print_if ppf Clflags.dump_typedtree
  63.                    Printtyped.implementation_with_coercion
  64. +      ++ quit_if Clflags.quit_after_typing
  65.        ++ Translmod.transl_implementation modulename
  66.        ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
  67. +      ++ quit_if Clflags.quit_after_rawlambda
  68.        ++ Simplif.simplify_lambda
  69.        ++ print_if ppf Clflags.dump_lambda Printlambda.lambda
  70. +      ++ quit_if Clflags.quit_after_lambda
  71.        ++ Bytegen.compile_implementation modulename
  72.        ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
  73. +      ++ quit_if Clflags.quit_after_instr
  74.        ++ Emitcode.to_file oc modulename;
  75.        Warnings.check_fatal ();
  76.        close_out oc;
  77. diff --git a/driver/main.ml b/driver/main.ml
  78. index 8deb883..203d0e2 100644
  79. --- a/driver/main.ml
  80. +++ b/driver/main.ml
  81. @@ -130,6 +130,13 @@ module Options = Main_args.Make_bytecomp_options (struct
  82.    let _drawlambda = set dump_rawlambda
  83.    let _dlambda = set dump_lambda
  84.    let _dinstr = set dump_instr
  85. +
  86. +  let _qparse = set quit_after_parse
  87. +  let _qtyping = set quit_after_typing
  88. +  let _qrawlambda = set quit_after_rawlambda
  89. +  let _qlambda = set quit_after_lambda
  90. +  let _qinstr = set quit_after_instr
  91. +
  92.    let anonymous = anonymous
  93.  end)
  94.  
  95. diff --git a/driver/main_args.ml b/driver/main_args.ml
  96. index 487a929..ee5da2b 100644
  97. --- a/driver/main_args.ml
  98. +++ b/driver/main_args.ml
  99. @@ -360,6 +360,30 @@ let mk_dinstr f =
  100.    "-dinstr", Arg.Unit f, " (undocumented)"
  101.  ;;
  102.  
  103. +let mk_qparse f =
  104. +  "-qparse", Arg.Unit f, " (undocumented)"
  105. +;;
  106. +
  107. +let mk_qtyping f =
  108. +  "-qtyping", Arg.Unit f, " (undocumented)"
  109. +;;
  110. +
  111. +let mk_qrawlambda f =
  112. +  "-qrawlambda", Arg.Unit f, " (undocumented)"
  113. +;;
  114. +
  115. +let mk_qlambda f =
  116. +  "-qlambda", Arg.Unit f, " (undocumented)"
  117. +;;
  118. +
  119. +let mk_qinstr f =
  120. +  "-qinstr", Arg.Unit f, " (undocumented)"
  121. +;;
  122. +
  123. +let mk_qcmm f =
  124. +  "-qcmm", Arg.Unit f, " (undocumented)"
  125. +;;
  126. +
  127.  let mk_dcmm f =
  128.    "-dcmm", Arg.Unit f, " (undocumented)"
  129.  ;;
  130. @@ -477,6 +501,12 @@ module type Bytecomp_options = sig
  131.    val _dlambda : unit -> unit
  132.    val _dinstr : unit -> unit
  133.  
  134. +  val _qparse : unit -> unit
  135. +  val _qtyping : unit -> unit
  136. +  val _qrawlambda : unit -> unit
  137. +  val _qlambda : unit -> unit
  138. +  val _qinstr : unit -> unit
  139. +
  140.    val anonymous : string -> unit
  141.  end;;
  142.  
  143. @@ -511,6 +541,12 @@ module type Bytetop_options = sig
  144.    val _dlambda : unit -> unit
  145.    val _dinstr : unit -> unit
  146.  
  147. +  val _qparse : unit -> unit
  148. +  val _qtyping : unit -> unit
  149. +  val _qrawlambda : unit -> unit
  150. +  val _qlambda : unit -> unit
  151. +  val _qinstr : unit -> unit
  152. +
  153.    val anonymous : string -> unit
  154.  end;;
  155.  
  156. @@ -586,6 +622,12 @@ module type Optcomp_options = sig
  157.    val _dlinear :  unit -> unit
  158.    val _dstartup :  unit -> unit
  159.  
  160. +  val _qparse : unit -> unit
  161. +  val _qtyping : unit -> unit
  162. +  val _qrawlambda : unit -> unit
  163. +  val _qlambda : unit -> unit
  164. +  val _qcmm : unit -> unit
  165. +
  166.    val anonymous : string -> unit
  167.  end;;
  168.  
  169. @@ -636,6 +678,12 @@ module type Opttop_options = sig
  170.    val _dlinear :  unit -> unit
  171.    val _dstartup :  unit -> unit
  172.  
  173. +  val _qparse : unit -> unit
  174. +  val _qtyping : unit -> unit
  175. +  val _qrawlambda : unit -> unit
  176. +  val _qlambda : unit -> unit
  177. +  val _qcmm : unit -> unit
  178. +
  179.    val anonymous : string -> unit
  180.  end;;
  181.  
  182. @@ -711,6 +759,12 @@ struct
  183.      mk_dlambda F._dlambda;
  184.      mk_dinstr F._dinstr;
  185.  
  186. +    mk_qparse F._qparse;
  187. +    mk_qtyping F._qtyping;
  188. +    mk_qrawlambda F._qrawlambda;
  189. +    mk_qlambda F._qlambda;
  190. +    mk_qinstr F._qinstr;
  191. +
  192.      mk__ F.anonymous;
  193.    ]
  194.  end;;
  195. @@ -748,6 +802,12 @@ struct
  196.      mk_dlambda F._dlambda;
  197.      mk_dinstr F._dinstr;
  198.  
  199. +    mk_qparse F._qparse;
  200. +    mk_qtyping F._qtyping;
  201. +    mk_qrawlambda F._qrawlambda;
  202. +    mk_qlambda F._qlambda;
  203. +    mk_qinstr F._qinstr;
  204. +
  205.      mk__ F.anonymous;
  206.    ]
  207.  end;;
  208. @@ -827,6 +887,12 @@ struct
  209.      mk_dlinear F._dlinear;
  210.      mk_dstartup F._dstartup;
  211.  
  212. +    mk_qparse F._qparse;
  213. +    mk_qtyping F._qtyping;
  214. +    mk_qrawlambda F._qrawlambda;
  215. +    mk_qlambda F._qlambda;
  216. +    mk_qcmm F._qcmm;
  217. +
  218.      mk__ F.anonymous;
  219.    ]
  220.  end;;
  221. @@ -878,6 +944,12 @@ module Make_opttop_options (F : Opttop_options) = struct
  222.      mk_dlinear F._dlinear;
  223.      mk_dstartup F._dstartup;
  224.  
  225. +    mk_qparse F._qparse;
  226. +    mk_qtyping F._qtyping;
  227. +    mk_qrawlambda F._qrawlambda;
  228. +    mk_qlambda F._qlambda;
  229. +    mk_qcmm F._qcmm;
  230. +
  231.      mk__ F.anonymous;
  232.    ]
  233.  end;;
  234. diff --git a/driver/main_args.mli b/driver/main_args.mli
  235. index 6d431e7..73080d2 100644
  236. --- a/driver/main_args.mli
  237. +++ b/driver/main_args.mli
  238. @@ -71,6 +71,12 @@ module type Bytecomp_options =
  239.      val _dlambda : unit -> unit
  240.      val _dinstr : unit -> unit
  241.  
  242. +    val _qparse : unit -> unit
  243. +    val _qtyping : unit -> unit
  244. +    val _qrawlambda : unit -> unit
  245. +    val _qlambda : unit -> unit
  246. +    val _qinstr : unit -> unit
  247. +
  248.      val anonymous : string -> unit
  249.    end
  250.  ;;
  251. @@ -106,6 +112,12 @@ module type Bytetop_options = sig
  252.    val _dlambda : unit -> unit
  253.    val _dinstr : unit -> unit
  254.  
  255. +  val _qparse : unit -> unit
  256. +  val _qtyping : unit -> unit
  257. +  val _qrawlambda : unit -> unit
  258. +  val _qlambda : unit -> unit
  259. +  val _qinstr : unit -> unit
  260. +
  261.    val anonymous : string -> unit
  262.  end;;
  263.  
  264. @@ -181,6 +193,12 @@ module type Optcomp_options = sig
  265.    val _dlinear :  unit -> unit
  266.    val _dstartup :  unit -> unit
  267.  
  268. +  val _qparse : unit -> unit
  269. +  val _qtyping : unit -> unit
  270. +  val _qrawlambda : unit -> unit
  271. +  val _qlambda : unit -> unit
  272. +  val _qcmm : unit -> unit
  273. +
  274.    val anonymous : string -> unit
  275.  end;;
  276.  
  277. @@ -231,6 +249,12 @@ module type Opttop_options = sig
  278.    val _dlinear :  unit -> unit
  279.    val _dstartup :  unit -> unit
  280.  
  281. +  val _qparse : unit -> unit
  282. +  val _qtyping : unit -> unit
  283. +  val _qrawlambda : unit -> unit
  284. +  val _qlambda : unit -> unit
  285. +  val _qcmm : unit -> unit
  286. +
  287.    val anonymous : string -> unit
  288.  end;;
  289.  
  290. diff --git a/driver/optcompile.ml b/driver/optcompile.ml
  291. index ebe2457..d07359a 100644
  292. --- a/driver/optcompile.ml
  293. +++ b/driver/optcompile.ml
  294. @@ -61,6 +61,9 @@ let print_if ppf flag printer arg =
  295.    if !flag then fprintf ppf "%a@." printer arg;
  296.    arg
  297.  
  298. +let quit_if flag arg =
  299. +  if !flag then (Warnings.check_fatal (); exit 0) else arg
  300. +
  301.  let (++) x f = f x
  302.  let (+++) (x, y) f = (x, f y)
  303.  
  304. @@ -81,20 +84,26 @@ let implementation ppf sourcefile outputprefix =
  305.        Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  306.        ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  307.        ++ print_if ppf Clflags.dump_source Pprintast.structure
  308. +      ++ quit_if Clflags.quit_after_parse
  309.        ++ Typemod.type_implementation sourcefile outputprefix modulename env
  310.        ++ print_if ppf Clflags.dump_typedtree
  311.                    Printtyped.implementation_with_coercion
  312. +      ++ quit_if Clflags.quit_after_typing
  313.      end else begin
  314.        Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
  315.        ++ print_if ppf Clflags.dump_parsetree Printast.implementation
  316.        ++ print_if ppf Clflags.dump_source Pprintast.structure
  317. +      ++ quit_if Clflags.quit_after_parse
  318.        ++ Typemod.type_implementation sourcefile outputprefix modulename env
  319.        ++ print_if ppf Clflags.dump_typedtree
  320.                    Printtyped.implementation_with_coercion
  321. +      ++ quit_if Clflags.quit_after_typing
  322.        ++ Translmod.transl_store_implementation modulename
  323.        +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
  324. +      +++ quit_if Clflags.quit_after_rawlambda
  325.        +++ Simplif.simplify_lambda
  326.        +++ print_if ppf Clflags.dump_lambda Printlambda.lambda
  327. +      +++ quit_if Clflags.quit_after_lambda
  328.        ++ Asmgen.compile_implementation outputprefix ppf;
  329.        Compilenv.save_unit_info cmxfile;
  330.      end;
  331. diff --git a/driver/optmain.ml b/driver/optmain.ml
  332. index 7571fca..ddfb9d0 100644
  333. --- a/driver/optmain.ml
  334. +++ b/driver/optmain.ml
  335. @@ -143,6 +143,12 @@ module Options = Main_args.Make_optcomp_options (struct
  336.    let _dlinear = set dump_linear
  337.    let _dstartup = set keep_startup_file
  338.  
  339. +  let _qparse = set quit_after_parse
  340. +  let _qtyping = set quit_after_typing
  341. +  let _qrawlambda = set quit_after_rawlambda
  342. +  let _qlambda = set quit_after_lambda
  343. +  let _qcmm = set quit_after_cmm
  344. +
  345.    let anonymous = anonymous
  346.  end);;
  347.  
  348. diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
  349. index 67a2bae..9da3f46 100644
  350. --- a/tools/ocamlcp.ml
  351. +++ b/tools/ocamlcp.ml
  352. @@ -98,6 +98,13 @@ module Options = Main_args.Make_bytecomp_options (struct
  353.    let _drawlambda = option "-drawlambda"
  354.    let _dlambda = option "-dlambda"
  355.    let _dinstr = option "-dinstr"
  356. +
  357. +  let _qparse = option "-qparse"
  358. +  let _qtyping = option "-qtyping"
  359. +  let _qrawlambda = option "-qrawlambda"
  360. +  let _qlambda = option "-qlambda"
  361. +  let _qinstr = option "-qinstr"
  362. +
  363.    let anonymous = process_file
  364.  end);;
  365.  
  366. diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml
  367. index 74d1314..c67bf40 100644
  368. --- a/tools/ocamloptp.ml
  369. +++ b/tools/ocamloptp.ml
  370. @@ -114,6 +114,12 @@ module Options = Main_args.Make_optcomp_options (struct
  371.    let _dlinear = option "-dlinear"
  372.    let _dstartup = option "-dstartup"
  373.  
  374. +  let _qparse = option "-qparse"
  375. +  let _qtyping = option "-qtyping"
  376. +  let _qrawlambda = option "-qrawlambda"
  377. +  let _qlambda = option "-qlambda"
  378. +  let _qcmm = option "-qcmm"
  379. +
  380.    let anonymous = process_file
  381.  end);;
  382.  
  383. diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
  384. index 87c36d1..0812c52 100644
  385. --- a/toplevel/topmain.ml
  386. +++ b/toplevel/topmain.ml
  387. @@ -91,6 +91,12 @@ module Options = Main_args.Make_bytetop_options (struct
  388.    let _dlambda = set dump_lambda
  389.    let _dinstr = set dump_instr
  390.  
  391. +  let _qparse = set quit_after_parse
  392. +  let _qtyping = set quit_after_typing
  393. +  let _qrawlambda = set quit_after_rawlambda
  394. +  let _qlambda = set quit_after_lambda
  395. +  let _qinstr = set quit_after_instr
  396. +
  397.    let anonymous s = file_argument s
  398.  end);;
  399.  
  400. diff --git a/utils/clflags.ml b/utils/clflags.ml
  401. index 4ff808f..564d3a7 100644
  402. --- a/utils/clflags.ml
  403. +++ b/utils/clflags.ml
  404. @@ -82,6 +82,13 @@ let dump_linear = ref false             (* -dlinear *)
  405.  let keep_startup_file = ref false       (* -dstartup *)
  406.  let dump_combine = ref false            (* -dcombine *)
  407.  
  408. +let quit_after_parse = ref false
  409. +let quit_after_typing = ref false
  410. +let quit_after_rawlambda = ref false
  411. +let quit_after_lambda = ref false
  412. +let quit_after_instr = ref false
  413. +let quit_after_cmm = ref false
  414. +
  415.  let native_code = ref false             (* set to true under ocamlopt *)
  416.  let inline_threshold = ref 10
  417.  let force_slash = ref false             (* for ocamldep *)
  418. diff --git a/utils/clflags.mli b/utils/clflags.mli
  419. index e671133..2866682 100644
  420. --- a/utils/clflags.mli
  421. +++ b/utils/clflags.mli
  422. @@ -76,6 +76,12 @@ val dump_scheduling : bool ref
  423.  val dump_linear : bool ref
  424.  val keep_startup_file : bool ref
  425.  val dump_combine : bool ref
  426. +val quit_after_parse : bool ref
  427. +val quit_after_typing : bool ref
  428. +val quit_after_rawlambda : bool ref
  429. +val quit_after_lambda : bool ref
  430. +val quit_after_instr : bool ref
  431. +val quit_after_cmm : bool ref
  432.  val native_code : bool ref
  433.  val inline_threshold : int ref
  434.  val dont_write_files : bool ref
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top