Prohibit indirect assignments

PLTools · Jan 5, 2025 · 2dad84d · 2dad84d
1 parent cfe325b
commit 2dad84d
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 12 deletions.
diff --git a/src/SM.ml b/src/SM.ml
@@ -1427,7 +1427,7 @@ let compile cmd ((imports, _), p) =
     | Expr.Ignore s ->
         let ls, env = env#get_label in
         add_code (compile_expr tail ls env s) ls false [ DROP ]
-    | Expr.ElemRef (x, i) -> compile_list tail l env [ x; i ]
+    | Expr.ElemRef _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited."
     | Expr.Var x -> (
         let env, line = env#gen_line x in
         let env, acc = env#lookup x in
@@ -1438,10 +1438,7 @@ let compile cmd ((imports, _), p) =
               false,
               line @ [ PROTO (name, env#current_function) ] )
         | _ -> (env, false, line @ [ LD acc ]))
-    | Expr.Ref x ->
-        let env, line = env#gen_line x in
-        let env, acc = env#lookup x in
-        (env, false, line @ [ LDA acc ])
+    | Expr.Ref _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited."
     | Expr.Const n -> (env, false, [ CONST n ])
     | Expr.String s -> (env, false, [ STRING s ])
     | Expr.Binop (op, x, y) ->
@@ -1496,12 +1493,15 @@ let compile cmd ((imports, _), p) =
         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) ->
+    | Expr.Assign (Expr.ElemRef (x, i), e) ->
         let lassn, env = env#get_label in
         add_code
-          (compile_list false lassn env [ x; e ])
+          (compile_list false lassn env [ x; i; e ])
           lassn false
-          [ (match x with Expr.ElemRef _ -> STA | _ -> STI) ]
+          [ STA ]
+    | Expr.Assign (x, _) ->
+        failwith
+          (Printf.sprintf "Indirect assignment is not supported yet: %s" (show Expr.t x))
     | Expr.Skip -> (env, false, [])
     | Expr.Seq (s1, s2) -> compile_list tail l env [ s1; s2 ]
     | Expr.If (c, s1, s2) ->

diff --git a/src/X86_64.ml b/src/X86_64.ml
@@ -697,7 +697,8 @@ let compile cmd env imports code =
                 let l, env = env#allocate in
                 let env, call = compile_call env ~fname:".string" 1 false in
                 (env, mov addr l @ call)
-            | LDA x -> (
+            | LDA _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited."
+            (*
                 let s, env' = (env#variable x)#allocate in
                 let s', env'' = env'#allocate in
                 let loc_x = env'#loc x in
@@ -710,7 +711,7 @@ let compile cmd env imports code =
                        assignment :("
                 | _ ->
                     ();
-                    (env'', [ Lea (loc_x, rax); Mov (rax, s); Mov (rax, s') ]))
+                    (env'', [ Lea (loc_x, rax); Mov (rax, s); Mov (rax, s') ])*)
             | LD x -> (
                 let s, env' = (env#variable x)#allocate in
                 ( env',
@@ -725,7 +726,8 @@ let compile cmd env imports code =
                   | S _ | M _ -> [ Mov (s, rax); Mov (rax, env'#loc x) ]
                   | _ -> [ Mov (s, env'#loc x) ] ))
             | STA -> compile_call env ~fname:".sta" 3 false
-            | STI -> (
+            | STI -> failwith "Should not happen. Indirect assignemts are temporarily prohibited."
+              (*
                 let v, env = env#pop in
                 let x = env#peek in
                 ( env,
@@ -737,7 +739,7 @@ let compile cmd env imports code =
                         Mov (rdx, I (0, rax));
                         Mov (rdx, x);
                       ]
-                  | _ -> [ Mov (v, rax); Mov (rax, I (0, x)); Mov (rax, x) ] ))
+                  | _ -> [ Mov (v, rax); Mov (rax, I (0, x)); Mov (rax, x) ] )*)
             | BINOP op -> compile_binop env op
             | LABEL s | FLABEL s | SLABEL s -> (env, [ Label s ])
             | JMP l -> ((env#set_stack l)#set_barrier, [ Jmp l ])