diff options
| -rw-r--r-- | src/vhdl/disp_vhdl.adb | 83 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 1 | ||||
| -rw-r--r-- | src/vhdl/sem_expr.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 17 |
4 files changed, 42 insertions, 61 deletions
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index b803a1c37..df4b071a5 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -2575,28 +2575,6 @@ package body Disp_Vhdl is end loop; end Disp_Choice; - -- Build an array of lexical appareance of choices in CHAIN. - -- (They have been re-ordered during analysis). - procedure Build_Choice_Order (Chain : Iir; Arr : out Iir_Array_Acc) - is - Count : Natural; - Assoc : Iir; - begin - Assoc := Chain; - Count := 0; - while Assoc /= Null_Iir loop - Count := Count + 1; - Assoc := Get_Chain (Assoc); - end loop; - Arr := new Iir_Array (0 .. Count - 1); - - Assoc := Chain; - while Assoc /= Null_Iir loop - Arr (Natural (Get_Choice_Position (Assoc))) := Assoc; - Assoc := Get_Chain (Assoc); - end loop; - end Build_Choice_Order; - -- EL_TYPE is Null_Iir for record aggregates. procedure Disp_Aggregate_1 (Aggr: Iir_Aggregate; Index : Positive; El_Type : Iir) @@ -2604,8 +2582,7 @@ package body Disp_Vhdl is Indent : Count; Assoc : Iir; Expr : Iir; - Prev_Expr : Iir; - Choices : Iir_Array_Acc; + Is_First : Boolean; begin Indent := Col + 1; if Indent > Line_Length - 10 then @@ -2613,44 +2590,44 @@ package body Disp_Vhdl is end if; Put ("("); Assoc := Get_Association_Choices_Chain (Aggr); - Build_Choice_Order (Assoc, Choices); - Prev_Expr := Null_Iir; - for I in Choices'Range loop - Assoc := Choices (I); - Expr := Get_Associated_Expr (Assoc); - pragma Assert (Expr /= Null_Iir); - if Expr = Prev_Expr then - Put (" | "); - elsif I /= Choices'First then + Is_First := True; + while Assoc /= Null_Iir loop + if Is_First then + Is_First := False; + else Put (", "); end if; + pragma Assert (not Get_Same_Alternative_Flag (Assoc)); + Expr := Get_Associated_Expr (Assoc); Disp_A_Choice (Assoc); - if I = Choices'Last - or else Expr /= Get_Associated_Expr (Choices (I + 1)) - then - if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then - Put (" => "); + if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then + Assoc := Get_Chain (Assoc); + while Assoc /= Null_Iir + and then Get_Same_Alternative_Flag (Assoc) + loop + Put (" | "); + Disp_A_Choice (Assoc); + Assoc := Get_Chain (Assoc); + end loop; + Put (" => "); + else + Assoc := Get_Chain (Assoc); + end if; + if Index > 1 then + Set_Col (Indent); + if Get_Kind (Expr) = Iir_Kind_String_Literal8 then + Disp_String_Literal (Expr, El_Type); + else + Disp_Aggregate_1 (Expr, Index - 1, El_Type); end if; - - if Index > 1 then + else + if Get_Kind (Expr) = Iir_Kind_Aggregate then Set_Col (Indent); - if Get_Kind (Expr) = Iir_Kind_String_Literal8 then - Disp_String_Literal (Expr, El_Type); - else - Disp_Aggregate_1 (Expr, Index - 1, El_Type); - end if; - else - if Get_Kind (Expr) = Iir_Kind_Aggregate then - Set_Col (Indent); - end if; - Disp_Expression (Expr); end if; + Disp_Expression (Expr); end if; - Prev_Expr := Expr; end loop; Put (")"); - - Free (Choices); end Disp_Aggregate_1; procedure Disp_Aggregate (Aggr: Iir_Aggregate) diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index af5c4c1b7..30aadc38b 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -567,6 +567,7 @@ package Iirs is -- * a sequential statement chain for a case_statement. -- Get/Set_Associated_Chain (Field4) -- + -- Set when share the same association as the previous one. -- Get/Set_Same_Alternative_Flag (Flag1) -- -- For aggregates: if True, associated expression is for one element. diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index f22ccb2b9..ff9cb177f 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -2962,7 +2962,7 @@ package body Sem_Expr is end if; Sem_Check_Continuous_Choices (Choice_Chain, Choice_Type, Low, High, Loc, - Is_Sub_Range, not Is_Case_Stmt); + Is_Sub_Range, False); -- not Is_Case_Stmt); end Sem_Choices_Range; -- Perform semantisation on a (sub)aggregate AGGR, which is of type diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index fa1f5a0b4..e8034ffda 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -2942,9 +2942,8 @@ package body Trans.Chap7 is -- Assign EXPR to current position (defined by index VAR_INDEX), and -- update VAR_INDEX. Handles sub-aggregates. - procedure Do_Assign (Assoc : Iir) + procedure Do_Assign (Assoc : Iir; Expr : Iir) is - Expr : constant Iir := Get_Associated_Expr (Assoc); Dest : Mnode; Len : Iir_Int64; begin @@ -2988,7 +2987,7 @@ package body Trans.Chap7 is loop exit when El = Null_Iir; exit when Get_Kind (El) /= Iir_Kind_Choice_By_None; - Do_Assign (El); + Do_Assign (El, Get_Associated_Expr (El)); if not Final or else Get_Element_Type_Flag (El) then P := P + 1; else @@ -3036,7 +3035,7 @@ package body Trans.Chap7 is New_Lit (Ghdl_Index_0), Ghdl_Bool_Type)); - Do_Assign (El); + Do_Assign (El, Get_Associated_Expr (El)); Dec_Var (Var_Len); Finish_Loop_Stmt (Label); Close_Temp; @@ -3058,7 +3057,7 @@ package body Trans.Chap7 is -- Handled by positional. raise Internal_Error; when Iir_Kind_Choice_By_Expression => - Do_Assign (El); + Do_Assign (El, Get_Associated_Expr (El)); return; when Iir_Kind_Choice_By_Range => declare @@ -3078,7 +3077,7 @@ package body Trans.Chap7 is New_Obj_Value (Var_I), New_Obj_Value (Var_Length), Ghdl_Bool_Type)); - Do_Assign (El); + Do_Assign (El, Get_Associated_Expr (El)); Inc_Var (Var_I); Finish_Loop_Stmt (Label); Close_Temp; @@ -3100,6 +3099,7 @@ package body Trans.Chap7 is Case_Blk : O_Case_Block; Label : O_Snode; Len_Tmp : O_Enode; + Expr : Iir; begin Open_Temp; -- Create a loop from left +- number of positionnals associations @@ -3135,7 +3135,10 @@ package body Trans.Chap7 is Start_Choice (Case_Blk); Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk); Finish_Choice (Case_Blk); - Do_Assign (El); + if not Get_Same_Alternative_Flag (El) then + Expr := Get_Associated_Expr (El); + end if; + Do_Assign (El, Expr); El := Get_Chain (El); end loop; Finish_Case_Stmt (Case_Blk); |