1. relsa
  2. le4-ml

Commits

relsa  committed e55f726

Ex3.16,17

  • Participants
  • Parent commits cd7a759
  • Branches master

Comments (0)

Files changed (4)

File Interpreter/eval.ml

View file
  • Ignore whitespace
 open Syntax 
 
 type exval = 
-  | IntV of int
-  | BoolV of bool
-  | ProcV of id * exp * dnval Environment.t ref (* Ex3.8 *)
-  | NilV of unit
-  | ConsV of exval * 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 *)
 and dnval = exval
 
 exception Error of string
 
 (* pretty printing *)
 let rec string_of_exval = 
-  let rec string_of_list str list =
+  let rec string_of_list str list = 	(* Ex3.16 *)
     match list with
     | NilV  _ -> str
     | ConsV (car, cdr) ->
-      string_of_list (str ^ "; " ^ string_of_exval car) cdr in
+      string_of_list (str ^ "; " ^ string_of_exval car) cdr
+    | _ -> err ("Not a list") in
   function
-    IntV i -> string_of_int i
+  | IntV i -> string_of_int i
   | BoolV b -> string_of_bool b
   | ProcV (i, e, t) -> "fun"		(* Ex3.8 *)
   | NilV _ -> "[]"
   | Mult, _, _ -> err ("Both arguments must be integer: *")
   | Lt, IntV i1, IntV i2 -> BoolV (i1 < i2)
   | Lt, _, _ -> err ("Both arguments must be integer: <")
-(* 以下、Ex3.3で追加 *)
+  (* 以下、Ex3.3で追加 *)
   | And, BoolV i1, BoolV i2 -> BoolV (i1 && i2)
   | And, _, _ -> err ("Both arguments must be boolean: &&")
   | Or, BoolV i1, BoolV i2 -> BoolV (i1 || i2)
 (* 以上 *)
 
 let rec eval_exp env = function
-    Var x -> 
-      (try Environment.lookup x env with 
-        Environment.Not_bound -> err ("Variable not bound: " ^ x))
+Var x -> 
+  (try Environment.lookup x env with 
+    Environment.Not_bound -> err ("Variable not bound: " ^ x))
   | ILit i ->
     IntV i
   | BLit b ->
     BoolV b
-  | NilLit _ ->
+  | NilLit _ ->				(* Ex3.16 *)
     NilV ()
   | BinOp (op, exp1, exp2) -> 
     let arg1 = eval_exp env exp1 in
     begin
       match param with
       | Params (id, rest) ->
-	ProcV (id, FunExp (rest, exp), ref env) (* fun x -> expの形に *)
+        ProcV (id, FunExp (rest, exp), ref env) (* fun x -> expの形に *)
       | Param id ->
-	ProcV (id, exp, ref env)
+        ProcV (id, exp, ref env)
     end
   | AppExp (exp1, exp2) ->		(* Ex3.8 *)
     let funval = eval_exp env exp1 in
     begin
       match funval with
       | ProcV (id, body, env') ->
-	let newenv = Environment.extend id arg !env' in
-	eval_exp newenv body
+        let newenv = Environment.extend id arg !env' in
+        eval_exp newenv body
       | _ -> err ("Non-functional value is applied")
     end
   | LetRecExp (id, para, exp1, exp2) ->	(* Ex3.14 *)
     let newenv = Environment.extend id (ProcV (para, exp1, dummyenv)) env in
     dummyenv := newenv;
     eval_exp newenv exp2
-  | ConsExp (car, cdr) ->
+  | 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) ->
-    let v = eval_exp env list in
+  | MatchExp (list, case_nil, id1, id2, case_else) -> (* Ex3.16 *)
+    let v = eval_exp env list in		      (* 適用するリストを評価 *)
     begin
-      match v with
-      | NilV _ -> eval_exp env case_nil
-      | ConsV (car, cdr) ->
-        let newenv = Environment.extend id1 car env in
-	let newenv' = Environment.extend id2 cdr newenv in
+      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
+      | _ -> err ("Unmatched pattern is given")
     end
 
 and eval_decl env = function

