1. relsa
  2. le4-ml

Commits

relsa  committed 54effa3 Merge

conflictを修正

  • Participants
  • Parent commits a954111, f47e33e
  • Branches master

Comments (0)

Files changed (4)

File Interpreter/eval.ml

View file
-open Syntax 
+open Syntax
 
-type exval = 
+type exval =
 | IntV of int
 | BoolV of bool
 | ProcV of id * exp * dnval Environment.t ref (* Ex3.8 *)
-| NilV of unit				      (* Ex3.16 *)
-| ConsV of exval * exval		      (* Ex3.16 *)
+| NilV of unit                                (* Ex3.16 *)
+| ConsV of exval * exval                      (* Ex3.16 *)
 and dnval = exval
 
 exception Error of string
 let err s = raise (Error s)
 
 (* pretty printing *)
-let rec string_of_exval = 
-  let rec string_of_list str list = 	(* Ex3.16 *)
+let rec string_of_exval =
+  let rec string_of_list str list =     (* Ex3.16 *)
     match list with
     | NilV  _ -> str
     | ConsV (car, cdr) ->
   function
   | IntV i -> string_of_int i
   | BoolV b -> string_of_bool b
-  | ProcV (i, e, t) -> "fun"		(* Ex3.8 *)
+  | ProcV (i, e, t) -> "fun"            (* Ex3.8 *)
   | NilV _ -> "[]"
   | ConsV (car, cdr) -> "[" ^ (string_of_list (string_of_exval car) cdr) ^  "]"
   | _ -> err ("This value cannot be converted to string")
   | Or, _, _ -> err ("Both arguments must be boolean: ||")
 (* 以上 *)
 
+
 let rec eval_exp env = function
 Var x -> 
   (try Environment.lookup x env with 
     IntV i
   | BLit b ->
     BoolV b
-  | NilLit _ ->				(* Ex3.16 *)
+  | NilLit _ ->                         (* Ex3.16 *)
     NilV ()
-  | BinOp (op, exp1, exp2) -> 
+  | BinOp (op, exp1, exp2) ->
     let arg1 = eval_exp env exp1 in
     let arg2 = eval_exp env exp2 in
     apply_prim op arg1 arg2
       BoolV true -> eval_exp env exp2 
     | BoolV false -> eval_exp env exp3
     | _ -> err ("Test expression must be boolean: if"))
-      
+
   (* | LetExp (id, exp1, exp2) -> (\* Ex3.4 *\) *)
   (*   let value = eval_exp env exp1 in *)
   (*   eval_exp (Environment.extend id value env) exp2 *)
-      
-  | LetExp (dec, exp) ->	       (* Ex3.7 *)
-    let v = eval_decl env dec in (*... and ... をそれぞれ評価して環境を更新 *)
-    let (_, nenv, _) = v in    (* 環境を取り出す *)
-    eval_exp nenv exp
 
-  (* | FunExp (id, exp) -> ProcV (id, exp, ref env) (\* Ex3.8 *\) *)
+  | LetExp (var, exp) ->               (* Ex3.7 *)
+    let newenv = env_contains_vars var env env in
+    eval_exp newenv exp
 
-  | FunExp (param, exp) ->		(* Ex3.10 *)
-    begin
-      match param with
-      | Params (id, rest) ->
-        ProcV (id, FunExp (rest, exp), ref env) (* fun x -> expの形に *)
-      | Param id ->
-        ProcV (id, exp, ref env)
-    end
-  | AppExp (exp1, exp2) ->		(* Ex3.8 *)
+  | FunExp (id, exp) -> ProcV (id, exp, ref env) (* Ex3.8 *)
+
+  (* | FunExp (param, exp) ->              (\* Ex3.10 *\) *)
+  (*   begin *)
+  (*     match param with *)
+  (*     | car :: [] -> *)
+  (*       ProcV (car, exp, ref env) *)
+  (*     | car :: cdr -> *)
+  (*       ProcV (car, FunExp (cdr, exp), ref env) (\* fun x -> expの形に *\) *)
+  (*   end *)
+  | AppExp (exp1, exp2) ->              (* Ex3.8 *)
     let funval = eval_exp env exp1 in
     let arg = eval_exp env exp2 in
     begin
         eval_exp newenv body
       | _ -> err ("Non-functional value is applied")
     end
-  | LetRecExp (id, para, exp1, exp2) ->	(* Ex3.14 *)
+  | LetRecExp (id, para, exp1, exp2) -> (* Ex3.14 *)
     let dummyenv = ref Environment.empty in
     let newenv = Environment.extend id (ProcV (para, exp1, dummyenv)) env in
     dummyenv := newenv;
     eval_exp newenv exp2
-  | ConsExp (car, cdr) ->		(* Ex3.16 *)
+  | ConsExp (car, cdr) ->               (* Ex3.16 *)
     let carval = eval_exp env car in
     ConsV (carval, eval_exp env cdr)
   | MatchExp (list, case_nil, id1, id2, case_else) -> (* Ex3.16 *)
