Commits

relsa committed 1447da9

Ex4.1,4.2,4.3

Comments (0)

Files changed (6)

Interpreter/Makefile

 PROGNAME=miniml
 
 # The list of object files for prog1
-OBJS=syntax.cmo parser.cmo lexer.cmo environment.cmo typing.cmo eval.cmo main.cmo
+OBJS=mySet.cmo syntax.cmo parser.cmo lexer.cmo environment.cmo typing.cmo eval.cmo main.cmo
 
 DEPEND += lexer.ml parser.ml
 

Interpreter/main.ml

 open Eval
 open Typing
 
-let rec read_eval_print env =
+let rec read_eval_print env tyenv =
   (* 例外処理機構,及びprint_error関数をEx3.2で追加 *)
-  let print_error s e = 
+  let print_error s e te = 
     print_string (s);
+    flush stdout;
     print_newline ();
-    read_eval_print e in
+    read_eval_print e te in
   print_string "# ";
   flush stdout;
   try
     read_eval_print newenv tyenv
   with 
   | Eval.Error s ->
-    print_error ("Eval error -- " ^ s) env
+    print_error ("Eval error -- " ^ s) env tyenv
   | Parsing.Parse_error ->
-    print_error "Parse error" env
+    print_error "Parse error" env tyenv
   | Failure s ->
-    print_error ("Failure -- " ^ s) env
+    print_error ("Failure -- " ^ s) env tyenv
+  | Typing.Error s ->
+    print_error ("Type error -- " ^ s) env tyenv
   | _ ->
-    print_error "Unknown Error" env
+    print_error "Unknown Error" env tyenv
 ;;
 
 let initial_env = 
+  Environment.extend "i" (IntV 1)
+    (* 以下、Ex3.1で追加*)
+    (Environment.extend "ii" (IntV 2)
+       (Environment.extend "iii" (IntV 3)
+          (Environment.extend "iv" (IntV 4)
+             (* 以上. *)
+             (Environment.extend "v" (IntV 5) 
+                (Environment.extend "x" (IntV 10) Environment.empty)))))
+
+
+let initial_tyenv = 
   Environment.extend "i" TyInt
     (* 以下、Ex3.1で追加*)
     (Environment.extend "ii" TyInt
        (Environment.extend "iii" TyInt
-	  (Environment.extend "iv" TyInt
-	     (* 以上. *)
-	     (Environment.extend "v" TyInt
-		(Environment.extend "x" TyInt Environment.empty)))))
+	        (Environment.extend "iv" TyInt
+	        (* 以上. *)
+	           (Environment.extend "v" TyInt
+		            (Environment.extend "x" TyInt Environment.empty)))))
 
 let _ = read_eval_print initial_env initial_tyenv

Interpreter/mySet.ml

+type 'a t = 'a list
+
+let empty = []
+
+let singleton x = [x]
+
+let from_list x = x
+let to_list x = x
+
+let rec insert x = function
+    [] -> [x]
+  | y::rest -> if x = y then y :: rest else y :: insert x rest
+
+let union xs ys = 
+  List.fold_left (fun zs x -> insert x zs) ys xs
+
+let rec remove x = function
+    [] -> []
+  | y::rest -> if x = y then rest else y :: remove x rest
+
+let diff xs ys =
+  List.fold_left (fun zs x -> remove x zs) xs ys
+
+let member = List.memq
+
+let rec map f = function
+    [] -> []
+  | x :: rest -> insert (f x) (map f rest)
+
+let rec bigunion = function
+    [] -> []
+  | set1 :: rest -> union set1 (bigunion rest)
+

Interpreter/mySet.mli

+type 'a t
+
+val empty : 'a t
+val singleton : 'a -> 'a t
+val from_list : 'a list -> 'a t
+val to_list : 'a t -> 'a list
+val insert : 'a -> 'a t -> 'a t
+val union : 'a t -> 'a t -> 'a t
+val remove : 'a -> 'a t -> 'a t
+val diff : 'a t -> 'a t -> 'a t
+val member : 'a -> 'a t -> bool
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+val bigunion : 'a t t -> 'a t

Interpreter/syntax.ml

 type id = string;;
 
 type binOp = Plus | Mult | Lt |
-             And | Or			(* Ex3.3 *)
+             And | Or                   (* Ex3.3 *)
 ;;
 
-type ty = TyInt | TyBool;;
+type tyvar = int;;
 
-let pp_ty = function
-  | TyInt -> print_string "int"
-  | TyBool -> print_string "bool"
+type ty =                               (* Ex4.1 *)
+  TyInt 
+| TyBool
+| TyVar of tyvar
+| TyFun of ty * ty
+;;
+
+let pp_ty ty =                          (* Ex4.2 *)
+  let rec string_of_type ty =
+    match ty with
+    | TyInt -> "int"
+    | TyBool -> "bool"
+    | TyVar t -> "'" ^ Char.escaped (char_of_int (97 + t))
+    | TyFun (tv, te) -> (string_of_type tv) ^ " -> " ^ (string_of_type te) in
+  print_string (string_of_type ty)
 ;;
 
 type exp =
