PreviousUpNext

15.4.194  src/lib/c-kit/src/ast/state.pkg


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

package   state
: (weak)  State                                         # State is from   src/lib/c-kit/src/ast/state.api
{
    package sym= symbol;                                # symbol        is from   src/lib/c-kit/src/ast/symbol.pkg

    # UID packages: program, type
    # and adornment identifiers:
    #
    package pid = pid;
    package tid = tid;
    package aid = aid;

    # Imperative uid tables (hashtables):
    #
    package tt= tidtab;                                 # tidtab        is from   src/lib/c-kit/src/ast/tidtab.pkg
    package at = aidtab;                                #  was TypeAddornmentTab 

    # Symbol table binary maps:
    #
    package st
        =
        binary_map_g (
            Key = sym::Symbol;
            compare = sym::compare; 
        );

    # Int binary maps 
    #
    package it
        =
        binary_map_g (
            Key = large_int::Int;
            compare = large_int::compare;
        );


    # Dictionaries:
    #
    Symtab = st::Map( namings::Sym_Naming );
    #
    Dictionary = List( Symtab );                        # Local dictionaries.


    # Global context types:
    #
    Uid_Tables
        =
        { ttab:       tables::Tidtab,                   # Type name table.
          atab:       tables::Aidtab,                   # Adornment table.
          implicits:  tables::Aidtab                    # "Optional" adornment table -- for special casts. 
        };

    Env_Context
        =
        { global_dictionary:  Ref( Symtab ),            # Global symbol table.
           local_dictionary:  Ref( Dictionary )         # Local dictionary stack.
        };

    # Local ("working") context types: 

    # Tids_Context:  Sequence of tids
    # of types created while processing
    # a phrase:
    #
    Tids_Context
        =
        { new_tids:  Ref(  List(  tid::Uid ) )
        };

    # Tmp_Variables:  Sequence of pids
    # created while processing a phrase. 
    # Used when inserting explicit
    # coercions in the case of ++, --, += 
    #
    Tmp_Variables
        =
        { new_variables:  Ref(  List(  raw_syntax::Id ) )
        };

    # For use in D:
    #
    Type_Context
        =
        { type_cxts:   Ref( List( Null_Or( raw_syntax::Ctype ) ) )
        };  

    # Information for the
    # current function def:
    #
    Fun_Context
        =
        { label_tab:   Ref( st::Map( (raw_syntax::Label, Bool) ) ),
          gotos:  Ref(  List(  sym::Symbol ) ),
          return_type:  Ref(  Null_Or(  raw_syntax::Ctype ) )
        };

    # Table for collecting switch labels
    # while processing switch statements:
    #
    Switch_Context
        =
        { switch_labels:   Ref( List { switch_tab:  it::Map( Void ),
                                       default:     Bool
                                     }
                              )
        };

    # Location context, mainly
    # for error messages:
    #
    Loc_Context
        =
        { loc_stack:  Ref( List(line_number_db::Location) )
        };


    # Global state components:
    #
    Global_State
        =
        { uid_tables:   Uid_Tables,
          env_context:  Env_Context,            # Contains some local working state in local_dictionary.
          error_state:  error::Error_State
        };

    # Local, "working", state components:
    #
    Local_State
        =
        { loc_context:    Loc_Context,
          tids_context:   Tids_Context,

          tmp_variables:  Tmp_Variables,
          fun_context:    Fun_Context,

          switch_context: Switch_Context,
          type_context:   Type_Context
        };


    # Initial state information for
    # calling make_raw_syntax_tree:
    #
    State_Info
      = STATE  (Uid_Tables, Symtab)             # Previous state info.
      | INITIAL                                 # No previous state info.
      ;

    State_Funs
        =
        { # The state records,
          # included for convenience:
          #
          global_state:  Global_State,
          local_state:   Local_State,
          

          loc_funs
              :
              { push_loc:  line_number_db::Location -> Void,
                pop_loc:   Void -> Void,
                get_loc:   Void -> line_number_db::Location,
                error:     String -> Void,
                warn:      String -> Void
              },

          tids_funs
              :
              { push_tids:  tid::Uid -> Void,
                reset_tids:  Void ->  List( tid::Uid )
              },

          tmp_vars_funs
              :
              { push_tmp_vars:   raw_syntax::Id -> Void,
                reset_tmp_vars:  Void -> List( raw_syntax::Id )
              },

          env_funs
              :
              { top_level:  Void -> Bool,

                push_local_dictionary:  Void -> Void,
                pop_local_dictionary:   Void -> Void,

                get_sym:    sym::Symbol -> Null_Or( namings::Sym_Naming ),
                bind_sym:  (sym::Symbol, namings::Sym_Naming) -> Void,

                get_sym__global:    sym::Symbol -> Null_Or( namings::Sym_Naming ),
                bind_sym__global:  (sym::Symbol, namings::Sym_Naming) -> Void,

                get_local_scope:        sym::Symbol -> Null_Or( namings::Sym_Naming ),
                get_global_dictionary:  Void -> Symtab
              },

          uid_tab_funs
              :
              { bind_aid:  raw_syntax::Ctype -> aid::Uid,
                get_aid:   aid::Uid -> Null_Or( raw_syntax::Ctype ),

                bind_tid:  (tid::Uid, namings::Tid_Naming) -> Void,
                get_tid:   tid::Uid -> Null_Or( namings::Tid_Naming )
              },

          fun_funs
              :
              { new_function:     raw_syntax::Ctype -> Void,

                get_return_type:  Void -> Null_Or( raw_syntax::Ctype ),
                check_labels:     Void ->  Null_Or( (symbol::Symbol, line_number_db::Location) ),

                add_label:        (sym::Symbol, line_number_db::Location) -> raw_syntax::Label,
                add_goto:         (sym::Symbol, line_number_db::Location) -> raw_syntax::Label
              },

          switch_funs
              :
              { push_switch_labels:  Void -> Void,
                pop_switch_labels:   Void -> Void,

                add_switch_label:    large_int::Int -> Null_Or( String ),       # Returns  Null_Or( error message ).
                add_default_label:   Void           -> Null_Or( String )        # Returns  Null_Or( error message ).
              }
        };
           


    # State initialization:
    #
    fun init_local (): Local_State
        =
        { tids_context   => { new_tids      => REF [] },
          tmp_variables  => { new_variables => REF [] },
          type_context   => { type_cxts     => REF [] },

          fun_context    => { label_tab   => REF st::empty,
                              gotos       => REF [],
                              return_type => REF NULL
                            },

          switch_context => { switch_labels => REF [] },
          loc_context    => { loc_stack     => REF [line_number_db::UNKNOWN] }
        };


    fun init_global (INITIAL, error_state: error::Error_State): Global_State
            =>
            { uid_tables =>  { ttab      => tt::uidtab(),
                               atab      => at::uidtab(),
                               implicits => at::uidtab()
                             },

              env_context => { global_dictionary => REF st::empty,
                               local_dictionary  => REF []
                             },
              error_state
            };

        init_global (STATE( { ttab, atab, implicits }, global_dictionary), error_state)
            =>
            { uid_tables  => { ttab, atab, implicits },

              env_context => { global_dictionary => REF (global_dictionary),
                               local_dictionary  => REF []
                             },
              error_state
            };
    end;


    # Provide packages of implicit
    # state manipulation functions:
    #
    fun state_funs
        ( global_state as { uid_tables, env_context, error_state } : Global_State,
          local_state  as { tids_context, tmp_variables, fun_context, switch_context, loc_context, ... }: Local_State
        )
        : State_Funs
        =
        {

            bug = error::bug error_state;



            #####################################
            # Tids_Context functions.

            stipulate

                my { new_tids } =  tids_context;

            herein

                fun push_tids tid
                    =
                    new_tids := tid ! *new_tids;


                # Contexts get pushed onto new_tids
                # as encountered, so we need to
                # reverse list to give original
                # program order:
                #
                fun reset_tids ()
                    =
                    reverse *new_tids
                    before
                    (new_tids := []);

            end;



            #####################################
            # New_Variables functions.

            stipulate

                my { new_variables }
                    =
                    tmp_variables;

            herein

                    fun push_tmp_vars pid_type
                        =
                        new_variables :=  pid_type ! *new_variables;

                    # Pid_Type pairs are pushed
                    # onto newVariables as encountered,
                    # so we need to reverse list
                    # to give original program order:
                    #
                    fun reset_tmp_vars ()
                        =
                        reverse *new_variables
                        before
                        new_variables := [];
            end;



            #####################################
            # Location functions.

            stipulate

                my { loc_stack }
                    =
                    loc_context;                # Also uses error_state.

            herein

                fun error (msg: String)
                    =
                    case *loc_stack
                        loc ! _ =>  error::error (error_state, loc, msg);
                        NIL     =>  bug "Empty location stack";
                    esac;

                fun warn (msg: String)
                    =
                    case *loc_stack
                        loc ! _ =>  error::warning (error_state, loc, msg);
                        NIL     =>  bug "Empty location stack";
                    esac;

                # Get "current" location.
                # Accesses: loc_stack.
                #
                fun get_loc ()
                    =
                    case *loc_stack

                        loc ! _ => loc;

                        NIL     => {   bug "getLoc: empty location stack";
                                       line_number_db::UNKNOWN;
                                   };
                    esac;

                # Push the location stack on
                # entering a marked phrase. 
                #
                fun push_loc loc
                    =
                    loc_stack :=  loc ! *loc_stack;

                # Pop the location stack on
                # exiting a marked phrase. 
                # 
                fun pop_loc ()
                    =
                    case *loc_stack
                         _ ! rest =>  loc_stack := rest;
                        NIL       =>  bug "popLoc: empty location stack";
                    esac;

            end;                                # stipulate



            #####################################
            # Switch label functions.

            stipulate

                my { switch_labels }
                    =
                    switch_context;

            herein

                fun pop_switch_labels ()
                    =
                    case *switch_labels
                        _ ! sw_labels =>  switch_labels := sw_labels;
                        NIL           =>  bug "State: Cannot pop empty switch_labels";
                    esac;


                fun push_switch_labels ()
                    =
                    {   new_entry =  { switch_tab =>  it::empty,
                                       default    =>  FALSE
                                     };

                        switch_labels
                            :=
                            new_entry ! *switch_labels;
                    };

                fun add_switch_label (i: large_int::Int): Null_Or( String )
                    =
                    case *switch_labels

                        { switch_tab, default } ! rest
                            =>
                            case (it::get (switch_tab, i))

                                NULL =>
                                    {   switch_tab = it::set (switch_tab, i, ());

                                        switch_labels := { switch_tab, default } ! rest;

                                        NULL;
                                    };

                                THE _ =>
                                    THE ("Duplicate case label " + (large_int::to_string i) +
                                         " in the same switch statement"
                                        );
                            esac;

                        NIL =>
                            THE ("Case label " + (large_int::to_string i) +
                                 " appears outside a switch statement"
                                );
                    esac;


                fun add_default_label (): Null_Or( String )
                    =
                    case *switch_labels

                        { switch_tab, default } ! rest
                            =>
                            if default
                                THE "Duplicate default label in the same switch statement";
                            else
                                switch_labels := { switch_tab, default=>TRUE } ! rest;
                                NULL;
                            fi;

                        NIL =>
                            THE "Default label appears outside a switch statement";
                    esac;

            end;                                        # stipulate



            #####################################
            # Identifier table functions

            stipulate

                uid_tables ->  { ttab, atab, ... };

            herein

                fun bind_aid type
                    =
                    { aid = aid::new ();
                      at::insert (atab, aid, type);
                      aid;
                    };

                fun get_aid aid
                    =
                    at::find (atab, aid);

                fun bind_tid (tid, naming)
                    =
                    tt::insert (ttab, tid, naming);

                fun get_tid tid
                    =
                    tt::find (ttab, tid);

            end;



            #####################################
            # fun_context functions

            stipulate

                fun_context ->  { label_tab, gotos, return_type };

            herein

                fun new_function returnty
                    =
                    {   label_tab   :=  st::empty;
                        gotos       :=  [];
                        return_type :=  THE returnty;
                    };


                fun get_return_type ()
                    =
                    *return_type;


                # David B MacQueen:
                #
                # labToPid called only with definition=FALSE from addGoto,
                # so errorFl will always be returned FALSE in that case.
                #
                # On the other hand, in addLabel the value
                # of the error flag is discarded.

                fun symbol_to_label
                    ( definition: Bool,
                      lab_sym:    symbol::Symbol,
                      loc:        line_number_db::Location
                    )
                    : (raw_syntax::Label, Bool)
                    =
                    case (st::get (*label_tab, lab_sym))

                        THE (label, TRUE)
                            =>
                            # Previously defined:
                            #
                            if definition  (label, TRUE);       #  error, multiple defitions 
                            else           (label, FALSE);      #  no error
                            fi; 

                        THE (label, FALSE)
                            =>
                            # Label has been seen previously
                            # but not defined:
                            #
                            {   if definition

                                    # Mark as defined, renaming
                                    # lab_sym in label_tab:
                                    #
                                    label_tab
                                        :=
                                        st::set(*label_tab, lab_sym, (label, TRUE));
                                fi;

                                (label, FALSE); #  no error 
                            };

                        NULL =>
                            # New label:
                            #
                            {   label = { name     => lab_sym,
                                          uid      => pid::new (),
                                          location => loc
                                        };

                                label_tab
                                    :=
                                    st::set(*label_tab, lab_sym, (label, definition));

                                (label, FALSE);
                            };
                    esac;


                fun add_goto (lab_sym, loc)
                    =
                    {   label = #1 (symbol_to_label (FALSE, lab_sym, loc));

                        # Discard error flag:
                        # no possibility of an error condition,
                        # since not a defining occurrence of the label:

                        gotos := lab_sym ! *gotos;

                        label;
                    };

                fun add_label (lab_sym, loc)
                    =
                    {   my (label, error_flag)
                            =
                            symbol_to_label (TRUE, lab_sym, loc);

                        if error_flag 
                            error("Repeated definition of label " + (sym::name lab_sym));
                        fi;

                        label;
                    };

            fun check_labels ()
                =
                check *gotos
                where
                    fun check NIL
                            =>
                            # All ok --all goto
                            # target labels defined:
                            #
                            NULL;

                        check (g ! gl)
                            =>
                            case (st::get (*label_tab, g))

                                THE (pid, TRUE)
                                    =>
                                    check gl;

                                THE( { name, location, ... }, FALSE)
                                    =>
                                    THE (name, location);

                                NULL =>
                                    # Error in program -- label
                                    # used but not defined:
                                    # 
                                    {   bug "State: checkLabels: goto label not in table";
                                        NULL;
                                    };
                           esac;

                        
                    end;
                end;
            end;                                # fun_context stipulate



            #####################################
            # Dictionary functions.

            stipulate

                env_context ->   { local_dictionary, global_dictionary };

            herein

                # Are we in a top-level dictionary? 
                # 
                fun top_level ()
                    =
                    list::null *local_dictionary;


                fun push_local_dictionary ()
                    =
                    local_dictionary
                        :=
                        st::empty ! *local_dictionary;


                fun pop_local_dictionary ()
                    =
                    case *local_dictionary

                        st ! dictionary
                            =>
                            local_dictionary := dictionary;

                        NIL =>
                            bug "State: popping an empty local dictionary";
                    esac;


                # get_sym: Look up a symbol
                # in the full dictionary
                # (local_dictionary over global_dictionary): 
                #
                fun get_sym (symbol: sym::Symbol)
                    :
                    Null_Or( namings::Sym_Naming )
                    =
                    look_up *local_dictionary
                    where
                        fun look_up []
                               => 
                               st::get (*global_dictionary, symbol);

                            look_up (st ! rest)
                                =>
                                case (st::get (st, symbol))

                                     THE x => THE x;
                                     NULL => look_up rest;
                                esac;
                       end;
                    end;


                fun get_sym__global (symbol: sym::Symbol)
                    :
                    Null_Or( namings::Sym_Naming )
                    =
                    st::get(*global_dictionary, symbol);


                # bindSym:  symbol * naming -> Void
                # bind a new symbol.
                #
                fun bind_sym (symbol, naming)
                    =
                    case *local_dictionary

                         st ! outer =>  local_dictionary  := st::set (st, symbol, naming) ! outer;
                         NIL        =>  global_dictionary := st::set (*global_dictionary, symbol, naming);
                    esac;

                # Force entry into the global dictionary.
                # 
                # (Used for patching up undeclared
                # function calls).
                # 
                # WARNING: Generates new pid/uid.
                # 
                fun bind_sym__global (symbol, naming)
                    =
                    global_dictionary := st::set(*global_dictionary, symbol, naming);


                # Is symbol bound in current
                # innermost scope level? 
                # 
                fun get_local_scope symbol
                    =
                    case *local_dictionary
                        NIL    => st::get (*global_dictionary, symbol);
                        st ! _ => st::get (st, symbol);
                    esac;

                # Return the current
                # global dictionary (symtab):
                #
                fun get_global_dictionary (): Symtab
                    =
                    *global_dictionary;

            end;                        # dictionary stipulate



            #####################################
            # State function package 

            { global_state,
              local_state,

              loc_funs      => { push_loc,
                                 pop_loc,
                                 get_loc,
                                 error,
                                 warn
                               },

              tids_funs     => { push_tids,
                                 reset_tids
                               },

              tmp_vars_funs => { push_tmp_vars,
                                 reset_tmp_vars
                               },

              env_funs      => { top_level,
                                 push_local_dictionary,
                                 pop_local_dictionary,
                                 get_sym,
                                 bind_sym,
                                 get_sym__global,
                                 bind_sym__global,
                                 get_local_scope,
                                 get_global_dictionary
                               },

              uid_tab_funs  => { bind_aid,
                                 get_aid,
                                 bind_tid,
                                 get_tid
                               },

              fun_funs      => { new_function,
                                 get_return_type,
                                 check_labels,
                                 add_label,
                                 add_goto
                               },

              switch_funs   => { push_switch_labels,
                                 pop_switch_labels,
                                 add_switch_label,
                                 add_default_label
                               }
            };
        };                              # fun state_funs 

};                                      # package state 


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext