add variable support

ast.ml

@@ -1,12 +1,45 @@
+type type_t = Int_t
+
 module Syntax = struct
+  type ident = string
+  type value = Int of int
+
   type expr =
-    | Int of
+    | Val of
-        { value : int
+        { value : value
         ; pos : Lexing.position
         }
+    | Var of
+        { name : ident
+        ; pos : Lexing.position
+        }
+
+  type instr =
+    | Decl of
+        { name : ident
+        ; type_t : type_t
+        ; pos : Lexing.position
+        }
+    | Assign of
+        { var : ident
+        ; expr : expr
+        ; pos : Lexing.position
+        }
+
+  and block = instr list
 end
 
 module IR = struct
+  type ident = string
   type value = Int of int
-  type expr = Val of value
+
+  type expr =
+    | Val of value
+    | Var of ident
+
+  type instr =
+    | Decl of ident
+    | Assign of ident * expr
+
+  and block = instr list
 end

compiler.ml

@@ -2,12 +2,47 @@ open Ast.IR
 open Mips
 module Env = Map.Make (String)
 
+type info =
+  { asm : instr list
+  ; env : loc Env.t
+  ; fpo : int (* FP offset *)
+  }
+
 let compile_value = function
   | Int n -> [ Li (V0, n) ]
 ;;
 
-let compile_expr = function
+let compile_expr env = function
   | Val v -> compile_value v
+  | Var v -> [ Lw (V0, Env.find v env) ]
 ;;
 
-let compile ir = { text = Baselib.builtins @ compile_expr ir; data = [] }
+let compile_instr info = function
+  | Decl v ->
+    { info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
+  | Assign (v, e) ->
+    { info with
+      asm = info.asm @ compile_expr info.env e @ [ Sw (V0, Env.find v info.env) ]
+    }
+;;
+
+let rec compile_block info = function
+  | [] -> info
+  | i :: b -> compile_block (compile_instr info i) b
+;;
+
+let compile_body body =
+  let compiled = compile_block { asm = []; env = Env.empty; fpo = 8 } body in
+  [ Addi (SP, SP, -compiled.fpo)
+  ; Sw (RA, Mem (SP, compiled.fpo - 4))
+  ; Sw (FP, Mem (SP, compiled.fpo - 8))
+  ; Addi (FP, SP, compiled.fpo - 4)
+  ]
+  @ compiled.asm
+  @ [ Addi (SP, SP, compiled.fpo); Lw (RA, Mem (FP, 0)); Lw (FP, Mem (FP, -4)); Jr RA ]
+;;
+
+let compile ir =
+  let asm = compile_body ir in
+  { text = Baselib.builtins @ asm; data = [] }
+;;

lexer.mll

@@ -5,11 +5,17 @@
   exception Error of char
 }
 
-let num = ['0'-'9']
+let alpha = ['a'-'z' 'A'-'Z']
+let num   = ['0'-'9']
+let ident = alpha (alpha | num | '-' | '_')*
 
 rule token = parse
-| eof             { Lend }
+| eof           { Lend }
-| [ ' ' '\t' ]    { token lexbuf }
+| [ ' ' '\t' ]  { token lexbuf }
-| '\n'            { Lexing.new_line lexbuf; token lexbuf }
+| '\n'          { Lexing.new_line lexbuf; token lexbuf }
-| num+ as n       { Lint (int_of_string n) }
+| num+ as n     { Lint (int_of_string n) }
-| _ as c          { raise (Error c) }
+| "int"         { Ltype (Int_t) }
+| '='           { Lassign }
+| ';'           { Lsc }
+| ident as i    { Lvar i }
+| _ as c        { raise (Error c) }

parser.mly

@@ -4,20 +4,41 @@
 %}
 
 %token <int> Lint
-%token Lend
+
+%token <Ast.type_t> Ltype
+
+%token <string> Lvar
+
+%token Lend Lassign Lsc
 
 %start prog
 
-%type <Ast.Syntax.expr> prog
+%type <Ast.Syntax.block> prog
 
 %%
 
 prog:
-| e = expr; Lend { e }
+  | Lend { [] }
+  | i = instr; Lsc; b = prog { i @ b }
 ;
 
+instr:
+  | t = Ltype; v = Lvar {
+    [ Decl { name = v; type_t = t; pos = $startpos(t) } ]
+  }
+  | t = Ltype; v = Lvar; Lassign; e = expr
+    { [ Decl   { name = v; type_t = t; pos = $startpos(t) }
+    ; Assign { var = v; expr = e; pos = $startpos(v) } ]
+    }
+  | v = Lvar; Lassign; e = expr
+    { [ Assign { var = v; expr = e; pos = $startpos(v) } ]
+    }
+
 expr:
-| n = Lint {
+  | n = Lint {
-  Int { value = n ; pos = $startpos(n) }
+    Val { value = Int (n) ; pos = $startpos(n) }
-}
+  }
+  | v = Lvar {
+    Var { name = v ; pos = $startpos(v) }
+  }
 ;

semantics.ml

@@ -2,11 +2,78 @@ open Ast
 open Ast.IR
 open Baselib
 
+(* Erreurs *)
+
 exception Error of string * Lexing.position
 
-let rec analyze_expr expr env =
+let errt expected given pos =
-  match expr with
+  let str_of_type_t = function
-  | Syntax.Int n -> Val (Int n.value)
+    | Int_t -> "int"
+  in
+  raise
+    (Error
+       ( Printf.sprintf
+           "Expected %s but %s given."
+           (str_of_type_t expected)
+           (str_of_type_t given)
+       , pos ))
 ;;
 
-let analyze parsed = analyze_expr parsed Baselib._types_
+let warn msg (pos : Lexing.position) =
+  Printf.eprintf
+    "Warning on line %d col %d: %s.\n"
+    pos.pos_lnum
+    (pos.pos_cnum - pos.pos_bol)
+    msg
+;;
+
+(* Sémantique *)
+
+let analyze_value = function
+  | Syntax.Int n -> Int n, Int_t
+;;
+
+let analyze_expr env ua x = function
+  | Syntax.Val v ->
+    let v2, t = analyze_value v.value in
+    if t != x then errt x t v.pos;
+    Val v2, t
+  | Syntax.Var v ->
+    if not (Env.mem v.name env)
+    then raise (Error ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
+    if List.mem v.name ua then warn ("Unassigned variable \"" ^ v.name ^ "\"") v.pos;
+    let t = Env.find v.name env in
+    if t != x then errt x t v.pos;
+    Var v.name, t
+;;
+
+let analyze_instr env ua = function
+  | Syntax.Decl d -> Decl d.name, Env.add d.name d.type_t env, [ d.name ] @ ua
+  | Syntax.Assign a ->
+    if not (Env.mem a.var env)
+    then raise (Error ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
+    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
+;;
+
+let rec analyze_block env ua = function
+  | [] -> []
+  | instr :: new_block ->
+    let new_instr, new_env, new_ua = analyze_instr env ua instr in
+    new_instr :: analyze_block new_env new_ua new_block
+;;
+
+let analyze parsed = analyze_block _types_ [] parsed
+
+let emit oc ast =
+  let rec fmt_v = function
+    | Int n -> "Int " ^ string_of_int n
+  and fmt_e = function
+    | Val v -> "Val (" ^ fmt_v v ^ ")"
+    | Var v -> "Var \"" ^ v ^ "\""
+  and fmt_i = function
+    | Decl v -> "Decl \"" ^ v ^ "\""
+    | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")"
+  and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]" in
+  Printf.fprintf oc "%s\n" (fmt_b ast)
+;;