Add unit type, remove Nop

This commit is contained in:
백현웅 2022-02-24 19:57:26 +09:00
parent 48ccec464e
commit ee1afedc6c
4 changed files with 33 additions and 24 deletions

2
ast.ml
View file

@ -1,6 +1,7 @@
(* simple, untyped AST. *)
type t =
| Nothing
| Nunit
| Nint of int
| Nfloat of float
| Nbool of bool
@ -29,6 +30,7 @@ let print ast =
let pr = Printf.printf in
let rec aux = function
| Nothing -> pr ""
| Nunit -> pr "()"
| Nint n -> pr "%d" n
| Nfloat n -> pr "%f" n
| Nbool b -> pr "%b" b

34
eval.ml
View file

@ -2,6 +2,7 @@ open Ast
(* resulting value of eval *)
type value =
| Unit
| Int of int
| Float of float
| Bool of bool
@ -10,7 +11,6 @@ type value =
(* (name), bound variables, expression, environment *)
| Function of string option * string list * expr * env
| External of string
| Nop (* return of system operations (will be deprecated) *)
and expr = Ast.t
@ -20,6 +20,7 @@ and env = Env of (string * value) list
(* TODO: add proper type system *)
module Type = struct
type t =
| Unit
| Int
| Float
| Bool
@ -33,6 +34,7 @@ module Type = struct
exception Expected of t
let to_string = function
| Unit -> "unit"
| Int -> "int"
| Float -> "float"
| Bool -> "bool"
@ -55,6 +57,7 @@ module Value = struct
type t = value
let to_string = function
| Unit -> "()"
| Int n -> string_of_int n
| Float n -> string_of_float n
| Bool b -> string_of_bool b
@ -62,17 +65,16 @@ module Value = struct
| Symbol s -> "#" ^ s
| Function _ -> "<fun>"
| External f -> "external " ^ f
| Nop -> "nop"
let typeof = function
| Int _ -> Type.Int
| Float _ -> Type.Float
| Bool _ -> Type.Bool
| String _ -> Type.String
| Symbol _ -> Type.Symbol
| Function _ -> Type.Function
| External _ -> Type.External
| Nop -> failwith "Value.typeof"
| Unit -> Type.Unit
| Int _ -> Int
| Float _ -> Float
| Bool _ -> Bool
| String _ -> String
| Symbol _ -> Symbol
| Function _ -> Function
| External _ -> External
let promote = function
| Int n -> Float (float n)
@ -148,7 +150,7 @@ module Primitive = struct
| [Symbol op; Int l] ->
let op = symbol_to_op op in
Hashtbl.replace Parser.precedence op l;
Nop
Unit
| _ -> failwith "set_op_pre"
let get_op_pre = function
@ -161,7 +163,7 @@ module Primitive = struct
| [Symbol op; String a] ->
let op = symbol_to_op op in
Hashtbl.replace Parser.oper_assoc op @@ Parser.assoc_of_string a;
Nop
Unit
| _ -> failwith "set_op_assoc"
let get_op_assoc = function
@ -183,12 +185,12 @@ module Primitive = struct
in
List.map to_string args
|> List.iter (Printf.printf "%s");
Nop
Unit
let println args =
ignore @@ print args;
Printf.printf "\n";
Nop
Unit
let methods =
@ -288,11 +290,13 @@ let extern f args =
f vs
exception Unbound of string
exception Noop
let rec eval global env ast =
let aux = eval global env in (* eval with current env *)
match ast with
| Nothing -> Nop
| Nothing -> raise Noop
| Nunit -> Unit
| Nint n -> Int n
| Nfloat n -> Float n
| Nbool b -> Bool b

View file

@ -49,9 +49,6 @@ let rep () : unit =
let ast = line |> Lex.tokenize |> Parser.parse in
if !debug then Ast.print ast;
let var, v = Eval.eval_top g ast in
match v with
| Nop -> ()
| _ ->
Hashtbl.replace g "ans" v;
printf "%s: %s = %s\n"
var (Type.to_string @@ Value.typeof v) (Value.to_string v)
@ -67,6 +64,7 @@ let init_repl () =
let rec repl () : unit =
try rep (); repl () with
| Exit | End_of_file (* Ctrl-D *) -> ()
| Noop -> repl ()
| Reset_line -> printf "\n"; repl ()
| e -> print_error e; repl ()

View file

@ -271,9 +271,14 @@ and value seq =
let _, t, seq = any seq in
Nsymbol (Token.to_string t), seq
| LParen ->
seq |> either
(fun seq ->
let _, seq = token RParen seq in
Nunit, seq)
(fun seq ->
let e, seq = mustbe (expr min_int) seq in
let _, seq = mustbe (token RParen) seq in
e, seq
e, seq)
| _ -> unexpected_token col x
end