Commits

relsa committed e20e663

let周り再実装

Comments (0)

Files changed (3)

Interpreter/eval.ml

-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
+      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
+    | [] ->
+      ("var", 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)
 ;;

Interpreter/parser.mly

 
 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

Interpreter/syntax.ml

 type id = string;;
 
 type binOp = Plus | Mult | Lt |
-             And | Or			(* Ex3.3 *)
-;;
-
-type param = 
-  | Params of id * param		(* Ex3.10 *)
-  | Param of id
+             And | Or                   (* Ex3.3 *)
 ;;
 
 type exp =
   | 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 *)
+(*  | LetExp of program * exp             (* Ex3.7で引数の型を変更 *) *)
+  | 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 = 
+type 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 *)
+  | 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);;
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.