From 700356022bca9d1e10178e154a30689701469766 Mon Sep 17 00:00:00 2001
From: Hyeonung Baek <wiserlix@gmail.com>
Date: Tue, 8 Feb 2022 00:26:03 +0900
Subject: [PATCH] Add symbol type

---
 ast.ml    | 22 ++--------------------
 env.ml    | 26 +++++++++++++++++++++++++-
 eval.ml   |  5 +++--
 main.ml   |  2 +-
 parser.ml |  8 ++++++++
 token.ml  |  2 ++
 6 files changed, 41 insertions(+), 24 deletions(-)

diff --git a/ast.ml b/ast.ml
index 4655a58..bdc631a 100644
--- a/ast.ml
+++ b/ast.ml
@@ -1,28 +1,9 @@
-module Type = struct
-  type t =
-    | Int
-    | Float
-    | Function
-    | External
-    | String
-
-  let to_string = function
-    | Int -> "int"
-    | Float -> "float"
-    | String -> "string"
-    | Function -> "fun"
-    | External -> "external"
-
-  let supertype = function
-    | Int -> Some Float
-    | _ -> None
-end
-
 (* simple, untyped AST. *)
 type t =
   | Nint of int
   | Nfloat of float
   | Nstring of string
+  | Nsymbol of string
   | Nfunction of string list * t
   | Nexternal of string
   | Var of string
@@ -64,6 +45,7 @@ let print ast =
     | Nint n -> pr "%d" n
     | Nfloat n -> pr "%f" n
     | Nstring s -> pr "\"%s\"" s
+    | Nsymbol s -> pr "#%s" s
     | Nfunction (args, e) ->
       pr "lambda (%s" @@ List.hd args;
       List.iter (pr " %s") @@ List.tl args;
diff --git a/env.ml b/env.ml
index fe64a35..21257bd 100644
--- a/env.ml
+++ b/env.ml
@@ -7,20 +7,43 @@ and value =
   | Int of int
   | Float of float
   | String of string
+  | Symbol of string
   | Function of string list * expr
   | External of string
   | Nop (* return of system operations (will be deprecated) *)
 
 and expr = Ast.t
 
+module Type = struct
+  type t =
+    | Int
+    | Float
+    | String
+    | Symbol
+    | Function
+    | External
+
+  let to_string = function
+    | Int -> "int"
+    | Float -> "float"
+    | String -> "string"
+    | Symbol -> "symbol"
+    | Function -> "fun"
+    | External -> "external"
+
+  let supertype = function
+    | Int -> Some Float
+    | _ -> None
+end
+
 module Value = struct
-  module Type = Ast.Type
   type t = value
 
   let to_string = function
     | Int n -> string_of_int n
     | Float n -> string_of_float n
     | String s -> "\"" ^ s ^ "\""
+    | Symbol s -> "symbol " ^ s
     | Function (vars, _) ->
       Printf.sprintf "function with %d arguments" @@ List.length vars
     | External f -> "external " ^ f
@@ -30,6 +53,7 @@ module Value = struct
     | Int _ -> Type.Int
     | Float _ -> Type.Float
     | String _ -> Type.String
+    | Symbol _ -> Type.Symbol
     | Function _ -> Type.Function
     | External _ -> Type.External
     | Nop -> failwith "Value.typeof"
diff --git a/eval.ml b/eval.ml
index 478f95b..3ffcfc5 100644
--- a/eval.ml
+++ b/eval.ml
@@ -5,10 +5,10 @@ open Env.Value
 exception No_operation
 exception No_such_variable of string
 exception No_such_function of string
-exception Invalid_type of Type.t
-
 exception Too_many_arguments
 
+exception Invalid_type of Type.t
+
 (* operators *)
 module Operator = struct
   type t = Ast.operator
@@ -125,6 +125,7 @@ let rec eval env ast =
     | Nint n -> Int n
     | Nfloat n -> Float n
     | Nstring s -> String s
+    | Nsymbol s -> Symbol s
     | Nfunction (args, e) -> Function (args, e)
     | Nexternal f -> External f
     | Var v -> begin match Env.get_opt env v with
diff --git a/main.ml b/main.ml
index bd7a75d..ec12155 100644
--- a/main.ml
+++ b/main.ml
@@ -8,7 +8,7 @@ let error_to_string e =
   | Lex.Expected c -> sprintf "expected %c" c
   | Parser.Expected t -> sprintf "expected %s" t
   | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
-  | Eval.Invalid_type t -> sprintf "invalid type %s" (Ast.Type.to_string t)
+  | Eval.Invalid_type t -> sprintf "invalid type %s" (Env.Type.to_string t)
   | Eval.No_such_variable v -> sprintf "no such variable %s" v
   | Eval.No_such_function f -> sprintf "no such function \"%s\"" f
   | Eval.Too_many_arguments -> "applied too many arguments"
diff --git a/parser.ml b/parser.ml
index 2362462..a63c406 100644
--- a/parser.ml
+++ b/parser.ml
@@ -70,6 +70,11 @@ let token_is_operator tok =
 
 (* common parsers *)
 
+let any seq =
+  match seq () with
+  | Seq.Nil -> raise End_of_tokens
+  | Seq.Cons (x, seq) -> x, seq
+
 let token tok seq =
   match seq () with
   | Seq.Nil -> expected @@ Token.to_string tok
@@ -229,6 +234,9 @@ and value seq =
       | Int x -> Nint x, seq
       | Float x -> Nfloat x, seq
       | String x -> Nstring x, seq
+      | Hash ->
+        let t, seq = any seq in
+        Nsymbol (Token.to_string t), seq
       | LParen ->
         let e, seq = expr min_int seq in
         let _, seq = token RParen seq in
diff --git a/token.ml b/token.ml
index ad33e6d..f4166f2 100644
--- a/token.ml
+++ b/token.ml
@@ -12,6 +12,7 @@ type t =
   | LParen
   | RParen
   | Equal
+  | Hash
   | Right_arrow
 
 let tokens = ref [
@@ -25,6 +26,7 @@ let tokens = ref [
   "(", LParen;
   ")", RParen;
   "=", Equal;
+  "#", Hash;
 ]
 
 let to_string = function