Created
November 6, 2018 17:31
-
-
Save Garciat/b0f060ddf8c5fcd6e4933a739fe57db9 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module StackExpr where | |
data Instr | |
= Const Integer | |
| Add | |
| Sub | |
| Mul | |
| Neg | |
| Abs | |
| Sig | |
deriving (Show) | |
newtype Program = P [Instr] deriving (Show) | |
instance Num Program where | |
fromInteger i = P [Const i] | |
P a + P b = P (b ++ a ++ [Add]) | |
P a - P b = P (b ++ a ++ [Sub]) | |
P a * P b = P (b ++ a ++ [Mul]) | |
negate (P a) = P (a ++ [Neg]) | |
abs (P a) = P (a ++ [Abs]) | |
signum (P a) = P (a ++ [Sig]) | |
eval :: Program -> Integer | |
eval (P xs) = go [] xs | |
where | |
go (x:_) [] = x | |
go xs (Const i:ys) = go (i:xs) ys | |
go (a:b:xs) (Add:ys) = go ((a+b):xs) ys | |
go (a:b:xs) (Mul:ys) = go ((a*b):xs) ys | |
go (a:b:xs) (Sub:ys) = go ((a-b):xs) ys | |
go (a:xs) (Neg:ys) = go ((negate a):xs) ys | |
go (a:xs) (Abs:ys) = go ((abs a):xs) ys | |
go (a:xs) (Sig:ys) = go ((signum a):xs) ys |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module StackExpr where | |
data BinOp | |
= Add | |
| Mul | |
| Sub | |
deriving (Show) | |
data UnaOp | |
= Neg | |
| Abs | |
| Sig | |
deriving (Show) | |
data Instr | |
= Const Integer | |
| BinOp BinOp | |
| UnaOp UnaOp | |
deriving (Show) | |
binop :: BinOp -> Integer -> Integer -> Integer | |
binop Add = (+) | |
binop Mul = (*) | |
binop Sub = (-) | |
unaop :: UnaOp -> Integer -> Integer | |
unaop Neg = negate | |
unaop Abs = abs | |
unaop Sig = signum | |
newtype Program = P [Instr] deriving (Show) | |
formatBin :: BinOp -> Program -> Program -> Program | |
formatBin op (P a) (P b) = P (b ++ a ++ [BinOp op]) | |
formatUna :: UnaOp -> Program -> Program | |
formatUna op (P a) = P (a ++ [UnaOp op]) | |
instance Num Program where | |
fromInteger i = P [Const i] | |
(+) = formatBin Add | |
(-) = formatBin Sub | |
(*) = formatBin Mul | |
negate = formatUna Neg | |
abs = formatUna Abs | |
signum = formatUna Sig | |
eval :: Program -> Integer | |
eval (P xs) = go [] xs | |
where | |
go (x:_) [] = x | |
go xs (Const i:ys) = go (i:xs) ys | |
go (a:b:xs) (BinOp x:ys) = go ((binop x a b):xs) ys | |
go (a:xs) (UnaOp x:ys) = go ((unaop x a):xs) ys |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# Language ConstraintKinds #-} | |
{-# Language GADTs #-} | |
module StackExpr where | |
data BinOp | |
= Add | |
| Mul | |
| Sub | |
deriving (Show) | |
data UnaOp | |
= Neg | |
| Abs | |
| Sig | |
deriving (Show) | |
data Instr | |
= Const Integer | |
| BinOp BinOp | |
| UnaOp UnaOp | |
deriving (Show) | |
newtype Program = P [Instr] deriving (Show) | |
formatBin :: BinOp -> Program -> Program -> Program | |
formatBin op (P a) (P b) = P (b ++ a ++ [BinOp op]) | |
formatUna :: UnaOp -> Program -> Program | |
formatUna op (P a) = P (a ++ [UnaOp op]) | |
instance Num Program where | |
fromInteger i = P [Const i] | |
(+) = formatBin Add | |
(-) = formatBin Sub | |
(*) = formatBin Mul | |
negate = formatUna Neg | |
abs = formatUna Abs | |
signum = formatUna Sig | |
--- | |
{- | |
class Num a where | |
(+) :: a -> a -> a | |
(-) :: a -> a -> a | |
(*) :: a -> a -> a | |
negate :: a -> a | |
abs :: a -> a | |
signum :: a -> a | |
fromInteger :: Integer -> a | |
-} | |
data DNum where | |
NumAdd :: DNum -> DNum -> DNum | |
NumSub :: DNum -> DNum -> DNum | |
NumMul :: DNum -> DNum -> DNum | |
NumNeg :: DNum -> DNum | |
NumAbs :: DNum -> DNum | |
NumSig :: DNum -> DNum | |
NumInt :: Integer -> DNum | |
deriving Show | |
instance Num DNum where | |
(+) = NumAdd | |
(-) = NumSub | |
(*) = NumMul | |
negate = NumNeg | |
abs = NumAbs | |
signum = NumSig | |
fromInteger = NumInt | |
asNum :: Num a => DNum -> a | |
asNum = go | |
where | |
go (NumAdd a b) = go a + go b | |
go (NumSub a b) = go a - go b | |
go (NumMul a b) = go a * go b | |
go (NumNeg a) = negate (go a) | |
go (NumAbs a) = abs (go a) | |
go (NumSig a) = signum (go a) | |
go (NumInt i) = fromInteger i | |
class ToDNum a where | |
toDNum :: a -> DNum | |
instance ToDNum DNum where | |
toDNum = id | |
instance ToDNum Program where | |
toDNum (P xs) = go [] xs | |
where | |
go [x] [] = x | |
go xs (Const i:ys) = go (NumInt i:xs) ys | |
go (a:b:xs) (BinOp op:ys) = go (bin op a b:xs) ys | |
go (a:xs) (UnaOp op:ys) = go (una op a:xs) ys | |
bin Add = NumAdd | |
bin Sub = NumSub | |
bin Mul = NumMul | |
una Neg = NumNeg | |
una Abs = NumAbs | |
una Sig = NumSig | |
eval :: Program -> Integer | |
eval = asNum . toDNum |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment