## 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
#
# \\ arg1 =
# \\ arg2 =
# \\ 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
#
# \\ arg1 = \\ arg2 = \\ 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-2015,
## released per terms of SMLNJ-COPYRIGHT.