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.

52 lines
1.6 KiB

4 years ago
  1. include import "./compile.ml"
  2. open import "prelude.ml"
  3. open import "lua/io.ml"
  4. let resolve_addr = function
  5. | Combinator n -> n ^ "_combinator"
  6. | Arg i -> "stack[sp - " ^ show (i + 1) ^ "][3]"
  7. let gm2lua = function
  8. | Push addr -> " stack[sp + 1] = " ^ resolve_addr addr ^ "; sp = sp + 1"
  9. | Pop n -> " sp = sp - " ^ show n
  10. | Update n -> " stack[sp - " ^ show (n + 1) ^ "] = { I, stack[sp] }; sp = sp - 1"
  11. | Mkap -> " stack[sp - 1] = { A, stack[sp - 1], stack[sp] }; sp = sp - 1"
  12. | Unwind -> " return unwind()"
  13. let compute_local_set xs =
  14. let rec go i (s : S.t string) = function
  15. | Cons ((name, _, _), xs) ->
  16. if i >= 100 then
  17. s
  18. else
  19. go (i + 2) (S.insert name (S.insert (name ^ "_combinator") s)) xs
  20. | Nil -> s
  21. go 1 S.empty xs
  22. let sc2lua (name, arity, body) =
  23. let body =
  24. body
  25. |> foldl (fun x s -> x ^ gm2lua s ^ ";\n") (name ^ " = function()\n")
  26. |> (^ "end")
  27. let dec =
  28. name ^ "_combinator = { F, " ^ name ^ ", " ^ show arity ^ ", " ^ show name ^ " };"
  29. body ^ "\n" ^ dec
  30. let preamble =
  31. let f = open_for_reading "preamble.lua"
  32. let x = read_all f
  33. close_file f
  34. match x with
  35. | Some s -> s
  36. | None -> error "no preamble.lua"
  37. let assm_program decs =
  38. match decs with
  39. | [] -> error "empty program"
  40. | _ ->
  41. let Cons (local1, locals) =
  42. compute_local_set decs |> S.members
  43. let local_decs =
  44. foldl (fun x v -> x ^ ", " ^ v) ("local " ^ local1) locals
  45. let body = foldl (fun x s -> x ^ sc2lua s ^ "\n") "" decs
  46. preamble ^ local_decs ^ "\n" ^ body ^ "stack[sp] = { A, main_combinator, 0 }; unwind()"