15.4.386  src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-constants.pkg

## adl-raw-syntax-constants.pkg

# Compiled by:
#     src/lib/compiler/back/low/tools/sml-ast.lib


# Translation from one sort to another



###                   "We are probably nearing the limit
###                    of all we can know about astronomy."
###
###                                -- Simon Newcomb 



stipulate
   package raw =  adl_raw_syntax_form;                                  # adl_raw_syntax_form           is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-form.pkg
herein

    package  adl_raw_syntax_constants
    : (weak) Adl_Raw_Syntax_Constants                                   # Adl_Raw_Syntax_Constants      is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-constants.api
    {
        fun id x
            =
            raw::ID_IN_EXPRESSION (raw::IDENT([], x));

        stipulate
            #
            Const_Table                                                         # Start of abstype-replacement recipe -- see http://successor-ml.org/index.php?title=Degrade_abstype_to_derived_form 
                =                                                               #
                TABLE  (Ref( List ((raw::Id, raw::Expression)) ), Ref( Int ));  #
        herein                                                                  #
            Const_Table = Const_Table;                                          # End of abstype-replacement recipe.

            fun new_const_table ()  = TABLE (REF [], REF  0);

             fun const (TABLE (entries, counter)) e
                 = 
                 lookup *entries
                 where
                     fun lookup []
                             => 
                             {   name = "TMP" +  int::to_string *counter;
                                 counter := *counter + 1;
                                 entries := (name, e) ! *entries;
                                 id name;
                             };

                         lookup((x, e') ! rest)
                             =>
                             if (e == e')   id x;
                             else           lookup rest;
                             fi;
                     end;
                 end;

             fun gen_consts (TABLE (entries, _))
                 = 
                 map
                     (\\ (x, e) =  raw::VAL_DECL [raw::NAMED_VARIABLE (raw::IDPAT x, e)]) 
                     (reverse *entries);

             fun with_consts f
                 =
                 {   table    = new_const_table();
                     decl   = f (const table);
                     consts = gen_consts table;

                     case consts
                         #
                         [] =>  decl;
                         _  =>  raw::LOCAL_DECL (consts,[decl]);
                     esac;
                 };
        end;
    };                                                                          # package  adl_raw_syntax_constants
end;                                                                            # stipulate