Seperate Ast and value (which should be in Eval)

This commit is contained in:
백현웅 2022-02-07 01:09:57 +09:00
parent 8093af06a7
commit 995d95df41
4 changed files with 36 additions and 22 deletions

38
ast.ml
View file

@ -20,7 +20,11 @@ end
(* simple, untyped AST. *)
type t =
| Value of value
| Nint of int
| Nfloat of float
| Nstring of string
| Nfunction of string list * t
| Nexternal of string
| Var of string
| Let of string * t
| Unary of operator * t
@ -31,14 +35,6 @@ type t =
| Set_binop_aso of operator * string
| Get_binop_aso of operator
and value =
| Int of int
| Float of float
| String of string
| Function of string list * t
| External of string
| Nop (* return of system operations (will be deprecated) *)
and operator =
| Add | Sub | Mul | Div (* arithmetics *)
| Mod (* modular operation *)
@ -48,7 +44,15 @@ and operator =
exception Invalid_type of Type.t
module Value = struct
type t = value
type expr = t
type t =
| Int of int
| Float of float
| String of string
| Function of string list * expr
| External of string
| Nop (* return of system operations (will be deprecated) *)
let to_string = function
| Int n -> string_of_int n
@ -88,6 +92,8 @@ module Operator = struct
| Exp -> "^"
| Negate -> "-"
open Value
let negate = function
| Int n -> Int ~-n
| Float n -> Float ~-.n
@ -131,8 +137,6 @@ module Operator = struct
|> List.assoc_opt typ
end
let value v = Value v
let unary op t =
Unary (op, t)
@ -142,9 +146,15 @@ let binop left op right =
(* print ast LISP style. *)
let print ast =
let pr = Printf.printf in
let pv v = pr "%s" @@ Value.to_string v in
let rec aux = function
| Value n -> pv n
| Nint n -> pr "%d" n
| Nfloat n -> pr "%f" n
| Nstring s -> pr "\"%s\"" s
| Nfunction (args, e) ->
pr "lambda (%s" @@ List.hd args;
List.iter (pr " %s") @@ List.tl args;
pr ") ("; aux e; pr")"
| Nexternal e -> pr "(extern %s)" e
| Var v -> pr "%s" v
| Let (v, e) ->
pr "(let %s " v; aux e; pr ")"

View file

@ -70,7 +70,11 @@ let ex_apply f args =
let rec eval env ast =
let rec aux = function
| Value v -> v
| Nint n -> Int n
| Nfloat n -> Float n
| Nstring s -> String s
| Nfunction (args, e) -> Function (args, e)
| Nexternal f -> External f
| Var v -> begin match Env.get_opt env v with
| None -> raise @@ No_such_variable v
| Some v -> v

View file

@ -24,7 +24,7 @@ let stdlib = [
"deg"; "rad";
]
|> List.to_seq
|> Seq.map (fun v -> v, Ast.External v)
|> Seq.map (fun v -> v, Ast.Value.External v)
let g =
let g = Env.init_global () in
@ -51,7 +51,7 @@ let rep env : unit =
exception Reset_line (* used to indicate ^C is pressed *)
let init_repl () =
Env.set g "ans" (Ast.Int 0);
Env.set g "ans" (Ast.Value.Int 0);
(* treat Ctrl-C as to reset line *)
let reset_line _ = raise Reset_line in
Sys.(set_signal sigint (Signal_handle reset_line))

View file

@ -192,7 +192,7 @@ and lambda seq =
let vars, seq = more any_ident seq in
let _, seq = token Right_arrow seq in
let e, seq = expr min_int seq in
Value (Function (v0::vars, e)), seq
Nfunction (v0::vars, e), seq
(* apply := value [value]+ *)
and apply seq =
@ -205,7 +205,7 @@ and apply seq =
and extern_value seq =
let _, seq = ident "external" seq in
let id, seq = any_ident seq in
Value (External id), seq
Nexternal id, seq
(* unary := - value *)
and unary seq =
@ -226,9 +226,9 @@ and value seq =
| Seq.Nil -> raise End_of_tokens
| Seq.Cons (x, seq) -> begin match x with
| Token.Ident id -> Var id, seq
| Int x -> Value (Int x), seq
| Float x -> Value (Float x), seq
| String x -> Value (String x), seq
| Int x -> Nint x, seq
| Float x -> Nfloat x, seq
| String x -> Nstring x, seq
| LParen ->
let e, seq = expr min_int seq in
let _, seq = token RParen seq in