115 lines
2.4 KiB
OCaml
115 lines
2.4 KiB
OCaml
|
type name = string
|
||
|
|
||
|
type literal =
|
||
|
| Int of int64
|
||
|
| True
|
||
|
| False
|
||
|
| Nil
|
||
|
|
||
|
type binop =
|
||
|
| Add
|
||
|
| Sub
|
||
|
| Mul
|
||
|
| Div
|
||
|
| Mod
|
||
|
| Eql
|
||
|
| Grt
|
||
|
| Lst
|
||
|
| Not_eql
|
||
|
| Grt_eql
|
||
|
| Lst_eql
|
||
|
|
||
|
type modl = { items : item list }
|
||
|
|
||
|
and item =
|
||
|
| Item_exp of exp
|
||
|
| Item_val of name * exp
|
||
|
| Item_fun of name * params * exp
|
||
|
| Item_obj of name * block
|
||
|
|
||
|
and params = name list
|
||
|
|
||
|
and exp =
|
||
|
| Literal of literal
|
||
|
| Path of path
|
||
|
| Call of path * exp list
|
||
|
| Binop of binop * exp * exp
|
||
|
| Fun of params * exp
|
||
|
| Obj of block
|
||
|
| Scope of block
|
||
|
|
||
|
and path =
|
||
|
| Var of name
|
||
|
| Ele of exp * name
|
||
|
|
||
|
and block = item list
|
||
|
|
||
|
(* pretty printer *)
|
||
|
|
||
|
let string_of_literal = function
|
||
|
| Int n -> Int64.to_string n
|
||
|
| True -> "true"
|
||
|
| False -> "false"
|
||
|
| Nil -> "nil"
|
||
|
|
||
|
let string_of_binop = function
|
||
|
| Add -> "+"
|
||
|
| Sub -> "-"
|
||
|
| Mul -> "*"
|
||
|
| Div -> "/"
|
||
|
| Mod -> "%"
|
||
|
| Eql -> "=="
|
||
|
| Grt -> ">"
|
||
|
| Lst -> "<"
|
||
|
| Not_eql -> "!="
|
||
|
| Grt_eql -> ">="
|
||
|
| Lst_eql -> "<="
|
||
|
|
||
|
let pf = Format.fprintf
|
||
|
let pp_str ppf str = pf ppf "%S" str
|
||
|
|
||
|
let pp_list pp_ele ppf list =
|
||
|
pf ppf "[";
|
||
|
List.iteri
|
||
|
(fun i ele ->
|
||
|
if i > 0 then pf ppf ",";
|
||
|
pp_ele ppf ele)
|
||
|
list;
|
||
|
pf ppf "]"
|
||
|
|
||
|
let rec pp_exp ppf = function
|
||
|
| Literal (Int n) -> pf ppf "{\"int\":%s}" (Int64.to_string n)
|
||
|
| Literal l -> pf ppf "%s" (string_of_literal l)
|
||
|
| Path (Var x) -> pf ppf "{\"var\":%S}" x
|
||
|
| Path (Ele (e, x)) -> pf ppf "{\"ele\":%a,\"field\":%S}" pp_exp e x
|
||
|
| Call (fn, args) -> pf ppf "{\"call\":%a}" (pp_list pp_exp) (Path fn :: args)
|
||
|
| Binop (op, e1, e2) ->
|
||
|
pf
|
||
|
ppf
|
||
|
"{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
|
||
|
(string_of_binop op)
|
||
|
pp_exp
|
||
|
e1
|
||
|
pp_exp
|
||
|
e2
|
||
|
| Fun (params, body) ->
|
||
|
pf ppf "{\"fun\":%a,\"body\":%a}" (pp_list pp_str) params pp_exp body
|
||
|
| Obj body -> pf ppf "{\"obj\":%a}" (pp_list pp_item) body
|
||
|
| Scope body -> pf ppf "{\"scope\":%a}" (pp_list pp_item) body
|
||
|
|
||
|
and pp_item ppf = function
|
||
|
| Item_exp e -> pf ppf "{\"exp\":%a}" pp_exp e
|
||
|
| Item_val (name, rhs) -> pf ppf "{\"val\":%S,\"rhs\":%a}" name pp_exp rhs
|
||
|
| Item_fun (name, params, body) ->
|
||
|
pf
|
||
|
ppf
|
||
|
"{\"fun\":%S,\"params\":%a,\"body\":%a}"
|
||
|
name
|
||
|
(pp_list pp_str)
|
||
|
params
|
||
|
pp_exp
|
||
|
body
|
||
|
| Item_obj (name, body) -> pf ppf "{\"obj\":%S,\"body\":%a}" name (pp_list pp_item) body
|
||
|
|
||
|
let pp_modl ppf m = pp_list pp_item ppf m.items
|