* add < to baselib

* loop support

ast.ml

@@ -51,6 +51,11 @@ module Syntax = struct
         ; else_b : block
         ; pos : Lexing.position
         }
+    | Loop of
+        { expr : expr
+        ; block : block
+        ; pos : Lexing.position
+        }
     | Return of
         { expr : expr
         ; pos : Lexing.position
@@ -111,6 +116,7 @@ module IR (P : Parameters) = struct
     | Assign of ident * expr
     | Do of expr
     | Cond of expr * block * block
+    | Loop of expr * block
     | Return of expr
 
   and block = instr list

baselib.ml

@@ -9,6 +9,7 @@ let _types_ =
        ; "%sub", Func_t (Int_t, [ Int_t; Int_t ])
        ; "%mul", Func_t (Int_t, [ Int_t; Int_t ])
        ; "%div", Func_t (Int_t, [ Int_t; Int_t ])
+       ; "%big", Func_t (Bool_t, [ Int_t; Int_t ])
        ; "puti", Func_t (Void_t, [ Int_t ])
        ; "puts", Func_t (Void_t, [ Str_t ])
        ; "geti", Func_t (Int_t, [])
@@ -23,6 +24,7 @@ let builtins =
     ; "%sub", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Sub (V0, T0, T1) ]
     ; "%mul", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Mul (V0, T0, T1) ]
     ; "%div", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Div (V0, T0, T1) ]
+    ; "%big", [ Lw (T0, Mem (SP, 4)); Lw (T1, Mem (SP, 0)); Slt (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 ]

compiler.ml

@@ -58,6 +58,20 @@ let rec compile_instr info = function
         @ [ Label ("endif" ^ uniq) ]
     ; cnt = ceb.cnt
     }
+  | Loop (e, b) ->
+    let uniq = string_of_int info.cnt in
+    let cb = compile_block { info with asm = []; cnt = info.cnt + 1 } b in
+    { info with
+      asm =
+        info.asm
+        @ [ Label ("while" ^ uniq) ]
+        @ compile_expr info.env e
+        @ [ Beqz (V0, "endwhile" ^ uniq) ]
+        @ cb.asm
+        @ [ J ("while" ^ uniq) ]
+        @ [ Label ("endwhile" ^ uniq) ]
+    ; cnt = cb.cnt
+    }
   | Do e -> { info with asm = info.asm @ compile_expr info.env e }
   | Return e -> { info with asm = info.asm @ compile_expr info.env e @ [ B info.ret ] }
 

lexer.mll

@@ -22,6 +22,7 @@ rule token = parse
   | "str"         { Ltype (Str_t) }
   | "if"          { Lif }
   | "else"        { Lelse }
+  | "while"       { Lwhile }
   | '{'           { Lbracedeb }
   | '}'           { Lbracefin }
   | '('           { Lpardeb }
@@ -33,6 +34,7 @@ rule token = parse
   | '-'           { Lsub }
   | '*'           { Lmul }
   | '/'           { Ldiv }
+  | '<'           { Lbig }
   | '"'           { read_string (Buffer.create 16) lexbuf }
   | ident as i    { Lvar i }
   | '#'           { comment lexbuf }

mips.ml

@@ -50,12 +50,14 @@ type instr =
   | Mul of reg * reg * reg
   | Sub of reg * reg * reg
   | Div of reg * reg * reg
+  | Slt of reg * reg * reg
   | Syscall
   | B of label
   | Beq of reg * reg * label
   | Bne of reg * reg * label
   | Beqz of reg * label
   | Jal of label
+  | J of label
   | Jr of reg
 
 type directive = Asciiz of string
