shithub: MicroHs

Download patch

ref: d87fa9fcb3cf363d91e90e5f1429ca28aeedd2ff
parent: 2aa587b57630793b669a34b5de365d81b97efe47
author: Lennart Augustsson <lennart@augustsson.net>
date: Wed Nov 8 12:21:43 EST 2023

Change how combinator file is generated.

--- a/Tools/Addcombs.hs
+++ b/Tools/Addcombs.hs
@@ -23,8 +23,8 @@
   file <- hGetContents stdin
   let size = length file
       chunks = chunkify 20 file
-  putStrLn $ "struct { BFILE mets; size_t b_size; size_t b_pos; uint8_t b_buffer[]; } combs =\n { { getb_buf, ungetb_buf, closeb_buf }, "
-             ++ show size ++ ", 0, {"
+  putStrLn $ "uint8_t combexprdata[] = {"
   mapM_ (putStrLn . showChunk) chunks
-  putStrLn "}};"
-  putStrLn "BFILE *comb_internal = (BFILE*)&combs;"
+  putStrLn "0 };"
+  putStrLn "uint8_t *combexpr = combexprdata;"
+  putStrLn $ "int combexprlen = " ++ show size ++ ";"
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.1
-1538
-((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)) _454))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _453))) ((A :10 (((S' P) _2) (((C' _13) _1) _1279))) ((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 _1365) ((A :22 ((B _1406) _21)) ((A :23 (((S' _1406) _21) I)) ((A :24 _1335) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1364) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1376) _170)) ((_258 (_34 _1378)) _169))) ((A :29 ((B ((S _1406) (_34 _1378))) _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) _453)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _454)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1279)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1279))) ((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 _557)) _54)) ((A :56 ((B (_256 _50)) (B (P _1279)))) ((A :57 ((B (_256 _50)) (BK (P _1279)))) ((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
+1543
+((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) _1284))) ((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 _1370) ((A :22 ((B _1411) _21)) ((A :23 (((S' _1411) _21) I)) ((A :24 _1340) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1369) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1381) _170)) ((_258 (_34 _1383)) _169))) ((A :29 ((B ((S _1411) (_34 _1383))) _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) _1284)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1284))) ((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 _1284)))) ((A :57 ((B (_256 _50)) (BK (P _1284)))) ((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/Data/List.hs
+++ b/lib/Data/List.hs
@@ -182,6 +182,12 @@
 isPrefixOfBy _ [] _ = True
 isPrefixOfBy _ _  _ = False
 
+isSuffixOf :: forall a . Eq a => [a] -> [a] -> Bool
+isSuffixOf = isSuffixOfBy (==)
+
+isSuffixOfBy :: forall a . (a -> a -> Bool) -> [a] -> [a] -> Bool
+isSuffixOfBy eq n h = isPrefixOfBy eq (reverse n) (reverse h)
+
 splitAt :: forall a . Int -> [a] -> ([a], [a])
 splitAt n xs = (take n xs, drop n xs)
 
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -13,6 +13,7 @@
 import qualified MicroHs.IdentMap as M
 import MicroHs.Translate
 import MicroHs.Interactive
+import MicroHs.MakeCArray
 --Ximport Compat
 
 main :: IO ()
@@ -65,7 +66,10 @@
     prg
 --    putStrLn "done"
    else do
-    writeFile (output flags) $ version ++ show numDefs ++ "\n" ++ res
+    let outFile = output flags
+        outData = version ++ show numDefs ++ "\n" ++ res
+        outData' = if ".c" `isSuffixOf` outFile then makeCArray outData else outData
+    writeFile outFile outData'
     t2 <- getTimeMilli
     when (verbose flags > 0) $
       putStrLn $ "final pass            " ++ padLeft 6 (show (t2-t1)) ++ "ms"
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -296,7 +296,7 @@
   BFILE    mets;
   size_t   b_size;
   size_t   b_pos;
-  uint8_t  b_buffer[1];
+  uint8_t  *b_buffer;
 };
 
 int
@@ -1353,7 +1353,7 @@
     fputc(')', f);
     break;
   case T_INT: fprintf(f, "#%"PRIvalue, GETVALUE(n)); break;
-  case T_DBL: fprintf(f, "%%%f", GETDBLVALUE(n)); break;
+  case T_DBL: fprintf(f, "&%.16g", GETDBLVALUE(n)); break;
   case T_STR:
     {
       const char *p = STR(n);
@@ -2301,7 +2301,8 @@
   return n;
 }
 
-BFILE *comb_internal;
+uint8_t *combexpr;                 /* Alternate version of internal data */
+int combexprlen;
 
 int
 main(int argc, char **argv)
@@ -2356,9 +2357,10 @@
   if (!stack)
     memerr();
 
-  if (comb_internal) {
+  if (combexpr) {
     int c;
-    BFILE *bf = comb_internal;
+    struct BFILE_buffer ibf = { { getb_buf, ungetb_buf, closeb_buf }, combexprlen, 0, combexpr };
+    BFILE *bf = (BFILE*)&ibf;
     c = bf->getb(bf);
     /* Compressed combinators start with a 'Z', otherwise 'v' (for version) */
     if (c == 'Z') {
--