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

34
eval.ml
View file

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

10
main.ml
View file

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

View file

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