add bitwise operators
This commit is contained in:
parent
03c8a89318
commit
04a2bf046a
4
AST.hs
4
AST.hs
|
@ -13,6 +13,10 @@ data AST = Add AST AST
|
|||
| NotEquals AST AST
|
||||
| LessThan AST AST
|
||||
| GreaterThan AST AST
|
||||
| BitAnd AST AST
|
||||
| BitOr AST AST
|
||||
| BitNot AST
|
||||
| BitShift AST AST Bool
|
||||
| Block [AST]
|
||||
| FunDef T.Text (Pattern, AST)
|
||||
| Defun T.Text AST
|
||||
|
|
23
Interp.hs
23
Interp.hs
|
@ -3,7 +3,7 @@
|
|||
-- Licensed under the terms of the zlib license, see LICENSE for details
|
||||
|
||||
module Interp where
|
||||
import Prelude hiding (lookup)
|
||||
import Prelude hiding (lookup, (<$))
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Network.Socket as SO
|
||||
|
@ -11,6 +11,7 @@ import qualified Data.Text as T
|
|||
import qualified Data.Text.IO as TIO
|
||||
import Data.List (intercalate, foldl1')
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Data.Bits
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Exception (try, SomeException)
|
||||
import Control.Concurrent (ThreadId, forkIO, threadDelay, killThread)
|
||||
|
@ -110,6 +111,21 @@ l <$ r = error $ "cannot < " ++ show l ++ " and " ++ show r
|
|||
(IntV l) >$ (IntV r) = BoolV (l > r)
|
||||
l >$ r = error $ "cannot > " ++ show l ++ " and " ++ show r
|
||||
|
||||
(IntV l) &$ (IntV r) = IntV (l .&. r)
|
||||
l &$ r = error $ "cannot & " ++ show l ++ " and " ++ show r
|
||||
|
||||
(IntV l) |$ (IntV r) = IntV (l .|. r)
|
||||
l |$ r = error $ "cannot | " ++ show l ++ " and " ++ show r
|
||||
|
||||
(IntV l) <<$ (IntV r) = IntV (l `shiftL` fromInteger r)
|
||||
l <<$ r = error $ "cannot << " ++ show l ++ " and " ++ show r
|
||||
|
||||
(IntV l) >>$ (IntV r) = IntV (l `shiftR` fromInteger r)
|
||||
l >>$ r = error $ "cannot >> " ++ show l ++ " and " ++ show r
|
||||
|
||||
bitNot (IntV v) = IntV (complement v)
|
||||
bitNot v = error $ "cannot ~ " ++ show v
|
||||
|
||||
l ==$ r = BoolV (l == r)
|
||||
l !=$ r = BoolV (l /= r)
|
||||
|
||||
|
@ -356,6 +372,11 @@ eval (NotEquals l r) = do { l <- eval l; r <- eval r; return $ l !=$ r }
|
|||
eval (LessThan l r) = do { l <- eval l; r <- eval r; return $ l <$ r }
|
||||
eval (GreaterThan l r) = do { l <- eval l; r <- eval r; return $ l >$ r }
|
||||
|
||||
eval (BitAnd l r) = do { l <- eval l; r <- eval r; return $ l &$ r }
|
||||
eval (BitOr l r) = do { l <- eval l; r <- eval r; return $ l |$ r }
|
||||
eval (BitShift l r dir) = do { l <- eval l; r <- eval r; return $ (if dir then (<<$) else (>>$)) l r }
|
||||
eval (BitNot v) = do { v <- eval v; return $ bitNot v }
|
||||
|
||||
eval (Access left (Var right)) = do
|
||||
lhs <- eval left
|
||||
case lhs of
|
||||
|
|
|
@ -76,10 +76,15 @@ expr :: AST
|
|||
= expr "::" expr { Cons $1 $2 }
|
||||
/ expr "+" fact { Add $1 $2 }
|
||||
/ expr "-" fact { Sub $1 $2 }
|
||||
/ expr "&" fact { BitAnd $1 $2 }
|
||||
/ expr "|" fact { BitOr $1 $2 }
|
||||
/ expr "<<" fact { BitShift $1 $2 True }
|
||||
/ expr ">>" fact { BitShift $1 $2 False }
|
||||
/ expr "==" fact { Equals $1 $2 }
|
||||
/ expr "!=" fact { NotEquals $1 $2 }
|
||||
/ expr "<" fact { LessThan $1 $2 }
|
||||
/ expr ">" fact { GreaterThan $1 $2 }
|
||||
/ "~" expr { BitNot $1 }
|
||||
/ def
|
||||
/ lambda
|
||||
/ identifier "(" funpattern ")" "->" expr { Defun $1 (Lambda [($2, $3)]) }
|
||||
|
|
Loading…
Reference in New Issue