@@ -136,6 +138,8 @@ let fmt_instr ?(indent = "  ") = function
     Printf.sprintf "%ssub %s, %s, %s" indent (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
   | Div (rd, rs, rt) ->
     Printf.sprintf "%sdiv %s, %s, %s" indent (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
+  | Slt (rd, rs, rt) ->
+    Printf.sprintf "%sslt %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) ->
@@ -144,6 +148,7 @@ let fmt_instr ?(indent = "  ") = function
     Printf.sprintf "%sbne %s, %s, %s" indent (fmt_reg rs) (fmt_reg rt) l
   | Beqz (r, l) -> Printf.sprintf "%sbeqz %s, %s" indent (fmt_reg r) l
   | Jal l -> Printf.sprintf "%sjal %s" indent l
+  | J l -> Printf.sprintf "%sj %s" indent l
   | Jr r -> Printf.sprintf "%sjr %s" indent (fmt_reg r)
 ;;
 

parser.mly

@@ -11,14 +11,14 @@
 %token Lend Lassign Lsc Lreturn
 %token Lbracedeb Lbracefin
 %token Lpardeb Lparfin Lcomma
-%token Ladd Lsub Lmul Ldiv
-%token Lif Lelse
+%token Ladd Lsub Lmul Ldiv Lbig
+%token Lif Lelse Lwhile
 
-%left Ladd Lsub Lmul Ldiv
+%left Ladd Lsub Lmul Ldiv Lbig
 
 %left Lbracedeb Lparfin Lbracefin Lreturn
 %left Ltype Lbool Lint Lvar Lstr
-%left Lif
+%left Lif Lwhile
 
 %start prog
 
@@ -125,6 +125,11 @@ instr:
     [ Cond { expr = e ; if_b = b ; else_b = [] ; pos = $startpos } ]
   }
 
+  /* while (e) {} */
+  | Lwhile ; Lpardeb ; e = expr ; Lparfin ; b = block {
+    [ Loop { expr = e ; block = b ; pos = $startpos } ]
+  }
+
 expr:
   /* int */
   | n = Lint {
@@ -166,6 +171,11 @@ expr:
     Call { func = "%div" ; args = [ a ; b ] ; pos = $startpos($2) }
   }
 
+  /* e < e */
+  | a = expr ; Lbig ; b = expr {
+    Call { func = "%big" ; args = [ a ; b ] ; pos = $startpos($2) }
+  }
+
   /* function(a */
   | f = Lvar ; Lpardeb ; a = args_expr {
     Call { func = f ; args = a ; pos = $startpos(a) }

semantics.ml

@@ -73,6 +73,10 @@ let rec analyze_instr env ua ret_t = function
     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 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
     Return ae, env, []

simplifier.ml

@@ -39,6 +39,10 @@ let collect_constant_strings code =
       let ib2, ccs2 = ccs_block ib in
       let eb2, ccs3 = ccs_block eb in
       IR2.Cond (e2, ib2, eb2), List.flatten [ ccs; ccs2; ccs3 ]
+    | IR1.Loop (e, b) ->
+      let e2, ccs = ccs_expr e in
+      let b2, ccs2 = ccs_block b in
+      IR2.Loop (e2, b2), List.flatten [ ccs; ccs2 ]
     | IR1.Return e ->
       let e2, ccs = ccs_expr e in
       IR2.Return e2, ccs

test.ml

@@ -20,6 +20,7 @@ let debug_parser oc parsed =
     | Syntax.Do d -> "Do (" ^ fmt_e d.expr ^ ")"
     | Syntax.Cond c ->
       "Cond (" ^ fmt_e c.expr ^ ", " ^ fmt_b c.if_b ^ ", " ^ fmt_b c.else_b ^ ")"
+    | Syntax.Loop l -> "Loop (" ^ fmt_e l.expr ^ ", " ^ fmt_b l.block ^ ")"
     | Syntax.Return d -> "Return (" ^ fmt_e d.expr ^ ")"
   and fmt_b b = " [ " ^ String.concat "\n ; " (List.map fmt_i b) ^ "\n ]"
   and fmt_f = function
@@ -59,6 +60,7 @@ let debug_semantics oc ast =
     | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")"
     | Do e -> "Do (" ^ fmt_e e ^ ")"
     | Cond (c, i, e) -> "Cond (" ^ fmt_e c ^ ", " ^ fmt_b i ^ ", " ^ fmt_b e ^ ")"
+    | Loop (c, b) -> "Loop (" ^ fmt_e c ^ ", " ^ fmt_b b ^ ")"
     | Return e -> "Return (" ^ fmt_e e ^ ")"
   and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]"
   and fmt_f = function