Anonymous avatar Anonymous committed 1d8e65f

instance var scopes

Comments (0)

Files changed (12)

 	<factor> ::= <factor1> <factor_next>
 
 	<factor1> ::= <ident> "=" <lterm>
+		    | "@" <ident> "=" <lterm>
 		    | <ident> "(" <expr> "," .. "," <expr> ")"
 	    	    | <ident> <block>
 		    | <ident>
+		    | "@" <ident>
 		    | "def" <ident> "(" <ident> "," .. "," <ident> ")" <expr> "end"
 		    | "def" <ident>  <expr> "end"
 		    | "class" <ident>  <expr>  "end"
 	    	    | "class"  <expr>  "end"
 		    | <block>
-		    | "lambda" <block>
 		    | "(" <expr> ")"
 		    | "if" <expr> "then" <expr> "else" <expr> "end"
 		    | <literal>
 type expr =
   | Ignore of expr * expr    (* 式 e1を実行して, e2 *)
   | Call of obj * string * expr list    (* 関数呼び出し、またはメソッド呼び出し *)
-  | Assign of string * expr    (* 変数へ代入 *)
+  | Assign of string * expr    (* インスタンス変数へ代入 *)
   | If of expr * expr * expr    (* if 式 *)
   | Literal of literal    (* 数値やブール等の定数値 *)
-  | Variable of string    (* 変数 *)
+  | Var of string    (* 変数 *)
+  | InstanceVar of string    (* インスタンス変数 *)
+  | VarDef of string * expr    (* 変数束縛 *)
   | FunDef of string * string list * expr    (* 関数定義 *)
   | ClassDef of pos * string * expr    (* クラス定義 *)
   | Const of inst    (* 評価済みのオブジェクト(内部で使用) *)
 
 (* CONTEXT *)
 and context = (string, inst) Hashtbl.t * (string, (string list * expr)) Hashtbl.t
-and inst = { class_name:string; ctx:context }
+and inst = { parent:unit->inst; class_name:string; ctx:context }
 exception UnboundValue
 
 
 let rec s_expr = function
   | Call (Self, fname, _) -> "Call Self#" ^ fname
   | Call (Obj o, fname, _) -> "Call ?#" ^ fname
+  | VarDef (vname, expr) -> "VarDef"
   | FunDef (fname, argnames, e) -> "FunDef:" ^ fname ^ "(" ^ s_expr e ^ ")"
   | ClassDef (p, cname, fs) -> "ClassDef"
   | Assign (vname, expr) -> "Assign:(" ^ vname ^ ":=" ^ s_expr expr ^ ")"
   | Ignore (e1, e2) -> "Ig(" ^ s_expr e1 ^ ");\t" ^ s_expr e2
   | External func -> "External"
   | Const obj -> "Const(" ^ s_obj obj ^ ")"
-  | Variable v -> "Var(" ^ v ^ ")"
+  | Var v -> "Var(" ^ v ^ ")"
+  | InstanceVar v -> "IVar(" ^ v ^ ")"
 and s_obj o =
   match o.class_name with
   | "String" | "Int" | "Bool" -> o.class_name ^ "(" ^ s_vars o.ctx ^ ")"
 										     
 let empty_ctx = Hashtbl.create 0, Hashtbl.create 0
 let copy_ctx (vhash, fhash)= Hashtbl.copy vhash, Hashtbl.copy fhash
+let hash_append h1 h2 =
+  let h = Hashtbl.copy h1 in
+  Hashtbl.iter (fun k v -> Hashtbl.add h k v) h2; h
 
-let null_obj s = { class_name=("Null$" ^ s); ctx = empty_ctx}
+let append_ctx (v1, f1) (v2, f2) =
+  hash_append v1 v2, hash_append f1 f2
+let rec null_obj s = { parent=(fun () -> null_obj s); class_name=("Null$" ^ s); ctx = empty_ctx}
+
+let make_inst (cname:string) ctx =
+  let rec iter () = { parent=iter; class_name=cname; ctx=ctx } in
+  iter()
 open Ast
 
 
