// syntax: syn3

//
// Synsh compiles source files from synsh.stx into shell scripts
//  (or any other text-based imperative language, really...)
//
//
// This file isn't meant to be run directly -- look for files
//  which import this file.
//


import "print";

// Always unwrap exprs:
macro synsh_expr $_;

//
// This set of funcs merges successive exprs by merging
//  their code sequentially, and allowing the last item
//  to determine the rest of the returned attributes (src,
//  dst, type, others?)
//
defun synsh_exprs3(first, second)
{
	if $second then {

		if $second's src then
			src: $second's src
		else
			src: { $first's src; };

		if $second's dst then
			dst: $second's dst
		else
			dst: { $first's dst; };

		if $second's type then
			type: $second's type
		else
			type: { $first's type; };

		code: {
			$first's code;
			$second's code;
		};
	} else {
		$first;
	};
};

defun synsh_exprs2(first, rest)
{
//	println("EXPRS2:", '$&first);
//	println("  REST:", '$&rest);
	if $rest then
		synsh_exprs3($first, synsh_exprs2(@$rest's first, $rest's rest))
	else
		$first;
};

// Don't eval rest before its time:
macro synsh_exprs synsh_exprs2($first, '$&rest);

//------------------------- Support for Synsh Types ---------------------------------

type = {
	// Technichally this should be properly recursive, but...
	src: "type1";		// Change this back to "type" when needed
	type: src: "type2";	// Change this back to "type" when needed
};

// At present, new types have to be declared in syn, not synsh
//  (see, e.g., tcshTypes.syn)
//
defun synsh_type(name)
{
	src: $name;
	type: type;
};

// This generically evaluates all variables as if they were syntactic macros:
macro synsh_var
	if %ismacro($var) then
		@%@$var: %syn_nil	// eval $var with no parameters.
	else
		println("ERROR: Attempt to use unassigned variable:", $var);

// Variable declarations get a type and a var name.
//  We'll invoke new_type() and make the result the
//  definition of var (when var is invoked via synsh_var
//  via the above macro):
defun synsh_var_decl2(name, type, initfunc)
{
//	println("NOTE: Declaring", $name, "of type", $type, "with", $initfunc);
	if %ismacro($initfunc) then
		@syn_macro: {
			syn_name: $name;
			syn_def: syn_quote: @%@$initfunc: %syn_nil;
		}
	else
		println("ERROR: missing initializer", $initfunc);
};

macro synsh_var_decl
	synsh_var_decl2('$&var, $type, %strcat("new_", $type's src));

//---------------------------------------------------------
//
// These methods parse function prototypes...
//

//
// These are support for synsh_fix_proto (see below):
//
defun synsh_eval_proto_param_types(params) {
	//println("EVAL_PARAM_TYPE:", $params's first's type, "EVALED:", @($params's first's type));
	if $params then {
		first: {
			name: $params's first's name;
			type: @($params's first's type);
		};
		if $params's rest then
			rest: synsh_eval_proto_param_types($params's rest);
	};
};

defun synsh_typename(val) {
	// println("TYPENAME:", $val, "is", $val's type's src);
	if $val's type's src then
		$val's type's src
	else
		"ERR";
};

defun synsh_mangle_name(params)
	if $params's rest then
		%strcat(synsh_typename($params's first),
			%strcat("_", synsh_mangle_name($params's rest)))
	else if $params's first then
		synsh_typename($params's first)
	else "VOID";

defun synsh_mangle_name2(name, params)
		%strcat($name, %strcat("_", synsh_mangle_name($params)));

defun synsh_fix_proto2(func, params)
{
	fullname: synsh_mangle_name2($func, $params);
	params: $params;
};

//
// This evals all the types in proto, and also
//  adds a fullname field which contains the type-mangled
//  name of the function:
//
defun synsh_fix_proto(proto)
{
	// println("FIX_PROTO:", $proto);
	type: @($proto's type);
	func: $proto's func;
	synsh_fix_proto2($proto's func, synsh_eval_proto_param_types($proto's params));
};

//----------------------------------------------------------
// 
// These methods handle function calls, as follows:
//
//		- eval all the parameters.  Each one should return a type, src, and code.
//		- mangle the function name based on the parameter types.
//		- call the mangled-named function, with the pre-evaled params.
//		- merge the param's code with the code returned by the function.
//

//
// func and parmno are just for error reporting:
//
defun synsh_eval_params2(func, parmno, first, rest)
{
	// println("PARAM", $parmno, "OF", $func, "IS:", $first);
	if $first's type then {
		first: $first;
	} else {
		println("ERROR: Parameter", $parmno, "to", $func, "is bogus.");
		first: "ERR";
	};
	if $rest then
		rest: synsh_eval_params($func, $parmno+1, $rest);
};

defun synsh_eval_params(func, parmno, params) {
	// println("EVAL PARAMS ENTRY");
	// println("  FIRST:", $params's first);
	if $params's first then
		synsh_eval_params2($func, $parmno, @($params's first), $params's rest);
};

//
// This just returns all the code blocks in params:
//
defun synsh_merge_params_code(evaledParams)
{
	// println("PARAM CODE MERGE:", $evaledParams's first's code);
	$evaledParams's first's code;
	if $evaledParams's rest then
		synsh_merge_params_code($evaledParams's rest);
};

//
// Fourth, merge the param code with the method's returned result:
//
defun synsh_funcall4(result, evaledParams)
{
	// println("RESULT:", $result);
	if $result's type then {
		src: { $result's src; };
		dst: { $result's dst; };
		type: $result's type;
		code: {
			synsh_merge_params_code($evaledParams);
			$result's code;
		};
	} else
		println("ERROR: returned result has no type.");
};

//
// Third, invoke the type-mangled macro:
//
defun synsh_funcall3(name, fullname, evaledParams)
{
//	println("NOTE: Evaluating", $fullname);
// println("WITH PARAMS:", $evaledParams);
	if %ismacro($fullname) then
		// (@(%@(fullname): evaledParams))
		synsh_funcall4(@%@$fullname: '$evaledParams, $evaledParams)
	else
		println("ERROR: method", $fullname, "is undefined.");
};

//
// Second, mangle the name:
//
defun synsh_funcall2(name, evaledParams)
	synsh_funcall3($name, synsh_mangle_name2($name, $evaledParams), $evaledParams);

//
// First, eval the parameters:
//
macro synsh_funcall synsh_funcall2('$&func, synsh_eval_params('$&func, 1, '$&params));


//----------------------------------------------------------
//
// When someone defines a macro in synsh...
//
// We need to define a syn macro for the type-mangled name which returns:
//
//		type: the type of the returned value
//		src:  the string to get this value (e.g., "$var" or "'foo'" or "20")
//		dst:  the string to set this value (optional; e.g. "var")
//		code: any setup code for the macro.
//
// The macro body presumably returns these things too, so it's just a
//    matter of invoking the body with the remapped parameters, and then
//    merging.


//
// This expects the the pre-evaled proto, plus the return
//  value from the evaled body, and returns the final composite value:
//
defun synsh_merge(proto, body)
{
	//println("MERGE Proto:", $proto);
	//println("MERGE Body:", $body);

	if $proto's type then {
		src: { $body's src; };
		dst: { $body's dst; };
		type: $proto's type;
		code: { $body's code; };
	} else
		println("ERROR: method returns unknown type.");
};


defun synsh_strip_code(val)
{
	//println("STRIP:", $val);
	src:  { $val's src; };
	dst:  { $val's dst; };
	type: { $val's type; };
};

//
// This remaps a first/rest style parameter list into a
//  key-value parameter list based on prototype params:
//
defun synsh_remap(proto, params)
{
//	println("REMAP Proto:", $proto, "Params:", $params);
//	println("REMAP RAW PARAMS:", '$&params);
	if $proto then
		if $params then {
//println("PARAM:", $proto's first's name, "=", $params's first);
			// Gah -- this strip_code is kind of ugly -- is this the
			//   right way to do this?  Without this, code gets re-emitted
			//   multiple times when it shouldn't; stripping the code is
			//   somewhat analogous to putting the value in "quotes" -- i.e.,
			//   as in to say it is pre-evaluated and only need be referenced,
			//   not computed.

			// Note the 'quote is necessary here since the params have been
			//  pre-evaluated and need to be turned back into "code" according
			//  to syn conventions:
			%@$proto's first's name: 'synsh_strip_code($params's first);
			synsh_remap($proto's rest, $params's rest);
		};
};


defun synsh_macro2(proto, def)
{
//	println("Proto:", $proto);
//	println("Def:", $def);

//	println("NOTE: defining", $proto's fullname, "via", $$_f);

	@syn_macro: {
		syn_name: '$$_f;
		syn_def: $def;
	};

	//	macro FULLNAME
	//		synsh_merge($proto, @%@$$_f: synsh_remap($proto's params, PARAMS));
	//------------- this is an expansion of the above:
	@%{
		syn_macro{
			syn_name%{ $proto's fullname }
			syn_def{
				syn_funcall{
					syn_func{
						syn_name=synsh_merge
						}
					syn_params{
						syn_first%{ '$proto }
						syn_rest{
							syn_first{
								syn_eval{
									syn_node{
										syn_name%{ $$_f }
										syn_val{
											syn_funcall{
												syn_func{
													syn_name=synsh_remap
													}
												syn_params{
													syn_first%{
														'$proto's params
														}
													syn_rest{
														syn_first{
															syn_macvar=_
															}
														}
													}
												}
											}
										}
									}
								}
							}
						}
					}
				}
			}
		};
	//-------------
};

macro synsh_macro
	synsh_macro2(synsh_fix_proto('$&proto), '$&def);

//-----------------------------------------------------------------------------------

// shline_var's are when macro variables show up in an shline...
//  which generally means we're expecting their src string to
//  be subbed in:
//
macro shline_var {
	// println("VAR ACCESS RAW:", '$&_);
	if $_'s src then
		$_'s src
	else
		println("ERROR: an un-sourceable inline-variable was accessed.");
};

// Like shline_vars, but these call for the destination representation:
macro shline_dst {
	if $_'s dst then
		$_'s dst
	else
		println("ERROR: tried to write to a non-dest value.");
};


//-----------------------------------------------------------------------------------

defun synsh_printn(str, n)
	if $n > 0 then {
		%print($str);
		synsh_printn($str, $n-1);
	};

defun synsh_printlines2(first, indent) {
	if $first then {
		if $first's syn_name == "line" then {
			if $first's syn_val == "INDENT" then
				synsh_printlines2($first's syn_next, $indent+1)
			else if $first's syn_val == "OUTDENT" then
				synsh_printlines2($first's syn_next, $indent-1)
			else {
				synsh_printn("    ", $indent);
				println($first's syn_val);
				synsh_printlines2($first's syn_next, $indent);
			};
		} else {
			println("ERROR: Non-line in code block:", $first's syn_name,"=", $first's syn_val);
			synsh_printlines2($first's syn_next, $indent);
		};
	};
};

defun synsh_printlines(first)
	synsh_printlines2($first, 0);