ref: 1156777ac4e50c47b1ec28704ce611d353e72f29
parent: e160e153a6a68173d1be7ca853b29fef3248f083
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Aug 28 08:13:58 EDT 2023
Add 'seq'
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
-v3.1
-708
-(($A :0 ((_531 _485) ((($S' ($C ((($C' ($S' _531)) ($C _2)) (($B ($B (_531 _559))) ((($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' _532)) ((($C' $B) (($B _619) (($B _549) ((($C' _657) _8) 0)))) (($B (_619 _552)) (($B (_564 "top level defns: ")) _513)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _532)) ((($C' $B) (($B _619) (($B _549) ((($C' _657) _8) 1)))) (_548 ($T (($B ($B (_619 _552))) ((($C' $B) _564) (($B (_564 " = ")) _381))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _532))) ((($C' $B) (($B $B) (($B _619) (($B _554) _11)))) (($B ($B (_564 _1))) (($B (($C' _564) _513)) (_564 (($O 10) $K))))))) (($B ($B (_531 _559))) ((($C' $B) (($B $B) (($B _619) (($B _549) ((($C' _657) _8) 0))))) (($B ($B (_619 _552))) (($B ($B (_564 "final pass "))) ((($C' ($C' _564)) (($B ($B (_526 6))) (($B ($B _513)) _651))) "ms")))))))) _3)))) _510))) (($B (($C' $C) (($B ($C _569)) _381))) (($C _582) (_599 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_564 "(($A :"))))) (($B ($B (($C' $B) (($B _564) _513)))) (($B ($B ($B (_564 (($O 32) $K))))) ((($C' $B) (($B ($C' _564)) ($B _381))) (($B (_564 ") ")) (($C _564) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _358)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _619) (($B _616) (($B (_619 _666)) (($B (_564 "main: findIdent: ")) _457))))) ($C _503)))) (($B ($B _507)) (($B (($C' _566) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _582) (_599 0)))))) (($B (_619 _357)) (($B (_564 (($O 95) $K))) _513))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _581) (_568 (_524 "-v")))) ((_598 _524) "-r"))) (($B (_562 (($O 46) $K))) (($B _618) (_567 ((_586 _642) "-i")))))) (($B (_619 _593)) ((($C' _564) (($B _618) (_567 ((_586 _642) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _653) _581) 1)) (_666 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _593)) (_568 ((_620 _662) ((_620 (_524 (($O 45) $K))) (_579 1)))))))) (($A :1 "v3.1\10&") (($A :2 ((($S' ($S' _531)) _16) (($B ($B ($B (_531 _559)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _532) (($B (_619 _550)) (($B (_619 (_580 1000000))) _184)))))) (($B ($B ($B ($B (_531 _559))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _532))) ((($C' $B) (($B $B) (($B _619) (($B _549) ((($C' _657) _8) 0))))) (($B ($B (_619 _552))) (($B ($B (_564 "combinator conversion "))) ((($C' ($C' _564)) (($B ($B (_526 6))) (($B ($B _513)) _651))) "ms"))))))) (($B ($B _533)) (($B $P) (($C _409) "main"))))))) (_566 ($T ((($C' ($C' $O)) ((($C' $B) $P) _384)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_619 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _351))) (($C' ($C' _566)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _619) (($B _616) (($B (_619 _666)) (_564 "not found "))))) ($C _352))))) (($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) _383))) (($B (_619 (_616 (_666 "primlookup")))) (($C (_602 _524)) _5))))) (_666 "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
+v3.2
+710
+(($A :0 ((_531 _485) ((($S' ($C ((($C' ($S' _531)) ($C _2)) (($B ($B (_531 _559))) ((($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' _532)) ((($C' $B) (($B _620) (($B _549) ((($C' _658) _8) 0)))) (($B (_620 _552)) (($B (_565 "top level defns: ")) _513)))))))) ((($S' $B) (($B $B) (($B ($C' $B)) (($B ($B $B)) (($B ($B _532)) ((($C' $B) (($B _620) (($B _549) ((($C' _658) _8) 1)))) (_548 ($T (($B ($B (_620 _552))) ((($C' $B) _565) (($B (_565 " = ")) _381))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _532))) ((($C' $B) (($B $B) (($B _620) (($B _554) _11)))) (($B ($B (_565 _1))) (($B (($C' _565) _513)) (_565 (($O 10) $K))))))) (($B ($B (_531 _559))) ((($C' $B) (($B $B) (($B _620) (($B _549) ((($C' _658) _8) 0))))) (($B ($B (_620 _552))) (($B ($B (_565 "final pass "))) ((($C' ($C' _565)) (($B ($B (_526 6))) (($B ($B _513)) _652))) "ms")))))))) _3)))) _510))) (($B (($C' $C) (($B ($C _570)) _381))) (($C _583) (_600 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_565 "(($A :"))))) (($B ($B (($C' $B) (($B _565) _513)))) (($B ($B ($B (_565 (($O 32) $K))))) ((($C' $B) (($B ($C' _565)) ($B _381))) (($B (_565 ") ")) (($C _565) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _358)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _620) (($B _617) (($B (_620 _667)) (($B (_565 "main: findIdent: ")) _457))))) ($C _503)))) (($B ($B _507)) (($B (($C' _567) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B ($C $P))) $K)))))) (($C _583) (_600 0)))))) (($B (_620 _357)) (($B (_565 (($O 95) $K))) _513))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _582) (_569 (_524 "-v")))) ((_599 _524) "-r"))) (($B (_563 (($O 46) $K))) (($B _619) (_568 ((_587 _643) "-i")))))) (($B (_620 _594)) ((($C' _565) (($B _619) (_568 ((_587 _643) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _654) _582) 1)) (_667 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _594)) (_569 ((_621 _663) ((_621 (_524 (($O 45) $K))) (_580 1)))))))) (($A :1 "v3.2\10&") (($A :2 ((($S' ($S' _531)) _16) (($B ($B ($B (_531 _559)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _532) (($B (_620 _550)) (($B (_620 (_581 1000000))) _184)))))) (($B ($B ($B ($B (_531 _559))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _532))) ((($C' $B) (($B $B) (($B _620) (($B _549) ((($C' _658) _8) 0))))) (($B ($B (_620 _552))) (($B ($B (_565 "combinator conversion "))) ((($C' ($C' _565)) (($B ($B (_526 6))) (($B ($B _513)) _652))) "ms"))))))) (($B ($B _533)) (($B $P) (($C _409) "main"))))))) (_567 ($T ((($C' ($C' $O)) ((($C' $B) $P) _384)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_620 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _351))) (($C' ($C' _567)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _620) (($B _617) (($B (_620 _667)) (_565 "not found "))))) ($C _352))))) (($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) _383))) (($B (_620 (_617 (_667 "primlookup")))) (($C (_603 _524)) _5))))) (_667 "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/ghc/Primitives.hs
+++ b/ghc/Primitives.hs
@@ -82,6 +82,9 @@
primUnsafeCoerce :: a -> b
primUnsafeCoerce = unsafeCoerce
+primSeq :: a -> b -> b
+primSeq = seq
+
------
primBind :: IO a -> (a -> IO b) -> IO b
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -48,6 +48,9 @@
primFix :: forall a . (a -> a) -> a
primFix = primitive "Y"
+primSeq :: forall a b . a -> b -> b
+primSeq = primitive "seq"
+
primChr :: Int -> Char
primChr = primitive "I"
primOrd :: Char -> Int
--- a/lib/System/IO.hs
+++ b/lib/System/IO.hs
@@ -159,3 +159,6 @@
unsafeInterleaveIO :: forall a . IO a -> IO a
unsafeInterleaveIO ioa = return (P.primPerformIO ioa)
+
+seq :: forall a b . a -> b -> b
+seq = P.primSeq
--- 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.1\n"
+version = "v3.2\n"
type Program = (Ident, [LDef])
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -64,6 +64,7 @@
("<=", primitive "<="), (">", primitive ">"), (">=", primitive ">="),+ ("seq", primitive "seq"), ("error", primitive "error"), ("IO.>>=", primitive "IO.>>="), ("IO.>>", primitive "IO.>>"),--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -70,7 +70,7 @@
#endif /* !defined(_MSC_VER) */
-#define VERSION "v3.1\n"
+#define VERSION "v3.2\n"
/* Keep permanent nodes for LOW_INT <= i < HIGH_INT */
#define LOW_INT (-10)
@@ -83,12 +83,12 @@
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_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_QUOT, T_REM, T_SUBR, T_EQ, T_NE, T_LT, T_LE, T_GT, T_GE, T_ERROR, T_SEQ, /* 22 - 32 */
+ T_IO_BIND, T_IO_THEN, T_IO_RETURN, T_IO_GETCHAR, T_IO_PUTCHAR, /* 33 - 37 */
+ T_IO_SERIALIZE, T_IO_DESERIALIZE, T_IO_OPEN, T_IO_CLOSE, T_IO_ISNULLHANDLE, /* 38 - 42 */
+ T_IO_STDIN, T_IO_STDOUT, T_IO_STDERR, T_IO_GETARGS, T_IO_PERFORMIO, /* 43 - 47 */
+ T_IO_GETTIMEMILLI, T_IO_PRINT, /* 48 - 49 */
+ T_STR, /* 50 */
T_LAST_TAG,
};
@@ -328,6 +328,7 @@
{ "<=", T_LE }, { ">", T_GT }, { ">=", T_GE },+ { "seq", T_SEQ }, { "error", T_ERROR },/* IO primops */
{ "IO.>>=", T_IO_BIND },@@ -905,6 +906,7 @@
case T_GT: fprintf(f, "$>"); break;
case T_GE: fprintf(f, "$>="); break;
case T_ERROR: fprintf(f, "$error"); break;
+ case T_SEQ: fprintf(f, "$seq"); break;
case T_IO_BIND: fprintf(f, "$IO.>>="); break;
case T_IO_THEN: fprintf(f, "$IO.>>"); break;
case T_IO_RETURN: fprintf(f, "$IO.return"); break;
@@ -1206,6 +1208,7 @@
case T_GE: CMP(>=);
case T_ERROR: CHKARGEV1(msg = evalstring(x)); fprintf(stderr, "error: %s\n", msg); free(msg); exit(1);
+ case T_SEQ: CHECK(2); eval(ARG(TOP(0))); POP(2); n = TOP(-1); y = ARG(n); GOIND(y); /* seq x y = eval(x); y */
case T_IO_ISNULLHANDLE: CHKARGEV1(hdl = evalhandleN(x)); GOIND(hdl == 0 ? comTrue : combFalse);
--- a/tests/IOTest.hs
+++ b/tests/IOTest.hs
@@ -42,5 +42,7 @@
putStrLn $ showInt $ trace "tracing" 5
as <- getArgs
putStrLn $ showList showString as
+ putStrLn $ showInt $ seq (1 + 2) 5
+ putStrLn $ showInt $ seq (1 + trace "seq" 2) 5
tend <- getTimeMilli
putStrLn $ showInt (tend - tstart) ++ "ms execution time"
--- a/tests/IOTest.ref
+++ b/tests/IOTest.ref
@@ -11,4 +11,7 @@
tracing
5
["a","bb","ccc"]
+5
+seq
+5
1ms execution time
--
⑨