code.ml

用ocaml编写的pascal编译程序

open Sem;;
open Instr;;


(*reference pour numeroter les labels*)
let lab=ref 0;;

(*fonction qui affiche les variable avec leur prof d'imbr*)

let show lst_v=
   let rec show_rec =function
       []->"\n"
       |(id_var,pi)::l->(id_var^(string_of_int pi))^(show_rec l)
in 
Printf.printf"%s"(show_rec lst_v);;


(*function qui renvoie la taille de variable*)


let rec taille_var vdecl=match vdecl with
[]->0
|(_,S_dbty _)::vdec->1+(taille_var vdec)
|(_ ,S_darr ((S_cst(S_num _ ),_),(S_cst(S_num _ ),_) ,_))::vdec->5+(taille_var vdec)
|_->0;;

let rec taille_var_loc vdecl=match vdecl with
[]->0
|(_,S_dbty _)::vdec->1+(taille_var_loc vdec)
|(_,S_darr(_,_,_))::vdec->5+(taille_var_loc vdec)
;;

(*function pour compter le nombre d'elements dans une liste*)

let rec nb_elt liste=match liste with
[]->0
|((A_arr _),A_val)::l->5+nb_elt l
|_::l->1+nb_elt l;;

(*Creation de la liste des variables avec leur profondeurs d'imbrication*)

let rec liste_var2 pi vdecl=match vdecl with
[]->[]
|(id_var,S_dbty _)::k->[(id_var,pi)]@(liste_var2 pi k)
|(id_var,S_darr((_,_),(_,_),_))::k->[(id_var,pi)]@[(id_var,pi)]@[(id_var,pi)]@[(id_var,pi)]@[(id_var,pi)]@(liste_var2 pi k)
;;

let rec liste_var pi l vdecl=l@(liste_var2 pi vdecl)


(*creation de la liste des procedures avec leur profondeur d'imbrication*)

let rec lstproc2 pi list =match list with
[]->[]
|(id_var,_,_)::l->[(id_var,pi)]@(lstproc2 pi l);;

let rec lstproc pi l list =l@(lstproc2 pi list);;



(*Recherche de le profondeur d'inbrication d'une variable*)

let rec rech2 id_var pi liste=match liste with
[]->0
|(x,p)::l->if (p=pi) then
                       begin
                         if (x=id_var) then 1 else (rech2 id_var pi l)
                       end
           else (rech2 id_var pi l)
;;


let rec rech id_var pi liste=
     let a=(rech2 id_var pi liste) in
        if a=1 
        then 0 
        else (1+(rech id_var (pi-1)  liste));;


(*Recherche de la place d'une variable dans une liste*)

let rec rech_place2 id_var pi liste=match liste with
[] -> -1
|(x,p)::l->if (p=pi) then
                       begin
                         if (x=id_var)  then 0 else (1+(rech_place2 id_var pi l))
                       end
           else (0+(rech_place2 id_var pi l))
;;

let rec rech_place id_var pi liste=
        if ((rech2 id_var pi liste)=1) 
        then (rech_place2 id_var pi liste)
        else (rech_place id_var (pi-1) liste)
;;



(*calcul des parties droites*)


let rec affec_d var pi liste=match var with
(S_cst(S_num id_var),A_btype A_int)->[I_ins(I_ldc(I_int,id_var))]
|(S_cst(S_true),A_btype A_bool)->[I_ins(I_ldc(I_int,1))]
|(S_cst(S_false),A_btype A_bool)->[I_ins(I_ldc(I_int,0))]
|(S_una(S_minus,id_var),A_btype A_int)->(affec_d id_var pi liste)@[I_ins(I_neg I_int)]
|(S_una(S_not,id_var),A_btype A_bool)->(affec_d id_var pi liste)@[I_ins(I_not)]
|(S_bin(S_add,val1,val2),A_btype A_int)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_add(I_int))]
|(S_bin(S_sub,val1,val2),A_btype A_int)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_sub(I_int))]
|(S_bin(S_mul,val1,val2),A_btype A_int)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_mul(I_int))]
|(S_bin(S_div,val1,val2),A_btype A_int)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_div(I_int))]
|(S_bin(S_leq,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_leq(I_int))]
|(S_bin(S_les,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_les(I_int))]
|(S_bin(S_geq,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_geq(I_int))]
|(S_bin(S_grt,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_grt(I_int))]
|(S_bin(S_eq,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_equ(I_int))]
|(S_bin(S_neq,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_neq(I_int))]
|(S_bin(S_and,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_and)]
|(S_bin(S_or,val1,val2),A_btype A_bool)->
(affec_d val1 pi liste)@(affec_d val2 pi liste)@[I_ins(I_or)]