-let make_inst = function
-  | LInt i -> (RbInt.of_int i)
-  | LBool b -> (RbBool.of_bool b)
-  | LString s -> (RbString.of_string s)
+let inst_of_literal self = function
+  | LInt i -> (RbInt.of_int i self.parent)
+  | LBool b -> (RbBool.of_bool b self.parent)
+  | LString s -> (RbString.of_string s self.parent)
 
 
-let rec eval self exp : inst * context =
+let rec eval_expr self exp : inst * context =
   match exp with
   | Const obj -> obj, self.ctx
-  | Literal l -> make_inst l, self.ctx
-  | Variable v ->
+  | Literal l -> inst_of_literal self l, self.ctx
+  | Var v ->
       begin try get_var self.ctx v, self.ctx with
       | UnboundValue -> (* 変数じゃなかったら引数ゼロの関数かもしれない *)
-	  begin try call self (get_fun self.ctx v) [] v, self.ctx with
-	  | UnboundValue -> failwith @@ "Eval.eval: unbound value: " ^ v
-	  end
-      end
+	  eval_expr self @@ Call (Self, v, []) end
+  | InstanceVar v ->
+      begin try get_var (self.parent()).ctx v, self.ctx with
+      | UnboundValue -> failwith @@ "ivar " ^ v ^ ": unbound value" end
   | Ignore (e1, e2) ->
-      let _, _ = eval self e1 in
-      eval self e2
+      let _, _ = eval_expr self e1 in
+      eval_expr self e2
   | Call (Self, fname, args) ->
       let f =
 	try get_fun self.ctx fname with
-	| UnboundValue -> failwith @@ "Eval.eval: Call: " ^ fname ^ " is unbound function in "
+	| UnboundValue -> failwith @@ "Eval.eval_expr: Call: " ^ fname ^ " is unbound function in "
 	    ^ self.class_name
       in
-      let args = List.map (fst $ eval self) args in
-      call self f args fname, self.ctx
+      let args = List.map (fst $ eval_expr self) args in
+      call self self f args fname, self.ctx
   | Call (Obj e, fname, args) ->
-      let o, ctx' = eval self e in
+      let o, ctx' = eval_expr self e in
       let f =
 	try get_fun o.ctx fname with
-	| UnboundValue -> failwith @@ "Eval.eval: Call: "^ o.class_name ^"#" ^ fname ^ " is unbound function"
+	| UnboundValue -> failwith @@ "Eval.eval_expr: Call: "^ o.class_name ^"#" ^ fname ^ " is unbound function"
       in
-      let args = List.map (fst $ eval self) args in
-      call o f args fname, ctx'
+      let args = List.map (fst $ eval_expr self) args in
+      call self o f args fname, ctx'
   | If (cond, e1, e2) ->
-      let b, ctx' = eval self cond in
-      eval self begin if RbBool.to_bool b then e1 else e2 end
+      let b, ctx' = eval_expr self cond in
+      eval_expr self begin if RbBool.to_bool b then e1 else e2 end
+  | VarDef (vname, e) ->
+      p "vardef: %s\n" vname;
+      let v, ctx' = eval_expr self e in
+      set_var ctx' vname v;
+      null_obj "vardef", ctx'
   | FunDef (fname, argnames, body) ->
       set_fun self.ctx fname (argnames, body);
       lambda self (argnames, body), self.ctx
   | ClassDef (pos, cname, body) ->
-      let cls = make_class self.ctx cname body in
+      let cls = make_class self cname body in
       set_var self.ctx cname cls;
       cls, self.ctx
   | Assign (vname, e) ->
-      let v, ctx' = eval self e in
-      set_var ctx' vname v;
+      let v, ctx' = eval_expr self e in
+      set_var ((self.parent()).ctx) vname v;
+      p "assign: %s -> %s[%s]\n" vname (self.parent()).class_name (s_ctx (self.parent()).ctx);
       null_obj "assign", ctx'
   | External ocaml_program ->
-      eval self @@ ocaml_program self
+      eval_expr self @@ ocaml_program self
 
