Last active
October 31, 2021 02:31
-
-
Save smunix/15c4b6c5a4bb7e917e97b3085e5a2bc7 to your computer and use it in GitHub Desktop.
Arithmetic Expressions
This file contains hidden or 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 GADTs #-} | |
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
-- | | |
module Arithmetic.Expr where | |
import Data.Char (chr) | |
import GHC.Real (RealFrac (truncate)) | |
{- | |
Expr :: Term | |
Term :: Int | |
| Factor + Factor | |
Factor :: Term | |
| Factor x Factor | |
-} | |
{- | |
data Term | |
= MkPrim Int | |
| MkAdd Factor Factor | |
deriving (Show, Eq) | |
-} | |
data Term where | |
MkPrim :: Int -> Term | |
MkAdd :: Factor -> Factor -> Term | |
deriving (Show, Eq) | |
data TermG a where | |
MkPrimG :: a -> TermG a | |
MkAddG :: FactorG a -> FactorG a -> TermG a | |
deriving (Show, Eq) | |
instance Functor TermG where | |
fmap f (MkPrimG a) = MkPrimG (f a) | |
fmap f (MkAddG l r) = MkAddG (fmap f l) (fmap f r) | |
{- d = MkPrimG 1.0 | |
i = MkPrimG 2 | |
s = MkPrimG "Mo" | |
-} | |
fnL :: forall a. [] a -> Maybe a | |
fnL [] = Nothing | |
fnL (a : as) = Just a | |
fnG :: forall a. (Num a) => TermG a -> a | |
fnG (MkPrimG a) = a | |
fnG (MkAddG l r) = evalF l + evalF r | |
evalF :: forall a. Num a => FactorG a -> a | |
evalF (MkTermG t) = fnG t | |
evalF (MkMulG l r) = evalF l * evalF r | |
{- | |
data Factor | |
= MkTerm Term | |
| MkMul Factor Factor | |
deriving (Show, Eq) | |
-} | |
data Factor where | |
MkTerm :: Term -> Factor | |
MkMul :: Factor -> Factor -> Factor | |
deriving (Show, Eq) | |
data FactorG a where | |
MkTermG :: TermG a -> FactorG a | |
MkMulG :: FactorG a -> FactorG a -> FactorG a | |
deriving (Show, Eq) | |
instance Functor FactorG where | |
fmap f (MkTermG t) = MkTermG (fmap f t) | |
fmap f (MkMulG l r) = MkMulG (fmap f l) (fmap f r) | |
type Expr = Term | |
type ExprG a = TermG a | |
{- e = 1 + 2 x 3 -} | |
{- | |
+ | |
1 x | |
2 3 | |
-} | |
e :: Expr | |
e = MkAdd f1 f2 | |
where | |
f2 :: Factor | |
f2 = MkMul (MkTerm (MkPrim 2)) (MkTerm (MkPrim 3)) | |
f1 :: Factor | |
f1 = MkTerm (MkPrim 1) | |
-- $> import Xiaoming.Arithmetic.Expr | |
-- $> e | |
eg :: forall a. (a ~ Float) => ExprG a | |
eg = MkAddG f1 f2 | |
where | |
f2 :: FactorG a | |
f2 = MkMulG (MkTermG (MkPrimG 2)) (MkTermG (MkPrimG 3)) | |
f1 :: FactorG a | |
f1 = MkTermG (MkPrimG 1) | |
-- $> import Arithmetic.Expr | |
-- $> (fnG eg, eg) | |
-- $> import Data.Char | |
-- $> (fmap (chr) . (fmap truncate) $ eg, eg) | |
-- $> (fmap (chr . truncate) $ eg, eg) |
This file contains hidden or 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
{- | |
BNF Grammar representation (Backus Nor Form) | |
Expr : Expr + Term | |
| Expr - Term | |
| Term | |
Term : Term * Factor | |
| Term / Factor | |
| Factor | |
Factor : Int | |
-} | |
data Factor where | |
Int :: Int -> Factor | |
deriving (Show) | |
data Term where | |
(:*:) :: Term -> Factor -> Term | |
(:/:) :: Term -> Factor -> Term | |
Factor :: Factor -> Term | |
deriving (Show) | |
data Expr where | |
(:+:) :: Expr -> Term -> Expr | |
(:-:) :: Expr -> Term -> Expr | |
Term :: Term -> Expr | |
deriving (Show) | |
-- 1 + 2 x 3 | |
v :: Expr | |
v = Term (Factor (Int 1)) :+: (Factor (Int 2) :*: Int 3) | |
-- $> v |
This file contains hidden or 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 GADTs #-} | |
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
-- | | |
module Regex.Expr where | |
{- | |
'a' | |
'ab' <=> ReConcat (ReChar 'a') (ReChar 'b') <=> 'a' * 'b' | |
'abc' <=> ReConcat (ReChar 'a') (ReConcat (ReChar 'b') (ReChar 'c'))<=> 'a' * 'b' | |
'a|b' <=> 'a' + 'b' | |
'a*' | |
Kleene Star | |
\epsilon | |
-} | |
data RegExpr a where | |
ReChar :: a -> RegExpr a | |
ReEpsilon :: RegExpr a | |
ReConcat :: RegExpr a -> RegExpr a -> RegExpr a | |
ReChoice :: RegExpr a -> RegExpr a -> RegExpr a | |
ReStar :: RegExpr a -> RegExpr a | |
data E a where | |
Var :: a -> E a | |
Fun :: a -> E a -> E a | |
App :: E a -> E a -> E a | |
data Ty a where | |
PrimTy :: a -> Ty a | |
TempTy :: a -> Ty a -> Ty a | |
AppTy :: Ty a -> Ty a -> Ty a |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
UPDATE I was wrong, I didn't consider if you were using
Expr
for everything, then haskell implementation would've been less than 10 lines, so now my C++ code is 30x longer than yoursUsing
Expr
to replaceTerm
andFactor
indeed makes code a little bit shorter, and removedString
type, because it doesn't make much sense at this momentThe current code is slightly shorter than 20x compare to your code, sigh, c++ is too verbose