ref: 042f4d6e10680aceeaadf1e707534719e14d685c
parent: fe190585071a15f13925d024b7bf6b788d28b68b
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Sep 22 08:53:06 EDT 2023
Make primCompare return Ordering
--- a/Makefile
+++ b/Makefile
@@ -45,6 +45,7 @@
rm -rf $(BOOTDIR)
$(GHCB) -c ghc/Primitives.hs
$(GHCB) -c ghc/Data/Bool_Type.hs
+ $(GHCB) -c ghc/Data/Ordering_Type.hs
$(GHCB) -c src/PrimTable.hs
$(GHCC) -c lib/Control/Error.hs
$(GHCC) -c lib/Data/Bool.hs
--- a/README.md
+++ b/README.md
@@ -211,14 +211,15 @@
* A: Maybe some time, maybe never.
*
* Q: Why are the error messages so bad?
- * A: Error messages are boring. But I plan to add location information to them.
+ * A: Error messages are boring.
*
* Q: Why is the so much source code?
- * A: I wonder this myself. Over 4000 lines of Haskell seems excessive.
- 1700 lines of C is also more than I'd like for such a simple system.
+ * A: I wonder this myself. Over 5000 lines of Haskell seems excessive.
+ 2000 lines of C is also more than I'd like for such a simple system.
*
* Q: Why are the binaries so big?
- * A: The combinator file is rather verbose. Compressed the combinator file
- for the compiler shrinks from 150kB to 20kB. The evaluator is about 40kB so
- the total size for runtime and (compressed) compiler is about 40k.
+ * A: The combinator file is rather verbose. The combinator file
+ for the compiler shrinks from 170kB to 30kB when compressed.
+ The evaluator is about 60kB.
+ The total compressed size for runtime and compiler is about 50k.
I'm sorry if you're running on a 16 bit system.
--- a/ghc/Primitives.hs
+++ b/ghc/Primitives.hs
@@ -187,6 +187,7 @@
primIsIO :: Any -> Bool
primIsIO = error "primIsIO"
+{-primCompare :: String -> String -> Int
primCompare s t =
case compare s t of
@@ -193,7 +194,9 @@
LT -> -1
EQ -> 0
GT -> 1
-
+-}
+primCompare :: String -> String -> Ordering
+primCompare = compare
primRnf :: (NFData a) => a -> ()
primRnf = rnf
--- a/lib/Data/Ord.hs
+++ b/lib/Data/Ord.hs
@@ -4,9 +4,8 @@
isEQ,
) where
import Data.Bool_Type
+import Data.Ordering_Type
import Data.Int
-
-data Ordering = LT | EQ | GT
isEQ :: Ordering -> Bool
isEQ EQ = True
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -2,6 +2,7 @@
-- See LICENSE file for full license.
module Primitives(module Primitives) where
import Data.Bool_Type
+import Data.Ordering_Type
infixr -1 ->
@@ -89,7 +90,8 @@
--primEqual :: forall a . a -> a -> Bool
--primEqual = primitive "equal"
-primCompare :: forall a . a -> a -> Int
+--primCompare :: forall a . a -> a -> Int
+primCompare :: [Char] -> [Char] -> Ordering
primCompare = primitive "compare"
primEqString :: [Char] -> [Char] -> Bool
--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -148,7 +148,8 @@
GT
-}
-compareString :: [Char] -> [Char] -> Ordering
-compareString s t = if r < 0 then LT else if r > 0 then GT else EQ
- where r = primCompare s t
+compareString :: String -> String -> Ordering
+compareString = primCompare
+--compareString s t = if r < 0 then LT else if r > 0 then GT else EQ
+-- where r = primCompare s t
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -397,7 +397,8 @@
/* Needed during reduction */
NODEPTR intTable[HIGH_INT - LOW_INT];
NODEPTR combFalse, combTrue, combUnit, combCons;
-NODEPTR combCC, combIOBIND;
+NODEPTR combCC, combBK, combIOBIND;
+NODEPTR combLT, combEQ, combGT;
/* One node of each kind for primitives, these are never GCd. */
/* We use linear search in this, because almost all lookups
@@ -497,6 +498,7 @@
case T_I: combUnit = n; break;
case T_O: combCons = n; break;
case T_CC: combCC = n; break;
+ case T_BK: combBK = n; break;
case T_IO_BIND: combIOBIND = n; break;
case T_IO_STDIN: SETTAG(n, T_HDL); HANDLE(n) = stdin; break;
case T_IO_STDOUT: SETTAG(n, T_HDL); HANDLE(n) = stdout; break;
@@ -515,6 +517,7 @@
case T_I: combUnit = n; break;
case T_O: combCons = n; break;
case T_CC: combCC = n; break;
+ case T_BK: combBK = n; break;
case T_IO_BIND: combIOBIND = n; break;
case T_IO_STDIN: SETTAG(n, T_HDL); HANDLE(n) = stdin; break;
case T_IO_STDOUT: SETTAG(n, T_HDL); HANDLE(n) = stdout; break;
@@ -530,6 +533,16 @@
}
#endif
+ /* The representation of the constructors of
+ * data Ordering = LT | EQ | GT
+ * do not have single constructors.
+ * But we can make compound one, since that are irreducible.
+ */
+#define NEWAP(c, f, a) do { NODEPTR n = HEAPREF(heap_start++); SETTAG(n, T_AP); FUN(n) = (f); ARG(n) = (a); (c) = n;} while(0)+ NEWAP(combLT, combBK, combFalse); /* BK B */
+ NEWAP(combEQ, combFalse, combFalse); /* K K */
+ NEWAP(combGT, combFalse, combTrue); /* K A */
+
#if INTTABLE
/* Allocate permanent Int nodes */
for (int i = LOW_INT; i < HIGH_INT; i++) {@@ -1549,7 +1562,8 @@
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_EQUAL: r = compare(ARG(TOP(0)), ARG(TOP(1))); POP(2); n = TOP(-1); GOIND(r==0 ? combTrue : combFalse);
- case T_COMPARE: r = compare(ARG(TOP(0)), ARG(TOP(1))); POP(2); n = TOP(-1); SETINT(n, r); RET;
+ case T_COMPARE: //r = compare(ARG(TOP(0)), ARG(TOP(1))); POP(2); n = TOP(-1); SETINT(n, r); RET;
+ r = compare(ARG(TOP(0)), ARG(TOP(1))); POP(2); n = TOP(-1); GOIND(r < 0 ? combLT : r > 0 ? combGT : combEQ);
case T_RNF: rnf(ARG(TOP(0))); POP(1); n = TOP(-1); GOIND(combUnit);
--
⑨