Fix for https://github.com/JetBrains-Research/Lama/issues/16

regression/orig/test110.log

@@ -0,0 +1,6 @@
+> 0
+0
+10
+0
+10
+100

regression/test110.input

@@ -0,0 +1 @@
+0

regression/test110.lama

@@ -0,0 +1,16 @@
+local x = [0], y = [0];
+
+read ();
+
+write (x[0]);
+write (y[0]);
+
+if 1 then x[0] else y[0] fi := 10;
+
+write (x[0]);
+write (y[0]);
+
+if 0 then x[0] else y[0] fi := 100;
+
+write (x[0]);
+write (y[0])

runtime/runtime.c

@@ -1184,11 +1184,17 @@ extern int Bsexp_tag_patt (void *x) {
 }
 
 extern void* Bsta (void *v, int i, void *x) {
-  ASSERT_BOXED(".sta:3", x);
+  if (UNBOXED(i)) {
-  ASSERT_UNBOXED(".sta:2", i);
+    ASSERT_BOXED(".sta:3", x);
+    //    ASSERT_UNBOXED(".sta:2", i);
   
-  if (TAG(TO_DATA(x)->tag) == STRING_TAG)((char*) x)[UNBOX(i)] = (char) UNBOX(v);
+    if (TAG(TO_DATA(x)->tag) == STRING_TAG)((char*) x)[UNBOX(i)] = (char) UNBOX(v);
-  else ((int*) x)[UNBOX(i)] = (int) v;
+    else ((int*) x)[UNBOX(i)] = (int) v;
+
+    return v;
+  }
+
+  * (void**) x = v;
 
   return v;
 }

src/Language.ml

@@ -81,6 +81,8 @@ module Value =
     | Builtin of string
     with show, html
 
+    let is_int = function Int _ -> true | _ -> false
+                                             
     let to_int = function
     | Int n -> n
     | x -> failwith (Printf.sprintf "int value expected (%s)\n" (show(t) (fun _ -> "<not supported>") (fun _ -> "<not supported>") x))

src/SM.ml

@@ -147,9 +147,14 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio
     | STI                     -> let z::(Value.Var r)::stack' = stack in 
                                  eval env (cstack, z::stack', update glob loc z r, loc, i, o) prg'
 
-    | STA                     -> let v::j::x::stack' = stack in
+    | STA                     -> let z::j::stack' = stack in
-                                 Value.update_elem x (Value.to_int j) v;
+                                 (match j with
-                                 eval env (cstack, v::stack', glob, loc, i, o) prg'
+                                  | Value.Var r -> eval env (cstack, z::stack', update glob loc z r, loc, i, o) prg'
+                                  | Value.Int _ ->
+                                     let x :: stack' = stack' in                                   
+                                     Value.update_elem x (Value.to_int j) z;
+                                     eval env (cstack, z::stack', glob, loc, i, o) prg'
+                                 )
                                  
     | SLABEL _ | LABEL  _ | FLABEL _ -> eval env conf prg'
                                       
@@ -826,9 +831,14 @@ let compile cmd ((imports, infixes), p) =
                                
   | Expr.StringVal e        -> let lsv, env = env#get_label in
                                add_code (compile_expr false lsv env e) lsv false [CALL (".stringval", 1, tail)]
+                               
+  | Expr.Assign (Expr.Ref x, e) ->  let lassn, env = env#get_label in
+                                    let env  , line = env#gen_line x in
+                                    let env  , acc  = env#lookup x in
+                                    add_code (compile_expr false lassn env e) lassn false (line @ [ST acc])     
 
   | Expr.Assign (x, e)      -> let lassn, env = env#get_label in
-                               add_code (compile_list false lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI]                              
+                               add_code (compile_list false lassn env [x; e]) lassn false [match x with Expr.Ref _ -> STI | _ -> STA] (*Expr.ElemRef _ -> STA | _ -> STI]*)
                              
   | Expr.Skip               -> env, false, []
 

src/X86.ml

@@ -272,12 +272,10 @@ let compile cmd env imports code =
              (env, Mov (M ("$" ^ s), l) :: call)
 
           | LDA x ->
-             let s, env' = (env#variable x)#allocate in
+             let s,  env' = (env #variable x)#allocate in
-             env',
+             let s', env''= env'#allocate in
-             (match s with
+             env'',
-	      | S _ | M _ -> [Lea (env'#loc x, eax); Mov (eax, s)]
+             [Lea (env'#loc x, eax); Mov (eax, s); Mov (eax, s')]	     
-	      | _         -> [Lea (env'#loc x, s)]
-             )
 
 	  | LD x ->
              let s, env' = (env#variable x)#allocate in

src/version.ml

@@ -1 +1 @@
-let version = "Version 1.00, 1849c7029, Mon Nov 16 20:49:07 2020 +0300"
+let version = "Version 1.00, 8f01e5eb5, Tue Nov 24 01:51:11 2020 +0300"