feat: rework on indirection compile

LANGUAGE.md

@@ -23,24 +23,31 @@ If you want to store some value, you need to use a argument.
 
 An argument have a addressing mode and a value.
 
-- (mode var) mode can be specified (mode is optional)
+- (none) replaced by immediate 0
+- (var) declare a argument using default mode
+- (mode var) declare a argument using specified mode
 
 ### Variables (var)
 
-Variables are numbers or texts used to store values.
+Variables are numbers or strings used to store values.
+By default, numbers use immediate mode and strings use direct mode.
 
-- Number Immediate mode by default
-- Text Direct mode by default
+- (number) integer signed or unsigned number
+- (string) string reference to let variable or label
+
+If the string corresponds to some variable in scope, the string will be replaced by a reference to this variable, otherwise the string will be kept referencing a label
 
 ### Addresing modes (mode)
 
 Addresing modes are used to specify how the argument is used in the instruction. If the addressing mode is not specified, the default mode is used.
 
-- (Dir var) direct addresing to var
-- (Ind var) indirect addresing to var
-- (Dec var) decrement var and indirect addresing to var
-- (Inc var) indirect addresing to var and increment var
-- (store var) store var value in this place (field is automatic)
+- (Imm var) | (# var) immediate addresing to var
+- (Dir var) | ($ var) direct addresing to var
+- (Ind var) | (@ var) indirect addresing to var
+- (Dec var) | (< var) decrement var and indirect addresing to var
+- (Inc var) | (> var) indirect addresing to var and increment var
+- (instr var) | (% var) points to the instruction instead of the value
+- (store var) | (! var) store var value in this place (field is automatic)
 
 
 ## Conditions (cond)
@@ -53,6 +60,7 @@ Unary conditions are used to specify when the control flow is executed based on
 
 - (JZ x) x is zero
 - (JN x) x is not zero
+- (DZ x) decrement x and x is zero
 - (DN x) decrement x and x is not zero
 
 ### Binary conditions (cond2)
@@ -71,7 +79,10 @@ Instructions are used to specify the operation to be performed. Instruction modi
 
 ### redcode instructions
 
-All redcode instructions are available for direct use
+All redcode instructions are available for direct use.
+Square brackets '[]' indicates that the argument is optional.
+
+- (NOP [arg1] [arg2]) no operation (arg1 & arg2 only store data)
 
 - (DAT arg1 arg2) data values
 - (MOV arg1 arg2) move arg1 to arg2
@@ -82,12 +93,8 @@ All redcode instructions are available for direct use
 - (DIV arg1 arg2) div arg1 from arg2
 - (MOD arg1 arg2) mod arg1 from arg2
 
-- (JMP arg1 [arg2]) jump to arg1 (arg2 is optional)
-- (SPL arg1 [arg2]) split to arg1 (arg2 is optional)
-
-- (NOP) no operation
-
-Not added yet
+- (JMP arg1 [arg2]) jump to arg1 (arg2 only store data)
+- (SPL arg1 [arg2]) split to arg1 (arg2 only store data)
 
 - (JMZ arg1 arg2) jump to arg1 if arg2 is zero
 - (JMN arg1 arg2) jump to arg1 if arg2 is not zero

README.md

@@ -15,8 +15,9 @@ work in progress.
 
 To execute the resulting redcode you can use one of these redcode interpreters.
 
+- [pMARS](https://corewar.co.uk/pmars.htm)
 - [A.R.E.S.](https://corewar.co.uk/ares.htm)
-- [PyMARS](https://github.com/rodrigosetti/corewar)
+- [python MARS](https://github.com/rodrigosetti/corewar)
 
 #### TODO
 

bbctests/examples/prog0.bbc

@@ -1,9 +1,9 @@
 NAME: test imp
 DESCRIPTION: evaluates a function declaration
 SRC:
-(MOV 0 1)
+(MOV (Dir 0) (Dir 1))
 EXPECTED:
 ;redcode-94b
 
-  MOV.I  #0     , #1     
+  MOV.I  $0     , $1     
   DAT    #0     , #0

bbctests/examples/prog1.bbc

@@ -3,8 +3,8 @@ DESCRIPTION: evaluates a function declaration
 SRC:
 (let (x dest)
   (seq
-      (MOV (Dir -1) (store x))
-      (ADD  4 x)
+      (MOV (Ins -1) (store x))
+      (ADD 4 x)
       (JMP x)
       (label dest) ))
 EXPECTED:

bbctests/examples/prog10.bbc

@@ -0,0 +1,18 @@
+NAME: long labels
+DESCRIPTION: evaluates a function declaration
+SRC:
+(let (x dest_with_some_extra_characters)
+  (seq
+      (MOV (Ins -1) (store x))
+      (ADD 4 x)
+      (JMP x)
+      (label dest_with_some_extra_characters) ))
+EXPECTED:
+;redcode-94b
+
+LET1  
+  MOV.I  $-1    , $dest_with_some_extra_characters
+  ADD.AB #4     , $LET1  
+  JMP    $LET1  , #0     
+dest_with_some_extra_characters
+  DAT    #0     , #0

bbctests/examples/prog4.bbc

@@ -15,7 +15,7 @@ SRC:
           (label dest4)
           (JMP (Ind c))
           (label dest1)
-          (MOV (Dir 0) (Dir 1)) )))))
+          (MOV (Ins 0) (Dir 1)) )))))
 EXPECTED:
 ;redcode-94b
 

