# nowhere.pkg
# Compiled by:
# src/lib/compiler/back/low/tools/nowhere/nowhere.lib### "Always try the problem that matters most to you."
###
### -- Andrew Wiles
stipulate
package rrs = adl_rewrite_raw_syntax_parsetree; # adl_rewrite_raw_syntax_parsetree is from src/lib/compiler/back/low/tools/adl-syntax/adl-rewrite-raw-syntax-parsetree.pkg package raw = adl_raw_syntax_form; # adl_raw_syntax_form is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-form.pkgherein
package no_where {
#
stipulate
#
i2s = int::to_string;
basis = "enum List X = NIL | ! of X * List(X) "
+ "enum Null_Or X = NULL | THE of X "
+ "enum order = LESS | EQUAL | GREATER ";
version = "1.2.2";
fun warning_fn file
=
"# WARNING: this is generated by running 'nowhere " + file + "'.\n" +
"# Do not edit this file directly.\n" +
"# Version " + version + "\n" +
"\n";
package raw_syntax_unparser = adl_raw_syntax_unparser; # adl_raw_syntax_unparser is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-unparser.pkg package mg
=
match_gen_g ( # match_gen_g is from src/lib/compiler/back/low/tools/match-compiler/match-gen-g.pkg #
package rsu = raw_syntax_unparser;
package rsj = adl_raw_syntax_junk;
);
package lit_map = mg::lit_map;
package parser
=
architecture_description_language_parser_g (
#
package rsu = raw_syntax_unparser; # "rsu" == "raw_syntax_unparser".
adl_mode = FALSE;
extra_cells = [];
);
package mc = mg::mc;
package spp = simple_prettyprinter; # simple_prettyprinter is from src/lib/prettyprint/simple/simple-prettyprinter.pkg include package adl_error;
include package adl_raw_syntax_junk;
++ = spp::CONS;
infix my ++ ;
herein
fun gen filename
=
{ # Parse file:
#
program = parser::load filename;
my () = mg::init();
# By default, we take after ML:
#
fun failure ()
=
raw::RAISE_EXPRESSION (id "MATCH");
literals = REF mg::lit_map::empty;
fun trans [ raw::LOCAL_DECL (defs, body) ]
=>
{ basis = parser::parse_string basis;
dts = mg::compile_types (basis @ defs);
# Translate a case statement:
#
fun compile_case (root, clauses)
=
{ dfa = mg::compile dts clauses;
mg::report
{ warning,
error,
log => write_to_log_and_stderr,
dfa,
rules => clauses
};
# print (mg::mc::to_string dfa)
mg::code_gen { root, dfa, fail=>failure,
literals };
}
except
mc::MATCH_COMPILER msg
=
{ error msg;
raw::CASE_EXPRESSION (root, clauses); # Just continue.
};
fun expression _ (e as raw::CASE_EXPRESSION (r, cs)) # Case expression.
=>
if (mg::is_complex cs) compile_case (r, cs);
else e;
fi;
#
expression _ e
=>
e;
end;
fun fbind (fb as raw::FUN (f, cs as c ! _))
=>
if (not (mg::is_complex cs))
#
fb;
else
# Expand function:
#
c -> raw::CLAUSE (args, _, _);
arity = length args;
vars = list::from_fn (arity, \\ i = "p_" + i2s i);
root = raw::TUPLE_IN_EXPRESSION (map id vars);
cs' = map (\\ raw::CLAUSE (ps, g, e) = raw::CLAUSE ( [ raw::TUPLEPAT ps ], g, e))
cs;
body = compile_case (root, cs');
raw::FUN (f, [ raw::CLAUSE (map raw::IDPAT vars, NULL, body)]);
fi;
fbind fb => fb;
end;
fun decl _ (raw::FUN_DECL fbs) => raw::FUN_DECL (map fbind fbs);
decl _ d => d;
end;
program
=
fns.rewrite_declaration_parsetree (raw::SEQ_DECL body)
where
fns = rrs::make_raw_syntax_parsetree_rewriters [ rrs::REWRITE_EXPRESSION_NODE expression, rrs::REWRITE_DECLARATION_NODE decl ];
end;
fun lit _ (raw::VAL_DECL [ raw::NAMED_VARIABLE (raw::WILDCARD_PATTERN, raw::LITERAL_IN_EXPRESSION (raw::STRING_LIT "literals"))])
=>
raw::VAL_DECL
(lit_map::keyed_fold_backward
(\\ (l, v, d)
=
raw::NAMED_VARIABLE (raw::IDPAT v, raw::LITERAL_IN_EXPRESSION l) ! d
)
[]
(*literals)
)
then
literals := lit_map::empty;
lit _ d => d;
end;
program
=
fns.rewrite_declaration_parsetree program
where
fns = rrs::make_raw_syntax_parsetree_rewriters [ rrs::REWRITE_DECLARATION_NODE lit ];
end;
if (lit_map::vals_count *literals > 0)
#
fail "missing declaration my _ = \"literals\"";
fi;
program;
};
trans [ raw::SEQ_DECL d ] => trans d;
trans [ raw::SOURCE_CODE_REGION_FOR_DECLARATION (_, d)] => trans [d];
#
trans _ => fail "program must be wrapped with local";
end;
program = trans program;
text = spp::prettyprint_expression_to_string (spp::PUSH_MODE "code" ++ spp::SET_WRAP_COLUMN 160 ++ raw_syntax_unparser::decl program);
warning_fn filename + text;
};
fun main x
=
if (gen_file::gen { program=>"nowhere", file_suffix=>"pkg", trans=>gen } x == 0 )
winix__premicrothread::process::success;
else
winix__premicrothread::process::failure;
fi;
end;
};
end;