open Pp open Code exception PasFini (* compilation des binop *) let cbinop = function | Pp.Plus -> Plus | Pp.Minus -> Minus | Pp.Times -> Times | Pp.Div -> Div | Pp.Lt -> Lt | Pp.Le -> Le | Pp.Gt -> Gt | Pp.Ge -> Ge | Pp.Eq -> Eq | Pp.Ne -> Ne (* idem pour les relop *) exception Error of string let erreur s = raise (Error s) let notrelop op = erreur (op^" n'est pas une relation") ;; let crelop = function | Pp.Lt -> Rlt | Pp.Le -> Rle | Pp.Gt -> Rgt | Pp.Ge -> Rge | Pp.Eq -> Req | Pp.Ne -> Rne | Pp.Plus -> notrelop "+" | Pp.Minus -> notrelop "-" | Pp.Times -> notrelop "*" | Pp.Div -> notrelop "/" let is_relop op = try let _ = crelop op in true with Error _ -> false (* expressions *) let rec cexpr env = function | Int i -> Const i | _ -> raise PasFini let rec cinstruction env i = match i with | Sequence is -> Seq (cinstruction_list env is) | Write_int e -> Exp (Call (Frame.write_int, [cexpr env e])) | _ -> raise PasFini and cinstruction_list env is = List.map (cinstruction env) is let cfun env f (s,{arguments = args ; result = r ; local_vars = locs ; body = ins}) = let new_env = env in f,Seq (cinstruction_list new_env ins) type 'a procedure = Frame.frame * 'a type 'a program = { number_of_globals : int; main : 'a procedure; procedures : 'a procedure list } (* Note: les frames sont bidons, pour le moment *) let cprog {global_vars = g ; definitions = defs ; Pp.main = p} = (* Faire passer le code principal pour une procédure *) let main_def = ("main",{arguments = [] ; result = None ; local_vars = [] ; body = p}) in let globals = [] and funs = [] (* Pour le moment *) in let env_init = Env.create_global globals funs in let funs = List.map (fun def -> cfun env_init Frame.bidon def) defs in let principal = cfun env_init Frame.bidon main_def in { number_of_globals = List.length globals ; main = principal ; procedures = funs } let program p = try cprog p with | Error s -> Printf.fprintf stderr "Erreur dans trans: %s\n" s ; exit 2