* add &&

* allow int in cond/loop

baselib.ml

@@ -16,6 +16,7 @@ let _types_ =
        ; "%sle", Func_t (Bool_t, [ Int_t; Int_t ])
        ; "%slt", Func_t (Bool_t, [ Int_t; Int_t ])
        ; "%sne", Func_t (Bool_t, [ Int_t; Int_t ])
+       ; "%and", Func_t (Int_t, [ Int_t; Int_t ])
        ; "puti", Func_t (Void_t, [ Int_t ])
        ; "puts", Func_t (Void_t, [ Str_t ])
        ; "geti", Func_t (Int_t, [])
@@ -38,6 +39,7 @@ let builtins =
     ; "%sle", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Sle (V0, T0, T1) ]
     ; "%slt", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Slt (V0, T0, T1) ]
     ; "%sne", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Sne (V0, T0, T1) ]
+    ; "%and", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); And (V0, T0, T1) ]
     ; "puti", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.print_int); Syscall ]
     ; "puts", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.print_str); Syscall ]
     ; "geti", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.read_int); Syscall ]

errors.ml

@@ -33,8 +33,8 @@ let errt expected given pos =
     (SemanticsError
        ( Printf.sprintf
            "Expected %s but given %s"
-           (string_of_type_t expected)
-           (string_of_type_t given)
+           (String.concat ", " (List.map string_of_type_t expected))
+           (String.concat ", " (List.map string_of_type_t given))
        , pos ))
 ;;
 

lexer.mll

@@ -41,6 +41,7 @@ rule token = parse
   | "<="          { Lsle }
   | "<"           { Lslt }
   | "!="          { Lsne }
+  | '&'           { Land }
   | '"'           { read_string (Buffer.create 16) lexbuf }
   | ident as i    { Lvar i }
   | '#'           { comment lexbuf }

mips.ml

@@ -55,6 +55,7 @@ type instr =
   | Sle of reg * reg * reg
   | Slt of reg * reg * reg
   | Sne of reg * reg * reg
+  | And of reg * reg * reg
   | Syscall
   | B of label
   | Beq of reg * reg * label
