<commit_before>open JavaScript
open Exprjs
open Prelude
open Printf
open Typedjs_types
open Typedjs_tc
open Format
open Typedjs_syntax
open Typedjs_fromExpr
open Typedjs_env
open Exprjs_syntax
open Format
open FormatExt
open Typedjs_cf
open Typedjs_cftc
open Lexing

module Lat = Typedjs_lattice

let cin = ref stdin

let cin_name = ref "stdin"

let env = ref Env.empty_env

let get_env () = 
  Env.set_global_object !env "HTMLWindow"

let action_load_file path =
  cin := open_in path;
  cin_name := path

let action_pretty () : unit = 
  let prog = parse_javascript !cin !cin_name in
    JavaScript.Pretty.p_prog prog std_formatter;
    print_newline ()

let action_contracts () : unit = 
  let prog = parse_javascript !cin !cin_name in
  let prog' = Typedjs_contracts.types_to_contracts prog in
    JavaScript.Pretty.p_prog prog' std_formatter;
    print_newline ()

let action_expr () : unit =
  let prog = parse_javascript !cin !cin_name in
  let e = from_javascript prog in
    Exprjs.Pretty.p_expr e std_formatter

let get_typedjs () =
  Typedjs_fromExpr.from_exprjs (get_env ())
    (from_javascript (parse_javascript !cin !cin_name))

let action_pretypecheck () : unit = 
  let typedjs = get_typedjs () in
    Typedjs_syntax.Pretty.p_def typedjs std_formatter

let action_tc () : unit = 
  let typedjs = get_typedjs () in
  let cpstypedjs = Typedjs_cps.cps typedjs in
  let cf_env =
    Lat.bind "%end" (Lat.singleton RT.Function)
      (Lat.bind "%global" (Lat.singleton RT.Object)
         (Lat.bind "%uncaught-exception" (Lat.singleton RT.Function)
            (cf_env_of_tc_env (get_env ())))) in
    typed_cfa cf_env cpstypedjs;
    let annotated_typedjs = insert_typecasts typedjs in
    let _ = Typedjs_tc.typecheck (get_env ()) annotated_typedjs in
    ()

let action_cps () : unit =
  let typedjs = get_typedjs () in
  let cps = Typedjs_cps.cps typedjs in
    Typedjs_cps.p_cpsexp cps std_formatter

let action_df () : unit =
  let typedjs = get_typedjs () in
  let cpstypedjs = Typedjs_cps.cps typedjs in
  let env =
    Lat.bind "%end" (Lat.singleton RT.Function)
      (Lat.bind "%global" (Lat.singleton RT.Object)
         (Lat.bind "%uncaught-exception" (Lat.singleton RT.Function)
            (cf_env_of_tc_env (get_env ())))) in
    typed_cfa env cpstypedjs;
    let annotated_exp = insert_typecasts typedjs in
      Typedjs_syntax.Pretty.p_def annotated_exp std_formatter ;
      printf "Dataflow analysis successful.\n"

let action = ref action_tc

let is_action_set = ref false

let set_action (thunk : unit -> unit) (() : unit) : unit =
  if !is_action_set then
    (eprintf "invalid arguments (-help for help)\n"; exit 1)
  else 
    (is_action_set := true; action := thunk)

let set_env (fname : string) : unit = 
  env := extend_global_env !env (parse_env (open_in fname) fname)

let main () : unit =
  Arg.parse
    [ ("-env", Arg.String set_env, "load the environment from a file");
      ("-pretty", Arg.Unit (set_action action_pretty),
       "pretty-print JavaScript");
      ("-expr", Arg.Unit (set_action action_expr),
       "simplify JavaScript to exprjs");
      ("-pretc", Arg.Unit (set_action action_pretypecheck),
       "basic well-formedness checks before type-checking and flow-analysis");
      ("-cps", Arg.Unit (set_action action_cps),
       "convert program to CPS");
      ("-df", Arg.Unit (set_action action_df),
       "convert program to ANF, then apply dataflow analysis");
      ("-tc", Arg.Unit (set_action action_tc),
       "type-check (default action)");
      ("-contracts", Arg.Unit (set_action action_contracts),
       "insert contracts") ]
    (fun s -> action_load_file s)
    "Typed JavaScript [action] [path]";;

Printexc.print main ();
let exitcode = begin
  try
    !action (); 0
  with 
      Failure s ->  eprintf "%s\n" s; 3
    | Not_well_formed (p, s) -> 
        eprintf "%s not well-formed:\n%s\n" (string_of_position p) s; 2
    | Typ_error (p, s) ->
        eprintf "%s type error:\n%s\n" (string_of_position p) s; 2
end in
  pp_print_flush std_formatter ();
  pp_print_flush err_formatter ();
  exit exitcode<commit_msg>-stdin flag<commit_after>open JavaScript
open Exprjs
open Prelude
open Printf
open Typedjs_types
open Typedjs_tc
open Format
open Typedjs_syntax
open Typedjs_fromExpr
open Typedjs_env
open Exprjs_syntax
open Format
open FormatExt
open Typedjs_cf
open Typedjs_cftc
open Lexing

module Lat = Typedjs_lattice

module Input : sig
  val get_cin : unit -> in_channel
  val get_cin_name : unit -> string
  val set_cin : in_channel -> string -> unit
