switch AST to use Data.Text

This commit is contained in:
darkf 2014-11-02 01:14:23 -07:00
parent e6b13b253f
commit 92594900b4
3 changed files with 23 additions and 21 deletions

13
AST.hs
View File

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

View File

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

View File

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