117 lines
2.5 KiB
OCaml
117 lines
2.5 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
|
|
| If of exp * 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 pp_list pp_ele ppf list =
|
|
Fmt.pf ppf "[";
|
|
List.iteri
|
|
(fun i ele ->
|
|
if i > 0 then Fmt.pf ppf ",";
|
|
pp_ele ppf ele)
|
|
list;
|
|
Fmt.pf ppf "]"
|
|
|
|
let rec pp_exp ppf = function
|
|
| Literal (Int n) -> Fmt.pf ppf "{\"int\":%s}" (Int64.to_string n)
|
|
| Literal l -> Fmt.pf ppf "%s" (string_of_literal l)
|
|
| Path (Var x) -> Fmt.pf ppf "{\"var\":%S}" x
|
|
| Path (Ele (e, x)) -> Fmt.pf ppf "{\"ele\":%a,\"field\":%S}" pp_exp e x
|
|
| Call (fn, args) -> Fmt.pf ppf "{\"call\":%a}" (pp_list pp_exp) (Path fn :: args)
|
|
| If (ec, et, ee) ->
|
|
Fmt.pf ppf "{\"if\":%a,\"then\":%a,\"else\":%a}"
|
|
pp_exp ec
|
|
pp_exp et
|
|
pp_exp ee
|
|
| Binop (op, e1, e2) ->
|
|
Fmt.pf ppf "{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
|
|
(string_of_binop op)
|
|
pp_exp e1
|
|
pp_exp e2
|
|
| Fun (params, body) ->
|
|
Fmt.pf ppf "{\"fun\":%a,\"body\":%a}"
|
|
(pp_list Fmt.string) params
|
|
pp_exp body
|
|
| Obj body -> Fmt.pf ppf "{\"obj\":%a}" (pp_list pp_item) body
|
|
| Scope body -> Fmt.pf ppf "{\"scope\":%a}" (pp_list pp_item) body
|
|
|
|
and pp_item ppf = function
|
|
| Item_exp e ->
|
|
Fmt.pf ppf "{\"exp\":%a}" pp_exp e
|
|
| Item_val (name, rhs) ->
|
|
Fmt.pf ppf "{\"val\":%S,\"rhs\":%a}" name pp_exp rhs
|
|
| Item_fun (name, params, body) ->
|
|
Fmt.pf ppf "{\"fun\":%S,\"params\":%a,\"body\":%a}"
|
|
name
|
|
(pp_list Fmt.string) params
|
|
pp_exp body
|
|
| Item_obj (name, body) ->
|
|
Fmt.pf ppf "{\"obj\":%S,\"body\":%a}"
|
|
name
|
|
(pp_list pp_item) body
|
|
|
|
let pp_modl ppf m = pp_list pp_item ppf m.items
|