end = struct

  let c = ref None

  let cname = ref "no input specified"

  let get_cin () = match !c with
    | None -> failwith "jst: no input files"
    | Some cin -> cin

  let get_cin_name () = !cname

  let set_cin cin name = match !c with
    | None -> c := Some cin; cname := name
    | Some _ -> failwith "invalid arguments" 

end

open Input
    
let env = ref Env.empty_env

let get_env () = 
  Env.set_global_object !env "HTMLWindow"


let action_pretty () : unit = 
  let prog = parse_javascript (get_cin ()) (get_cin_name ()) in
    JavaScript.Pretty.p_prog prog std_formatter;
    print_newline ()

let action_contracts () : unit = 
  let prog = parse_javascript (get_cin ()) (get_cin_name ()) in
  let prog' = Typedjs_contracts.types_to_contracts prog in
    JavaScript.Pretty.p_prog prog' std_formatter;
    print_newline ()

let action_expr () : unit =
  let prog = parse_javascript (get_cin ()) (get_cin_name ()) in
  let e = from_javascript prog in
    Exprjs.Pretty.p_expr e std_formatter

let get_typedjs () =
  Typedjs_fromExpr.from_exprjs (get_env ())
    (from_javascript (parse_javascript (get_cin ()) (get_cin_name ())))

let action_pretypecheck () : unit = 
  let typedjs = get_typedjs () in
    Typedjs_syntax.Pretty.p_def typedjs std_formatter

let action_tc () : unit = 
  let typedjs = get_typedjs () in
  let cpstypedjs = Typedjs_cps.cps typedjs in
  let cf_env =
    Lat.bind "%end" (Lat.singleton RT.Function)
      (Lat.bind "%global" (Lat.singleton RT.Object)
         (Lat.bind "%uncaught-exception" (Lat.singleton RT.Function)
            (cf_env_of_tc_env (get_env ())))) in
    typed_cfa cf_env cpstypedjs;
    let annotated_typedjs = insert_typecasts typedjs in
    let _ = Typedjs_tc.typecheck (get_env ()) annotated_typedjs in
    ()

let action_cps () : unit =
  let typedjs = get_typedjs () in
  let cps = Typedjs_cps.cps typedjs in
    Typedjs_cps.p_cpsexp cps std_formatter

let action_df () : unit =
  let typedjs = get_typedjs () in
  let cpstypedjs = Typedjs_cps.cps typedjs in
  let env =
    Lat.bind "%end" (Lat.singleton RT.Function)
      (Lat.bind "%global" (Lat.singleton RT.Object)
         (Lat.bind "%uncaught-exception" (Lat.singleton RT.Function)
            (cf_env_of_tc_env (get_env ())))) in
    typed_cfa env cpstypedjs;
    let annotated_exp = insert_typecasts typedjs in
      Typedjs_syntax.Pretty.p_def annotated_exp std_formatter ;
      printf "Dataflow analysis successful.\n"

let action = ref action_tc

let is_action_set = ref false

let set_action (thunk : unit -> unit) (() : unit) : unit =
  if !is_action_set then
    (eprintf "invalid arguments (-help for help)\n"; exit 1)
  else 
    (is_action_set := true; action := thunk)

let set_env (fname : string) : unit = 
  env := extend_global_env !env (parse_env (open_in fname) fname)

let main () : unit =
  Arg.parse
    [ ("-tc", Arg.Unit (set_action action_tc),
       "type-check the source program (default when no options are given)");
      ("-contracts", Arg.Unit (set_action action_contracts),
       "insert contracts into the source program") ;
      ("-stdin", Arg.Unit (fun () -> set_cin stdin "<stdin>"),
       "read from stdin instead of a file");
      ("-env", Arg.String set_env, "<file> read environment types from <file>");
      ("-pretty", Arg.Unit (set_action action_pretty),
       "pretty-print JavaScript");
      ("-expr", Arg.Unit (set_action action_expr),
       "simplify JavaScript to exprjs");
      ("-pretc", Arg.Unit (set_action action_pretypecheck),
       "basic well-formedness checks before type-checking and flow-analysis");
      ("-cps", Arg.Unit (set_action action_cps),
       "convert program to CPS");
      ("-df", Arg.Unit (set_action action_df),
       "convert program to ANF, then apply dataflow analysis")
    ]
    (fun s -> set_cin (open_in s) s)
    "Usage: jst [options] [file]\noptions are:\n";;

Printexc.print main ();
let exitcode = begin
  try
    !action (); 0
  with 
      Failure s ->  eprintf "%s\n" s; 3
    | Not_well_formed (p, s) -> 
        eprintf "%s not well-formed:\n%s\n" (string_of_position p) s; 2
    | Typ_error (p, s) ->
        eprintf "%s type error:\n%s\n" (string_of_position p) s; 2
end in
  pp_print_flush std_formatter ();
  pp_print_flush err_formatter ();
  exit exitcode
{'fraction_non_alphanumeric': 0.107817626428329, 'fraction_numerical': 0.0011313497001923295, 'mean_word_length': 3.369747899159664, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5162099', 'n_tokens_mistral': 3179, 'n_tokens_neox': 3063, 'n_words': 864}