PreviousUpNext

15.4.572  src/lib/compiler/front/parser/raw-syntax/printf-format-string-to-raw-syntax.pkg

## printf-format-string-to-raw-syntax.pkg

# Compiled by:
#     src/lib/compiler/front/parser/parser.sublib



#             Motivation
#             ----------
#
# In C we can write
#
#     printf( "%d %6.2f %-15s\n", 7, 12.3, "hello" );
#
# The Mythryl package   src/lib/src/sfprintf.pkg   lets us write
#
#     printf' "%d %6.2f %-15s\n" [ INT 7,  FLOAT 12.3,  STRING "hello" ];
#
# I find the above obnoxiously wordy;
# I would rather write
#
#     printf "%d %6.2f %-15s\n"  7  12.3  "hello";
#
# This file implements parser logic to expand the
# latter into the former.
#
# I swiped the core idea of turning the format string
# into a curried function from
#
#     src/lib/src/printf-combinator.pkg
#
# This syntax conversion has to be done as a hack
# here in the parser because making it well-typed
# requires exposing the type information buried in
# the format string to the typechecker, which can
# only be done post-parse, pre-typecheck.
#
# (Maybe someday we'll implement some equivalent
# to Lisp macros, which run after parsing and
# before typechecking, and then this can be written
# as a library macro rather than an ad hoc parser
# hack.  For now, this gets the job done.)



#             Mechanics
#             ---------
#
# We get invoked by the
#
#     app_exp:   PRINTF_T  STRING
#
# rule in
#
#     src/lib/compiler/front/parser/yacc/mythryl.grammar
#
# to turn surface syntax like
#
#     printf "%d %-15s %6.2f\n"
#
# into Raw_Syntax for an equivalent anonymous
# curried function, using the functionality in
#
#     src/lib/src/sfprintf.pkg
#
# to do all the actual work.




###                        Twin Mysteries
###
###                 To many people artists seem
###                     undisciplined and lawless;
###                 such talent with such laziness
###                     seems little short of crime.
###
###                 One mystery is how they make
###                     the things they make so flawless;
###                 the other, what they're doing
###                     with their energy and time.
###
###                                -- Piet Hein



