Add unit type, remove Nop
This commit is contained in:
parent
48ccec464e
commit
ee1afedc6c
4 changed files with 33 additions and 24 deletions
2
ast.ml
2
ast.ml
|
@ -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
34
eval.ml
|
@ -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
10
main.ml
|
@ -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 ()
|
||||||
|
|
||||||
|
|
11
parser.ml
11
parser.ml
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue