OSDN Git Service

add let-expresion(not complete)
authorMIZUNO Hiroki <mzpppp@gmail.com>
Mon, 19 May 2008 14:30:01 +0000 (23:30 +0900)
committerMIZUNO Hiroki <mzpppp@gmail.com>
Mon, 19 May 2008 14:30:01 +0000 (23:30 +0900)
example/let.scm [new file with mode: 0644]
src/ast.ml
src/ast.mli
src/init.ml
src/lisp.ml
util/instruction.txt

diff --git a/example/let.scm b/example/let.scm
new file mode 100644 (file)
index 0000000..7426ca2
--- /dev/null
@@ -0,0 +1,2 @@
+(let ((x 42))
+  (print 42))
\ No newline at end of file
index c8038e6..3f85d95 100644 (file)
@@ -16,11 +16,27 @@ type ast =
   | Gt of ast * ast
   | Geq of ast * ast
   | If of ast * ast * ast
+  | Let of (string*ast) list * ast
+  | Var of string
 
+let find name table = 
+  let rec sub i = function
+      [] -> 
+       failwith @@ "no name: " ^ name
+    | x::xs ->
+       try
+         i,List.assoc name x
+       with Not_found ->
+         sub (i+1) xs in
+    sub 0 table
 
-let rec generate_expr ast = 
+let scope_depth = function
+    [] -> 0
+  | (_,(scope,_))::_ -> scope
+
+let rec generate_expr ast table = 
   let expr ast =
-    right (generate_expr ast) in
+    right (generate_expr ast table) in
   let binary_op op l r =
     Right ((expr l)@(expr r)@[op])  in
   match ast with
@@ -47,6 +63,25 @@ let rec generate_expr ast =
                  exceptions=[];
                  traits=[];
                  instructions=inst}]
+    | Var name ->
+       let scope,slot = 
+         List.assoc name table in
+         Right [GetScopeObject scope;
+                GetSlot slot]
+    | Let (vars,body) ->
+       let depth = 
+         scope_depth table + 1 in
+       let table' =
+         (ExtList.List.mapi (fun i (name,_) -> name,(depth,i+1)) vars)@table in
+       let inits =
+         concatMap (fun (name,init)-> 
+                      let scope,slot = 
+                        List.assoc name table' in
+                        List.concat [ expr init;
+                                     [GetScopeObject scope;Swap;SetSlot slot]]) vars in
+       Right (List.concat [[NewObject 0; PushScope];
+                           inits;
+                           right @@ generate_expr body table'])
     | Call (name,args) ->
        let mname =
          Cpool.QName ((Cpool.Namespace ""),name) in
@@ -80,7 +115,7 @@ let rec generate_expr ast =
 
 
 let generate_method program =
-    left @@ generate_expr program
+    left @@ generate_expr program []
 
 let generate program =
   let m = 
index fd77781..fe32ab3 100644 (file)
@@ -13,6 +13,8 @@ type ast =
   | Gt of ast * ast (* greater than *)
   | Geq of ast * ast (* greatr than equlas *)
   | If of ast * ast * ast
+  | Let of (string*ast) list * ast
+  | Var of string
 
 
 val generate_method : ast -> Asm.meth list
index cf48577..314dea1 100644 (file)
@@ -3,6 +3,7 @@
 
 #load "debug.cmo";;
 #load "base.cmo";;
+#load "label.cmo";;
 #load "bytes.cmo";;
 #load "abc.cmo";;
 #load "cpool.cmo";;
index 0df1856..9c3d994 100644 (file)
@@ -5,6 +5,7 @@ let rec make_ast =
   function
       String s -> Ast.String s 
     | Int n -> Ast.Int n
+    | Symbol name -> Ast.Var name
     | List xs -> 
        begin match xs with
            [Symbol "+";l;r] ->
@@ -28,6 +29,8 @@ let rec make_ast =
              Ast.Leq (make_ast l,make_ast r)
          | [Symbol "if";t;c;a] ->
              Ast.If (make_ast t,make_ast c,make_ast a)
+         | [(Symbol "let");List vars;body] ->
+             Ast.Let (List.map (fun (List [Symbol n;init]) -> (n,make_ast init)) vars,make_ast body)
          | ((Symbol name)::args) ->
              Ast.Call (name,List.map make_ast args)
          | _ ->
index 70709f7..c38b579 100644 (file)
@@ -49,7 +49,7 @@ SetLocal_2: op=0xD6; stack=1
 SetLocal_3: op=0xD7; stack=1
 SetLocal of int: op=0x63; stack=1; args=const [u30 arg0]
 GetGlobalScope:op=0x64; stack=1
-GetScopeObject:op=0x65; stack=1
+GetScopeObject of int:op=0x65; stack=1; args=const[u8 arg0]
 GetSlot of int:op=0x6c; args=const [u30 arg0]
 SetSlot of int:op=0x6d; stack= ~2; args=const [u30 arg0]
 GetGlobalSlot of int:op=0x6e; stack=1; args=const [u30 arg0]
@@ -61,3 +61,5 @@ PushUInt of int: op=0x2E; stack=1; const=uint arg0; args=fun cmap -> [uint_get a
 CallPropLex of Cpool.multiname * int: op=0x4c; stack= ~-arg1; args=fun cmap->[multiname_get arg0 cmap;Bytes.u30 arg1]
 Pop: op=0x29; stack= ~-1
 Swap:op=0x2b
+
+NewObject of int:op=0x55; args=const [u30 arg0]
\ No newline at end of file