package   printf_format_string_to_raw_syntax
: (weak)  Printf_Format_String_To_Raw_Syntax                                            # Printf_Format_String_To_Raw_Syntax    is from   src/lib/compiler/front/parser/raw-syntax/printf-format-string-to-raw-syntax.api
{
    Flavor =  PRINTF | FPRINTF | SPRINTF;

                                
                                                                                        # printf_field  is from   src/lib/src/printf-field.pkg
                                                                                        # sfprintf      is from   src/lib/src/sfprintf.pkg
                                                                                        # raw_syntax    is from   src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg
                                                                                        # fast_symbol   is from   src/lib/compiler/front/basics/map/fast-symbol.pkg
                                                                                        # hash_string   is from   src/lib/src/hash-string.pkg


    # Support for the following function:
    #
    quickstring_symbol =  fast_symbol::make_value_symbol'  "QUICKSTRING";
    lint_symbol        =  fast_symbol::make_value_symbol'  "LINT";
    int_symbol         =  fast_symbol::make_value_symbol'  "INT";
    lunt_symbol        =  fast_symbol::make_value_symbol'  "LUNT";
    unt_symbol         =  fast_symbol::make_value_symbol'  "UNT";
    unt8_symbol        =  fast_symbol::make_value_symbol'  "UNT8";
    bool_symbol        =  fast_symbol::make_value_symbol'  "BOOL";
    char_symbol        =  fast_symbol::make_value_symbol'  "CHAR";
    string_symbol      =  fast_symbol::make_value_symbol'  "STRING";
    float_symbol       =  fast_symbol::make_value_symbol'  "FLOAT";
    left_symbol        =  fast_symbol::make_value_symbol'  "LEFT";
    right_symbol       =  fast_symbol::make_value_symbol'  "RIGHT";

    fun printf_arg_to_constructor_symbol
            printf_arg
        =
        case printf_arg
            #     
            printf_field::QUICKSTRING   _ =>    quickstring_symbol;
            printf_field::LINT          _ =>    lint_symbol;
            printf_field::INT           _ =>     int_symbol;
            printf_field::LUNT          _ =>    lunt_symbol;
            printf_field::UNT           _ =>     unt_symbol;
            printf_field::UNT8          _ =>    unt8_symbol;
            printf_field::BOOL          _ =>    bool_symbol;
            printf_field::CHAR          _ =>    char_symbol;
            printf_field::STRING        _ =>  string_symbol;
            printf_field::FLOAT         _ =>   float_symbol;
            printf_field::LEFT          _ =>    left_symbol;
            printf_field::RIGHT         _ =>   right_symbol;
        esac;

    sfprintf_package_symbol
        =
        fast_symbol::make_package_symbol' "sfprintf";

    fprintf'_value_symbol =  fast_symbol::make_value_symbol' "fprintf'";
     printf'_value_symbol =  fast_symbol::make_value_symbol'  "printf'";
    sprintf'_value_symbol =  fast_symbol::make_value_symbol' "sprintf'";


    fun make_anonymous_curried_function
            (
              maybe_fd,                                 # NULL for printf/sprintf, THE dot_exp for fprintf
              printf_format_string,                     # "%d %6.2f %-15s\n" or such.
              error,    
              expressionleft,
              stringleft,
              expressionright,
              flavor
            )
        =
        [   to_fixity_item   anonymous_curried_function   ]
        where

            # Turn a Raw_Expression into a Fixity_Item( Raw_Expression )
            # because the former is what we generate but the latter is
            # what we're required to return:
            #
            fun to_fixity_item   item
                =
                {   item,
                    source_code_region => (expressionleft, expressionright),
                    fixity             => NULL
                };


            # Map list element   FIELD (_, _, INT_FIELD)   to   INT_FIELD  and so forth:
            #
            fun printf_field_list_to_printf_field_type_list  ([], results)
                    =>
                    reverse results;

                printf_field_list_to_printf_field_type_list  (field' ! fields, results)
                    =>
                    case (printf_field_to_printf_field_type  field')
                        #                      
                        THE printf_field_type =>  printf_field_list_to_printf_field_type_list( fields, printf_field_type ! results);
                        NULL                  =>  printf_field_list_to_printf_field_type_list( fields,                     results);
                    esac
                    where
                        fun printf_field_to_printf_field_type
                                printf_field
                            =
                            case printf_field
                              
                                 printf_field::FIELD (_, _, printf_field_type) =>  THE printf_field_type;
                                 _                                             =>  NULL;
                            esac;
                    end;
            end;


            # Given a List(printf_field::Printf_Field), drop
            # all but the FIELD list members:
            #
            fun drop_nonfields ([], results)
                    =>
                    reverse results;

                drop_nonfields (member ! rest, results)
                    =>
                    case member
                        #                      
                        f as printf_field::FIELD _ =>  drop_nonfields (rest, f ! results);
                        _                          =>  drop_nonfields (rest,     results);
                    esac;
            end;

            # Map list element  INT_FIELD  to  INT 0  and so forth:
            #
            fun printf_field_type_list_to_printf_arg_list  ([], results)
                    =>
                    reverse results;

                printf_field_type_list_to_printf_arg_list  (this_field_type ! remaining_field_types, results)
                    =>
                    case (sfprintf::printf_field_type_to_printf_arg_list  this_field_type)
                        #
                        printf_arg ! _ =>  printf_field_type_list_to_printf_arg_list (remaining_field_types, printf_arg ! results);
                        _              =>  printf_field_type_list_to_printf_arg_list (remaining_field_types,              results);
                    esac;
            end;



            # Map list element   INT 0   to value symbol  INT  and so forth:
            #
            fun printf_arg_list_to_constructor_symbol_list  ([], results)
                    =>
                    reverse results;

                printf_arg_list_to_constructor_symbol_list  (this_arg ! remaining_args,  results)
                    =>
                    printf_arg_list_to_constructor_symbol_list  (remaining_args,  (printf_arg_to_constructor_symbol  this_arg) ! results);
            end;



            fun parameter_to_pattern  parameter
                =
                to_fixity_item (raw_syntax::VARIABLE_IN_PATTERN [parameter] );


            # Given  expression  list   [ INT _, FLOAT _, ... ]
            # return fast_symbol list   [ arg1, arg2, ... ]
            # (The input list is used only for its length.)
            #
            fun constructor_symbol_list_to_parameter_symbol_list  ([], n, results)
                    =>
                    reverse results;

                constructor_symbol_list_to_parameter_symbol_list  (symbol ! symbols,  n,  results)
                    =>
                    constructor_symbol_list_to_parameter_symbol_list
                        (
                          symbols,
                          n + 1,
                          (int_to_parameter_symbol n) ! results
                        )
                        where
                            # Given 7 return symbol 'arg7':
                            #
                            fun int_to_parameter_symbol n
                                =
                                fast_symbol::make_value_symbol'  ("arg" + int::to_string n);
                        end;
            end;


            # Given a fast_symbol
            #
            #     foo
            #
            # construct raw syntax for
            #
            #     sfprintf::foo
            #
            fun sfprintf_symbol  foo_symbol
                =
                raw_syntax::VARIABLE_IN_EXPRESSION   
                    [
                      sfprintf_package_symbol,
                      foo_symbol
                    ];



            # Here we're basically doing what
            #
            #     src/lib/compiler/front/parser/yacc/mythryl.grammar
            #
            # would do for
            #
            #     fn arg1 =
            #     fn arg2 =
            #     fn arg3
            #         =
            #         sfprintf::printf'
            #             "%d %6.2f %-15s\n"
            #             [ sfprintf::INT    arg1,
            #               sfprintf::FLOAT  arg2,
            #               sfprintf::STRING arg3
            #             ]; 
            # 
            # or such:
            # 
            fun make_raw_syntax_for_anonymous_curried_function
                    (
                      printf_format_string,     # "%d %6.2f %-15s\n"            # Or some such printf format string.
                      constructor_symbols,      # [ INT,  FLOAT, STRING, ... ]  # Digested from some printf string like the above.
                      parameter_symbols         # [ arg1, arg2,  arg3,   ... ]  # One parameter fast_symbol for each of the above.
                    )
                =
                function
                where
                    # Construct raw syntax for our
                    #
                    #     "%d %6.2f %-15s\n"
                    #
                    # (or whatever) format string:
                    #
                    printf_format_string
                        =
                        raw_syntax::STRING_CONSTANT_IN_EXPRESSION
                            printf_format_string;


                    # Construct raw syntax for appropriate one of
                    #
                    #     sfprintf::printf'
                    #     sfprintf::fprintf'
                    #     sfprintf::sprintf'
                    #
                    printf_function
                        =
                        sfprintf_symbol

                            case flavor
                              
                                 FPRINTF =>  fprintf'_value_symbol;
                                  PRINTF =>   printf'_value_symbol;
                                 SPRINTF =>  sprintf'_value_symbol;
                            esac;


                    # Construct raw syntax for
                    #
                    #   [ sfprintf::INT    arg1,
                    #     sfprintf::FLOAT  arg2,
                    #     sfprintf::STRING arg3
                    #   ]
                    #
                    # or such:
                    #
                    printf_arglist
                        = 
                        raw_syntax::LIST_EXPRESSION (

                            combine_by_pairs
                                (
                                  constructor_symbols,  # [ INT,  FLOAT, STRING, ... ]
                                  parameter_symbols,    # [ arg1, arg2,  arg3,   ... ]
                                  []                    # Resultlist.
                                )
                            where

                                fun combine_by_pairs ([], [], results)
                                        =>
                                        reverse results;

                                    combine_by_pairs ( constructor_symbol ! remaining_constructor_symbols,
                                                       parameter_symbol   ! remaining_parameter_symbols,
                                                       results
                                                     )
                                        => 
                                        combine_by_pairs (

                                            remaining_constructor_symbols,
                                            remaining_parameter_symbols,

                                            raw_syntax::PRE_FIXITY_EXPRESSION
                                                [
                                                  to_fixity_item( sfprintf_symbol  constructor_symbol ),
                                                  to_fixity_item( raw_syntax::VARIABLE_IN_EXPRESSION [ parameter_symbol ] )
                                                ]
                                            !
                                            results
                                        );

                                    combine_by_pairs _
                                        =>
                                        {   exception IMPOSSIBLE;
                                            raise exception IMPOSSIBLE;
                                        };
                                end;
                            end
                        );


                    # Construct raw syntax for
                    #
                    #     sfprintf::printf'
                    #
                    #         "%d %6.2f %-15s\n"
                    #
                    #         [ sfprintf::INT    arg1,
                    #           sfprintf::FLOAT  arg2,
                    #           sfprintf::STRING arg3
                    #         ];
                    #
                    # or such:
                    #
                    printf_of_arglist
                        =
                        case (maybe_fd)
                            #
                            NULL  => raw_syntax::PRE_FIXITY_EXPRESSION
                                         [
                                           to_fixity_item  printf_function,
                                           to_fixity_item  printf_format_string,
                                           to_fixity_item  printf_arglist
                                         ];      


                            THE fd => raw_syntax::PRE_FIXITY_EXPRESSION
                                         [
                                           to_fixity_item  printf_function,
                                          (to_fixity_item (raw_syntax::PRE_FIXITY_EXPRESSION fd)),
                                           to_fixity_item  printf_format_string,
                                           to_fixity_item  printf_arglist
                                         ];      
                        esac;

                    # Construct raw syntax for
                    #
                    #     fn arg1 = fn arg2 = fn arg3 = ... = expression;
                    #
                    fun make_fn_syntax ([], expression)
                            =>
                            expression;

                        make_fn_syntax (parameter_symbol ! parameter_symbols, expression)
                            =>
                            function
                            where
                                expression =  make_fn_syntax( parameter_symbols, expression );

                                pattern
                                    =  
                                    raw_syntax::PRE_FIXITY_PATTERN 
                                        [ parameter_symbol_to_pattern  parameter_symbol ]
                                    where
                                        fun parameter_symbol_to_pattern  parameter_symbol
                                            =
                                            to_fixity_item (
                                                raw_syntax::VARIABLE_IN_PATTERN [
                                                    parameter_symbol
                                                ]
                                            );
                                    end;

                                case_rule  =  raw_syntax::CASE_RULE { pattern, expression };

                                function   =  raw_syntax::FN_EXPRESSION [ case_rule ];
                            end;
                    end;

                    expression =  raw_syntax::PRE_FIXITY_EXPRESSION   [   to_fixity_item  printf_of_arglist   ];
                    function   =  make_fn_syntax( parameter_symbols, expression );
                end;

                                                                                                # error_message         is from   src/lib/compiler/front/basics/errormsg/error-message.pkg
            fun parse_format_string_into_printf_field_list   printf_format_string
                =
                sfprintf::parse_format_string_into_printf_field_list   printf_format_string
                except
                    printf_field::BAD_FORMAT diagnostic_string
                        =
                        {   error
                               (stringleft, expressionright)
                                error_message::ERROR
                              (diagnostic_string + ": " + printf_format_string)
                                error_message::null_error_body;

                            parse_format_string_into_printf_field_list   "foo";
                        }; 


            # Parse the printf format string (something like "%d %6.2f %-15s\n")
            # into a list of fields and then successively transform that list
            # into what we need:
            #
            printf_fields       =  parse_format_string_into_printf_field_list             printf_format_string;                 # [ FIELD (_, _, INT_FIELD), ... ]
            printf_fields       =  drop_nonfields (printf_fields, []);  
            printf_field_types  =  printf_field_list_to_printf_field_type_list          ( printf_fields,               [] );    # [ INT_FIELD, ... ]
            printf_args         =  printf_field_type_list_to_printf_arg_list            ( printf_field_types,          [] );    # [ (INT 0), ... ]
            constructor_symbols =  printf_arg_list_to_constructor_symbol_list           ( printf_args,                 [] );    # [ INT, ... ]
            parameter_symbols   =  constructor_symbol_list_to_parameter_symbol_list     ( constructor_symbols,   1,    [] );    # [ arg1, ... ]

            anonymous_curried_function
                =
                make_raw_syntax_for_anonymous_curried_function
                    (
                      printf_format_string,
                      constructor_symbols,
                      parameter_symbols
                    );

            

        end;
};









# 2008-01-09 0322:
#
#   eval:  printf "%g %d\n" 23.4592 12
#   printf_fields:  (float)  (int) 
#   printf_field_types:  (float)  (int) 
#   printf_args:  FLOAT  INT 
#   constructor_symbols:  {{ FLOAT }}  {{ INT }} 
#   parameter_symbols:  [[ arg1 ]]  [[ arg2 ]] 
#   23.4592 12
#
# :) :) :)


## Code by Jeff Prothero: Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext