ref: 98bc6360dd36c2545207f81373ca4910c06d164e
parent: b2ddf4524fe751e90f2eb3e1ce5000446835f141
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Thu Aug 24 09:55:18 EDT 2023
Add BK combinator.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.0
684
-(($A :0 ((_510 _463) ((($S' ($C ((($C' ($S' _510)) ($C _2)) (($B ($B (_510 _538))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _511)) ((($C' $B) (($B _597) (($B _528) ((($C' _634) _8) 0)))) (($B (_597 _531)) (($B (_542 "top level defns: ")) _492)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _511)) ((($C' $B) (($B _597) (($B _528) ((($C' _634) _8) 1)))) (_527 ($T (($B ($B (_597 _531))) ((($C' $B) _542) (($B (_542 " = ")) _240))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _511))) ((($C' $B) (($B $B) (($B _597) (($B _533) _11)))) (($B ($B (_542 _1))) (($B (($C' _542) _492)) (_542 (($O 10) $K))))))) (($B ($B (_510 _538))) ((($C' $B) (($B $B) (($B _597) (($B _528) ((($C' _634) _8) 0))))) (($B ($B (_597 _531))) (($B ($B (_542 "final pass "))) ((($C' ($C' _542)) (($B ($B (_505 6))) (($B ($B _492)) _628))) "ms")))))))) _3)))) _488))) (($B (($C' $C) (($B ($C _547)) _240))) (($C _560) (_577 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B ($B $K))) (($B ($B ($B ($B (_542 "(($A :"))))) (($B ($B (($C' $B) (($B _542) _492)))) (($B ($B ($B (_542 (($O 32) $K))))) ((($C' $B) (($B ($C' _542)) ($B _240))) (($B (_542 ") ")) (($C _542) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _217)) $I))) (($B $K) $K))) $K))))) $T)) (($B (($S' _597) (($B _594) (($B (_597 _642)) (($B (_542 "main: findIdent: ")) _310))))) ($C _481)))) (($B ($B _485)) (($B (($C' _544) (($B $T) (($B ($C $B)) (($B ($B ($B $K))) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _560) (_577 0)))))) (($B (_597 _216)) (($B (_542 (($O 95) $K))) _492))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _559) (_546 (_503 "-v")))) ((_576 _503) "-r"))) (($B (_540 (($O 46) $K))) (($B _596) (_545 ((_564 _619) "-i")))))) (($B (_597 _571)) ((($C' _542) (($B _596) (_545 ((_564 _619) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _630) _559) 1)) (_642 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _571)) (_546 ((_598 _639) ((_598 (_503 (($O 45) $K))) (_557 1)))))))) (($A :1 "v3.0\10&") (($A :2 ((($S' ($S' _510)) _16) (($B ($B ($B (_510 _538)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _511) (($B (_597 _529)) (($B (_597 (_558 1000000))) _44)))))) (($B ($B ($B ($B (_510 _538))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _511))) ((($C' $B) (($B $B) (($B _597) (($B _528) ((($C' _634) _8) 0))))) (($B ($B (_597 _531))) (($B ($B (_542 "combinator conversion "))) ((($C' ($C' _542)) (($B ($B (_505 6))) (($B ($B _492)) _628))) "ms"))))))) (($B ($B _512)) (($B $P) (($C _312) "main"))))))) (_544 ($T ((($C' ($C' $O)) ((($C' $B) $P) _243)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_597 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _210))) (($C' ($C' _544)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _597) (($B _594) (($B (_597 _642)) (_542 "not found "))))) ($C _211))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) (($B $K) $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _242))) (($B (_597 (_594 (_642 "primlookup")))) (($C (_580 _503)) _5))))) (_642 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P (($O 43) $K)) $+)) (($O (($P (($O 45) $K)) $-))
\ No newline at end of file
+(($A :0 ((_510 _463) ((($S' ($C ((($C' ($S' _510)) ($C _2)) (($B ($B (_510 _538))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B ($B $B))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) (($B $B) (($B $B) (($B $C') (($B ($S' _511)) ((($C' $B) (($B _597) (($B _528) ((($C' _634) _8) 0)))) (($B (_597 _531)) (($B (_542 "top level defns: ")) _492)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _511)) ((($C' $B) (($B _597) (($B _528) ((($C' _634) _8) 1)))) (_527 ($T (($B ($B (_597 _531))) ((($C' $B) _542) (($B (_542 " = ")) _240))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _511))) ((($C' $B) (($B $B) (($B _597) (($B _533) _11)))) (($B ($B (_542 _1))) (($B (($C' _542) _492)) (_542 (($O 10) $K))))))) (($B ($B (_510 _538))) ((($C' $B) (($B $B) (($B _597) (($B _528) ((($C' _634) _8) 0))))) (($B ($B (_597 _531))) (($B ($B (_542 "final pass "))) ((($C' ($C' _542)) (($B ($B (_505 6))) (($B ($B _492)) _628))) "ms")))))))) _3)))) _488))) (($B (($C' $C) (($B ($C _547)) _240))) (($C _560) (_577 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_542 "(($A :"))))) (($B ($B (($C' $B) (($B _542) _492)))) (($B ($B ($B (_542 (($O 32) $K))))) ((($C' $B) (($B ($C' _542)) ($B _240))) (($B (_542 ") ")) (($C _542) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _217)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _597) (($B _594) (($B (_597 _642)) (($B (_542 "main: findIdent: ")) _310))))) ($C _481)))) (($B ($B _485)) (($B (($C' _544) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _560) (_577 0)))))) (($B (_597 _216)) (($B (_542 (($O 95) $K))) _492))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _559) (_546 (_503 "-v")))) ((_576 _503) "-r"))) (($B (_540 (($O 46) $K))) (($B _596) (_545 ((_564 _619) "-i")))))) (($B (_597 _571)) ((($C' _542) (($B _596) (_545 ((_564 _619) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _630) _559) 1)) (_642 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _571)) (_546 ((_598 _639) ((_598 (_503 (($O 45) $K))) (_557 1)))))))) (($A :1 "v3.0\10&") (($A :2 ((($S' ($S' _510)) _16) (($B ($B ($B (_510 _538)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _511) (($B (_597 _529)) (($B (_597 (_558 1000000))) _44)))))) (($B ($B ($B ($B (_510 _538))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _511))) ((($C' $B) (($B $B) (($B _597) (($B _528) ((($C' _634) _8) 0))))) (($B ($B (_597 _531))) (($B ($B (_542 "combinator conversion "))) ((($C' ($C' _542)) (($B ($B (_505 6))) (($B ($B _492)) _628))) "ms"))))))) (($B ($B _512)) (($B $P) (($C _312) "main"))))))) (_544 ($T ((($C' ($C' $O)) ((($C' $B) $P) _243)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_597 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _210))) (($C' ($C' _544)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _597) (($B _594) (($B (_597 _642)) (_542 "not found "))))) ($C _211))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _242))) (($B (_597 (_594 (_642 "primlookup")))) (($C (_580 _503)) _5))))) (_642 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O (($P (($O 43) $K)) $+)) (($O (($P (($O 45) $K)
\ No newline at end of file
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -339,7 +339,7 @@
S.return $ mkCase i narms ndflt
eMatchErr :: Exp
-eMatchErr = dsExpr $ EApp (ELit (LPrim "error")) (ELit $ LStr "no match")
+eMatchErr = App (Lit (LPrim "error")) (Lit (LStr "no match"))
-- If the first expression isn't a variable, the use
-- a let binding and pass variable to f.
@@ -358,7 +358,7 @@
case ae of
Var _ -> True
Lit _ -> True
- App (Lit _) _ -> True
+-- App (Lit _) _ -> True
_ -> False
-- Ugh, what a hack
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -340,8 +340,12 @@
in
if isK ff && isI aa then
Lit (LPrim "A")
--- else if isI ff then
--- aa
+{- Using I x --> x does not improve things.+ else if isI ff then
+ aa
+-}
+ else if isB ff && isK aa then
+ Lit (LPrim "BK")
else if isC ff && isI aa then
Lit (LPrim "T")
else
@@ -434,3 +438,6 @@
--
-- Q = C I
-- Q x y z = (C I x y) z = I y x z = y x z
+--
+-- BK = B K
+-- BK x y z = B K x y z = K (x y) z = x y
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -63,7 +63,7 @@
putStrLn $ "final pass " ++ padLeft 6 (showInt (t2-t1)) ++ "ms"
version :: String
-version = "v3.0\n"
+version = "v3.1\n"
type Program = (Ident, [LDef])
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -51,6 +51,7 @@
("T", primitive "T"), ("Y", primitive "Y"), ("B'", primitive "B'"),+ ("BK", primitive "BK"), ("+", primitive "+"), ("-", primitive "-"), ("*", primitive "*"),--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -56,7 +56,7 @@
#define FASTTAGS 1
#define UNIONPTR 1
-#define VERSION "v3.0\n"
+#define VERSION "v3.1\n"
#define HEAP_CELLS 100000
#define STACK_SIZE 10000
@@ -64,13 +64,13 @@
#define ERR(s) do { fprintf(stderr, "ERR: %s\n", s); exit(1); } while(0) enum node_tag { T_FREE, T_IND, T_AP, T_INT, T_HDL, T_S, T_K, T_I, T_B, T_C, /* 0 - 9 */- T_A, T_Y, T_SS, T_BB, T_CC, T_P, T_O, T_T, T_ADD, T_SUB, T_MUL, /* 10 - 20 */
- T_QUOT, T_REM, T_SUBR, T_EQ, T_NE, T_LT, T_LE, T_GT, T_GE, T_ERROR, /* 21 - 30 */
- T_IO_BIND, T_IO_THEN, T_IO_RETURN, T_IO_GETCHAR, T_IO_PUTCHAR, /* 31 - 35 */
- T_IO_SERIALIZE, T_IO_DESERIALIZE, T_IO_OPEN, T_IO_CLOSE, T_IO_ISNULLHANDLE, /* 36 - 40 */
- T_IO_STDIN, T_IO_STDOUT, T_IO_STDERR, T_IO_GETARGS, T_IO_PERFORMIO, /* 41 - 45 */
- T_IO_GETTIMEMILLI, T_IO_PRINT, /* 46 - 47 */
- T_STR, /* 48 */
+ T_A, T_Y, T_SS, T_BB, T_CC, T_P, T_O, T_T, T_BK, T_ADD, T_SUB, T_MUL, /* 10 - 21 */
+ T_QUOT, T_REM, T_SUBR, T_EQ, T_NE, T_LT, T_LE, T_GT, T_GE, T_ERROR, /* 22 - 31 */
+ T_IO_BIND, T_IO_THEN, T_IO_RETURN, T_IO_GETCHAR, T_IO_PUTCHAR, /* 32 - 36 */
+ T_IO_SERIALIZE, T_IO_DESERIALIZE, T_IO_OPEN, T_IO_CLOSE, T_IO_ISNULLHANDLE, /* 37 - 41 */
+ T_IO_STDIN, T_IO_STDOUT, T_IO_STDERR, T_IO_GETARGS, T_IO_PERFORMIO, /* 42 - 46 */
+ T_IO_GETTIMEMILLI, T_IO_PRINT, /* 47 - 48 */
+ T_STR, /* 49 */
T_LAST_TAG,
};
@@ -294,6 +294,7 @@
{ "T", T_T }, { "Y", T_Y }, { "B'", T_BB },+ { "BK", T_BK },/* primops */
{ "+", T_ADD }, { "-", T_SUB },@@ -877,6 +878,7 @@
case T_O: fprintf(f, "$O"); break;
case T_SS: fprintf(f, "$S'"); break;
case T_BB: fprintf(f, "$B'"); break;
+ case T_BK: fprintf(f, "$BK"); break;
case T_CC: fprintf(f, "$C'"); break;
case T_ADD: fprintf(f, "$+"); break;
case T_SUB: fprintf(f, "$-"); break;
@@ -1194,6 +1196,16 @@
n = TOP(0);
FUN(n) = f;
ARG(n) = new_ap(g, x);
+ GOTO ap;
+ break;
+ case T_BK: /* BK f g x = f g */
+ CHECK(3);
+ f = ARG(TOP(1));
+ g = ARG(TOP(2));
+ POP(3);
+ n = TOP(0);
+ FUN(n) = f;
+ ARG(n) = g;
GOTO ap;
break;
case T_C: /* C f g x = f x g */
--
⑨