File Interpreter/parser.mly

View file
  • Ignore whitespace
   | LOExpr { $1 } // Ex3.3
   | FunExpr { $1 } // Ex3.8
   | LetRecExpr { $1 } // Ex3.14
-  | MatchExpr { $1 }
-  | ConsExpr { $1 }
+  | MatchExpr { $1 } // Ex3.15
 
 
-MatchExpr :
+MatchExpr : // Ex3.15
   | MATCH Expr WITH LBR RBR RARROW Expr BAR ID CONS ID RARROW Expr
       { MatchExp ($2, $7, $9, $11, $13) }
 
-ConsExpr :
-  | LBR RBR { NilLit () }
-  | ListExpr { $1 }
-  | Expr CONS ConsExpr { ConsExp ($1, $3) }
-
-ListExpr :
-  | LBR ListElems RBR { List.fold_right cleate_consexp $2 (NilLit ()) }
-
-ListElems :
-  | Expr SEMI ListElems { $1 :: $3 }
-  | Expr { $1 :: [] }
-  | Expr SEMI { $1 :: [] }
-
 // FunExpr : // Ex3.8
 //   | FUN ID RARROW Expr { FunExp ($2, $4) }
 
     LTExpr LAND LAExpr { BinOp (And, $1, $3) }
   | LTExpr { $1 }
 
+// LTExpr : 
+//     PExpr LT PExpr { BinOp (Lt, $1, $3) }
+//   | PExpr { $1 }
+
 LTExpr : 
-    PExpr LT PExpr { BinOp (Lt, $1, $3) }
+    PExpr LT ConsExpr { BinOp (Lt, $1, $3) }
+  | ConsExpr { $1 }
+
+ConsExpr : // Ex3.15, Ex3.16
+  | PExpr CONS ConsExpr { ConsExp ($1, $3) }
+  | LBR ListElems RBR { List.fold_right cleate_consexp $2 (NilLit ()) }
   | PExpr { $1 }
 
+ListElems : // Ex3.16
+  | Expr SEMI ListElems { $1 :: $3 }
+  | Expr { $1 :: [] }
+  | Expr SEMI { $1 :: [] }
+
 PExpr :
     PExpr PLUS MExpr { BinOp (Plus, $1, $3) }
   | MExpr { $1 }
   | FALSE { BLit false }
   | ID { Var $1 }
   | LPAREN Expr RPAREN { $2 }
+  | LBR RBR { NilLit () } // Ex3.15
 
 IfExpr :
     IF Expr THEN Expr ELSE Expr { IfExp ($2, $4, $6) }

File Interpreter/report.ml

View file
  • Ignore whitespace
    # fact 5;;
    val - = 120
 *)
+
+(* -------------------------------- *)
+
+(* Ex3.16 *)
+
+(* 
+   [説明]
+   match文とリストを実装した。
+
+   [実行例]
+   # 2 :: 1 :: [];;
+   val - = [2; 1]
+   # true :: (1 < 0) :: [];;
+   val - = [true; false]
+   # let l = 1 :: 0 :: [] in
+       match l with
+       | [] -> 10
+       | car :: cdr -> car;;
+   val - = 1
+*)
+
+(* -------------------------------- *)
+
+(* Ex3.17 *)
+
+(* 
+   [説明]
+   MLリストの各要素を、Ocaml組み込みのリストに格納し、
+   ConsExpを生成する関数でfoldを行って構文木を生成する。
+   リスト要素の最後にセミコロンがついていても受理する。
+
+   [実行例]
+   # [1; 2; 3];;
+   val - = [1; 2; 3]
+   # [1; 2; 3;];;
+   val - = [1; 2; 3]
+   # [1 < 3];;
+   val - = [true]
+   # 3 :: [2; 1];;   
+   val - = [3; 2; 1]
+
+*)
+

File submit.zip

  • Ignore whitespace
Binary file added.