From ca02eb9a3d6fcfc94d8f67c7daa6d35b38567a9f Mon Sep 17 00:00:00 2001 From: Mylloon Date: Thu, 8 Dec 2022 19:55:22 +0100 Subject: [PATCH] add variable support --- ast.ml | 39 ++++++++++++++++++++++++--- compiler.ml | 39 +++++++++++++++++++++++++-- lexer.mll | 18 ++++++++----- parser.mly | 33 ++++++++++++++++++----- semantics.ml | 75 +++++++++++++++++++++++++++++++++++++++++++++++++--- 5 files changed, 183 insertions(+), 21 deletions(-) diff --git a/ast.ml b/ast.ml index f6cd2bf..08d1961 100644 --- a/ast.ml +++ b/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 - { value : int + | Val of + { 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 diff --git a/compiler.ml b/compiler.ml index bf86436..3257b02 100644 --- a/compiler.ml +++ b/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 = [] } +;; diff --git a/lexer.mll b/lexer.mll index ff62844..75cbd53 100644 --- a/lexer.mll +++ b/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 } -| [ ' ' '\t' ] { token lexbuf } -| '\n' { Lexing.new_line lexbuf; token lexbuf } -| num+ as n { Lint (int_of_string n) } -| _ as c { raise (Error c) } +| eof { Lend } +| [ ' ' '\t' ] { token lexbuf } +| '\n' { Lexing.new_line lexbuf; token lexbuf } +| num+ as n { Lint (int_of_string n) } +| "int" { Ltype (Int_t) } +| '=' { Lassign } +| ';' { Lsc } +| ident as i { Lvar i } +| _ as c { raise (Error c) } diff --git a/parser.mly b/parser.mly index 3f3665c..c6f0714 100644 --- a/parser.mly +++ b/parser.mly @@ -4,20 +4,41 @@ %} %token Lint -%token Lend + +%token Ltype + +%token Lvar + +%token Lend Lassign Lsc %start prog -%type prog +%type 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 { - Int { value = n ; pos = $startpos(n) } -} + | n = Lint { + Val { value = Int (n) ; pos = $startpos(n) } + } + | v = Lvar { + Var { name = v ; pos = $startpos(v) } + } ; diff --git a/semantics.ml b/semantics.ml index 90f7432..63652c2 100644 --- a/semantics.ml +++ b/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 = - match expr with - | Syntax.Int n -> Val (Int n.value) +let errt expected given pos = + let str_of_type_t = function + | 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) +;;