-    let v = eval_exp env list in		      (* 適用するリストを評価 *)
+    let v = eval_exp env list in                      (* 適用するリストを評価 *)
     begin
-      match v with			
-      | NilV _ -> eval_exp env case_nil	
-      | ConsV (car, cdr) ->		
+      match v with
+      | NilV _ -> eval_exp env case_nil 
+      | ConsV (car, cdr) ->
         let newenv = Environment.extend id1 car env in (* carを環境に追加 *)
-	let newenv' = Environment.extend id2 cdr newenv in (* cdrを環境に追加 *)
-	eval_exp newenv' case_else
+        let newenv' = Environment.extend id2 cdr newenv in (* cdrを環境に追加 *)
+        eval_exp newenv' case_else
       | _ -> err ("Unmatched pattern is given")
     end
 
-and eval_decl env = function
-  | Exp e -> 
+and env_contains_vars l env env'=
+  match l with
+    | [] -> env
+    | car :: cdr ->
+      let (id, exp) = car in
+      let arg = eval_exp env' exp in
+      let newenv = Environment.extend id arg env in
+      Printf.printf "val %s = " id;
+      pp_val arg;
+      print_newline();
+      env_contains_vars cdr newenv env'
+;;
+
+let rec eval_decl env = function
+  | Exp e ->
     let v = eval_exp env e in ("-", env, v)
-  | Decl (id, e) ->			(* Ex3.4 *)
-    let v = eval_exp env e in (id, Environment.extend id v env, v)
-  | AndDecl (d1, d2) ->
-    let v1 = eval_decl env d1 and
-	v2 = eval_decl env d2 in
-    let (_, env1, _) = v1 and
-	(id2, _, val2) = v2 in
-    (id2, Environment.extend id2 val2 env1, val2)
-  | LetDecl (d, e) ->		      (* Ex3.5 *)
-    let v = eval_decl env d in	      (* 先頭のlet文を評価 *)
-    let (_, nenv, _) = v in      (* 評価結果から環境を取り出す *)
-    eval_decl nenv e (* 先頭のlet文により変更された環境で残りを評価 *)
-  | RecDecl (id, para, exp) ->		(* Ex3.14 *)
+  | LetDecl decls ->
+    begin match decls with
+    | [] ->
+      ("-", env, BoolV true)
+    | car :: cdr ->
+      let newenv = env_contains_vars car env env in
+      eval_decl newenv (LetDecl cdr)
+    end
+  | RecDecl (id, para, exp) ->          (* Ex3.14 *)
     let dummyenv = ref Environment.empty in
     let newenv = Environment.extend id (ProcV (para, exp, dummyenv)) env in
     dummyenv := newenv;
     (id, newenv, ProcV(para, exp, ref newenv))
-  | FunDecl (name, params, exp) ->	(* Ex3.10 *)
-    let v = eval_exp env (FunExp (params, exp)) in
-    (name, Environment.extend name v env, v)
 ;;

File Interpreter/parser.mly

View file
 
 toplevel :
     Expr SEMISEMI { Exp $1 }
-  | LDecl SEMISEMI { $1 } // Ex3.5
+  | LET LetDecl SEMISEMI { LetDecl $2 } // Ex3.5
   | LET REC ID EQ FUN ID RARROW Expr SEMISEMI { RecDecl ($3, $6, $8) } // Ex3.14
 
-LDecl : // Ex3.5 let ... let ...の処理
-  | LET ADecl LDecl { LetDecl ($2, $3) }
-  | LET ADecl { $2 }
+LetDecl : // Ex3.5 let ... let ...の処理
+  | LetVar LET LetDecl { $1 :: $3 }
+  | LetVar  { $1 :: [] }
 
-ADecl : // Ex3.7 ... and ...の処理
-  | Decl AND ADecl { AndDecl ($1, $3) }
-  | Decl { $1 }
-  | FunDecl { $1 }
-
-FunDecl :
-  | ID Params EQ Expr { FunDecl ($1, $2, $4) }
-
-Decl : // Ex3.4
-  | ID EQ Expr { Decl ($1, $3) }
+LetVar :
+  | ID EQ Expr AND LetVar { ($1, $3) :: $5 }
+  | ID EQ Expr { ($1, $3) :: [] }
+  | ID Params EQ Expr AND LetVar { ($1, List.fold_right cleate_funexp $2 $4) :: $6 }
+  | ID Params EQ Expr { ($1, List.fold_right cleate_funexp $2 $4) :: [] }
 
 Expr :
     IfExpr { $1 }
 //   | FUN ID RARROW Expr { FunExp ($2, $4) }
 
 FunExpr :
-  | FUN Params RARROW Expr { FunExp ($2, $4) }
+  | FUN Params RARROW Expr { List.fold_right cleate_funexp $2 $4 }
 
 Params : // Ex3.10
-  | ID Params { Params ($1, $2) }
-  | ID { Param $1 }
+  | ID Params { $1 :: $2 }
+  | ID { $1 :: [] }
 
 LetRecExpr : // Ex3.14
   | LET REC ID EQ FUN ID RARROW Expr IN Expr
 //     LET ID EQ Expr IN Expr { LetExp ($2, $4, $6) }
 
 LetExpr : // Ex3.7で変更
