Changeset 28f8f15


Ignore:
Timestamp:
Apr 27, 2023, 3:13:24 PM (11 months ago)
Author:
JiadaL <j82liang@…>
Branches:
ADT
Children:
561354f
Parents:
b110bcc
Message:

Save progress

Location:
src
Files:
16 edited

Legend:

Unmodified
Added
Removed
  • src/AST/Convert.cpp

    rb110bcc r28f8f15  
    321321                        get<Type>().accept1(node->base)
    322322                );
     323                decl->data_constructors = get<StructDecl>().acceptL( node->data_constructors );
     324                decl->data_union = get<UnionDecl>().accept1( node->data_union );
     325                decl->tags = get<EnumDecl>().accept1( node->tag );
     326                decl->tag_union = get<StructDecl>().accept1( node->tag_union );
    323327                return aggregatePostamble( decl, node );
    324328        }
  • src/AST/Decl.cpp

    rb110bcc r28f8f15  
    132132
    133133// These must harmonize with the corresponding AggregateDecl::Aggregate enumerations.
    134 static const char * aggregateNames[] = { "struct", "union", "enum", "exception", "trait", "generator", "coroutine", "monitor", "thread", "NoAggregateName" };
     134static const char * aggregateNames[] = { "struct", "union", "enum", "exception", "trait", "generator", "coroutine", "monitor", "thread", "NoAggregateName", "data" };
    135135
    136136const char * AggregateDecl::aggrString( AggregateDecl::Aggregate aggr ) {
  • src/AST/Decl.hpp

    rb110bcc r28f8f15  
    248248class AggregateDecl : public Decl {
    249249public:
    250         enum Aggregate { Struct, Union, Enum, Exception, Trait, Generator, Coroutine, Monitor, Thread, NoAggregate };
     250        enum Aggregate { Struct, Union, Enum, Exception, Trait, Generator, Coroutine, Monitor, Thread, NoAggregate, ADT };
    251251        static const char * aggrString( Aggregate aggr );
    252252
     
    286286        bool is_monitor  () const { return kind == Monitor  ; }
    287287        bool is_thread   () const { return kind == Thread   ; }
     288        bool is_adt              () const { return kind == ADT          ; }
    288289
    289290        const Decl * accept( Visitor & v ) const override { return v.visit( this ); }
     
    320321        enum class EnumHiding { Visible, Hide } hide;
    321322
     323        std::vector<ptr<StructDecl>> data_constructors;
     324        bool isData = false;
     325        ptr<UnionDecl> data_union;
     326        ptr<EnumDecl> tag;
     327        ptr<StructDecl> tag_union;
     328
    322329        EnumDecl( const CodeLocation& loc, const std::string& name, bool isTyped = false,
    323330                std::vector<ptr<Attribute>>&& attrs = {}, Linkage::Spec linkage = Linkage::Cforall,
    324                 Type const * base = nullptr, EnumHiding hide = EnumHiding::Hide,
     331                Type const * base = nullptr, EnumHiding hide = EnumHiding::Visible,
    325332                std::unordered_map< std::string, long long > enumValues = std::unordered_map< std::string, long long >() )
    326333        : AggregateDecl( loc, name, std::move(attrs), linkage ), isTyped(isTyped), base(base), hide(hide), enumValues(enumValues) {}
  • src/AST/Pass.impl.hpp

    rb110bcc r28f8f15  
    693693                        maybe_accept( node, &EnumDecl::members    );
    694694                        maybe_accept( node, &EnumDecl::attributes );
     695                        maybe_accept( node, &EnumDecl::data_constructors );
     696                        maybe_accept( node, &EnumDecl::data_union );
     697                        maybe_accept( node, &EnumDecl::tag );
     698                        maybe_accept( node, &EnumDecl::tag_union );
    695699                } else {
    696700                        maybe_accept( node, &EnumDecl::base );
     
    698702                        maybe_accept( node, &EnumDecl::members    );
    699703                        maybe_accept( node, &EnumDecl::attributes );
     704                        maybe_accept( node, &EnumDecl::data_constructors );
     705                        maybe_accept( node, &EnumDecl::data_union );
     706                        maybe_accept( node, &EnumDecl::tag );
     707                        maybe_accept( node, &EnumDecl::tag_union );
    700708                }
    701709        }
  • src/CodeGen/CodeGenerator.cc

    rb110bcc r28f8f15  
    295295        }
    296296
     297        void CodeGenerator::handleData( EnumDecl * dataDecl ) {
     298                output << " /** data type */" << endl;
     299                for ( StructDecl * decl : dataDecl->data_constructors ) {
     300                        postvisit(decl);
     301                        output << ";" << endl;
     302                }
     303                postvisit( dataDecl->data_union );
     304                output << ";" << endl;
     305                postvisit( dataDecl->tags );
     306                output << ";" << endl;
     307                postvisit( dataDecl->tag_union );
     308                output << ";" << endl;
     309        }
     310
    297311        void CodeGenerator::postvisit( EnumDecl * enumDecl ) {
    298                 extension( enumDecl );
     312                if ( enumDecl->data_constructors.size() > 0 ) return handleData( enumDecl );
     313                extension( enumDecl );
    299314                std::list< Declaration* > &memb = enumDecl->get_members();
    300315                if (enumDecl->base && ! memb.empty()) {
  • src/CodeGen/CodeGenerator.h

    rb110bcc r28f8f15  
    165165                void handleTypedef( NamedTypeDecl *namedType );
    166166                std::string mangleName( DeclarationWithType * decl );
     167
     168                void handleData( EnumDecl * EnumDecl );
    167169        }; // CodeGenerator
    168170
  • src/Common/PassVisitor.impl.h

    rb110bcc r28f8f15  
    754754
    755755        // unlike structs, traits, and unions, enums inject their members into the global scope
    756         // if ( node->base ) maybeAccept_impl( node->base, *this ); // Need this? Maybe not?
     756        maybeAccept_impl( node->data_constructors, *this );
     757        maybeAccept_impl( node->data_union, *this );
     758        maybeAccept_impl( node->tags, *this );
    757759        maybeAccept_impl( node->parameters, *this );
    758760        maybeAccept_impl( node->members   , *this );
  • src/Parser/DeclarationNode.cc

    rb110bcc r28f8f15  
    279279} // DeclarationNode::newEnum
    280280
     281DeclarationNode * DeclarationNode::newADT( const string * name, DeclarationNode * constructors ) {
     282        DeclarationNode * newnode = newEnum( name, nullptr, true, false );
     283        newnode->type->enumeration.isData = true;
     284        newnode->type->enumeration.data_constructors = constructors;
     285        return newnode;
     286}
     287
     288
    281289DeclarationNode * DeclarationNode::newName( const string * name ) {
    282290        DeclarationNode * newnode = new DeclarationNode;
     
    305313        } // if
    306314} // DeclarationNode::newEnumValueGeneric
     315
     316DeclarationNode * DeclarationNode::newDataConstructor( const string * name ) {
     317        DeclarationNode * newnode = newName(name);
     318        return newnode;
     319}
    307320
    308321DeclarationNode * DeclarationNode::newEnumInLine( const string name ) {
     
    10831096        }
    10841097        return nullptr;
     1098}
     1099
     1100void buildDataConstructors( DeclarationNode * firstNode, std::vector<ast::ptr<ast::StructDecl>> & outputList ) {
     1101        std::back_insert_iterator<std::vector<ast::ptr<ast::StructDecl>>> out( outputList );
     1102        for ( const DeclarationNode * cur = firstNode; cur; cur = strict_next( cur ) ) {
     1103                // td->kind == TypeData::Symbolic
     1104                assert( cur->type->kind == TypeData::Symbolic );
     1105                const std::string * name = cur->name;
     1106                auto ctor = new ast::StructDecl( cur->location,
     1107                        std::string(*name),
     1108                        ast::AggregateDecl::Aggregate::Struct
     1109                );
     1110                ctor->set_body(true);
     1111                TypeData * td = cur->type;
     1112                TypeData::Symbolic_t st = td->symbolic;
     1113                DeclarationNode * params = st.params;
     1114               
     1115                if ( params ) {
     1116                        buildList( params, ctor->members );
     1117                }
     1118
     1119                for ( std::size_t i = 0; i < ctor->members.size(); ++i ) {
     1120                        assert(ctor->members[i]->name == "");
     1121                        ast::Decl * member = ctor->members[i].get_and_mutate();
     1122                        member->name = "field_" + std::to_string(i);
     1123                }
     1124                *out++ = ctor;         
     1125        }
     1126}
     1127
     1128ast::UnionDecl * buildDataUnion( ast::EnumDecl * data, const std::vector<ast::ptr<ast::StructDecl>> & typeList ) {
     1129        ast::UnionDecl * out = new ast::UnionDecl( data->location, "temp_data_union" );
     1130        // size_t index = 0;
     1131        if ( typeList.size() > 0 ) out->set_body( true );
     1132        size_t i = 0;
     1133        for (const ast::ptr<ast::StructDecl> structDecl : typeList ) {
     1134                ast::StructInstType * inst = new ast::StructInstType(structDecl);
     1135                ast::ObjectDecl * instObj = new ast::ObjectDecl(
     1136                        structDecl->location,
     1137                        "option_" + std::to_string(i),
     1138                        inst
     1139                );
     1140                i++;
     1141                out->members.push_back( instObj );
     1142
     1143        }
     1144        return out;
     1145}
     1146
     1147ast::EnumDecl * buildTag( ast::EnumDecl * data, const std::vector<ast::ptr<ast::StructDecl>> & typeList ) {
     1148        ast::EnumDecl * out = new ast::EnumDecl( data->location, "temp_data_tag" );
     1149        if ( typeList.size() > 0 ) out->set_body( true );
     1150        for ( const ast::ptr<ast::StructDecl> structDecl : typeList ) {
     1151                ast::EnumInstType * inst = new ast::EnumInstType( out );
     1152                assert( inst->base != nullptr );
     1153                ast::ObjectDecl * instObj = new ast::ObjectDecl(
     1154                        structDecl->location,
     1155                        structDecl->name,
     1156                        inst
     1157                );
     1158                out->members.push_back( instObj );
     1159        }
     1160        return out;
     1161}
     1162
     1163ast::StructDecl * buildTaggedUnions( const ast::EnumDecl * data, const ast::EnumDecl * tags, const ast::UnionDecl * data_union ) {
     1164        assert( tags->members.size() == data_union->members.size() );
     1165        ast::StructDecl * out = new ast::StructDecl( data->location, data->name );
     1166        out->kind = ast::AggregateDecl::ADT;
     1167
     1168        out->set_body( true );
     1169
     1170        ast::EnumInstType * tag = new ast::EnumInstType( tags );
     1171        ast::ObjectDecl * tag_obj = new ast::ObjectDecl(
     1172                data->location,
     1173                "tag",
     1174                tag
     1175        );
     1176        ast::UnionInstType * value = new ast::UnionInstType( data_union );
     1177        ast::ObjectDecl * value_obj = new ast::ObjectDecl(
     1178                data->location,
     1179                "value",
     1180                value
     1181        );
     1182
     1183        out->members.push_back( value_obj );
     1184        out->members.push_back( tag_obj );
     1185        return out;
    10851186}
    10861187
  • src/Parser/DeclarationNode.h

    rb110bcc r28f8f15  
    7676        static DeclarationNode * newStaticAssert( ExpressionNode * condition, ast::Expr * message );
    7777
     78        // Experimental algebric data type
     79        static DeclarationNode * newADT( const std::string * name, DeclarationNode * constructors );
     80        static DeclarationNode * newDataConstructor( const std::string * name );
     81        // static DeclarationNode * newDataConstructor( const std::string * name, DeclarationNode * typeSpecifiers );
     82
    7883        DeclarationNode();
    7984        ~DeclarationNode();
     
    156161        ExpressionNode * bitfieldWidth = nullptr;
    157162        std::unique_ptr<ExpressionNode> enumeratorValue;
     163
    158164        bool hasEllipsis = false;
    159165        ast::Linkage::Spec linkage;
     
    210216void buildList( DeclarationNode * firstNode, std::vector<ast::ptr<ast::DeclWithType>> & outputList );
    211217void buildTypeList( const DeclarationNode * firstNode, std::vector<ast::ptr<ast::Type>> & outputList );
     218void buildDataConstructors( DeclarationNode * firstNode, std::vector<ast::ptr<ast::StructDecl>> & outputList );
     219ast::UnionDecl * buildDataUnion( ast::EnumDecl * data, const std::vector<ast::ptr<ast::StructDecl>> & typeList );
     220ast::EnumDecl * buildTag( ast::EnumDecl * data, const std::vector<ast::ptr<ast::StructDecl>> & typeList );
     221ast::StructDecl * buildTaggedUnions( const ast::EnumDecl * data, const ast::EnumDecl * tags, const ast::UnionDecl * data_union );
    212222
    213223template<typename AstType, typename NodeType,
  • src/Parser/TypeData.cc

    rb110bcc r28f8f15  
    12601260        );
    12611261        buildList( td->enumeration.constants, ret->members );
     1262        if ( td->enumeration.data_constructors != nullptr ) {
     1263                buildDataConstructors( td->enumeration.data_constructors, ret->data_constructors );
     1264                ret->data_union = buildDataUnion( ret, ret->data_constructors );
     1265                ret->tag = buildTag( ret, ret->data_constructors );
     1266                ret->tag_union = buildTaggedUnions( ret, ret->tag.get(), ret->data_union.get() );
     1267        }
     1268
     1269        if ( ret->data_constructors.size() > 0 ) ret->isData = true;
    12621270        auto members = ret->members.begin();
    12631271        ret->hide = td->enumeration.hiding == EnumHiding::Hide ? ast::EnumDecl::EnumHiding::Hide : ast::EnumDecl::EnumHiding::Visible;
  • src/Parser/TypeData.h

    rb110bcc r28f8f15  
    2525struct TypeData {
    2626        enum Kind { Basic, Pointer, Reference, Array, Function, Aggregate, AggregateInst, Enum, EnumConstant, Symbolic,
    27                                 SymbolicInst, Tuple, Basetypeof, Typeof, Vtable, Builtin, GlobalScope, Qualified, Unknown };
     27                                SymbolicInst, Tuple, Basetypeof, Typeof, Vtable, Builtin, GlobalScope, Qualified, ADT, Ctor, Unknown };
    2828
    2929        struct Aggregate_t {
     
    5858                bool typed;
    5959                EnumHiding hiding;
     60                bool isData = false;
     61
     62                DeclarationNode * data_constructors = nullptr;
     63        };
     64
     65        struct ADT_t {
     66                const std::string * name = nullptr;
     67                DeclarationNode * constructors;
     68        };
     69
     70        struct Constructor_t {
     71                const std::string * name;
     72                DeclarationNode * type; // types?
    6073        };
    6174
     
    98111        Array_t array;
    99112        Enumeration_t enumeration;
     113        ADT_t adt;
     114        Constructor_t data_constructor;
     115
    100116        Function_t function;
    101117        Symbolic_t symbolic;
  • src/Parser/lex.ll

    rb110bcc r28f8f15  
    353353with                    { KEYWORD_RETURN(WITH); }                               // CFA
    354354zero_t                  { NUMERIC_RETURN(ZERO_T); }                             // CFA
     355_DATA_            { KEYWORD_RETURN(DATA); }                             // Experimental
    355356
    356357                                /* identifier */
  • src/Parser/parser.yy

    rb110bcc r28f8f15  
    339339%token SIZEOF TYPEOF VA_LIST VA_ARG AUTO_TYPE                   // GCC
    340340%token OFFSETOF BASETYPEOF TYPEID                                               // CFA
    341 %token ENUM STRUCT UNION
     341%token ENUM STRUCT UNION DATA
    342342%token EXCEPTION                                                                                // CFA
    343343%token GENERATOR COROUTINE MONITOR THREAD                               // CFA
     
    453453%type<decl> enumerator_list enum_type enum_type_nobody
    454454%type<init> enumerator_value_opt
     455
     456%type<decl> value_list
     457%type<decl> data_constructor type_specifier_list
    455458
    456459%type<decl> external_definition external_definition_list external_definition_list_opt
     
    24412444                }
    24422445        | enum_type
     2446        /* | algebric_data_type */
    24432447        ;
    24442448
     
    26942698                }
    26952699        | enum_type_nobody
    2696         ;
     2700        | DATA identifier
     2701        { typedefTable.makeTypedef( *$2 ); }
     2702         '{' value_list '}'
     2703         {
     2704                $$ = DeclarationNode::newADT( $2, $5 );
     2705         }
     2706        ;
     2707
     2708value_list:
     2709        data_constructor
     2710        {
     2711                $$ = $1;
     2712        }
     2713        /* | identifier_or_type_name '(' type_specifier ')'
     2714        {
     2715                $$ = DeclarationNode::newEnumValueGeneric( $1, nullptr );
     2716        } */
     2717        /* | data_constructor '|' value_list   */
     2718        | value_list '|' data_constructor
     2719        {
     2720                 { $$ = $1->appendList( $3 ); }
     2721        }
     2722        ;
     2723
     2724data_constructor:
     2725        identifier_or_type_name
     2726        {
     2727                typedefTable.makeTypedef( *$1 );
     2728                $$ =  DeclarationNode::newTypeDecl( $1, nullptr );;
     2729        }
     2730        | identifier_or_type_name '(' type_specifier_list ')'
     2731        {
     2732                typedefTable.makeTypedef( *$1 );
     2733                $$ = DeclarationNode::newTypeDecl( $1, $3 );
     2734        }
     2735
     2736type_specifier_list:
     2737        type_specifier
     2738        /* | type_specifier ',' type_specifier_list  */
     2739        | type_specifier_list ',' type_specifier
     2740        {
     2741                $$ = $1->appendList($3);
     2742        }
     2743        ;
     2744
    26972745
    26982746hide_opt:
  • src/SynTree/AggregateDecl.cc

    rb110bcc r28f8f15  
    2929
    3030// These must harmonize with the corresponding AggregateDecl::Aggregate enumerations.
    31 static const char * aggregateNames[] = { "struct", "union", "enum", "exception", "trait", "generator", "coroutine", "monitor", "thread", "NoAggregateName" };
     31static const char * aggregateNames[] = { "struct", "union", "enum", "exception", "trait", "generator", "coroutine", "monitor", "thread", "NoAggregateName", "data" };
    3232
    3333const char * AggregateDecl::aggrString( AggregateDecl::Aggregate aggr ) {
  • src/SynTree/Declaration.h

    rb110bcc r28f8f15  
    268268        typedef Declaration Parent;
    269269  public:
    270         enum Aggregate { Struct, Union, Enum, Exception, Trait, Generator, Coroutine, Monitor, Thread, NoAggregate };
     270        enum Aggregate { Struct, Union, Enum, Exception, Trait, Generator, Coroutine, Monitor, Thread, NoAggregate, ADT };
    271271        static const char * aggrString( Aggregate aggr );
    272272
     
    341341        Type * base;
    342342        enum EnumHiding { Visible, Hide } hide;
     343
     344        std::list<StructDecl*> data_constructors;
     345        UnionDecl * data_union;
     346        EnumDecl * tags;
     347        StructDecl * tag_union;
    343348
    344349        EnumDecl( const std::string & name,
  • src/Validate/Autogen.cpp

    rb110bcc r28f8f15  
    125125        // Built-ins do not use autogeneration.
    126126        bool shouldAutogen() const final { return !decl->linkage.is_builtin && !structHasFlexibleArray(decl); }
     127        void genADTFuncs();
     128        void getADTFuncBody(const ast::ObjectDecl * lhs, ast::FunctionDecl * func);
    127129private:
    128130        void genFuncBody( ast::FunctionDecl * decl ) final;
     
    193195        }
    194196
    195         bool shouldAutogen() const final { return true; }
     197        bool shouldAutogen() const final { return !(decl->isData); }
    196198private:
    197199        void genFuncBody( ast::FunctionDecl * decl ) final;
     
    238240        if ( !enumDecl->body ) return;
    239241
    240         // if ( auto enumBaseType = enumDecl->base ) {
    241         //      if ( auto enumBaseTypeAsStructInst = dynamic_cast<const ast::StructInstType *>(enumBaseType.get()) ) {
    242         //              const ast::StructDecl * structDecl = enumBaseTypeAsStructInst->base.get();
    243         //              this->previsit( structDecl );
    244         //      }
    245         // }
    246 
    247242        ast::EnumInstType enumInst( enumDecl->name );
    248243        enumInst.base = enumDecl;
     
    264259        }
    265260        StructFuncGenerator gen( structDecl, &structInst, functionNesting );
     261
     262        gen.genADTFuncs();
    266263        gen.generateAndAppendFunctions( declsToAddAfter );
    267264}
     
    475472                }
    476473                produceDecl( decl );
     474        }
     475}
     476
     477void StructFuncGenerator::getADTFuncBody(
     478                const ast::ObjectDecl * lhs,
     479                ast::FunctionDecl * func
     480        ) {
     481        const CodeLocation& location = func->location;
     482        assert( decl->members.size() == 2 );
     483        auto first = (decl->members[0]).as<ast::ObjectDecl>();
     484        assert(first != nullptr);
     485        auto firstType = first->type;
     486        auto unionInstDecl = firstType.as<ast::UnionInstType>();
     487        assert(unionInstDecl != nullptr);
     488
     489        auto unionDecl = unionInstDecl->base;
     490       
     491        const ast::ObjectDecl * dstParam =
     492                        func->params.front().strict_as<ast::ObjectDecl>();
     493        const ast::ObjectDecl * srcParam =
     494                        func->params.back().strict_as<ast::ObjectDecl>();
     495       
     496        ast::Expr * srcSelect = new ast::VariableExpr( location, srcParam );
     497
     498        ast::CompoundStmt * stmts = new ast::CompoundStmt( location );
     499
     500        InitTweak::InitExpander_new srcParamTweak( srcSelect );
     501        ast::Expr * dstSelect =
     502        new ast::MemberExpr(
     503                location,
     504                lhs,
     505                new ast::MemberExpr(
     506                        location,
     507                        first,
     508                        new ast::CastExpr(
     509                                location,
     510                                new ast::VariableExpr( location, dstParam ),
     511                                dstParam->type.strict_as<ast::ReferenceType>()->base
     512                        )
     513                )
     514        );
     515        auto stmt = genImplicitCall(
     516                srcParamTweak, dstSelect, location, func->name,
     517                first, SymTab::LoopForward
     518        );
     519        stmts->push_back( stmt );
     520        func->stmts = stmts;
     521}
     522
     523void StructFuncGenerator::genADTFuncs() {
     524        if ( decl->kind != ast::AggregateDecl::ADT ) return;
     525        assert( decl->members.size() == 2 );
     526        auto first = (decl->members[0]).as<ast::ObjectDecl>();
     527        assert(first != nullptr);
     528        auto firstType = first->type;
     529        auto unionInstDecl = firstType.as<ast::UnionInstType>();
     530        assert(unionInstDecl != nullptr);
     531        auto unionDecl = unionInstDecl->base;
     532
     533        // for (auto mem: unionDecl->members) {
     534        for ( std::size_t i = 0; i < unionDecl->members.size(); ++i ) {
     535                auto mem = unionDecl->members[i];
     536                const ast::ObjectDecl * mem_as_obj = mem.as<ast::ObjectDecl>();
     537                assert( mem_as_obj );
     538                auto mem_type = mem_as_obj->type.as<ast::StructInstType>();
     539                assert( mem_type );
     540                auto location = getLocation();
     541                ast::FunctionDecl * func = new ast::FunctionDecl(
     542                        getLocation(),
     543                        "?{}", // name
     544                        {}, //forall
     545                        { dstParam(), new ast::ObjectDecl( getLocation(), "_src", ast::deepCopy( mem_type ) ) }, // params
     546                        {}, // returns
     547                        {}, // statements
     548                        // Use static storage if we are at the top level.
     549                        (0 < functionNesting) ? ast::Storage::Classes() : ast::Storage::Static,
     550                        proto_linkage,
     551                        std::vector<ast::ptr<ast::Attribute>>(),
     552                        // Auto-generated routines are inline to avoid conflicts.
     553                        ast::Function::Specs( ast::Function::Inline )
     554                );
     555                getADTFuncBody(mem_as_obj, func);
     556                func->fixUniqueId();
     557                produceForwardDecl(func);
     558                if ( CodeGen::isAssignment( func->name ) ) {
     559                        appendReturnThis( func );
     560                }
     561                produceDecl( func );
    477562        }
    478563}
Note: See TracChangeset for help on using the changeset viewer.