-and make_class local_ctx cname body : inst =
-  let ctx = copy_ctx local_ctx in
+and make_class self cname body : inst =
+  let ctx = create_ctx () in
   set_fun ctx "to_s" ([], Literal (LString cname));
-  let cls = { class_name="Class"; ctx=ctx } in
-  let init0 = { class_name=cname; ctx=create_ctx() } in
-  let _ = eval init0 body in
+  let cls = { parent=self.parent; class_name="Class"; ctx=ctx } in
+  let init0 = make_inst cname (create_ctx()) in
+  let _ = eval_expr init0 body in
   let init = match get_initializer init0.ctx body with
   | Some (init_argnames, init_body) ->
       init_argnames, External (fun self ->
 	let args = List.map (fun a -> get_var self.ctx a) init_argnames in
-	let _ = call init0 (init_argnames, init_body) args "initialize" in
+	p "%s#initialize ctx= %s\n" cname (s_ctx self.ctx);
+	let _ = call self init0 (init_argnames, init_body) args "initialize" in
 	Const init0)
-  | None -> [], External (fun ctx -> Const init0)
+  | None -> [], External (fun self -> Const init0)
   in
   set_fun ctx "new" init;
   cls
 and get_initializer ctx expr =
-  let ctx' = copy_ctx ctx in
-  let ctx'' = snd @@ eval {class_name="Eval.get_initializer"; ctx=ctx'} expr in
-  try Some (get_fun ctx'' "initialize") with
+  try Some (get_fun ctx "initialize") with
   | UnboundValue -> None
 
-and call self (argnames, body) args fname =
+and call self subject (argnames, body) args fname =
+  let ctx = copy_ctx self.ctx in
+  let clos = { parent=(const subject); class_name=("__Closure: "^fname); ctx=ctx } in
   let _ =
-    try List.iter2 (add_var self.ctx) argnames args with
-    | Invalid_argument s -> failwith @@ Printf.sprintf "function %s required %d arguments, but is taked %d: %s\n" fname (length argnames) (length args) s;
+    try List.iter2 (add_var clos.ctx) argnames args with
+    | Invalid_argument s -> failwith @@ Printf.sprintf "function %s required %d arguments, but is here taked %d: %s\n" fname (length argnames) (length args) s;
   in
-  let result = fst @@ eval self body in
-  List.iter (remove_var self.ctx) argnames;
+  let result = fst @@ eval_expr clos body in
   result
 
 and lambda self (argnames, body) =
   let ctx = copy_ctx self.ctx in
   set_fun ctx "call" (argnames, (External (fun self -> body)));
-  { class_name="__LAMBDA"; ctx=ctx }
-
+  make_inst "__LAMBDA" ctx
 
 let toplevel : inst =
   let ctx = create_ctx () in
   let aname = "__puts_argument" in
   set_fun ctx "puts" ([aname], External (fun self ->
     let x = get_var self.ctx aname in
-    print_endline @@ RbString.to_string @@ call x (get_fun x.ctx "to_s") [] "puts";
+    print_endline @@ RbString.to_string @@ fst @@ eval_expr self @@ Call (Obj (Const x), "to_s", []);
     Const (null_obj "putsend")));
-  { class_name = "__TopLevelClass"; ctx=ctx }
-
+  set_fun ctx "lambda" (["b"], External (fun self ->
+    let b = get_var self.ctx "b" in
+    Const b));
+  make_inst "__TopLevelClass" ctx
+    
+let eval = eval_expr toplevel
-let lexer = Genlex.make_lexer ["`"; "def"; "end"; "lambda"; "if"; "then"; "else"; "class"; "return"; "("; ")"; "."; ","; "+"; "-"; "*"; "/"; "=="; "<="; ">="; "<"; ">"; "="; "&&"; "||"; "@"; "&"; "do"; "{"; "}"; "|"; "lambda"; ":"]
+open Util
+let lexer =
+  let l = Genlex.make_lexer ["`"; "def"; "end"; "if"; "then"; "else"; "class"; "return"; "("; ")"; "."; ","; "+"; "-"; "*"; "/"; "=="; "<="; ">="; "<"; ">"; "="; "&&"; "||"; "@"; "&"; "do"; "{"; "}"; "|"; ":"]
+  in
+  l $ stream_map (function
+    | '\n' -> '`'
+    | '\'' -> '"'
+    | c -> c) 
 			       
 			       
 
     | Invalid_argument s -> prerr_endline "no input file"; exit 0
   in
   try
-    Eval.eval Eval.toplevel @@ Parser.parse
-     @@ Llist.of_stream @@ Lexer.lexer
-     @@ stream_map (function '\n' -> '`' | c -> c) @@ Stream.of_channel ch
+    Eval.eval @@ Parser.parse @@ Lexer.lexer @@ Stream.of_channel ch
   with
-  | Parser.ParseError (pos, msg) -> p "Parse error: line %d: %s\n" pos.Ast.line msg ; exit 0
+  | Parser.ParseError (pos, msg) -> p "Parse error: line %d: %s\n" pos.Ast.line msg; exit 0
   
 
 let kwd k = unit_parser (function | (pos, Genlex.Kwd ki) when k = ki -> `Val (pos,k) | (pos,t) -> `Err (pos,"token'"^s_token0 t^"' is not kwd'"^ k ^"'"))
 let ident0 = unit_parser (function | (pos, Genlex.Ident s) -> `Val s | (pos,t) -> `Err (pos, "token'"^s_token0 t^"' is not identifier."))
-let ident = (kwd "@" >> ident0) <|> (kwd "&" >> ident0)  <|> ident0
+let ident = (kwd "@" >> ident0 >>= (return $ (^) "@")) <|> (kwd "&" >> ident0)  <|> ident0
 
 let literal = unit_parser (function
   | pos, Genlex.String s -> `Val (LString s)
 and factor () =
   factor1() >>= fun fac -> factor_next fac
 and factor1 () =
-  (ident >>= fun vname -> kwd "=" >> lterm() >>= fun tm -> return (Assign (vname, tm)))
+  (kwd "@" >> ident >>= fun vname -> kwd "=" >> lterm() >>= fun tm -> return (Assign ("@"^vname, tm)))
+  <|>
+  (ident >>= fun vname -> kwd "=" >> lterm() >>= fun tm -> return (VarDef (vname, tm)))
   <|>
   (ident >>= fun fname -> arguments_as (expr) >>= fun args -> return (Call (Self, fname, args)))
   <|>
   <|>
   (block())
   <|>
-  (kwd "lambda" >> block())
-  <|>
   (kwd "if" >> expr >>= fun cond -> kwd "then" >> expr >>= fun e1 -> kwd "else" >> expr >>= fun e2 -> kwd"end" >>
     return (If (cond, e1, e2)))
   <|>
   <|>
   (literal >>= fun l -> return @@ Literal l)
   <|>
-  (ident >>= fun x -> return @@ Variable x)
+  (kwd "@" >> ident >>= fun x -> return @@ InstanceVar ("@"^x))
+  <|>
+  (ident >>= fun x -> return @@ Var x)
 and factor_next fac =
   (kwd "." >> ident >>= fun fname -> arguments_as expr >>= fun args -> factor_next @@ Call (Obj fac, fname, args))
   <|>
   | Cons (t, tl) -> Cons (({ line=l; idx=i }, t), lazy (set_position l (i+1) !$tl))
   | Nil -> Nil
 
-let parse code =
-  match expr @@ set_position 1 1 code with
+let parse str =
+  match expr @@ set_position 1 1 @@ Llist.of_stream str with
   | Inl (states, Nil) ->
       states
   | Inl (states, Cons((pos,t),ts)) ->
-      raise (ParseError (pos, "unread token: '"^s_token0 t^"'."))
+      begin match lterm() (Cons ((pos,t),ts)) with
+      | Inr e -> raise (ParseError e)
+      | _ -> raise (ParseError (pos, "unread token: '"^s_token0 t^"'."))
+      end
   | Inr e ->
       raise (ParseError e)
     type error = T.error
     type 'a m = ts -> ('a * ts, error) either
 
-    (* return : 'a -> 'a m*)
+    (* return : 'a -> 'a m *)
     let return x = fun code -> Inl (x, code)
       
     (* (>>=) : 'a m -> ('a -> 'b m) -> 'b m *)
   | (_, Literal (LBool x)) -> x
   | _ -> failwith @@ "RbBool.to_bool: " ^ obj.class_name
 
-let of_bool b =
+let of_bool b parent =
   let fmake args f = (args, External (fun self ->
     let xs = List.map (to_bool $ get_var self.ctx) args in
     f b xs))
   set_fun ctx "!=" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x != List.hd xs)));
   set_fun ctx "&&" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x && List.hd xs)));
   set_fun ctx "||" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x || List.hd xs)));
+  { parent=parent; class_name="Bool"; ctx=ctx }
 
-  { class_name="Bool"; ctx=ctx }
   | (_, Literal (LInt x)) -> x
   | _ -> failwith @@ "RbInt.to_int: " ^ obj.class_name
 
-let of_int i =
+let of_int i parent =
   let ctx = create_ctx () in
   let fmake args f = (args, External (fun self ->
     let xs = List.map (to_int $ get_var self.ctx) args in
   set_fun ctx "<"  @@ fmake ["__x"] (fun x xs -> Literal (LBool (x <  List.hd xs)));
   set_fun ctx ">=" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x >= List.hd xs)));
   set_fun ctx ">"  @@ fmake ["__x"] (fun x xs -> Literal (LBool (x >  List.hd xs)));
-  { class_name="Int"; ctx=ctx }
+  { parent=parent; class_name="Int"; ctx=ctx }
+
       s
   | _ -> failwith @@ "RbString.to_string: " ^ s_obj.class_name
 
-let of_string s =
+let of_string s parent =
   let ctx = create_ctx () in
   let fmake args f = (args, External (fun self ->
     let xs = List.map (to_string $ get_var self.ctx) args in
   set_fun ctx "+" @@ fmake ["__x"] (fun x xs -> Literal (LString (x ^ List.hd xs)));
   set_fun ctx "==" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x = List.hd xs)));
   set_fun ctx "!=" @@ fmake ["__x"] (fun x xs -> Literal (LBool (x != List.hd xs)));
-  { class_name="String"; ctx=ctx }
+  { parent=parent; class_name="String"; ctx=ctx }
 
 
 
 
 
-def fff () ggg() + ggg() end
-def ggg() 99 end
-puts (fff()) 
+id = lambda { |x| x }
+puts (id.call('IDENTITY: ' + 'bar'))
 
 
-
-id = lambda do|x| x end
-puts (id.call("IDENTITY"))
-
-
-puts(3+8)
-
-puts("foo" + "bar")
-
 def ff (x)
   puts(x+3)
 end.call(5)
 
 
 class CCC
-  def initialize()
-    @hoge = 3
+  def initialize(h)
+    @hoge = h
   end
   def getx
     @hoge
 
 x = 10
 
-c = CCC.new()
+c = CCC.new(90)
 puts(c.getx)
 puts(c.to_s())
 puts(c)
 
+c.setx(5)
+puts(c.getx())
 
 
-
-puts (10 == x)
-c.setx(5)
-puts (10 == x)
-
 puts(5 == c.getx())
 y = c.getx()
 puts(5 == y)
 
 
 
-
-
-puts ("hello, world")
+puts ('hello, world')
 
 class C
   def f (x, y)

samples/test02.rb

+
+class X
+  def initialize
+    @n = 56
+  end
+  def setn(n)
+    @n = n
+  end
+  def getn()
+    @n
+  end
+  def to_s
+    "X:" + @n.to_s
+  end
+end
+
+class CCC
+  def initialize
+    puts("initialize")
+    @x = X.new
+    @x.setn(99)
+  end
+  def getx ()
+    @x
+  end
+  def setx(x)
+    @x = x
+  end
+end
+
+
+c = CCC.new
+puts("getset")
+puts(c.getx)
+
+c.getx.setn(10)
+puts("getget")
+puts(c.getx.getn)
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.