87 lines
2.8 KiB
OCaml
87 lines
2.8 KiB
OCaml
|
|
type literal =
|
|
| Int of int
|
|
| Double of float
|
|
| String of string
|
|
| Nil
|
|
| Cons of literal * literal
|
|
|
|
(* The Core Abstract Syntax Tree.
|
|
This tree does not use a GADT, as every type of expression
|
|
will be reduced to its simplest equivalent form before ending
|
|
up here. There is no reason to make this tree typed.
|
|
*)
|
|
type expression =
|
|
| Literal of literal
|
|
| Var of string
|
|
| Apply of expression * expression list
|
|
| Lambda of string list * expression
|
|
| Let of (string * expression) list * expression
|
|
| LetRec of (string * expression) list * expression
|
|
| If of expression * expression * expression
|
|
| Set of string * expression
|
|
| Begin of expression list
|
|
|
|
|
|
type top_level =
|
|
| Define of string * expression
|
|
| Expr of expression
|
|
|
|
|
|
|
|
|
|
|
|
let rec pair_of_def : Syntactic_ast.definition Syntactic_ast.t -> string * expression = function
|
|
| Syntactic_ast.Define (s, e) -> (s, of_expr e)
|
|
and pair_of_binding = function
|
|
| Syntactic_ast.LetBinding (s, e) -> (s, of_expr e)
|
|
and pair_of_clause = function
|
|
| Syntactic_ast.CondClause (e1, e2) -> (of_expr e1, of_expr e2)
|
|
(* We convert a body into a regular letrec form.
|
|
A body is defined as a series of definitions followed by a series
|
|
of expressions. The definitions behave exactly as a letrec, so
|
|
it makes sense to convert the body into a normal letrec.
|
|
*)
|
|
and of_body : Syntactic_ast.body Syntactic_ast.t -> expression = function
|
|
| Body (defs, exprs) ->
|
|
let exprs = List.map of_expr exprs in
|
|
let defs = List.map pair_of_def defs in
|
|
let b = Begin exprs in
|
|
LetRec (defs, b)
|
|
|
|
(* TODO: currently this ignores the "optional" part of the lambda list,
|
|
fix this *)
|
|
and of_ll : Syntactic_ast.lambda_list Syntactic_ast.t -> string list = function
|
|
| LambdaList (sl, _) -> sl
|
|
|
|
and of_expr : Syntactic_ast.expression Syntactic_ast.t -> expression = function
|
|
| LitNil -> Literal Nil
|
|
| LitInt x -> Literal (Int x)
|
|
| LitDouble x -> Literal (Double x)
|
|
| LitString x -> Literal (String x)
|
|
| Var x -> Var x
|
|
| QuotedList _ -> failwith "TODO: rethink how quoted lists should work, the current definition makes no sense."
|
|
| Lambda (ll, b) -> Lambda (of_ll ll, of_body b)
|
|
| Let (bindings, b) -> Let (List.map pair_of_binding bindings, of_body b)
|
|
| LetRec (bindings, b) -> LetRec (List.map pair_of_binding bindings, of_body b)
|
|
| Cond (clauses) ->
|
|
List.fold_right
|
|
(fun (e1, e2) acc -> If (e1, e2, acc))
|
|
(List.map pair_of_clause clauses)
|
|
(Literal Nil)
|
|
| If (e1, e2, e3) ->
|
|
If (of_expr e1, of_expr e2, of_expr e3)
|
|
| Set (s, e) -> Set (s, of_expr e)
|
|
| Apply (f, es) -> Apply (of_expr f, List.map of_expr es)
|
|
|
|
|
|
and of_syntactic : Syntactic_ast.top_level -> top_level = function
|
|
| Def (Define (s, e)) -> Define (s, of_expr e)
|
|
| Exp (e) -> Expr (of_expr e)
|
|
| _ -> .
|
|
|
|
|
|
let of_sexpr x =
|
|
Result.bind (Syntactic_ast.make x)
|
|
(fun x -> Ok (of_syntactic x))
|