|(S_der((id_var,A_name(A_var(A_bty A_int,A_val))),None),A_name(A_var(A_bty A_int,A_val)))->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_ind I_int)]
|(S_der((id_var,A_name(A_var(A_bty A_int,A_adr))),None),A_name(A_var(A_bty A_int,A_adr)))->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_ind I_addr)]@[I_ins(I_ind I_int)]
|(S_der((id_var,A_name(A_var(A_bty A_bool,A_val))),None),A_name(A_var(A_bty A_bool,A_val)))->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_ind I_int)]
|(S_der((id_var,A_name(A_var(A_bty A_bool,A_adr))),None),A_name(A_var(A_bty A_bool,A_adr)))->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_ind I_addr)]@[I_ins(I_ind I_int)]
|(S_der ((id_var,A_name (A_var (A_arr _, A_val))),Some(a)), A_name (A_var (A_bty A_int,A_val)))->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_dpl I_addr)]@[I_ins(I_ind I_addr)]@(affec_d a pi liste)@[I_ins(I_ixa 1)]@[I_ins(I_sli I_int)]@[I_ins(I_ind I_int)]
|(S_der((id_var,_),_),_)->[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]
|_->[]
;;


(*calcul des parties gauches*)

let affec_g var pi liste =match var with
((id_var,A_name(A_var(A_bty A_int,A_val))),None)->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]
|((id_var,A_name(A_var(A_bty A_bool,A_val))),None)->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]
|((id_var,A_name(A_var(A_bty A_int,A_adr))),None)->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_ind I_addr)]
|((id_var,A_name(A_var(A_bty A_bool,A_adr))),None)->
[I_ins(I_lda((rech id_var pi liste),(5+rech_place id_var pi liste)))]@[I_ins(I_ind I_addr)]
|((id_var,A_name(A_var(A_arr _,A_val))),Some(x))->
[I_ins(I_lda ((rech id_var pi liste), (5 + rech_place id_var pi liste)))]@[I_ins(I_dpl I_addr)]@[I_ins(I_ind I_addr)]@(affec_d x pi liste)@[I_ins(I_ixa 1)]@[I_ins(I_sli I_int)]
|_ -> []
;;


