teyalem/ce
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement Ocaml-style return

Browse source
This commit is contained in:
백현웅 2022-02-08 01:22:49 +09:00
parent 7cddc45e8b
commit 1f91d214ee
3 changed files with 27 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
eval.ml
View file

@ -213,7 +213,7 @@ let rec binop op l r =
exception Unbound of string exception Unbound of string
let rec eval env ast : value = let rec eval env ast : string * value =
let rec aux = function let rec aux = function
| Nint n -> Int n | Nint n -> Int n
| Nfloat n -> Float n | Nfloat n -> Float n
@ -232,9 +232,6 @@ let rec eval env ast : value =
| Binop (l, op, r) -> | Binop (l, op, r) ->
let l = aux l and r = aux r in let l = aux l and r = aux r in
binop op l r binop op l r
| Let (var, e) ->
let v = aux e in
Env.set env var v; v
| Apply (v, args) -> | Apply (v, args) ->
begin match aux v with begin match aux v with
| Function (vars, e) -> | Function (vars, e) ->
@ -243,7 +240,7 @@ let rec eval env ast : value =
let nenv = Env.make env in let nenv = Env.make env in
List.combine vars args List.combine vars args
|> List.iter (fun (v, a) -> Env.set nenv v a); |> List.iter (fun (v, a) -> Env.set nenv v a);
eval nenv e snd @@ eval nenv e
| External f -> | External f ->
let args = List.map aux args in let args = List.map aux args in
External.apply f args External.apply f args
@ -263,8 +260,15 @@ let rec eval env ast : value =
Hashtbl.replace Parser.oper_assoc op @@ Parser.assoc_of_string a; Hashtbl.replace Parser.oper_assoc op @@ Parser.assoc_of_string a;
Nop Nop
| Get_binop_aso op -> | Get_binop_aso op ->
match Hashtbl.find_opt Parser.oper_assoc op with (match Hashtbl.find_opt Parser.oper_assoc op with
| None -> String "left" | None -> String "left"
| Some a -> String (Parser.assoc_to_string a) | Some a -> String (Parser.assoc_to_string a))
| _ -> failwith "Eval.eval"
in in
aux ast
match ast with
| Let (var, e) ->
let v = aux e in
Env.set env var v;
var, v
| ast -> "-", aux ast

5
main.ml
View file

@ -36,7 +36,7 @@ let rep env : unit =
printf "> "; printf "> ";
let line = read_line () in let line = read_line () in
if line = "quit" then raise Exit; if line = "quit" then raise Exit;
let v = let var, v =
line line
|> Lex.tokenize |> Lex.tokenize
|> Parser.parse |> Parser.parse
@ -46,7 +46,8 @@ let rep env : unit =
| Nop -> () | Nop -> ()
| _ -> | _ ->
Env.set env "ans" v; Env.set env "ans" v;
printf "%s\n" @@ Value.to_string v printf "%s: %s = %s\n"
var (Type.to_string @@ Value.typeof v) (Value.to_string v)
exception Reset_line (* used to indicate ^C is pressed *) exception Reset_line (* used to indicate ^C is pressed *)

15
parser.ml
View file

@ -139,17 +139,24 @@ let more f seq =
let xs, seq = aux [] seq in let xs, seq = aux [] seq in
List.rev xs, seq List.rev xs, seq
(* decl := let_value
* | expr
*)
let rec decl seq =
seq |> oneof [
let_value;
expr min_int;
]
(* expr := level (* expr := level
* | assoc * | assoc
* | let
* | apply * | apply
* | value binop_right * | value binop_right
*) *)
let rec expr pre seq = and expr pre seq =
seq |> oneof [ seq |> oneof [
level; level;
assoc; assoc;
let_value;
lambda; lambda;
extern_value; extern_value;
apply; apply;
@ -267,6 +274,6 @@ and binop pre left seq =
(* parse tokens *) (* parse tokens *)
let parse ts = let parse ts =
let ast, rest = expr min_int ts in let ast, rest = decl ts in
if rest () <> Seq.Nil then failwith "Parser.parse"; if rest () <> Seq.Nil then failwith "Parser.parse";
ast ast