PreviousUpNext

15.4.184  src/lib/c-kit/src/ast/initializer-normalizer.pkg

## initializer-normalizer.pkg
## AUTHORS: Dino Oliva (oliva@research.bell-labs.com)

# Compiled by:
#     src/lib/c-kit/src/ast/ast.sublib

package initializer_normalizer: (weak)  Set_Up_Normalizer {             # Set_Up_Normalizer     is from   src/lib/c-kit/src/ast/initializer-normalizer.api
    #
    package raw_syntax = raw_syntax;
    package b= namings;                                                 # namings               is from   src/lib/c-kit/src/ast/bindings.pkg

    include raw_syntax;

    exception NORMALIZE_EXCEPTION;

    fun fail msg
        =
        {   print msg;
            raise exception NORMALIZE_EXCEPTION;
        };

    # Does this signal an internal "compiler bug"?
    # only acts as a warning, since normalize acts as an identity
    # on the expression if this is called.

    fun warn msg
        =
        {   print msg;
            ();
        };

    int_ct
        =
        raw_syntax::NUMERIC
          ( raw_syntax::NONSATURATE,
            raw_syntax::WHOLENUM,
            raw_syntax::SIGNED,
            raw_syntax::INT,
            raw_syntax::SIGNASSUMED
          );

    char_ct
        =
        raw_syntax::NUMERIC
          ( raw_syntax::NONSATURATE,
            raw_syntax::WHOLENUM,
            raw_syntax::UNSIGNED,
            raw_syntax::CHAR,
            raw_syntax::SIGNASSUMED
          );

    # David B MacQueen:
    #     The bindAid function introduces
    #     new aid mappings in the atab state
    #     component.

    # This takes the type of a declaration
    # and the initializer and massages the
    # initializer so that it exactly matches
    # the type of declaration.  It is called
    # in BuildRawSyntaxTree.
    #
    fun normalize
        {
          get_tid: tid::Uid -> Null_Or( namings::Tid_Naming ),
          bind_aid: raw_syntax::Ctype -> aid::Uid,
          init_type: raw_syntax::Ctype,
          init_expr: raw_syntax::Init_Expression
        }
        : raw_syntax::Init_Expression
        =
        {   fun core_expression2expression (ctype, core_expression)
                = 
                {   aid = bind_aid ctype;
                    EXPRESSION (core_expression, aid, line_number_db::UNKNOWN);
                };

            fun make_chr_init c
                =
                SIMPLE (core_expression2expression (char_ct, (INT_CONST (large_int::from_int (char::to_int c)))));

            fun make_int_init i
                = 
                SIMPLE (core_expression2expression (int_ct, (INT_CONST (i: large_int::Int))));

            fun make_chrs (NULL,  []    ) =>  [];
                make_chrs (THE c, []    ) =>  [ make_chr_init c ];
                make_chrs (c_opt, c ! cs) =>  make_chr_init c ! make_chrs (c_opt, cs);
            end;

            # padding out with zero (via scalarNorm)
            # when too few initializers.
            # as per [ISO-C, p.72-73]
            #
            fun arr_norm (arr_type, raw_syntax::QUAL (_, ctype), max_op) orig_inits     # strip qual 
                    =>
                    arr_norm (arr_type, ctype, max_op) orig_inits; 

                arr_norm (arr_type, raw_syntax::TYPE_REF tid, max_op) orig_inits        # Dereference type REF 
                    =>
                    case (get_tid tid)

                         THE { ntype => THE (b::TYPEDEFX (tid, ctype)), ... }
                             => 
                             arr_norm (arr_type, ctype, max_op) orig_inits;

                           _ => fail "Inconsistent table for type REF";
                    esac;

                arr_norm (arr_type, raw_syntax::NUMERIC(_, _, _, raw_syntax::CHAR, _), max_op)
                        (SIMPLE (EXPRESSION (STRING_CONST s, aid, loc)) ! rest)
                    =>
                    # Secial case for character arrays initialized w/strings 
                    #
                    {   len = (string::length s) + 1; #  size of c string 

                        max = case max_op
                                  THE l => large_int::to_int l;
                                  _     => len;
                              esac;

                        null_opt =  if (len == max + 1)  NULL;
                                    else                 THE '\000';
                                    fi;

                        char_inits
                            =
                            make_chrs (null_opt, explode s);

                        norm (arr_type, (AGGREGATE char_inits) ! rest);
                    };

                arr_norm (arr_type, base_type, max_op) orig_inits
                    =>
                    {   max = case max_op   
                                  THE l => large_int::to_int l;
                                  _     => length orig_inits;
                              esac;

                        fun loop (i, inits)
                            = 
                            if   (i==max)

                                 ([], inits);
                            else
                                 my (elem_init,  remainder ) =  norm (base_type, inits);
                                 my (elem_inits, remainder') =  loop (i+1, remainder);

                                 (elem_init ! elem_inits, remainder');
                            fi;

                        my (array_inits, remainder)
                            =
                            loop (0, orig_inits);

                        (AGGREGATE array_inits, remainder);
                    };
            end 

            also
            fun struct_norm (struct_type, fields) orig_inits
                =
                {   fun loop [] inits
                            =>
                            ([], inits);

                        loop ((field_type, NULL, li_opt) ! fields) inits
                            =>
                            # According to the standard, unnamed fields don't
                            # have initializers.
                            #
                            loop fields inits;

                        loop ((field_type, pid_opt, li_opt) ! fields) inits
                            =>
                            {   my (field_init,  remainder ) =  norm (field_type, inits);
                                my (field_inits, remainder') =  loop fields remainder;

                                (field_init ! field_inits, remainder');
                            };
                    end;

                    my (struct_inits, remainder)
                        =
                        loop fields orig_inits;

                    (AGGREGATE struct_inits, remainder);
                }


            also
            fun union_norm (union_type, fields) orig_inits
                = 
                case fields

                     []  => {   warn "Empty union type, initializing to {}";
                                (AGGREGATE [], orig_inits);
                            };

                     (field_ctype, member) ! _
                         =>
                         {   my (field_init, remainder)
                                 =
                                 norm (field_ctype, orig_inits);

                             (AGGREGATE [field_init], remainder);
                         };
                esac

            #  fill in with zeros if you run out of initializers 
            also
            fun scalar_norm ctype orig_inits
                =
                case orig_inits

                    (scalar_init ! remainder)
                        =>
                        (scalar_init, remainder);

                    []  => {   scalar_init = make_int_init 0;
                               (scalar_init, []);
                           };
                esac


            # feed supplies its argument initfn
            # with the inits from the first aggregate,
            # if there is one.  The initfn should
            # consume all the inits from the aggregate.
            #
            also
            fun feed (initfn, (AGGREGATE elem_inits) ! inits)
                    =>
                    {   my (newinit, remainder)
                            =
                            initfn elem_inits;

                        case remainder

                             [] => (newinit, inits);

                              _ => {   warn "Too many initializers for expression, ignoring extras";
                                       (newinit, inits);
                                   };
                        esac;
                    };

                feed (initfn, inits)
                    =>
                    initfn inits;
            end 

            also
            fun norm (ctype, inits)
                = 
                case ctype

                    raw_syntax::QUAL (_, ctype)
                        =>
                        norm (ctype, inits);            #  strip qual 

                    raw_syntax::TYPE_REF tid            #  Dereference type REF 
                        =>
                        case (get_tid tid)

                            THE { ntype => THE (b::TYPEDEFX (tid, ctype)), ... }
                                => 
                                norm (ctype, inits);

                            _   => fail "Inconsistent table for type REF";
                        esac;

                    raw_syntax::ARRAY (opt, base_type)
                        =>
                        {   len_op = case opt
                                         THE (i, _) => THE i;
                                         NULL       => NULL;
                                     esac;

                            feed (arr_norm (ctype, base_type, len_op), inits);
                        };

                    raw_syntax::STRUCT_REF tid
                        =>
                        case (get_tid tid)

                            THE { ntype => THE (b::STRUCT (tid, fields)), ... }
                                =>
                                feed (struct_norm (ctype, fields), inits);

                            THE _ =>  fail "Incomplete type for struct REF";
                            NULL  =>  fail "Inconsistent table for struct REF";
                        esac;

                    raw_syntax::UNION_REF tid
                        =>
                        case (get_tid tid)

                            THE { ntype => THE (b::UNION (tid, fields)), ... }
                                =>
                                feed (union_norm (ctype, fields), inits);

                            THE _ => fail "Incomplete type for union REF";
                            NULL  => fail "Inconsistent table for union REF";
                        esac;

                    ( raw_syntax::NUMERIC _
                    | raw_syntax::POINTER _
                    | raw_syntax::FUNCTION _
                    | raw_syntax::ENUM_REF _
                    )   =>
                        feed (scalar_norm ctype, inits);

                    raw_syntax::VOID     => fail "Incomplete type: void";
                    raw_syntax::ELLIPSES => fail "Cannot initialize ellipses";
                    raw_syntax::ERROR    => fail "Cannot initialize error type";
                esac;



            {   my (newinit, remainder)
                    =
                    norm (init_type, [init_expr]);

                case remainder

                    [] => newinit;  # Used them all. 

                    _  => {   warn "Too many initializers for expression, ignoring extras";
                              newinit;
                          };
                esac;
            }
            except
                NORMALIZE_EXCEPTION = init_expr;


        };                      # fun normalize 

};                              # package initializer_normalizer 


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext