switch AST to use Data.Text
This commit is contained in:
parent
e6b13b253f
commit
92594900b4
3 changed files with 23 additions and 21 deletions
13
AST.hs
13
AST.hs
|
@ -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]
|
||||||
|
|
22
Interp.hs
22
Interp.hs
|
@ -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) =
|
||||||
|
|
|
@ -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) }
|
||||||
|
|
Loading…
Reference in a new issue