Name = Text

Name = Text

src/Core/HindleyMilner.hs

@@ -14,6 +14,7 @@ module Core.HindleyMilner
 import Lens.Micro
 import Lens.Micro.Mtl
 import Data.Maybe               (fromMaybe)
+import Data.Text                qualified as T
 import Control.Monad            (foldM)
 import Control.Monad.State
 import Control.Monad.Utils      (mapAccumLM)
@@ -101,7 +102,7 @@ uniqueVar :: StateT ([Constraint], Int) HMError Type
 uniqueVar = do
     n <- use _2
     _2 %= succ
-    pure (TyVar $ '$' : 'a' : show n)
+    pure (TyVar . T.pack $ '$' : 'a' : show n)
 
 addConstraint :: Type -> Type -> StateT ([Constraint], Int) HMError ()
 addConstraint t u = _1 %= ((t, u):)

src/Core/Lex.x

@@ -3,6 +3,7 @@
 Module      : Core.Lex
 Description : Lexical analysis for the core language
 -}
+{-# LANGUAGE OverloadedStrings #-}
 module Core.Lex
     ( lexCore
     , lexCore'
@@ -15,13 +16,16 @@ module Core.Lex
     where
 import Data.Char (chr)
 import Debug.Trace
+import Data.Text            (Text)
+import Data.Text            qualified as T
+import Data.String          (IsString(..))
 import Core.Syntax
 import Compiler.RLPC
 import Lens.Micro
 import Lens.Micro.TH
 }
 
-%wrapper "monad"
+%wrapper "monad-strict-text"
 
 $whitechar = [ \t\n\r\f\v]
 $special   = [\(\)\,\;\[\]\{\}]
@@ -91,7 +95,7 @@ rlp :-
     @varsym                 { lexWith TokenVarSym }
     @consym                 { lexWith TokenConSym }
 
-    @decimal                { lexWith (TokenLitInt . read @Int) }
+    @decimal                { lexWith (TokenLitInt . read @Int . T.unpack) }
 
     $white                  { skip }
     \n                      { skip }
@@ -139,7 +143,7 @@ data CoreToken = TokenLet
                | TokenTypeApp
                | TokenLPragma
                | TokenRPragma
-               | TokenWord String
+               | TokenWord Text
                | TokenEOF
                deriving Show
 
@@ -157,11 +161,11 @@ data SrcErrorType = SrcErrLexical String
 
 type Lexer = AlexInput -> Int -> Alex (Located CoreToken)
 
-lexWith :: (String -> CoreToken) -> Lexer
-lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located y x l (f $ take l s)
+lexWith :: (Text -> CoreToken) -> Lexer
+lexWith f (AlexPn _ y x,_,_,s) l = pure $ Located y x l (f $ T.take l s)
 
 -- | The main lexer driver.
-lexCore :: String -> RLPC SrcError [Located CoreToken]
+lexCore :: Text -> RLPC SrcError [Located CoreToken]
 lexCore s = case m of
     Left e   -> addFatal err
         where err = SrcError
@@ -175,7 +179,7 @@ lexCore s = case m of
 
 -- | @lexCore@, but the tokens are stripped of location info. Useful for
 -- debugging
-lexCore' :: String -> RLPC SrcError [CoreToken]
+lexCore' :: Text -> RLPC SrcError [CoreToken]
 lexCore' s = fmap f <$> lexCore s
     where f (Located _ _ _ t) = t
 

src/Core/Parse.y

@@ -3,6 +3,7 @@
 Module : Core.Parse
 Description : Parser for the Core language
 -}
+{-# LANGUAGE OverloadedStrings #-}
 module Core.Parse
     ( parseCore
     , parseCoreExpr
@@ -22,6 +23,8 @@ import Compiler.RLPC
 import Lens.Micro
 import Data.Default.Class   (def)
 import Data.Hashable        (Hashable)
+import Data.Text.IO         qualified as TIO
+import Data.Text            qualified as T
 import Data.HashMap.Strict  qualified as H
 }
 
@@ -157,8 +160,8 @@ ExprPragma      :: { Expr Name }
 ExprPragma      : '{-#' Words '#-}'      {% exprPragma $2 }
 
 Words           :: { [String] }
-Words           : word Words                    { $1 : $2 }
-                | word                          { [$1] }
+Words           : word Words                    { T.unpack $1 : $2 }
+                | word                          { [T.unpack $1] }
 
 PackCon         :: { Expr Name }
 PackCon         : pack '{' litint litint '}'    { Con $3 $4 }
@@ -195,7 +198,7 @@ parseError (Located y x l _ : _) = addFatal err
 
 parseTmp :: IO (Module Name)
 parseTmp = do
-    s <- readFile "/tmp/t.hs"
+    s <- TIO.readFile "/tmp/t.hs"
     case parse s of
         Left e -> error (show e)
         Right (ts,_) -> pure ts

src/Core/Syntax.hs

@@ -43,6 +43,7 @@ import Data.Function                ((&))
 import Data.String
 import Data.HashMap.Strict          qualified as H
 import Data.Hashable
+import Data.Text                    qualified as T
 -- Lift instances for the Core quasiquoters
 import Language.Haskell.TH.Syntax   (Lift)
 import Lens.Micro.TH                (makeLenses)
@@ -109,7 +110,7 @@ data AltCon = AltData Tag
 data Lit = IntL Int
     deriving (Show, Read, Eq, Lift)
 
-type Name = String
+type Name = T.Text
 type Tag = Int
 
 data ScDef b = ScDef b [b] (Expr b)
@@ -134,10 +135,10 @@ type Alter' = Alter Name
 type Binding' = Binding Name
 
 instance IsString (Expr b) where
-    fromString = Var
+    fromString = Var . fromString
 
 instance IsString Type where
-    fromString = TyVar
+    fromString = TyVar . fromString
 
 instance (Hashable b) => Semigroup (Program b) where
     (<>) = undefined

src/Core/TH.hs

@@ -10,11 +10,12 @@ module Core.TH
     where
 ----------------------------------------------------------------------------------
 import Language.Haskell.TH
-import Language.Haskell.TH.Syntax hiding (Module)
+import Language.Haskell.TH.Syntax   hiding (Module)
 import Language.Haskell.TH.Quote
 import Control.Monad                ((>=>))
 import Compiler.RLPC
 import Data.Default.Class           (def)
+import Data.Text                    qualified as T
 import Core.Parse
 import Core.Lex
 ----------------------------------------------------------------------------------
@@ -44,21 +45,21 @@ coreExpr = QuasiQuoter
     }
 
 qCore :: String -> Q Exp
-qCore s = case parse s of
+qCore s = case parse (T.pack s) of
     Left e       -> error (show e)
     Right (m,ts) -> lift m
     where
         parse = evalRLPC def . (lexCore >=> parseCore)
 
 qCoreExpr :: String -> Q Exp
-qCoreExpr s = case parseExpr s of
+qCoreExpr s = case parseExpr (T.pack s) of
     Left e       -> error (show e)
     Right (m,ts) -> lift m
     where
         parseExpr = evalRLPC def . (lexCore >=> parseCoreExpr)
 
 qCoreProg :: String -> Q Exp
-qCoreProg s = case parseProg s of
+qCoreProg s = case parseProg (T.pack s) of
     Left e       -> error (show e)
     Right (m,ts) -> lift m
     where