shithub: MicroHs

--- a/Makefile

+++ b/Makefile

@@ -199,7 +199,7 @@

 MCABALBIN=$(MCABAL)/bin

 MDIST=dist-mcabal

 BASE=base-$(VERSION)

-BASEMODULES=Control.Applicative Control.Arrow Control.DeepSeq Control.Error Control.Exception Control.Monad Control.Monad.Fail Control.Monad.ST Data.Array Data.Bits Data.Bool Data.Bounded Data.ByteString Data.Char Data.Complex Data.Constraint Data.Data Data.Double Data.Dynamic Data.Either Data.Enum Data.Eq Data.Float Data.FloatW Data.Floating Data.Foldable Data.Fractional Data.Function Data.Functor Data.Functor.Const Data.Functor.Identity Data.IOArray Data.IORef Data.Int Data.Integer Data.Integral Data.Ix Data.List Data.List.NonEmpty Data.Maybe Data.Monoid Data.Num Data.Ord Data.Proxy Data.Ratio Data.Real Data.RealFloat Data.RealFrac Data.Records Data.STRef Data.Semigroup Data.String Data.Time.Clock Data.Time.Format Data.Traversable Data.Tuple Data.Type.Equality Data.TypeLits Data.Typeable Data.Version Data.Void Data.Word Data.ZipList Debug.Trace Foreign.C.String Foreign.C.Types Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Utils Foreign.Ptr Foreign.Storable GHC.Stack GHC.Types Numeric Numeric.FormatFloat Numeric.Natural Prelude System.Cmd System.Compress System.Directory System.Environment System.Exit System.IO System.IO.MD5 System.IO.PrintOrRun System.IO.Serialize System.IO.TimeMilli System.IO.Unsafe System.Info System.Process Text.Printf Text.Read Text.Read.Lex Text.Read.Numeric Text.Show TimeCompat Unsafe.Coerce

+BASEMODULES=Control.Applicative Control.Arrow Control.DeepSeq Control.Error Control.Exception Control.Monad Control.Monad.Fail Control.Monad.ST Data.Array Data.Bits Data.Bool Data.Bounded Data.ByteString Data.Char Data.Complex Data.Constraint Data.Data Data.Double Data.Dynamic Data.Either Data.Enum Data.Eq Data.Float Data.FloatW Data.Floating Data.Foldable Data.Fractional Data.Function Data.Functor Data.Functor.Const Data.Functor.Identity Data.IOArray Data.IORef Data.Int Data.Integer Data.Integral Data.Ix Data.List Data.List.NonEmpty Data.Maybe Data.Monoid Data.Num Data.Ord Data.Proxy Data.Ratio Data.Real Data.RealFloat Data.RealFrac Data.Records Data.STRef Data.Semigroup Data.String Data.Text Data.Time.Clock Data.Time.Format Data.Traversable Data.Tuple Data.Type.Equality Data.TypeLits Data.Typeable Data.Version Data.Void Data.Word Data.ZipList Debug.Trace Foreign.C.String Foreign.C.Types Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Utils Foreign.Ptr Foreign.Storable GHC.Stack GHC.Types Numeric Numeric.FormatFloat Numeric.Natural Prelude System.Cmd System.Compress System.Directory System.Environment System.Exit System.IO System.IO.MD5 System.IO.PrintOrRun System.IO.Serialize System.IO.TimeMilli System.IO.Unsafe System.Info System.Process Text.Printf Text.Read Text.Read.Lex Text.Read.Numeric Text.Show TimeCompat Unsafe.Coerce

 $(MCABALBIN)/mhs: bin/mhs

 	@mkdir -p $(MCABALBIN)

--- a/lib/Data/ByteString.hs

+++ b/lib/Data/ByteString.hs

@@ -1,9 +1,12 @@

 module Data.ByteString(

   ByteString,

-  append, append3,

   pack, unpack,

+  empty,

+  append, append3,

   ) where

 import Prelude hiding ((++))

+import Data.Monoid

+import Data.Semigroup

 import Data.String

 import Data.Word(Word8)

@@ -48,6 +51,15 @@

 instance IsString ByteString where

   fromString = pack . map (toEnum . fromEnum)

+instance Semigroup ByteString where

+  (<>) = append

+instance Monoid ByteString where

+  mempty = empty

+empty :: ByteString

+empty = pack []

 append :: ByteString -> ByteString -> ByteString

 append = primBSappend

--- a/lib/libs.cabal

+++ b/lib/libs.cabal

@@ -65,6 +65,7 @@

         Data.String

         Data.Time.Clock    -- XXX remove

         Data.Time.Format   -- XXX remove

+        Data.Text

         Data.Traversable

         Data.Tuple

         Data.Type.Equality

--- a/src/runtime/eval.c

+++ b/src/runtime/eval.c

@@ -710,6 +710,7 @@

   { "icmp", T_COMPARE },

   { "rnf", T_RNF },

   { "fromUTF8", T_BSFROMUTF8 },

+  { "toUTF8", T_BSTOUTF8 },

   /* IO primops */

   { "IO.>>=", T_IO_BIND },

   { "IO.>>", T_IO_THEN },

@@ -2461,8 +2462,8 @@

 /* Evaluate a string, returns a newly allocated buffer. */

 /* XXX this is cheating, should use continuations */

 /* XXX the malloc()ed string is leaked if we yield in here. */

-char *

-evalstring(NODEPTR n, value_t *lenp)

+struct bytestring

+evalstring(NODEPTR n)

   size_t sz = 100;

   char *name = MALLOC(sz);

