## make-raw-syntax.pkg
# Compiled by:
# src/lib/compiler/front/parser/parser.sublib### "One of the endlessly alluring aspects
### of mathematics is that its thorniest
### paradoxes have a way of blooming into
### beautiful theories."
###
### -- Philip Davis
stipulate
package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package mrs = map_raw_syntax; # map_raw_syntax is from src/lib/compiler/front/parser/raw-syntax/map-raw-syntax.pkg package raw = raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkgherein
package make_raw_syntax
: Make_Raw_Syntax # Make_Raw_Syntax is from src/lib/compiler/front/parser/raw-syntax/make-raw-syntax.api {
include package fast_symbol;
include package raw_syntax;
include package raw_syntax_junk;
fun to_fixity_item (item, left, right)
=
{ item,
source_code_region => (left, right),
fixity => NULL
};
# Construct raw syntax for parameter tuple in
#
# \\ (arg1, arg2, ... ) = ...
#
fun make_parameter_tuple
(parameters as p1 ! p2 ! rest, left, right)
=>
pattern
where
parameters
=
map
(\\ parameter
=
raw::PRE_FIXITY_PATTERN [
to_fixity_item (
raw::VARIABLE_IN_PATTERN
[ parameter ],
left,
right
)
]
)
parameters;
pattern = to_fixity_item (
raw::TUPLE_PATTERN parameters,
left,
right
);
end;
make_parameter_tuple _
=>
{ exception BAD_TUPLE String;
raise exception BAD_TUPLE "parameter tuple must have at least two elements";
};
end;
# Construct raw syntax for argument tuple in
#
# f (arg1, arg2, ... )
#
fun make_argument_tuple
(args as p1 ! p2 ! rest, left, right)
=>
expression
where
args
=
map
(\\ arg
=
raw::PRE_FIXITY_EXPRESSION [
to_fixity_item (
raw::VARIABLE_IN_EXPRESSION
[ arg ],
left,
right
)
]
)
args;
expression = to_fixity_item (
raw::TUPLE_EXPRESSION args,
left,
right
);
end;
make_argument_tuple _
=>
{ exception BAD_TUPLE String;
raise exception BAD_TUPLE "argument tuple must have at least two elements";
};
end;
# Construct raw syntax for expression tuple in
#
# f (0, "a", ... )
#
fun make_expression_tuple
(expressions as p1 ! p2 ! rest, left, right)
=>
expression
where
expressions
=
map
(\\ expression
=
raw::PRE_FIXITY_EXPRESSION [
to_fixity_item (
expression,
left,
right
)
]
)
expressions;
expression = to_fixity_item (
raw::TUPLE_EXPRESSION expressions,
left,
right
);
end;
make_expression_tuple _
=>
{ exception BAD_TUPLE String;
raise exception BAD_TUPLE "expression tuple must have at least two elements";
};
end;
# Construct raw syntax for
#
# \\ (arg1, arg2... ) = expression;
#
fun make_tuple_arg_fn_syntax (parameters, expression, left, right)
=
function
where
pattern = make_parameter_tuple (parameters, left, right);
pattern = raw::PRE_FIXITY_PATTERN [ pattern ];
case_rule = raw::CASE_RULE { pattern, expression };
function = raw::FN_EXPRESSION [ case_rule ];
end;
# Construct raw syntax for
#
# \\ arg1 = \\ arg2 = \\ arg3 = ... = expression;
#
# (At present we only use it for the
# one-parameter case, but it doesn't
# hurt to have it more general.)
#
fun make_curried_fn_syntax ([], expression, left, right)
=>
expression;
make_curried_fn_syntax (parameter ! parameters, expression, left, right)
=>
function
where
expression = make_curried_fn_syntax( parameters, expression, left, right );
pattern = raw::PRE_FIXITY_PATTERN [
to_fixity_item (
raw::VARIABLE_IN_PATTERN
[ parameter ],
left,
right
)
];
case_rule = raw::CASE_RULE { pattern, expression };
function = raw::FN_EXPRESSION [ case_rule ];
end;
end;
fun expression_to_expression_fixity_item
(expression, left, right)
=
{ { item => expression,
source_code_region => (left, right),
fixity => NULL
};
};
fun lowercase_id_to_variable_in_expression_fixity_item
(lowercase_id, left, right)
=
{ my (v, f)
=
make_value_and_fixity_symbols lowercase_id;
{ item => mark_expression (VARIABLE_IN_EXPRESSION [v], left, right),
source_code_region => (left, right),
fixity => THE f
};
};
fun lowercase_id_to_variable_in_pattern_fixity_item
(lowercase_id, left, right)
=
{ my (v, f)
=
make_value_and_fixity_symbols lowercase_id;
{ item => VARIABLE_IN_PATTERN [v],
source_code_region => (left, right),
fixity => THE f
};
};
# There is a problem in that if we naively
# translate
#
# for (i=0, j=10; i<10; ++i) { ++j; printf "%d %d\n" i j; }
#
# into something like
#
# { fun foo (i, j)
# =
# if i < 10
# then
# { ++j; printf "%d %d\n" i j; };
# ++i;
# foo (i, j);
# else
# ();
# fi;
#
# foo (0, 10);
# };
#
# then 'j' won't increment as the user expects due to it being
# local to a sub-block. To get around this, we need to combine
# the user's loop-body block with our added stuff to produce
#
# { fun foo (i, j)
# =
# if i < 10
# then
# ++j;
# printf "%d %d\n" i j;
# ++i;
# foo (i, j);
# else
# ();
# fi;
#
# foo (0, 10);
# };
#
#
# Our job here is to help implement this by, if 'body'
# is a LET_EXPRESSION, dissolving it into a list of its
# constituents, to which our caller can then append the new
# stuff. If 'body' is not a LET_EXPRESSION, we do very little:
#
fun let_expression_to_declaration_list
(body, left, right)
=
case body
# This is the case that will run if
# the for loop body is a block:
#
PRE_FIXITY_EXPRESSION [ { fixity, source_code_region, item => SOURCE_CODE_REGION_FOR_EXPRESSION (LET_EXPRESSION { declaration, expression },region) } ]
=>
[ declaration, expression_to_declaration( expression, left, right) ];
# This case won't currently run,
# but provides some robustness
# against changes elsewhere:
#
PRE_FIXITY_EXPRESSION [ { fixity, source_code_region, item => LET_EXPRESSION { declaration, expression } } ]
=>
[ declaration, expression_to_declaration( expression, left, right) ];
# This is the case that will run if
# the for loop body is not a block:
#
_ => [ expression_to_declaration (body, left, right) ];
esac;
# Here we expand
# for (i = 0; i < 10; ++i) printf "%d\n" i;
# into
# { fun foo i # Actually we call it 'for' not 'foo'.
# =
# if i < 10
# then
# printf "%d\n" i;
# ++i;
# foo i;
# else
# ();
# fi;
#
# foo 0;
# };
#
fun for_loop
( (for_tleft, for_tright),
inits
as
( ( (lvar as (lvar_expression, lvar_left, lvar_right)), # "lvar" == "loop variable" (i)
(init as (init_expression, init_left, init_right))
)
!
more
),
test as (test_expression, test_left, test_right),
loops,
done as (done_expression, done_left, done_right),
body as (body_expression, body_left, body_right)
)
=>
{ # Name our loop function 'for':
# Since 'for' is a reserved word,
# that eliminates any risk of
# shadowing a user variable:
#
fvar # "fvar" == "'for'/'foo'/'fun' variable"
=
(make_raw_symbol "for", for_tleft, for_tright);
lvars = map #1 inits;
exprs = map #2 inits;
tail_call_arguments
=
case lvars
[lvar]
=>
lowercase_id_to_variable_in_expression_fixity_item lvar;
(lvar ! more)
=>
{ args = map #1 lvars;
args = map make_value_symbol args;
make_argument_tuple (args, body_left, body_right);
};
[] => { exception IMPOSSIBLE; raise exception IMPOSSIBLE; };
esac;
init_call_arguments
=
case exprs
[expr]
=>
expression_to_expression_fixity_item expr;
(expr ! more)
=>
{ expressions = map #1 exprs;
make_expression_tuple (expressions, body_left, body_right);
};
[] => { exception IMPOSSIBLE; raise exception IMPOSSIBLE; };
esac;
parameters
=
case lvars
[lvar]
=>
lowercase_id_to_variable_in_pattern_fixity_item lvar;
(lvar ! more)
=>
{ parameters = map #1 lvars;
parameters = map make_value_symbol parameters;
make_parameter_tuple (parameters, body_left, body_right);
};
[] => { exception IMPOSSIBLE; raise exception IMPOSSIBLE; };
esac;
# Raw syntax for our tail-recursive call:
#
tail_call_expression
=
PRE_FIXITY_EXPRESSION
[ lowercase_id_to_variable_in_expression_fixity_item fvar,
tail_call_arguments
];
# Raw syntax for our initial call:
#
initial_call_expression
=
PRE_FIXITY_EXPRESSION
[ lowercase_id_to_variable_in_expression_fixity_item fvar,
init_call_arguments
];
# Our list of loop-step expressions
# like ++i, ++j:
#
loop_declarations
=
map #1 (loops: List( (raw::Declaration, Int, Int)));
# Synthesize block of code to execute on
# non-final iterations. This consists
# of, in order:
# o The user-supplied loop body: printf "%d\n" i;
# o The user-supplied increments: ++i
# o The tail-recursive call: foo i;
#
then_expression
=
# NOTE: The list we give to 'block_to_let'
# must be in REVERSE order!
#
block_to_let
(
[ expression_to_declaration (tail_call_expression, body_left, body_right) ] # foo i
@
(reverse loop_declarations) # ++i
@
(reverse (let_expression_to_declaration_list body)) # printf "%d\n" i
);
if_expression
=
IF_EXPRESSION
{ test_case => test_expression,
then_case => then_expression,
else_case => done_expression
};
fun_apats
=
[ lowercase_id_to_variable_in_pattern_fixity_item fvar,
parameters
];
eq_clause
=
PATTERN_CLAUSE
{
patterns => fun_apats,
result_type => NULL, # constraint
expression => mark_expression (if_expression, body_left, body_right)
};
pattern_clauses
=
[ eq_clause ];
fun_decls
=
[ SOURCE_CODE_REGION_FOR_NAMED_FUNCTION
( NAMED_FUNCTION { pattern_clauses, is_lazy => FALSE, kind => PLAIN_FUN, null_or_type => NULL },
(body_left, body_right)
)
];
fun_definition
=
FUNCTION_DECLARATIONS (fun_decls, NIL);
outermost_block
=
LET_EXPRESSION {
declaration => fun_definition,
expression => initial_call_expression
};
outermost_block;
};
for_loop _
=>
{ exception IMPOSSIBLE;
raise exception IMPOSSIBLE;
};
end;
# Here we expand a thunk like {. #a < #b }
# into equivalent raw syntax \\ a = \\ b = a < b;
#
fun thunk
( lbrace_dotleft,
lbrace_dotright,
block_contents,
block_contentsleft,
block_contentsright,
rbraceright
)
=
{
my (block_contents, parameters)
=
mrs::map_raw_expression
( block_contents,
[]
)
\\ (x, y)
=>
case x
#
raw::IMPLICIT_THUNK_PARAMETER (path as [ fastsymbol ])
=>
( raw::VARIABLE_IN_EXPRESSION path,
fastsymbol ! y
);
_ => (x, y);
esac;
end;
aexp = block_contents;
dot_exp = [ { item => mark_expression (aexp, block_contentsleft, block_contentsright),
source_code_region => (block_contentsleft, block_contentsright),
fixity => NULL
}
];
app_exp = dot_exp;
expression = PRE_FIXITY_EXPRESSION app_exp;
# XXX BUGGO FIXME Right now if a #var is used outside of a {. ... }
# it triggers an "IMPOSSIBLE" exception. We need to
# do something like keep a count of #vars generated
# and consumed during parsetree generation, and if
# the numbers don't match (a single up/down counter
# would suffice, actually), then do a sweep through
# the parsetree turning them into regular variables
# while issuing sane diagnostic messages.
# If parameter list contains more than one element,
# sort it alphabetically and merge duplicates.
# This may reduce it to a one-element list:
#
parameters
=
case parameters
#
[] => parameters;
[x] => parameters;
_ => lms::sort_list_and_drop_duplicates
#
sy::symbol_compare
parameters;
esac;
case parameters
#
[] => { apat = { item => void_pattern,
source_code_region => (lbrace_dotleft, lbrace_dotright),
fixity => NULL
};
apats = [apat];
pattern = PRE_FIXITY_PATTERN apats;
eq_rule = CASE_RULE
{
pattern,
expression => mark_expression ( expression,
block_contentsleft,
block_contentsright
)
};
mark_expression (FN_EXPRESSION [eq_rule], lbrace_dotleft, rbraceright);
};
[x] => {
make_curried_fn_syntax( parameters, expression, block_contentsleft, block_contentsright );
};
_ => make_tuple_arg_fn_syntax( parameters, expression, block_contentsleft, block_contentsright );
esac;
};
};
end;
## Copyright 1992 by AT&T Bell Laboratories
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.