-    Var of id
-  | ILit of int
-  | BLit of bool
-  | BinOp of binOp * exp * exp
-  | IfExp of exp * exp * exp
-  | LetExp of (id * exp) list * exp            (* Ex2.4 *)
-  | FunExp of id * exp               (* Ex3.8, Ex3.10 *)
-  | AppExp of exp * exp                 (* Ex3.8 *)
-  | LetRecExp of id * id * exp * exp    (* Ex3.14 *)
-  | MatchExp of exp * exp * id * id * exp (* Ex3.16 *)
-  | NilLit of unit                        (* Ex3.16 *)
-  | ConsExp of exp * exp                  (* Ex3.16 *)
+  Var of id
+| ILit of int
+| BLit of bool
+| BinOp of binOp * exp * exp
+| IfExp of exp * exp * exp
+| LetExp of (id * exp) list * exp       (* Ex3.4 *)
+| FunExp of id * exp                    (* Ex3.8, Ex3.10 *)
+| AppExp of exp * exp                   (* Ex3.8 *)
+| LetRecExp of id * id * exp * exp      (* Ex3.14 *)
+| MatchExp of exp * exp * id * id * exp (* Ex3.16 *)
+| NilLit of unit                        (* Ex3.16 *)
+| ConsExp of exp * exp                  (* Ex3.16 *)
 ;;
 
 type program =
-    Exp of exp
-  | LetDecl of (id * exp) list list  (* Ex3.5 *)
-  | RecDecl of id * id * exp              (* Ex3.14 *)
+  Exp of exp
+| LetDecl of (id * exp) list list       (* Ex3.5 *)
+| RecDecl of id * id * exp              (* Ex3.14 *)
+;;
+
+let fresh_tyvar =                       (* Ex4.2 *)
+  let counter = ref 0 in
+  let body () =
+    let v = !counter in
+    counter := v + 1; v
+  in body
+
+let rec freevar_ty ty =                 (* Ex4.2 *)
+  match ty with
+  | TyInt ->
+    MySet.empty
+  | TyBool ->
+    MySet.empty
+  | TyVar t ->
+    MySet.singleton t
+  | TyFun (tv, te) ->
+    MySet.union (freevar_ty tv) (freevar_ty te)
 ;;
 
+
 let cleate_funexp x y = FunExp (x, y);;
 let cleate_consexp x y = ConsExp (x, y);;

Interpreter/typing.ml

 (* type Environment *)
 
 type tyenv = ty Environment.t;;
+type subst = (tyvar * ty) list;;
 
 let ty_prim op ty1 ty2 =
   match op with
       | TyBool, TyBool ->
 	TyBool
       | _ ->
-	err ("Argument must be of integer: &&")
+	err ("Argument must be of boolean: &&")
     end
   | Or ->
     begin
       | TyBool, TyBool ->
 	TyBool
       | _ ->
-	err ("Argument must be of integer: ||")
+	err ("Argument must be of boolean: ||")
     end
 ;;
 
     let tyarg3 = ty_exp tyenv exp3 in
     begin match tyarg1 with
     | TyBool ->
-      if (not tyarg2 = tyarg3) then
-	err ("Arguments must have same type")
+      if not (tyarg2 = tyarg3) then
+	      err ("Arguments must have same type")
       else
-	tyarg2
+	      tyarg2
     | _ ->
       err ("If-condition must be bool")
     end
-  | LetExp (id, exp1, exp2) ->
-    
+  | LetExp (id_exp_list, exp) ->        (* let文拡張に伴う変更あり *)
+    let rec iter list tyenv tyenv' =
+      match list with
+      | [] ->
+        tyenv'
+      | (id, exp) :: cdr ->
+        let tyarg = ty_exp tyenv exp in
+        let newenv = Environment.extend id tyarg tyenv in
+        iter cdr tyenv newenv in
+    let newenv = iter id_exp_list tyenv tyenv in
+    ty_exp newenv exp
   | _ -> err ("Not Implemented")
 ;;
 
 let ty_decl tyenv = function
   | Exp e -> ty_exp tyenv e
+  (* | LetDecl list -> *)
   | _ -> err ("Not Implemented")
+;;
+
+let rec subst_type subst ty =           (* Ex4.3 *)
+ 
+ let rec get_type_from_key k s =
+    match s with
+    | [] ->
+      err ("This variable's type is unable to identified.")
+    | (v, t) :: rest ->
+      if v = k then
+        subst_type s t
+      else
+        get_type_from_key k rest in
+
+  match ty with
+  | TyInt -> TyInt
+  | TyBool -> TyBool
+  | TyVar t1 -> get_type_from_key t1 subst
+  | TyFun (t1, t2) -> TyFun (subst_type subst t1, subst_type subst t2)
+;; 
+    
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.