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
52 lines
1.6 KiB
include import "./compile.ml"
|
|
open import "prelude.ml"
|
|
open import "lua/io.ml"
|
|
|
|
let resolve_addr = function
|
|
| Combinator n -> n ^ "_combinator"
|
|
| Arg i -> "stack[sp - " ^ show (i + 1) ^ "][3]"
|
|
|
|
let gm2lua = function
|
|
| Push addr -> " stack[sp + 1] = " ^ resolve_addr addr ^ "; sp = sp + 1"
|
|
| Pop n -> " sp = sp - " ^ show n
|
|
| Update n -> " stack[sp - " ^ show (n + 1) ^ "] = { I, stack[sp] }; sp = sp - 1"
|
|
| Mkap -> " stack[sp - 1] = { A, stack[sp - 1], stack[sp] }; sp = sp - 1"
|
|
| Unwind -> " return unwind()"
|
|
|
|
let compute_local_set xs =
|
|
let rec go i (s : S.t string) = function
|
|
| Cons ((name, _, _), xs) ->
|
|
if i >= 100 then
|
|
s
|
|
else
|
|
go (i + 2) (S.insert name (S.insert (name ^ "_combinator") s)) xs
|
|
| Nil -> s
|
|
go 1 S.empty xs
|
|
|
|
let sc2lua (name, arity, body) =
|
|
let body =
|
|
body
|
|
|> foldl (fun x s -> x ^ gm2lua s ^ ";\n") (name ^ " = function()\n")
|
|
|> (^ "end")
|
|
let dec =
|
|
name ^ "_combinator = { F, " ^ name ^ ", " ^ show arity ^ ", " ^ show name ^ " };"
|
|
body ^ "\n" ^ dec
|
|
|
|
let preamble =
|
|
let f = open_for_reading "preamble.lua"
|
|
let x = read_all f
|
|
close_file f
|
|
match x with
|
|
| Some s -> s
|
|
| None -> error "no preamble.lua"
|
|
|
|
let assm_program decs =
|
|
match decs with
|
|
| [] -> error "empty program"
|
|
| _ ->
|
|
let Cons (local1, locals) =
|
|
compute_local_set decs |> S.members
|
|
let local_decs =
|
|
foldl (fun x v -> x ^ ", " ^ v) ("local " ^ local1) locals
|
|
let body = foldl (fun x s -> x ^ sc2lua s ^ "\n") "" decs
|
|
preamble ^ local_decs ^ "\n" ^ body ^ "stack[sp] = { A, main_combinator, 0 }; unwind()"
|