-    LET ADecl IN Expr { LetExp ($2, $4) }
-
+  | LET LetVar IN Expr { LetExp ($2, $4) }
 
 LOExpr : // Ex3.3
     LAExpr LOR LOExpr { BinOp (Or, $1, $3) }
   | Expr SEMI { $1 :: [] }
 
 PExpr :
-    PExpr PLUS MExpr { BinOp (Plus, $1, $3) }
+  | PExpr PLUS MExpr { BinOp (Plus, $1, $3) }
   | MExpr { $1 }
 
-MExpr : 
-    MExpr MULT AppExpr { BinOp (Mult, $1, $3) }
+MExpr :
+  | MExpr MULT AppExpr { BinOp (Mult, $1, $3) }
   | AppExpr { $1 }
 
 AppExpr : // Ex3.8

File Interpreter/report.ml

View file
 (* -------------------------------- *)
 
 (* Ex3.5 *)
+(* Ex3.7 *)
 
 (* 
    [説明]
    let文を拡張した。
-   let ... let ...を実装するために
-   program型に新しく
-   program * program型を受け取るコンストラクタLetDeclを設けた。
-   左結合的に実装されている。
+   これに伴って、
+   LetExpの引数型が(id * exp) list * expに、
+   LetDeclの引数型が(id * exp) list listになった。
    
    [実行例]
-   
-   # let x = 1 let y = x + 1;;
-   val y = 2 (* 最後の値の束縛結果しか表示されない *)
-   # x;;
+   # let i = 0 let j = 1;;
+   val i = 0
+   val j = 1
+   val - = true                         (* 意味は無い *)
+   # i;;
+   val - = 0
+   # j;;
    val - = 1
-   # y;;
-   val - = 2
-
-   let文を評価する際、
-   最後の束縛結果しかインタプリタに表示されていないが、
-   環境は正しく更新されている。
-   表示部分は余力があれば改善を試みたい。
-*)
-
-(* -------------------------------- *)
-
-(* Ex3.7 *)
-
-(*
-  [説明]
-  let文を拡張した。
-  e1 and e2の形に対応するために規則ADeclを実装、
-  program型に新しく
-  program * program型を受け取るコンストラクタAndDeclを設けた。
-  また、規則LetExprもADeclを使えるように変更した。
-  それに伴い、exp型のコンストラクタLetExpが受け取る引数の型も変更された。
-  
+   # let x = 5 and y = x + 5 in x + y;;
+   val x = 5
+   val y = 15                           (* 大域環境のxが参照されている *)
+   val - = 20                           (* 直前で定義されたxとyの和 *)
+   # x;;
+   val - = 10                           (* xは束縛から開放された *)
+   
 
-  [実行例]
-  # let x = 0 and y = x in x + y;;
-  val - = 10
-  # x;;
-  val - = 10 (* 大域環境のx *)
+   let宣言を評価する際、
+   最後にvar - = trueと表示されるが、
+   特に意味は無い。
+   余力があれば表示されないように改善する。
 *)
 
 (* -------------------------------- *)
   let f x y z = exp
   let f = fun x -> fun y -> fun z -> exp
-  として解釈されるよう意識して、
-  parser.ml, eval.mlを変更した。
-  また、syntax.mlに新しくparam型を追加した。
+  として解釈されるようfoldを用いてパーサを拡張した。
   
   [実行例]
   # (fun x y z -> x * y + z) 5 2 3;;

File Interpreter/syntax.ml

View file
 
 type ty = TyInt | TyBool;;
 
-type param = 
-  | Params of id * param		(* Ex3.10 *)
-  | Param of id
-;;
-
 let pp_ty = function
   | TyInt -> print_string "int"
   | TyBool -> print_string "bool"
   | BLit of bool
   | BinOp of binOp * exp * exp
   | IfExp of exp * exp * exp
-  (* | LetExp of id * exp * exp (\* Ex3.4 *\) *)
-  | LetExp of program * exp		(* Ex3.7で引数の型を変更 *)
-  | FunExp of param * exp		(* Ex3.8, Ex3.10 *)
-  | AppExp of exp * exp			(* Ex3.8 *)
-  | LetRecExp of id * id * exp * exp	(* Ex3.14 *)
+  | 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 *)
+  | NilLit of unit                        (* Ex3.16 *)
+  | ConsExp of exp * exp                  (* Ex3.16 *)
+;;
 
-and program = 
-  | Exp of exp
-  | Decl of id * exp
-  | FunDecl of id * param * exp
-  | AndDecl of program * program	(* Ex3.7 *)
-  | LetDecl of program * program	(* Ex3.5 *)
-  | RecDecl of id * id * exp		(* Ex3.14 *)
+type program =
+    Exp of exp
+  | LetDecl of (id * exp) list list  (* Ex3.5 *)
+  | RecDecl of id * id * exp              (* Ex3.14 *)
 ;;
 
+let cleate_funexp x y = FunExp (x, y);;
 let cleate_consexp x y = ConsExp (x, y);;