Skip to content

Commit

Permalink
minor improvements
Browse files Browse the repository at this point in the history
  • Loading branch information
@billhails
billhails committed Nov 23, 2024
1 parent 9095f51 commit 8b4f65f
Show file tree
Hide file tree
Showing 5 changed files with 104 additions and 46 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ tmp_scm/
cekf
pratt_test
tags
xref
.generated
.*.swp
.$*.drawio.*
Expand Down
5 changes: 4 additions & 1 deletion Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,9 @@ $(EXTRA_DOCS): docs/generated/%.md: src/%.yaml tools/makeAST.py src/primitives.y
tags: src/* $(EXTRA_TARGETS)
ctags src/* $(EXTRA_TARGETS)

xref: src/* $(EXTRA_TARGETS)
ctags -x src/* $(EXTRA_TARGETS) > $@

$(MAIN_OBJ) $(OBJ): obj/%.o: src/%.c | obj
$(CC) $(INCLUDE_PATHS) -c $< -o $@

Expand Down Expand Up @@ -193,7 +196,7 @@ generated/UnicodeDigits.inc: unicode/UnicodeData.txt tools/makeUnicodeDigits.py
$(PYTHON) ./tools/makeUnicodeDigits.py > $@

realclean: clean
rm -rf tags unicode
rm -rf tags xref unicode

clean: deps
rm -rf $(TARGET) obj callgrind.out.* generated $(TEST_TARGETS) .typedefs src/*~ .generated gmon.out *.fnc core.*
Expand Down
14 changes: 1 addition & 13 deletions fn/listutils.fn
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,19 +131,7 @@ fn indices(f, lst) {

// nths: list(number) -> list(#a) -> list(#a)
fn nths (indices, lst) {
let
fn helper {
([], _) { [] }
(h @ t, n) {
if (member(n, indices)) {
h @ helper(t, n + 1)
} else {
helper(t, n + 1)
}
}
}
in
helper(lst, 0)
map(fn (n) { nth(n, lst) }, indices)
}

// except_nth: number -> list(#a) -> list(#a)
Expand Down
117 changes: 90 additions & 27 deletions fn/pettersson92.fn
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,9 +7,9 @@ let
link "listutils.fn" as lst;

infix left 80 "=>" fn (arg, fun) { fun(arg) };
infix left 80 "?" fn (l, n) { lst.nth(n, l) };
infix left 80 "??" fn (l, n) { lst.nths(n, l) };
infix left 80 "|>" fn (l, f) { lst.map(f, l) };
infix left 80 "?" fn (l, n) { lst.nth(n, l) };
infix left 80 "??" fn (l, ns) { lst.nths(ns, l) };
infix left 80 ".." lst.range;
prefix 85 "$" io.to_string;

Expand Down Expand Up @@ -59,8 +59,6 @@ let
test(string, string, list(string), number, list(Arc))
}

// typedef Check { check(pattern -> list(string)) }

print tpmc(state) {
let fn h {
(final(stamp, free, refcount, substs, code)) {
Expand Down Expand Up @@ -111,7 +109,7 @@ let
typedef code {
symbol(string) |
case(code, list(code)) |
rule(pattern, code) |
of(pattern, code) |
letrec(list(#(code, code)), code) |
lambda(list(code), code) |
apply(code, list(code))
Expand Down Expand Up @@ -149,29 +147,39 @@ let
(_, _, d, []) { #([], d) }
(base, n, d, pat @ pats) {
let
// tag: string -> pattern -> substs -> #(pattern, substs)
// tag: string -> pattern -> substs ->
// #(pattern, substs)
fn tag {
(base, wildcard, d) { #(tagged(base, wildcard), d) }
(base, wildcard, d) {
#(tagged(base, wildcard), d)
}
(base, variable(name), d) {
#(tagged(base, wildcard),
dict.insert(name, base, d))
}
(base, c = const(_), d) { #(tagged(base, c), d) }
(base, c = const(_), d) {
#(tagged(base, c), d)
}
(base, ctor(name, pats), d) {
mapTag(base, 0, d, pats) => fn (#(pats, d)) {
mapTag(base, 0, d, pats) =>
fn (#(pats, d)) {
#(tagged(base, ctor(name, pats)), d)
}
}
(base, tuple(pats), d) {
mapTag(base, 0, d, pats) => fn (#(pats, d)) {
mapTag(base, 0, d, pats) =>
fn (#(pats, d)) {
#(tagged(base, tuple(pats)), d)
}
}
(_, tagged(t, _), _) { error("already tagged: " @@ t) }
(_, tagged(t, _), _) {
error("already tagged: " @@ t)
}
}
in
tag(makeTag(base, n), pat, d) => fn (#(pat, d)) {
mapTag(base, n + 1, d, pats) => fn (#(pats, d)) {
mapTag(base, n + 1, d, pats) =>
fn (#(pats, d)) {
#(pat @ pats, d)
}
}
Expand All @@ -187,7 +195,7 @@ let
}
}
(case(cond, rules)) { case(h(cond), rules |> h) }
(rule(pattern, action)) { rule(pattern, h(action)) }
(of(pattern, action)) { of(pattern, h(action)) }
(letrec(defs, body)) {
letrec(defs |> fn {
(#(name, value)) { #(h(name), h(value)) }
Expand All @@ -201,15 +209,22 @@ let
// renameRow: #(list(pattern), code) -> #(list(pattern), tpmc)
fn renameRow (#(row, target, label)) {
mapTag("x", 0, dict.E, row) => fn(#(pats, substs)) {
#(pats, final(label, [], 1, substs, applySubsts(substs, target)))
#(pats,
final(label,
[],
1,
substs,
applySubsts(substs, target)))
}
}
// labelRows: list(#(list(pattern), code)) ->
// list(#(list(pattern), code, string))
fn labelRows (rows) {
let fn h {
([], _) { [] }
(#(pats, body) @ rest, n) { #(pats, body, "Q$" @@ $n) @ h(rest, n + 1) }
(#(pats, body) @ rest, n) {
#(pats, body, "Q$" @@ $n) @ h(rest, n + 1)
}
}
in h(rows, 0)
}
Expand Down Expand Up @@ -297,7 +312,11 @@ let
} else {
// Otherwise, a default arc (_,state) is the last arc.
let var = varName(N?0);
in test("LD_" @@ var, var, [], 1, uarcs @@ [makeDefaultArc(N, M_N, S)])
in test("LD_" @@ var,
var,
[],
1,
uarcs @@ [makeDefaultArc(N, M_N, S)])
}
}

Expand All @@ -310,7 +329,9 @@ let
// makeErrorArc: list(pattern) => Arc
fn makeErrorArc {
(tagged(x, _) @ _) {
arc(tagged(x, wildcard), [], final("error", [], 1, dict.E, symbol("error")))
arc(tagged(x, wildcard),
[],
final("error", [], 1, dict.E, symbol("error")))
}
(_) { error("makeErrorArc") }
}
Expand Down Expand Up @@ -537,7 +558,7 @@ let

// Stage 4.2 Translate the DFA to intermediate code
// translate: tpmc -> code
fn translate (tpmc) {
fn translate (original, tpmc) {
let
fn collectArcs {
([], d) { d }
Expand Down Expand Up @@ -580,12 +601,13 @@ let
}
}
fn translateArc(arc(pat, _, state)) {
rule(pat, translateState(state))
of(pat, translateState(state))
}
fn translateLambdas(lambdas) {
dict.values(lambdas) |> fn {
(final(stamp, free, _, _, code)) {
#(symbol(stamp), lambda(free |> fn(s){symbol(s)}, code))
#(symbol(stamp),
lambda(free |> fn (s) { symbol(s) }, code))
}
(test(stamp, var, free, _, arcs)) {
#(symbol(stamp), lambda(free |> fn (s) {
Expand All @@ -597,13 +619,21 @@ let
fn wrapLetRec(body, lambdas) {
letrec(translateLambdas(lambdas), body)
}
in collectLambdas(tpmc, dict.E) => wrapLetRec(translateState(tpmc))
fn wrapLambda(code) {
let fn h {
([], _) { [] }
(_ @ args, n) {
symbol("x$" @@ $n) @ h(args, n + 1)
}
}
unsafe fn getargs(#(args, _) @ _) { args }
in lambda(h(getargs(original), 0), code)
}
in collectLambdas(tpmc, dict.E) =>
wrapLetRec(translateState(tpmc)) =>
wrapLambda
}

///////////////////////////////////////////////////////////////////////////
// TODO: Wrap resulting letrec in a top-level lambda
///////////////////////////////////////////////////////////////////////////

///////////////////////////////////////////////////////////////////////////
// Input
///////////////////////////////////////////////////////////////////////////
Expand Down Expand Up @@ -634,6 +664,39 @@ let
///////////////////////////////////////////////////////////////////////////

in

print input => rename => match => countStates =>
transferRefCountsToStates => calculateFreeVariables => translate
transferRefCountsToStates => calculateFreeVariables =>
translate(input)

// lambda(
// [ symbol("x$0"), symbol("x$1"), symbol("x$2"), symbol("x$3") ],
// letrec([
// #(symbol("Q$1"), lambda([symbol("x$2$0")], symbol("x$2$0"))),
// #(symbol("error"), lambda([], symbol("error")))],
// case(symbol("x$1"), [
// of(x$1=1,
// case(symbol("x$2"), [
// of(x$2=#(x$2$0=_, x$2$1=_),
// case(symbol("x$3"), [
// of(x$3=cons(x$3$0=_, x$3$1=_),
// case(symbol("x$2$1"), [
// of(x$2$1=3,
// apply(symbol("cons"), [
// symbol("x$3$0"),
// symbol("x$3$1")])),
// of(x$2$1=_,
// apply(symbol("error"),
// []))])),
// of(x$3=nil,
// apply(symbol("Q$1"),
// [symbol("x$2$0")]))]))])),
// of(x$1=_,
// case(symbol("x$2"), [
// of(x$2=#(x$2$0=_, x$2$1=_),
// case(symbol("x$3"), [
// of(x$3=nil,
// apply(symbol("Q$1"),
// [symbol("x$2$0")])),
// of(x$3=_,
// apply(symbol("error"),
// []))]))]))])))
13 changes: 8 additions & 5 deletions src/tc_helper.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ void ppTcType(TcType *type) {
ppTcVar(type->val.var);
break;
case TCTYPE_TYPE_BIGINTEGER:
eprintf("bigint");
eprintf("number");
break;
case TCTYPE_TYPE_SMALLINTEGER:
eprintf("smallint");
Expand Down Expand Up @@ -66,7 +66,7 @@ void ppTcType(TcType *type) {
}

void ppTcFunction(TcFunction *function) {
eprintf("<function>(");
eprintf("(");
ppTcType(function->arg);
eprintf(") -> ");
ppTcType(function->result);
Expand Down Expand Up @@ -110,9 +110,12 @@ static void ppUserTypeArgs(TcUserTypeArgs *args) {
}

void ppTcUserType(TcUserType *userType) {
eprintf("%s:%d(", userType->name->name, userType->ns);
ppUserTypeArgs(userType->args);
eprintf(")");
eprintf("%s", userType->name->name);
if (userType->args != NULL) {
eprintf("(");
ppUserTypeArgs(userType->args);
eprintf(")");
}
}

bool eqTcVar(struct TcVar *a, struct TcVar *b, HashTable *map) {
Expand Down

0 comments on commit 8b4f65f

Please sign in to comment.