@@ -148,6 +149,8 @@ let fmt_instr ?(indent = "  ") = function
     Printf.sprintf "%sslt %s, %s, %s" indent (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
   | Sne (rd, rs, rt) ->
     Printf.sprintf "%ssne %s, %s, %s" indent (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
+  | And (rd, rs, rt) ->
+    Printf.sprintf "%sand %s, %s, %s" indent (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
   | Syscall -> Printf.sprintf "%ssyscall" indent
   | B l -> Printf.sprintf "%sb %s" indent l
   | Beq (rs, rt, l) ->

parser.mly

@@ -12,9 +12,11 @@
 %token Lbracedeb Lbracefin
 %token Lpardeb Lparfin Lcomma
 %token Ladd Lsub Lmul Ldiv Lrem Lseq Lsge Lsgt Lsle Lslt Lsne
+%token Land
 %token Lif Lelse Lwhile
 
 %left Ladd Lsub Lmul Ldiv Lrem Lseq Lsge Lsgt Lsle Lslt Lsne
+%left Land
 
 %left Lbracedeb Lparfin Lbracefin Lreturn
 %left Ltype Lbool Lint Lvar Lstr
@@ -211,6 +213,11 @@ expr:
     Call { func = "%sne" ; args = [ a ; b ] ; pos = $startpos($2) }
   }
 
+  /* e && e */
+  | a = expr ; Land ; Land ; b = expr {
+    Call { func = "%and" ; args = [ a ; b ] ; pos = $startpos($2) }
+  }
+
   /* function(a */
   | f = Lvar ; Lpardeb ; a = args_expr {
     Call { func = f ; args = a ; pos = $startpos(a) }

semantics.ml

@@ -14,21 +14,21 @@ let analyze_value = function
 let rec analyze_expr env ua t = function
   | Syntax.Val v ->
     let v2, new_t = analyze_value v.value in
-    if new_t != t && t != Magic_t then errt t new_t v.pos;
+    if (not (List.mem new_t t)) && not (List.mem Magic_t t) then errt t [ new_t ] v.pos;
     Val v2, new_t
   | Syntax.Var v ->
     if not (Env.mem v.name env)
     then raise (SemanticsError ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
     if List.mem v.name ua then warn ("Unassigned variable \"" ^ v.name ^ "\"") v.pos;
     let new_t = Env.find v.name env in
-    if new_t != t then errt t new_t v.pos;
+    if not (List.mem new_t t) then errt t [ new_t ] v.pos;
     Var v.name, new_t
   | Syntax.Call c ->
     if not (Env.mem c.func env)
     then raise (SemanticsError ("Unbound function \"" ^ c.func ^ "\"", c.pos));
     (match Env.find c.func env with
     | Func_t (ret_t, tl) ->
-      if ret_t != t && t != Magic_t then errt ret_t t c.pos;
+      if (not (List.mem ret_t t)) && not (List.mem Magic_t t) then errt [ ret_t ] t c.pos;
       if List.length tl != List.length c.args
       then
         raise
@@ -41,14 +41,14 @@ let rec analyze_expr env ua t = function
              , c.pos ));
       let args =
         List.map2
-          (fun t e ->
-            let e2, t2 = analyze_expr env ua t e in
-            if t2 = t
+          (fun tt e ->
+            let e2, t2 = analyze_expr env ua [ tt ] e in
+            if t2 = tt
             then e2
             else
               errt
-                t
-                t2
+                [ tt ]
+                [ t2 ]
                 (match e with
                 | Syntax.Val v -> v.pos
                 | Syntax.Var v -> v.pos
@@ -65,22 +65,22 @@ let rec analyze_instr env ua ret_t = function
   | Syntax.Assign a ->
     if not (Env.mem a.var env)
     then raise (SemanticsError ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
-    let ae, et = analyze_expr env ua (Env.find a.var env) a.expr in
+    let ae, et = analyze_expr env ua [ Env.find a.var env ] a.expr in
     Assign (a.var, ae), env, List.filter (fun x -> x <> a.var) ua
   | Syntax.Do d ->
-    let ae, _ = analyze_expr env ua Magic_t d.expr in
+    let ae, _ = analyze_expr env ua [ Magic_t ] d.expr in
     Do ae, env, []
   | Syntax.Cond c ->
-    let cond, _ = analyze_expr env ua Bool_t c.expr in
+    let cond, _ = analyze_expr env ua [ Bool_t; Int_t ] c.expr in
     let if_b, _ = analyze_block env ua Magic_t c.pos c.if_b in
     let else_b, _ = analyze_block env ua Magic_t c.pos c.else_b in
     Cond (cond, if_b, else_b), env, []
   | Syntax.Loop l ->
-    let cond, _ = analyze_expr env ua Bool_t l.expr in
+    let cond, _ = analyze_expr env ua [ Bool_t; Int_t ] l.expr in
     let block, _ = analyze_block env ua Magic_t l.pos l.block in
     Loop (cond, block), env, []
   | Syntax.Return r ->
-    let ae, _ = analyze_expr env ua ret_t r.expr in
+    let ae, _ = analyze_expr env ua [ ret_t ] r.expr in
     Return ae, env, []
 
 and analyze_block env ua ret_t pos = function

tests/29_if-int.test

@@ -1,6 +1,5 @@
 void main () {
-    if (1) { # Error on line 2 col 8: Expected bool but given int.
-             # Requiert le type bool, pas de convertion implicite
+    if (1) { # Même les int peuvent fonctionner dans les conditions
         return;
     }
 }

tests/32_while-int.test

@@ -1,6 +1,5 @@
 void main () {
-    while (1) { # Error on line 2 col 11: Expected bool but given int.
-                # Requiert le type bool, pas de convertion implicite
+    while (1) { # Comme les conditions, les int sont autorisés
         return;
     }
 }

tests/35_op.test

@@ -0,0 +1,7 @@
+void main () {
+    if (1 && 3 < 4) {
+        puti(1);
+    } else {
+        puti(0);
+    }
+}

tests/36_if-str.test

@@ -0,0 +1,6 @@
+void main () {
+    if ("mettez20svp") { # Error on line 2 col 20: Expected bool, int but given str.
+                         # les strings ne sont pas valides pour les conditions
+        return;
+    }
+}

tests/37_while-str.test

@@ -0,0 +1,7 @@
+void main () {
+    while ("salut") { # Error on line 2 col 17: Expected bool, int but given str.
+                      # Comme les conditions, les strings peuvent pas être
+                      # des conditions
+        return;
+    }
+}