+++ /dev/null
-#include <sclpl.h>
-
-static bool isatomic(AST* tree)
-{
- switch (tree->type) {
- case AST_STRING:
- case AST_SYMBOL:
- case AST_IDENT:
- case AST_CHAR:
- case AST_INT:
- case AST_FLOAT:
- case AST_BOOL:
- case AST_FUNC:
- case AST_TEMP:
- return true;
- default:
- return false;
- }
-}
-
-static bool isconst(AST* tree) {
- bool ret = isatomic(tree);
- if (!ret && tree->type == AST_FNAPP) {
- ret = isatomic(fnapp_fn(tree));
- for (int i = 0; i < vec_size(fnapp_args(tree)); i++) {
- ret = ret && isatomic(vec_at(fnapp_args(tree), i));
- }
- }
- return ret;
-}
-
-static AST* normalize_def(AST* tree)
-{
- Tok name = { .value.text = def_name(tree) };
- return Def(&name, normalize(def_value(tree)));
-}
-
-static AST* normalize_fnapp(AST* tree)
-{
- AST* normalized = tree;
- AST* fn = fnapp_fn(tree);
- /* Normalize the function */
- if (!isatomic(fn)) {
- AST* temp = TempVar();
- fnapp_set_fn(tree, temp);
- normalized = Let(temp, fn, tree);
- }
- /* Normalize the function arguments */
- vec_t temps;
- vec_init(&temps);
- vec_t* args = fnapp_args(tree);
- for (int i = 0; i < vec_size(args); i++) {
- AST* arg = (AST*)vec_at(args, i);
- if (!isatomic(arg)) {
- AST* temp = TempVar();
- vec_push_back(&temps, Let(temp, arg, NULL));
- vec_set(args, i, temp);
- }
- }
- /* Nest all the scopes and return the new form */
- for (int i = vec_size(&temps); i > 0; i--) {
- AST* let = (AST*)vec_at(&temps,i-1);
- let_set_body(let, normalized);
- normalized = let;
- }
- vec_deinit(&temps);
- return normalized;
-}
-
-static AST* normalize_if(AST* tree)
-{
- AST* cond = normalize(ifexpr_cond(tree));
- AST* thenbr = normalize(ifexpr_then(tree));
- AST* elsebr = normalize(ifexpr_else(tree));
- if (!isatomic(cond)) {
- AST* temp = TempVar();
- AST* body = IfExpr();
- ifexpr_set_cond(body, temp);
- ifexpr_set_then(body, thenbr);
- ifexpr_set_else(body, elsebr);
- tree = Let(temp, cond, body);
- } else {
- tree = IfExpr();
- ifexpr_set_cond(tree, cond);
- ifexpr_set_then(tree, thenbr);
- ifexpr_set_else(tree, elsebr);
- }
- return tree;
-}
-
-static AST* normalize_func(AST* tree)
-{
- func_set_body(tree, normalize(func_body(tree)));
- return tree;
-}
-
-static AST* normalize_let(AST* tree)
-{
- AST* var = let_var(tree);
- AST* val = normalize(let_val(tree));
- AST* body = normalize(let_body(tree));
- /* Find the inner most let block */
- if (val->type == AST_IF && isatomic(body)) {
- tree = val;
- } else if (!isconst(val)) {
- AST* let = val;
- while (let->type == AST_LET && let_body(let)->type == AST_LET)
- let = let_body(let);
- let_set_body(let, Let(var, let_body(let), body));
- tree = let;
- } else {
- tree = Let(var, val, body);
- }
- return tree;
-}
-
-AST* normalize(AST* tree)
-{
- if (NULL == tree)
- return tree;
- switch (tree->type)
- {
- case AST_DEF: tree = normalize_def(tree); break;
- case AST_FNAPP: tree = normalize_fnapp(tree); break;
- case AST_IF: tree = normalize_if(tree); break;
- case AST_FUNC: tree = normalize_func(tree); break;
- case AST_LET: tree = normalize_let(tree); break;
- default: break;
- }
- return tree;
-}
-
+++ /dev/null
-#include <sclpl.h>
-
-void codegen(FILE* file, AST* tree)
-{
- switch(tree->type) {
- case AST_STRING:
- fprintf(file, "\"%s\"", string_value(tree));
- break;
-
- case AST_SYMBOL:
- //fprintf(file, "__symbol(\"%s\")", symbol_value(tree));
- break;
-
- case AST_CHAR:
- //fprintf(file, "'%s'", char_value(tree));
- break;
-
- case AST_INT:
- fprintf(file, "%ld", integer_value(tree));
- break;
-
- case AST_FLOAT:
- fprintf(file, "%f", float_value(tree));
- break;
-
- case AST_BOOL:
- fprintf(file, "%s", bool_value(tree) ? "true" : "false");
- break;
-
- case AST_IDENT:
- fprintf(file, "%s", ident_value(tree));
- break;
-
- case AST_TEMP:
- fprintf(file, "_t%lu", temp_value(tree));
- break;
-
- case AST_DEF:
- if (def_value(tree)->type == AST_FUNC) {
- fprintf(file, "val %s", def_name(tree));
- codegen(file, def_value(tree));
- } else {
- fprintf(file, "val %s", def_name(tree));
- fprintf(file, " = ");
- codegen(file, def_value(tree));
- fprintf(file, ";");
- }
- break;
-
- case AST_IF:
- fprintf(file," if (");
- codegen(file, ifexpr_cond(tree));
- fprintf(file,")\n");
- codegen(file, ifexpr_then(tree));
- if (ifexpr_else(tree)) {
- fprintf(file,"\n else\n");
- codegen(file, ifexpr_else(tree));
- } else {
- fprintf(file," {return nil;}");
- }
- break;
-
- case AST_FUNC:
- fprintf(file,"(");
- for (size_t i = 0; i < vec_size(func_args(tree)); i++) {
- fprintf(file,"val ");
- codegen(file, vec_at(func_args(tree), i));
- if (i+1 < vec_size(func_args(tree)))
- fprintf(file,", ");
- }
- fprintf(file,") {\n");
- codegen(file, func_body(tree));
- fprintf(file,"\n}\n");
- break;
-
- case AST_FNAPP:
- codegen(file, fnapp_fn(tree));
- fprintf(file,"(");
- for (size_t i = 0; i < vec_size(fnapp_args(tree)); i++) {
- codegen(file, vec_at(fnapp_args(tree), i));
- if (i+1 < vec_size(fnapp_args(tree)))
- fprintf(file,",");
- }
- fprintf(file,")");
- break;
-
- case AST_LET:
- fprintf(file," {val ");
- codegen(file, let_var(tree));
- fprintf(file," = ");
- codegen(file, let_val(tree));
- fprintf(file,";\n");
- if (let_body(tree)->type != AST_LET && let_body(tree)->type != AST_IF) {
- fprintf(file," return ");
- codegen(file, let_body(tree));
- fprintf(file,";");
- } else {
- codegen(file, let_body(tree));
- }
- fprintf(file,"}");
- break;
-
- case AST_REQ:
- default:
- break;
- }
-}
+++ /dev/null
-require 'open3'
-
-describe "sclpl a-normal form" do
- context "literals" do
- it "strings should remain untouched" do
- expect(anf('"foo"')).to eq(['T_STRING:"foo"'])
- end
-
- it "characters should remain untouched" do
- expect(anf('\\c')).to eq(['T_CHAR:c'])
- end
-
- it "integers should remain untouched" do
- expect(anf('123')).to eq(['T_INT:123'])
- end
-
- it "floats should remain untouched" do
- expect(anf('123.0')).to eq(['T_FLOAT:123.000000'])
- end
-
- it "booleans should remain untouched" do
- expect(anf('true')).to eq(['T_BOOL:true'])
- end
-
- it "ids should remain untouched" do
- expect(anf('foo')).to eq(['T_ID:foo'])
- end
- end
-
- context "definitions" do
- it "should leave atomic defintions alone" do
- expect(anf('def foo 123;')).to eq([
- ["def", "foo", "T_INT:123"]
- ])
- end
-
- it "should leave normalize complex defintions" do
- expect(anf('def foo bar();')).to eq([
- ["def", "foo", ["T_ID:bar"]]
- ])
- end
- end
-
- context "function applications" do
- it "should leave an application with no args alone" do
- expect(anf('foo()')).to eq([
- ['T_ID:foo']
- ])
- end
-
- it "should leave an application with one arg alone" do
- expect(anf('foo(a)')).to eq([
- ['T_ID:foo', 'T_ID:a']
- ])
- end
-
- it "should normalize an application with a complex function" do
- expect(anf('(foo())()')).to eq([
- ['let', ['$:0', ['T_ID:foo']],
- ['$:0']]
- ])
- end
-
- it "should normalize an application with a complex arg" do
- expect(anf('foo(bar())')).to eq([
- ['let', ['$:0', ['T_ID:bar']],
- ['T_ID:foo', '$:0']]
- ])
- end
-
- it "should normalize an application with two complex args" do
- expect(anf('foo(bar(),baz())')).to eq([
- ['let', ['$:0', ['T_ID:bar']],
- ['let', ['$:1', ['T_ID:baz']],
- ['T_ID:foo', '$:0', '$:1']]]
- ])
- end
-
- it "should normalize an application with three complex args" do
- expect(anf('foo(bar(),baz(),boo())')).to eq([
- ['let', ['$:0', ['T_ID:bar']],
- ['let', ['$:1', ['T_ID:baz']],
- ['let', ['$:2', ['T_ID:boo']],
- ['T_ID:foo', '$:0', '$:1', '$:2']]]]
- ])
- end
-
- it "should normalize an application with simple and complex args (s,c,c)" do
- expect(anf('foo(a,bar(),baz())')).to eq([
- ['let', ['$:0', ['T_ID:bar']],
- ['let', ['$:1', ['T_ID:baz']],
- ['T_ID:foo', 'T_ID:a', '$:0', '$:1']]]
- ])
- end
-
- it "should normalize an application with simple and complex args (c,s,c)" do
- expect(anf('foo(bar(),a,baz())')).to eq([
- ['let', ['$:0', ['T_ID:bar']],
- ['let', ['$:1', ['T_ID:baz']],
- ['T_ID:foo', '$:0', 'T_ID:a', '$:1']]]
- ])
- end
-
- it "should normalize an application with simple and complex args (c,c,s)" do
- expect(anf('foo(bar(),baz(),a)')).to eq([
- ['let', ['$:0', ['T_ID:bar']],
- ['let', ['$:1', ['T_ID:baz']],
- ['T_ID:foo', '$:0', '$:1', 'T_ID:a']]]
- ])
- end
- end
-
- context "if expressions" do
- it "should leave atomic expressions alone" do
- expect(anf('if 1 2 3;')).to eq([
- ["if", "T_INT:1",
- ["let", ["$:0", "T_INT:2"],
- ["let", ["$:1", "T_INT:3"],
- "$:1"]]]
- ])
- end
-
- it "should normalize the conditional expression" do
- expect(anf('if foo() 2 else 3;')).to eq([
- ["let", ["$:2", ["T_ID:foo"]],
- ["if", "$:2",
- ["let", ["$:0", "T_INT:2"], "$:0"],
- ["let", ["$:1", "T_INT:3"], "$:1"]]]
- ])
- end
-
- it "should normalize the first branch expression" do
- expect(anf('if 1 foo() else 3;')).to eq([
- ["if", "T_INT:1",
- ["let", ["$:0", ["T_ID:foo"]], "$:0"],
- ["let", ["$:1", "T_INT:3"], "$:1"]]
- ])
- end
-
- it "should normalize the first branch expression" do
- expect(anf('if 1 2 else foo();')).to eq([
- ["if", "T_INT:1",
- ["let", ["$:0", "T_INT:2"], "$:0"],
- ["let", ["$:1", ["T_ID:foo"]], "$:1"]]
- ])
- end
- end
-
- context "function literals" do
- it "should normalize a literal with a simple expression" do
- expect(anf('fn() 123;')).to eq([
- ["fn", [],
- ["let", ["$:0", "T_INT:123"],
- "$:0"]]
- ])
- end
-
- it "should normalize a literal with two sequential simple expressions" do
- expect(anf('fn() 1 2;')).to eq([
- ["fn", [],
- ["let", ["$:0", "T_INT:1"],
- ["let", ["$:1", "T_INT:2"],
- "$:1"]]]
- ])
- end
-
- it "should normalize a literal with three sequential simple expressions" do
- expect(anf('fn() 1 2 3;')).to eq([
- ["fn", [],
- ["let", ["$:0", "T_INT:1"],
- ["let", ["$:1", "T_INT:2"],
- ["let", ["$:2", "T_INT:3"],
- "$:2"]]]]
- ])
- end
-
- it "should normalize a literal with a complex expression" do
- expect(anf('fn() foo(bar());')).to eq([
- ["fn", [],
- ["let", ["$:1", ["T_ID:bar"]],
- ["let", ["$:0", ["T_ID:foo", "$:1"]],
- "$:0"]]]
- ])
- end
-
- #it "should normalize a literal with an if expression" do
- # expect(anf('fn() if 1 2 else 3;;')).to eq([
- # ["fn", [],
- # ["if", "T_INT:1",
- # ["let", ["$:1", "T_INT:2"], "$:1"],
- # ["let", ["$:2", "T_INT:3"], "$:2"]]]
- # ])
- #end
-
- #it "should normalize a literal with two sequential if expressions" do
- # expect(anf('fn() if 1 2 else 3; if 1 2 else 3; ;')).to eq([
- # ])
- #end
- end
-end
projects / proto / sclpl.git / commitdiff