(*declaration d'un tableau dynamique*)

let rec make_arr pi list nb list2=match list with
[]->[]
|(_,S_dbty _)::l->make_arr pi l (nb+1) list2
|(id_var,S_darr ((S_cst(S_num li),_),(S_cst(S_num ui),_),_))::l->
 [I_ins(I_ldc(I_int,li))]@
 [I_ins(I_str(I_int,pi,5+nb+3))]@
 [I_ins(I_ldc(I_int,ui))]@
 [I_ins (I_str (I_int,pi,5+nb+4))]@
 [I_ins (I_str (I_int,pi,5+nb+4))]@
 [I_ins (I_lod (I_int,pi,5+nb+3))]@
 [I_ins (I_sub I_int)]@
 [I_ins (I_inc (I_int,1))]@
 [I_ins (I_ldc (I_int,1))]@ 
 [I_ins (I_mul I_int)]@
 [I_ins (I_str (I_int,pi,5+nb+1))]@
 [I_ins (I_lod (I_int,pi,5+nb+3))]@
 [I_ins (I_str (I_int,pi,5+nb+2))]@
 [I_ins (I_alcd (5+nb))]@(make_arr pi l (nb+5) list2)
|(id_var,S_darr (x,y,_))::l ->
 (affec_d x (pi+1) list2)@
 [I_ins (I_str (I_int,pi,5+nb+3))]@
 (affec_d y (pi+1) list2)@
 [I_ins (I_str (I_int,pi,5+nb+4))]@
 [I_ins (I_lod (I_int,pi,5+nb+4))]@
 [I_ins (I_lod (I_int,pi,5+nb+3))]@
 [I_ins (I_sub I_int)]@
 [I_ins (I_inc (I_int,1))]@
 [I_ins (I_ldc (I_int,1))]@
 [I_ins (I_mul I_int)]@
 [I_ins (I_str (I_int,pi,5+nb+1))]@
 [I_ins (I_lod (I_int,pi,5+nb+3))]@
 [I_ins (I_str (I_int,pi,5+nb+2))]@
 [I_ins (I_alcd (5+nb))]@
 (make_arr pi l (nb+5) list2)

;;


(*calcul de la taille des parametres d'une procedure*)

let rec nb_param liste cpt =match liste with
[]->0
|(S_value,_,S_sarr(_,_,_))::l->(5+(nb_param l (cpt+5)))
|_::l->(1+(nb_param l (cpt+1)))
;;

(*creation de la liste des movd provoque par une liste de parametres*)



let rec lst_movd liste cpt = match liste with
[] -> []
| (S_value, _, S_sarr (_, _, _))::l -> [I_ins (I_movd cpt)]@(lst_movd l (cpt+5))
| _::l ->  lst_movd l (cpt+1)
;;

(*creation de la liste de smovs*)

let lst_movs liste = match liste with
| ((A_arr _),A_val) -> [I_ins (I_movs 5)]
| _ ->  [] 
;;

(*creation de la liste avec profondeur d'imbrication pour des parametres*)

let rec liste_param liste pi = match liste with
[] -> []
|(S_addr, id_var, S_sarr (_, _, _))::l -> [(id_var,pi)]@(liste_param l pi)
|(S_value, id_var, S_sarr (x, y, _))::l -> [(id_var,pi)]@[(id_var,pi)]@[(id_var,pi)]@[(x,pi)]@[(y,pi)]@(liste_param l pi)
|(S_addr, id_var, S_sbty _)::l -> [(id_var,pi)]@(liste_param l pi)
|(S_value, id_var, S_sbty _)::l -> [(id_var,pi)]@(liste_param l pi)
;;


(*decomposition en instruction d'une liste de parametres*)

let rec decomp pi list c_lexpr l_tspec= match (c_lexpr,l_tspec) with
([],[]) -> []
|(_::_,[])->[]
|([],_::_)->[]
| ((S_der((id_var,_),_),_))::a2 , (((A_arr _),A_val)::b2) ->[I_ins(I_lda ((rech id_var pi list), (5 + rech_place id_var pi list)))] @[I_ins (I_movs 5)]@(decomp pi list a2 b2)

| ((S_der((id_var,_),_),_))::a2 , (((A_arr _),A_adr)::b2) ->[I_ins(I_lda ((rech id_var pi list), (5 + rech_place id_var pi list)))] @(decomp pi list a2 b2)

|((S_der ((id_var,A_name (A_var (A_bty _, A_adr))),None), A_name (A_var (A_bty _,A_adr))))::a2, (((A_bty _),A_adr)::b2) ->
[I_ins(I_lda ((rech id_var pi list), (5 + rech_place id_var pi list)))]@(decomp pi list a2 b2)

|((S_der ((id_var,A_name (A_var (A_bty _, A_val))),None), A_name (A_var (A_bty _,A_val))))::a2, (((A_bty _),A_adr)::b2) ->
[I_ins(I_lda ((rech id_var pi list), (5 + rech_place id_var pi list)))]@(decomp pi list a2 b2)

|((S_der ((id_var,A_name (A_var (A_bty _, A_adr))),None), A_name (A_var (A_bty _,A_adr))))::a2, (((A_bty _),A_val)::b2) ->
[I_ins(I_lda ((rech id_var pi list), (5 + rech_place id_var pi list)))]@(decomp pi list a2 b2)

|((S_der ((id_var,A_name (A_var (A_bty _, A_val))),None), A_name (A_var (A_bty _,A_val))))::a2, (((A_bty _),A_val)::b2) ->
[I_ins(I_lda ((rech id_var pi list), (5 + rech_place id_var pi list)))]@(decomp pi list a2 b2)


| (a1::a2 , b1::b2) -> (affec_d a1 pi list)@(decomp pi list a2 b2)

;;


(*Creation de la liste des instructions*)

let rec make_instr l_instr pi list list_proc =
  (*creation du code pour le if then else*)
  let make_ite if1 pi list =
  match if1 with
  (expr1,then1,else1) ->
    begin
      lab := !lab+2 ;
      (affec_d expr1 pi list)@[I_ins (I_fjp ("l"^(string_of_int (!lab-1))))]@(make_instr       [then1] pi list list_proc)@
      [I_ins (I_ujp ("l"^(string_of_int (!lab))))]@[I_lab ("l"^(string_of_int (!lab-1)))]@      (make_instr [else1] pi list list_proc)@
      [I_lab ("l"^(string_of_int (!lab)))]
    end
in
  let make_whi wh1 pi list =
  match wh1 with
  (expr1,whi1) ->
  begin
  lab := !lab+2;
  [(I_lab ("l"^(string_of_int (!lab-1))))]@
  (affec_d expr1 pi list)@[I_ins(I_fjp("l"^(string_of_int (!lab))))]@
  (make_instr [whi1] pi list list_proc)
  @[I_ins (I_ujp ("l"^(string_of_int (!lab-1))))]@
  [(I_lab ("l"^(string_of_int (!lab))))]
  end
in

  let make_cal cal pi list= match cal with
  ((id_var, A_name (A_proc l_tspec)), c_lexpr) -> 
  [I_ins (I_mst (rech id_var (pi+1) list_proc))]@
  (decomp pi list c_lexpr l_tspec)

  @[I_ins(I_cup((nb_elt l_tspec), ("l_"^id_var)))]
  |(_,_) -> []

in
  match l_instr with
  [] -> []
  | (S_aff(x,y))::k -> (affec_g x pi list)@(affec_d y pi list)@[I_ins(I_sto I_int)]
                     @(make_instr k pi list list_proc)
  | (S_ite(x,y,z))::k -> (make_ite (x,y,z) pi list)
                        @(make_instr k pi list list_proc)
  | (S_whi(x,y))::k -> (make_whi (x,y) pi list)
                     @(make_instr k pi list list_proc )
  | (S_lst(x))::k ->  (make_instr x pi list list_proc)@(make_instr k pi list list_proc)
  | (S_cal(x,y))::k -> (make_cal (x,y) pi list)@(make_instr k pi list list_proc)
;;


(*Creation des procedures*)

let rec make_proc proc pi list listp = let label = !lab+1 in match proc with
[] -> []
|(id_var,p_spec, S_blk(list_var, list_proc, liste_instr))::l ->lab:=!lab+1;
  [I_lab ("l_"^id_var)]@[I_ins (I_ssp (5 + (nb_param p_spec 5) + (taille_var_loc list_var)))]@(lst_movd p_spec 5)@
(make_arr 0 list_var (nb_param p_spec 0)  (list@(liste_param p_spec pi)))@
  [I_ins (I_sep 0)]@[I_ins (I_ujp ("l"^(string_of_int(label+1))))]@
(make_proc list_proc (pi+1) (liste_var pi (liste_var pi (list@(liste_param p_spec pi)) list_var) list_var) (lstproc pi listp list_proc))@
  [I_lab ("l"^string_of_int(label+1))]@
(make_instr liste_instr pi (liste_var pi (list@(liste_param p_spec pi)) list_var) (lstproc (pi+1) listp list_proc) )@
  [I_ins (I_retp)]@
(make_proc l  pi list (lstproc pi listp list_proc))
;;


(* generation du code*)

let code source =
  match source with
    (_,S_blk(vdecl,pdecl,body)) ->
      [I_ins (I_ssp (5 + (taille_var vdecl)))]@
      (make_arr 0 vdecl 0 [])@
      [I_ins (I_sep 0)]@
      [I_ins (I_ujp "l0")]@
      (make_proc pdecl 1 (liste_var 0 [] vdecl) (lstproc 1 [] pdecl) )@
      [I_lab "l0"]@
      (make_instr body 0 (liste_var 0 [] vdecl) (lstproc 1 [] pdecl))@
      [I_ins (I_stp)]
;;