switch AST to use Data.Text

AST.hs

@@ -3,6 +3,7 @@
 -- Licensed under the terms of the zlib license, see LICENSE for details
 
 module AST where
+import qualified Data.Text as T
 
 data AST = Add AST AST
 		 | Sub AST AST
@@ -13,10 +14,10 @@ data AST = Add AST AST
 		 | LessThan AST AST
 		 | GreaterThan AST AST
 		 | Block [AST]
-		 | FunDef String (Pattern, AST)
-		 | Defun String AST
+		 | FunDef T.Text (Pattern, AST)
+		 | Defun T.Text AST
 		 | Def Pattern AST
-		 | Var String
+		 | Var T.Text
 		 | Lambda [(Pattern, AST)]
 		 | Call AST AST
 		 | Access AST AST
@@ -25,13 +26,13 @@ data AST = Add AST AST
 		 | TupleConst [AST]
 		 | ListConst [AST]
 		 | BoolConst Bool
-		 | StrConst String
+		 | StrConst T.Text
 		 | IntConst Integer
 		 deriving (Show, Eq)
 
-data Pattern = VarP String
+data Pattern = VarP T.Text
 			 | IntP Integer
-			 | StrP String
+			 | StrP T.Text
 			 | BoolP Bool
 			 | ConsP Pattern Pattern
 			 | TupleP [Pattern]

Interp.hs

@@ -231,7 +231,7 @@ _Import (StrV modname) = do
 
 bif = Builtin . BIF
 initialState = [M.fromList $ map (\(k,v) -> (T.pack k, v)) $ [
-                            ("id", FnV emptyEnv [(VarP "x", Var "x")]),
+                            ("id", FnV emptyEnv [(VarP (T.pack "x"), Var (T.pack "x"))]),
                             ("loop", bif _loop),
                             ("ref!", bif _ref),
                             ("readRef!", bif _readRef),
@@ -262,7 +262,7 @@ initialState = [M.fromList $ map (\(k,v) -> (T.pack k, v)) $ [
 eval :: AST -> InterpState Value
 
 eval (IntConst i) = return $ IntV i
-eval (StrConst s) = return $ StrV $ T.pack s
+eval (StrConst s) = return $ StrV s
 eval (BoolConst b) = return $ BoolV b
 
 eval (Block body) = foldr1 (>>) $ map eval body
@@ -284,19 +284,19 @@ eval (IfExpr c t e) = eval c >>= \cond ->
 		_ -> error "if: condition must be a boolean"
 
 eval (Var var) = get >>= \env ->
-	maybe (error $ "unbound variable " ++ var) return (lookup env (T.pack var))
+	maybe (error $ "unbound variable " ++ T.unpack var) return (lookup env var)
 
 eval (Defun name fn) = do
 	env <- get
-	case lookup env (T.pack name) of
+	case lookup env name of
             Nothing -> -- bind new fn
                     eval fn >>= \fn' ->
-                    	put (bind env (T.pack name) fn') >> return fn'
+                    	put (bind env name fn') >> return fn'
             Just oldfn -> -- add pattern to old fn
                     let FnV cls oldpats = oldfn
                         Lambda [(pat, body)] = fn
                         newfn = FnV cls (oldpats ++ [(pat, body)]) in
-                        put (bind env (T.pack name) newfn) >> return newfn
+                        put (bind env name newfn) >> return newfn
 
 eval (Def pat v') = do
 	v <- eval v'
@@ -327,7 +327,7 @@ eval (Access left (Var right)) = do
 	lhs <- eval left
 	case lhs of
 		DictV dict ->
-			case M.lookup (StrV $ T.pack right) dict of
+			case M.lookup (StrV right) dict of
 				Just (FnV [] fn) -> -- use the module's global scope
 					return $ FnV (mapToEnv dict) fn
 				Just v -> return v
@@ -355,7 +355,7 @@ eval (Call lhs arg) = do
 eval x = error $ "eval: unhandled: " ++ show x
 
 patternBindings :: Pattern -> Value -> Maybe (M.Map T.Text Value)
-patternBindings (VarP n) v = Just $ M.fromList [(T.pack n, v)]
+patternBindings (VarP n) v = Just $ M.fromList [(n, v)]
 
 patternBindings (IntP n) (IntV v)
 	| v == n = Just M.empty
@@ -367,7 +367,7 @@ patternBindings (BoolP b) (BoolV v)
 	| otherwise = Nothing
 
 patternBindings (StrP x) (StrV y)
-	| T.pack x == y = Just M.empty
+	| x == y = Just M.empty
 	| otherwise = Nothing
 patternBindings (StrP _) _ = Nothing
 
@@ -380,8 +380,8 @@ patternBindings (ConsP x (ListP [])) (StrV str) =
 		_ -> Nothing
 -- "xy":xs pattern
 patternBindings (ConsP (StrP xp) xsp) (StrV str) =
-	let len = length xp in
-	if T.take len str == T.pack xp then -- matches
+	let len = T.length xp in
+	if T.take len str == xp then -- matches
 		patternBindings xsp $ StrV (T.drop len str) -- match the rest of the string
 	else Nothing -- no match
 patternBindings (ConsP xp xsp) (StrV str) =

Parser.hs

@@ -3,6 +3,7 @@
 module Parser where
 import Data.Maybe (fromMaybe)
 import Text.Peggy hiding (space)
+import qualified Data.Text as T
 import AST
 
 [peggy|
@@ -41,7 +42,7 @@ pattern :: Pattern
   / patterntuple
   / "true" { BoolP True } / "false" { BoolP False }
   / identifier { VarP $1 }
-  / stringlit { StrP $1 }
+  / stringlit { StrP (T.pack $1) }
   / integer { IntP $1 }
 
 funpattern :: Pattern
@@ -104,7 +105,7 @@ term :: AST
   / ifcond
   / doblock
   / "true" { BoolConst True } / "false" { BoolConst False }
-  / stringlit { StrConst $1 }
+  / stringlit { StrConst (T.pack $1) }
   / integer { IntConst $1 }
   / identifier { Var $1 }
 
@@ -124,8 +125,8 @@ escChar :: Char
   / 'r' { '\r' }
   / 't' { '\t' }
 
-identifier ::: String
-  = [a-zA-Z_] [a-zA-Z0-9_'?!]* { $1 : $2 }
+identifier ::: T.Text
+  = [a-zA-Z_] [a-zA-Z0-9_'?!]* { T.pack ($1 : $2) }
 
 integer ::: Integer
   = [0-9] [0-9]* { read ($1 : $2) }