bbctests/examples/prog6.bbc

@@ -4,7 +4,7 @@ SRC:
 (let (x (Dir 3))
     (repeat
       (seq
-        (MOV (Dir -1) (store x))
+        (MOV (Ins -1) (store x))
         (ADD 1 x) )))
 EXPECTED:
 ;redcode-94b

bbctests/examples/prog7.bbc

@@ -6,7 +6,7 @@ SRC:
     (JMP (Dir 2))
     (DAT 0 (store x))
     (do-while (DN 100)
-      (MOV (Dir -1) (Inc x)) )))
+      (MOV (Ins -1) (Inc x)) )))
 EXPECTED:
 ;redcode-94b
 

bbctests/examples/prog8.bbc

@@ -8,7 +8,7 @@ SRC:
       (DAT (store x) (store y))
       (while (LT y x)
         (seq
-          (MOV x (Dec x)) )))))
+          (MOV (Ins x) (Dec x)) )))))
 EXPECTED:
 ;redcode-94b
 
@@ -19,7 +19,7 @@ LET2
 WHI9  
   SLT.BA $LET2  , $LET1  
   JMP    $WHF9  , #0     
-  MOV.A  $LET1  , {LET1  
+  MOV.I  $LET1  , {LET1  
   JMP    $WHI9  , #0     
 WHF9  
   DAT    #0     , #0

dev/analyse.ml

@@ -2,17 +2,14 @@
 open String
 open Ast
 open Lib
-open Verify
-
-exception CTError of string
 
 
 let analyse_store_arg (arg : arg) (id : string) (place : place) (penv : penv) : penv =
   match arg with
   | AStore (s) ->
     (match (equal id s) with
     | true -> (extend_penv s place penv)
-    | _ -> penv)
+    | false -> penv)
   | _ -> penv
 
 let analyse_store_cond (cond : cond) (id : string) (penv : penv) : penv =
@@ -24,22 +21,25 @@ let analyse_store_cond (cond : cond) (id : string) (penv : penv) : penv =
 
 let rec analyse_store_expr (e : tag eexpr) (id : string) (penv : penv) : penv =
   match e with
+  | ELabel (_) -> penv
   | EPrim2 (_, a1, a2, _) ->
     let env' = (analyse_store_arg a1 id PA penv) in
     (analyse_store_arg a2 id PB env')
-  | ELet (_, _, e, _) ->
-    (analyse_store_expr e id penv)
-  | ECont1 (_, cond, expr, _) ->
+  | EFlow (_, exp, _) -> (analyse_store_expr exp id penv)
+  | EFlow1 (_, cond, exp, _) ->
     let env' = (analyse_store_cond cond id penv) in
-    (analyse_store_expr expr id env')
-  | ERepeat (e, _) -> (analyse_store_expr e id penv)
-  | ESeq (exprs, _) -> List.fold_left (fun penv' e -> (analyse_store_expr e id penv')) penv exprs
-  | _ -> penv
+    (analyse_store_expr exp id env')
+  | EFlow2 (_, cond, exp1, exp2, _) ->
+    let penv' = (analyse_store_cond cond id penv) in
+    let penv'' = (analyse_store_expr exp1 id penv') in
+    (analyse_store_expr exp2 id penv'')
+  | ELet (_, _, exp, _) -> (analyse_store_expr exp id penv)
+  | ESeq (exps, _) -> List.fold_left (fun penv' exp -> (analyse_store_expr exp id penv')) penv exps
+
 
 let analyse_let (id : string) (arg : arg) (body : tag eexpr) (label : string) (env : env) : env =
-  let _ = (verify_let arg) in
   let aenv, penv, lenv = env in
   let aenv' = (extend_aenv id arg aenv) in
   let penv' = (analyse_store_expr body id penv) in
   let lenv' = (extend_lenv id label lenv) in
-  (aenv', penv', lenv')
+  (aenv', penv', lenv')

dev/ast.ml

@@ -6,11 +6,16 @@ type place =
 | PB
 
 
+type imode =
+| MINone
+| MIInc
+| MIDec
+
 type mode =
-| MDir
-| MInd
-| MDec
-| MInc
+| MIns          (* Instruction *)
+| MImm          (* Immediate *)
+| MDir          (* Direct *)
+| MInd of imode (* Indirect *)
 
 type arg =
 | ANone
@@ -24,6 +29,7 @@ type arg =
 type cond1 =
 | Cjz
 | Cjn
+| Cdz
 | Cdn
 
 type cond2 =
@@ -47,55 +53,69 @@ type prim2 =
 | Mod
 | Jmp
 | Spl
+| Nop
+
+| Jmz
+| Jmn
+| Djn
+| Seq
+| Sne
+| Slt
 
-type cont1 =
+type flow =
+| Repeat
+
+type flow1 =
 | If
 | While
-| Dowhile
+| DoWhile
+
+type flow2 =
+| IfElse
 
 
 type expr =
-| Nop
 | Label of string
 | Prim2 of prim2 * arg * arg
-| Cont1 of cont1 * cond * expr
+| Flow of flow * expr
+| Flow1 of flow1 * cond * expr
+| Flow2 of flow2 * cond * expr * expr
 | Let of string * arg * expr
-| Repeat of expr
 | Seq of expr list
 
 type 'a eexpr =
-| ENop of 'a
 | ELabel of string * 'a
 | EPrim2 of prim2 * arg * arg * 'a
-| ECont1 of cont1 * cond * 'a eexpr * 'a
+| EFlow of flow * 'a eexpr * 'a
+| EFlow1 of flow1 * cond * 'a eexpr * 'a
+| EFlow2 of flow2 * cond * 'a eexpr * 'a eexpr * 'a
 | ELet of string * arg * 'a eexpr * 'a
-| ERepeat of 'a eexpr * 'a
 | ESeq of 'a eexpr list * 'a
 
 
 type tag = int
 
-
 let rec tag_expr_help (e : expr) (cur : tag) : (tag eexpr * tag) =
   match e with
-  | Nop ->
-    let (next_tag) = (cur + 1) in
-    (ENop (cur), next_tag)
   | Label (s) ->
     let (next_tag) = (cur + 1) in
     (ELabel (s, cur), next_tag)
   | Prim2 (op, a1, a2) ->
     let (next_tag) = (cur + 1) in
     (EPrim2 (op, a1, a2, cur), next_tag)
-  | Cont1 (op, c, expr) ->
+  | Flow (op, expr) ->
     let (tag_expr, next_tag) = tag_expr_help expr (cur + 1) in
-    (ECont1 (op, c, tag_expr, cur), next_tag)
+    (EFlow (op, tag_expr, cur), next_tag)
+  | Flow1 (op, cond, expr) ->
+    let (tag_expr, next_tag) = tag_expr_help expr (cur + 1) in
+    (EFlow1 (op, cond, tag_expr, cur), next_tag)
+  | Flow2 (op, cond, expr1, expr2) ->
+    let (tag_expr1, next_tag1) = tag_expr_help expr1 (cur + 1) in
+    let (tag_expr2, next_tag2) = tag_expr_help expr2 next_tag1 in
+    (EFlow2 (op, cond, tag_expr1, tag_expr2, cur), next_tag2)
   | Let (x, a, expr) ->
     let (tag_expr, next_tag) = tag_expr_help expr (cur + 1) in
     (ELet (x, a, tag_expr, cur), next_tag)
-  | Repeat (expr) ->
-    let (tag_expr, next_tag) = tag_expr_help expr (cur + 1) in
-    (ERepeat (tag_expr, cur), next_tag)
   | Seq (exprs) ->
     let rec tag_seq (exprs : expr list) (cur : tag) : tag eexpr list * tag =
       (match exprs with