diff --git a/AST.hs b/AST.hs index eda7d92..60e0ce2 100644 --- a/AST.hs +++ b/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] diff --git a/Interp.hs b/Interp.hs index 0deac39..022e046 100644 --- a/Interp.hs +++ b/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) = diff --git a/Parser.hs b/Parser.hs index be4a0ce..dc0a2e6 100644 --- a/Parser.hs +++ b/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) }