You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

97 lines
2.5 KiB

4 years ago
4 years ago
4 years ago
4 years ago
4 years ago
4 years ago
4 years ago
4 years ago
  1. module C = import "./compile.ml"
  2. module A = import "./assemble.ml"
  3. module T = import "./tc.ml"
  4. open import "./parser.ml"
  5. open import "prelude.ml"
  6. open import "lua/io.ml"
  7. module Stg = import "./stg/lower.ml"
  8. module Out = import "./stg/output.ml"
  9. external val dofile : string -> () = "dofile"
  10. let printerror (e, { line, col }) =
  11. put_line @@ "line " ^ show line ^ ", col " ^ show col ^ ":"
  12. print e
  13. let go infile outfile =
  14. let infile = open_for_reading infile
  15. let outfile = open_file outfile Write_m
  16. match read_all infile with
  17. | Some str ->
  18. match lex prog str with
  19. | Right (ds, _) ->
  20. ds
  21. |> T.tc_program [] []
  22. |> fun (_, _, z) -> z
  23. |> C.program
  24. |> A.assm_program
  25. |> write_bytes outfile
  26. | Left e -> printerror e
  27. | _ -> ()
  28. close_file infile
  29. close_file outfile
  30. let go' infile outfile =
  31. go infile outfile
  32. dofile outfile
  33. let test str =
  34. match lex prog str with
  35. | Right (ds, _) ->
  36. let code =
  37. ds
  38. |> T.tc_program [] []
  39. |> fun (_, _, z) -> z
  40. |> C.program
  41. let lua = code |> A.assm_program
  42. print code
  43. put_line lua
  44. | Left e -> printerror e
  45. let test_file infile =
  46. let infile = open_for_reading infile
  47. match read_all infile with
  48. | Some str -> test str
  49. | None -> ()
  50. close_file infile
  51. let rec take n xs =
  52. match n, xs with
  53. | _, [] -> []
  54. | 0, _ -> []
  55. | n, Cons (x, xs) -> Cons (x, take (n - 1) xs)
  56. let go_stg infile outfile =
  57. let infile = open_for_reading infile
  58. let outfile = open_file outfile Write_m
  59. match read_all infile with
  60. | Some str ->
  61. match lex prog str with
  62. | Right (ds, _) ->
  63. let decs =
  64. ds |> T.tc_program [] []
  65. |> fun (_, _, z) -> z
  66. |> flip (>>=) Stg.lower_dec
  67. let (_, sts, locals) = foldl Out.stmts_of_def (M.empty, [], []) decs
  68. write_bytes outfile "local Constr_mt = { __call = function(x) return x end }\n"
  69. Out.get_file_contents () |> (^"\n") |> write_bytes outfile
  70. write_bytes outfile (Out.mk_pap_def ^ "\n")
  71. write_bytes outfile (Out.ppr_stmt "" (Out.Local (take 100 locals, [])) ^ "\n")
  72. iter (write_bytes outfile # (^"\n") # Out.ppr_stmt "") sts
  73. write_bytes outfile "main_entry(function() return 'the real world is fake' end)\n"
  74. | Left e ->
  75. printerror e
  76. | None -> ()
  77. close_file infile
  78. close_file outfile
  79. external val args : string * string =
  80. "{ _1 = select(1, ...), _2 = select(2, ...) }"
  81. external val has_args : bool = "select('#', ...) ~= 0"
  82. let () =
  83. if has_args then
  84. let (from, into) = args
  85. go from into
  86. else ()