Commits

relsa  committed cd7a759

List, Conflictあり

  • Participants
  • Parent commits 85d6a60

Comments (0)

Files changed (4)

File Interpreter/eval.ml

   | IntV of int
   | BoolV of bool
   | ProcV of id * exp * dnval Environment.t ref (* Ex3.8 *)
+  | NilV of unit
+  | ConsV of exval * exval
 and dnval = exval
 
 exception Error of string
 let err s = raise (Error s)
 
 (* pretty printing *)
-let rec string_of_exval = function
+let rec string_of_exval = 
+  let rec string_of_list str list =
+    match list with
+    | NilV  _ -> str
+    | ConsV (car, cdr) ->
+      string_of_list (str ^ "; " ^ string_of_exval car) cdr in
+  function
     IntV i -> string_of_int i
   | BoolV b -> string_of_bool b
   | 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")
 
 let pp_val v = print_string (string_of_exval v)
     IntV i
   | BLit b ->
     BoolV b
+  | NilLit _ ->
+    NilV ()
   | BinOp (op, exp1, exp2) -> 
-      let arg1 = eval_exp env exp1 in
-      let arg2 = eval_exp env exp2 in
-      apply_prim op arg1 arg2
+    let arg1 = eval_exp env exp1 in
+    let arg2 = eval_exp env exp2 in
+    apply_prim op arg1 arg2
   | IfExp (exp1, exp2, exp3) ->
-      let test = eval_exp env exp1 in
-        (match test with
-            BoolV true -> eval_exp env exp2 
-          | BoolV false -> eval_exp env exp3
-          | _ -> err ("Test expression must be boolean: if"))
-
+    let test = eval_exp env exp1 in
+    (match test with
+      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    (* 環境を取り出す *)
       | ProcV (id, body, env') ->
 	let newenv = Environment.extend id arg !env' in
 	eval_exp newenv body
-      | _ -> err ("Non-function value is applied")
+      | _ -> err ("Non-functional value is applied")
     end
   | 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) ->
+    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
+    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
+	eval_exp newenv' case_else
+    end
 
 and eval_decl env = function
   | Exp e -> 

File Interpreter/lexer.mll

   ("if", Parser.IF);
   ("then", Parser.THEN);
   ("true", Parser.TRUE);
-  ("in", Parser.IN); (* Ex3.4 *)
-  ("let", Parser.LET); (* Ex3.4 *)
-  ("and", Parser.AND); (* Ex3.7 *)
-  ("fun", Parser.FUN); (* Ex3.8 *)
-  ("rec", Parser.REC); (* Ex3.14 *)
+  ("in", Parser.IN);			(* Ex3.4 *)
+  ("let", Parser.LET);			(* Ex3.4 *)
+  ("and", Parser.AND);			(* Ex3.7 *)
+  ("fun", Parser.FUN);			(* Ex3.8 *)
+  ("rec", Parser.REC);			(* Ex3.14 *)
+  ("match", Parser.MATCH);		(* Ex3.16 *)
+  ("with", Parser.WITH);		(* Ex3.16 *)
 ] 
 }
 
 | "+" { Parser.PLUS }
 | "*" { Parser.MULT }
 | "<" { Parser.LT }
-| "&&" { Parser.LAND } (* Ex3.3 *)
-| "||" { Parser.LOR } (* Ex3.3 *)
-| "=" { Parser.EQ } (* Ex3.4 *)
-| "->" { Parser.RARROW } (* Ex3.7 *)
-
+| "&&" { Parser.LAND }			(* Ex3.3 *)
+| "||" { Parser.LOR }			(* Ex3.3 *)
+| "=" { Parser.EQ }			(* Ex3.4 *)
+| "->" { Parser.RARROW }		(* Ex3.7 *)
+| "::" { Parser.CONS }			(* Ex3.16 *)
+| "|" { Parser.BAR }			(* Ex3.16 *)
+| "[" { Parser.LBR }			(* Ex3.16 *)
+| "]" { Parser.RBR }			(* Ex3.16 *)
+| ";" { Parser.SEMI }
 | ['a'-'z'] ['a'-'z' '0'-'9' '_' '\'']*
     { let id = Lexing.lexeme lexbuf in
       try 

File Interpreter/parser.mly

 %{
-open Syntax
+  open Syntax
 %}
 
 %token LPAREN RPAREN SEMISEMI
 %token AND // Ex3.7
 %token RARROW FUN // Ex3.8
 %token REC // Ex3.14
+%token MATCH WITH CONS BAR LBR RBR // Ex3.16
+%token SEMI // Ex3.17
 
 %token <int> INTV
 %token <Syntax.id> ID
   | LOExpr { $1 } // Ex3.3
   | FunExpr { $1 } // Ex3.8
   | LetRecExpr { $1 } // Ex3.14
+  | MatchExpr { $1 }
+  | ConsExpr { $1 }
+
+
+MatchExpr :
+  | 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) }

File Interpreter/syntax.ml

 (* ML interpreter / type reconstruction *)
-type id = string
+type id = string;;
 
 type binOp = Plus | Mult | Lt |
              And | Or			(* Ex3.3 *)
+;;
 
 type param = 
   | Params of id * param		(* Ex3.10 *)
   | Param of id
+;;
 
 type exp =
     Var of id
   | FunExp of param * 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 *)
+
 and program = 
     Exp of exp
   | Decl of id * exp
   | LetDecl of program * program	(* Ex3.5 *)
   | RecDecl of id * id * exp		(* Ex3.14 *)
 ;;
+
+let cleate_consexp x y = ConsExp (x, y);;