ref: 9fc3bc673e725264675a6c990265efe8d24055f8
parent: f60c2bb7769051c59f24b703e91f1950ea7914e7
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Nov 10 12:28:22 EST 2023
Simplify conversion a little.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
-v4.2
+v4.3
1556
((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _271) ((B _12) _1)) _456))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _455))) ((A :10 (((S' P) _2) (((C' _13) _1) _1290))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _268) _12) _259))) ((A :20 (((S' B) _14) (((C' _271) _12) _260))) ((A :21 _1376) ((A :22 ((B _1424) _21)) ((A :23 (((S' _1424) _21) I)) ((A :24 _1346) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1375) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1394) _170)) ((_258 (_34 _1396)) _169))) ((A :29 ((B ((S _1424) (_34 _1396))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _455)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _456)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1290)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1290))) ((A :46 ((C _43) _259)) ((A :47 ((B _261) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _261) _48)) ((A :50 T) ((A :51 ((_266 ((B (B (_256 _50))) ((B ((C' C) _54)) (B P)))) (_270 _51))) ((A :52 (((((_11 _51) ((B (_256 _50)) P)) (_38 _53)) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_258 _559)) _54)) ((A :56 ((B (_256 _50)) (B (P _1290)))) ((A :57 ((B (_256 _50)) (BK (P _1290)))) ((A :58 ((_256 _50) ((S P) I))) ((A :59 ((B (_256 _50)) ((C (S' P)) I))) ((A :60 ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))) ((B (B (B (B (B (B (B (B (B (B (B C))))))))))) ((B (B (B (B (B (B (B (B (B (B C)))))))))) ((B (B (B (B (B (B (B (B (B C))))))))) ((B (B (B (B (B (B (B (B C)))))))) ((B (B (B (B (B (B (B C))))))) ((B (B (B (B (B (B C)))))) ((B (B (B (B (B C))))) ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P))))))))))))))))))))) ((A :61 (T (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :62 (T (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :63 (T (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :64 (T (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :65 (T (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :66 (T (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :67 (T (K (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK
\ No newline at end of file
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -92,9 +92,9 @@
primWordInv :: Word -> Word
primWordInv = primitive "inv"
primWordToDoubleRaw :: Word -> Double
-primWordToDoubleRaw = primitive "ffromraw"
+primWordToDoubleRaw = primitive "toDbl"
primWordFromDoubleRaw :: Double -> Word
-primWordFromDoubleRaw = primitive "ftoraw"
+primWordFromDoubleRaw = primitive "toInt"
primIntEQ :: Int -> Int -> Bool
primIntEQ = primitive "=="
@@ -228,7 +228,7 @@
primPeekCAString = primitive "peekCAString"
primWordToPtr :: forall a . Word -> Ptr a
-primWordToPtr = primitive "wordToPtr"
+primWordToPtr = primitive "toPtr"
primPtrToWord :: forall a . Ptr a -> Word
-primPtrToWord = primitive "ptrToWord"
+primPtrToWord = primitive "toInt"
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -16,6 +16,11 @@
import MicroHs.MakeCArray
--Ximport Compat
+-- Version number of combinator file.
+-- Must match version in eval.c.
+version :: String
+version = "v4.3\n"
+
main :: IO ()
main = do
aargs <- getArgs
@@ -73,6 +78,3 @@
t2 <- getTimeMilli
when (verbose flags > 0) $
putStrLn $ "final pass " ++ padLeft 6 (show (t2-t1)) ++ "ms"
-
-version :: String
-version = "v4.2\n"
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -81,8 +81,6 @@
("shl", primitive "shl"), ("shr", primitive "shr"), ("ashr", primitive "ashr"),- ("ftoraw", primitive "ftoraw"),- ("ffromraw", primitive "ffromraw"), ("subtract", primitive "subtract"), ("==", primitive "=="), ("/=", primitive "/="),@@ -140,6 +138,7 @@
("newCAString", primitive "newCAString"), ("peekCAString", primitive "peekCAString"), ("free", primitive "free"),- ("ptrToWord", primitive "ptrToWord"),- ("wordToPtr", primitive "wordToPtr")+ ("toInt", primitive "toInt"),+ ("toPtr", primitive "toPtr"),+ ("toDbl", primitive "toDbl")]
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -136,7 +136,7 @@
/***************************************/
-#define VERSION "v4.2\n"
+#define VERSION "v4.3\n"
/* Keep permanent nodes for LOW_INT <= i < HIGH_INT */
#define LOW_INT (-10)
@@ -153,7 +153,6 @@
T_AND, T_OR, T_XOR, T_INV, T_SHL, T_SHR, T_ASHR,
T_FADD, T_FSUB, T_FMUL, T_FDIV, T_FNEG, T_ITOF,
T_FEQ, T_FNE, T_FLT, T_FLE, T_FGT, T_FGE, T_FSHOW, T_FREAD,
- T_FTORAW, T_FFROMRAW,
T_EQ, T_NE, T_LT, T_LE, T_GT, T_GE, T_ULT, T_ULE, T_UGT, T_UGE,
T_ERROR, T_NODEFAULT, T_NOMATCH, T_SEQ, T_EQUAL, T_COMPARE, T_RNF,
T_IO_BIND, T_IO_THEN, T_IO_RETURN, T_IO_GETCHAR, T_IO_PUTCHAR,
@@ -163,7 +162,7 @@
T_IO_GETTIMEMILLI, T_IO_PRINT, T_IO_CATCH,
T_IO_CCALL, T_IO_GETRAW, T_IO_FLUSH, T_DYNSYM,
T_NEWCASTRING, T_FREEPTR, T_PEEKCASTRING,
- T_WORDTOPTR, T_PTRTOWORD,
+ T_TOPTR, T_TOINT, T_TODBL,
T_STR,
T_LAST_TAG,
};
@@ -676,8 +675,6 @@
{ "fge", T_FGE}, { "fshow", T_FSHOW}, { "fread", T_FREAD},- { "ftoraw", T_FTORAW},- { "ffromraw", T_FFROMRAW}, { "==", T_EQ }, { "/=", T_NE }, { "<", T_LT },@@ -721,8 +718,9 @@
{ "free", T_FREEPTR }, { "newCAString", T_NEWCASTRING }, { "peekCAString", T_PEEKCASTRING },- { "wordToPtr", T_WORDTOPTR },- { "ptrToWord", T_PTRTOWORD },+ { "toPtr", T_TOPTR },+ { "toInt", T_TOINT },+ { "toDbl", T_TODBL },};
void
@@ -1439,8 +1437,6 @@
case T_FGE: fprintf(f, "fge"); break;
case T_FSHOW: fprintf(f, "fshow"); break;
case T_FREAD: fprintf(f, "fread"); break;
- case T_FTORAW: fprintf(f, "ftoraw"); break;
- case T_FFROMRAW: fprintf(f, "ffromraw"); break;
case T_EQ: fprintf(f, "=="); break;
case T_NE: fprintf(f, "/="); break;
case T_LT: fprintf(f, "<"); break;
@@ -1481,8 +1477,9 @@
case T_NEWCASTRING: fprintf(f, "newCAString"); break;
case T_PEEKCASTRING: fprintf(f, "peekCAString"); break;
case T_FREEPTR: fprintf(f, "free"); break;
- case T_PTRTOWORD: fprintf(f, "ptrToWord"); break;
- case T_WORDTOPTR: fprintf(f, "wordToPtr"); break;
+ case T_TOINT: fprintf(f, "toInt"); break;
+ case T_TOPTR: fprintf(f, "toPtr"); break;
+ case T_TODBL: fprintf(f, "toDbl"); break;
default: ERR("print tag");}
}
@@ -1963,43 +1960,12 @@
// update n to be s
GOIND(s);
- case T_FTORAW:
- CHECK(1);
- x = evali(ARG(TOP(0)));
- GCCHECK(1);
- y = alloc_node(T_INT);
- SETVALUE(y, GETVALUE(x));
- POP(1);
- n = TOP(-1);
- GOIND(y);
- case T_FFROMRAW:
- CHECK(1);
- x = evali(ARG(TOP(0)));
- GCCHECK(1);
- y = alloc_node(T_DBL);
- SETVALUE(y, GETVALUE(x));
- POP(1);
- n = TOP(-1);
- GOIND(y);
-
- case T_PTRTOWORD:
- CHECK(1);
- x = evali(ARG(TOP(0)));
- GCCHECK(1);
- y = alloc_node(T_INT);
- SETVALUE(y, GETVALUE(x));
- POP(1);
- n = TOP(-1);
- GOIND(y);
- case T_WORDTOPTR:
- CHECK(1);
- x = evali(ARG(TOP(0)));
- GCCHECK(1);
- y = alloc_node(T_PTR);
- SETVALUE(y, GETVALUE(x));
- POP(1);
- n = TOP(-1);
- GOIND(y);
+ /* Retag a word sized value, keeping the bits */
+#define CONV(t) do { CHECK(1); x = evali(ARG(TOP(0))); GCCHECK(1); y = alloc_node(T_DBL); SETVALUE(y, GETVALUE(x)); POP(1); n = TOP(-1); GOIND(y); } while(0)+ case T_TODBL: CONV(T_DBL);
+ case T_TOINT: CONV(T_INT);
+ case T_TOPTR: CONV(T_PTR);
+#undef CONV
case T_EQ: CMP(==);
case T_NE: CMP(!=);
--
⑨