add bitwise operators

This commit is contained in:
darkf 2017-06-01 20:26:33 +00:00
parent 03c8a89318
commit 04a2bf046a
3 changed files with 33 additions and 3 deletions

4
AST.hs
View File

@ -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

View File

@ -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

View File

@ -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)]) }