@@ -2469,6 +2470,7 @@

   size_t offs;

   uvalue_t c;

   NODEPTR x;

+  struct bytestring bs;

   if (!name)

     memerr();

@@ -2510,9 +2512,9 @@

   name[offs] = 0;

-  if (lenp)

-    *lenp = (value_t)offs;

-  return name;

+  bs.size = offs;

+  bs.string = name;

+  return bs;

 struct bytestring

@@ -2946,7 +2948,7 @@

   case T_ITOF: OPINT1(rd = (flt_t)xi); SETDBL(n, rd); RET;

   case T_FREAD:

     CHECK(1);

-    msg = evalstring(ARG(TOP(0)), 0);

+    msg = evalstring(ARG(TOP(0))).string;

 #if WORD_SIZE == 64

     xd = strtod(msg, NULL);

 #elif WORD_SIZE == 32

@@ -3006,6 +3008,17 @@

       GOIND(arr == ARR(y) ? combTrue : combFalse);

+  case T_BSTOUTF8:

+    {

+      CHECK(1);

+      struct bytestring bs = evalstring(ARG(TOP(0)));

+      POP(1);

+      n = TOP(-1);

+      SETTAG(n, T_BSTR);

+      FORPTR(n) = mkForPtr(bs);

+      RET;

+    }

   case T_BSFROMUTF8:

     if (doing_rnf) RET;

     CHECK(1);

@@ -3029,6 +3042,7 @@

   case T_BSPACK:

+      CHECK(1);

       struct bytestring bs = evalbstr(ARG(TOP(0)));

       POP(1);

       n = TOP(-1);

@@ -3060,7 +3074,7 @@

       //TOP(0) = new_ap(combShowExn, TOP(0));

       FUN(TOP(0)) = combShowExn; /* TOP(0) = (combShowExn exn) */

       x = evali(TOP(0));        /* evaluate it */

-      msg = evalstring(x, 0);   /* and convert to a C string */

+      msg = evalstring(x).string;   /* and convert to a C string */

       POP(1);

 #if WANT_STDIO

       /* A horrible hack until we get proper exceptions */

@@ -3127,7 +3141,7 @@

   case T_DYNSYM:

     /* A dynamic FFI lookup */

     CHECK(1);

-    msg = evalstring(ARG(TOP(0)), 0);

+    msg = evalstring(ARG(TOP(0))).string;

     GCCHECK(1);

     x = ffiNode(msg);

     FREE(msg);

@@ -3400,7 +3414,6 @@

   stackptr_t stk = stack_ptr;

   NODEPTR f, x, n, q, r, s, res, top1;

   char *name;

-  value_t len;

   struct handler *h;

 #if WANT_STDIO

   void *ptr;

@@ -3563,12 +3576,14 @@

     case T_NEWCASTRINGLEN:

+      {

       CHECKIO(1);

-      name = evalstring(ARG(TOP(1)), &len);

+      struct bytestring bs = evalstring(ARG(TOP(1)));

       GCCHECK(4);

-      n = new_ap(new_ap(combPair, x = alloc_node(T_PTR)), mkInt(len));

-      PTR(x) = name;

+      n = new_ap(new_ap(combPair, x = alloc_node(T_PTR)), mkInt(bs.size));

+      PTR(x) = bs.string;

       RETIO(n);

+      }

     case T_PEEKCASTRING:

--- a/tests/Makefile

+++ b/tests/Makefile

@@ -69,6 +69,7 @@

 	$(TMHS) Irref      && $(EVAL) > Irref.out      && diff Irref.ref Irref.out

 	$(TMHS) DfltSig    && $(EVAL) > DfltSig.out    && diff DfltSig.ref DfltSig.out

 	$(TMHS) Bytestring && $(EVAL) > Bytestring.out && diff Bytestring.ref Bytestring.out

+	$(TMHS) Text       && $(EVAL) > Text.out       && diff Text.ref Text.out

 errtest:

 	sh errtester.sh $(MHS) < errmsg.test

--- /dev/null

+++ b/tests/Text.hs

@@ -1,0 +1,26 @@

+module Text where

+import Data.Text

+bs1 :: Text

+bs1 = pack "abc"

+bs2 :: Text

+bs2 = pack "abd"

+bs3 :: Text

+bs3 = pack "ab"

+bs4 :: Text

+bs4 = pack "acd"

+main :: IO ()

+main = do

+  print (unpack bs1)

+  print bs1

+  print $ bs1 `append` bs2

+  print [ op x y | op <- [(==), (/=), (<), (<=), (>), (>=)]

+                 , x <- [bs1, bs2, bs3, bs4]

+                 , y <- [bs1, bs2, bs3, bs4]

+        ]

+  print [ compare x y | x <- [bs1, bs2, bs3, bs4], y <- [bs1, bs2, bs3, bs4] ]

+  print ("abc" :: Text)

--- /dev/null

+++ b/tests/Text.ref

@@ -1,0 +1,6 @@

+"abc"

+"abc"

+"abcabd"

+[True,False,False,False,False,True,False,False,False,False,True,False,False,False,False,True,False,True,True,True,True,False,True,True,True,True,False,True,True,True,True,False,False,True,False,True,False,False,False,True,True,True,False,True,False,False,False,False,True,True,False,True,False,True,False,True,True,True,True,True,False,False,False,True,False,False,True,False,True,False,True,False,False,False,False,False,True,True,True,False,True,False,True,False,True,True,True,False,False,False,True,False,True,True,True,True]

+[EQ,LT,GT,LT,GT,EQ,GT,LT,LT,LT,EQ,LT,GT,GT,GT,EQ]

+"abc"

--

⑨