Created
July 4, 2010 18:30
-
-
Save cutthroat/463645 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
| {- how to eval Icon pure integer-expressions -} | |
| {- values -} | |
| data D = DNull | DInt Int | |
| deriving (Show, Eq) | |
| newtype V = V { runV :: [D] } | |
| deriving (Show) | |
| {- glue code -} | |
| vReturn :: D -> V | |
| vReturn x = V [x] | |
| vJoin :: [V] -> V | |
| vJoin vs = V $ concatMap runV vs | |
| vBind :: (D -> V) -> V -> V | |
| vBind f v1 = vJoin [ f x | x <- runV v1 ] | |
| vBind2 :: (D -> D -> V) -> V -> V -> V | |
| vBind2 f v1 v2 = vJoin [ f x y | x <- runV v1, y <- runV v2 ] | |
| {- operators -} | |
| vFail :: V | |
| vFail = V [] | |
| vAlt :: [V] -> V | |
| vAlt = vJoin | |
| vSeq :: [V] -> V | |
| vSeq [] = vReturn DNull | |
| vSeq vs = V $ last $ sequence $ map runV vs | |
| vNot :: V -> V | |
| vNot (V []) = vReturn DNull | |
| vNot _ = vFail | |
| {- arithmetic -} | |
| dAdd (DInt x) (DInt y) = vReturn $ DInt (x + y) | |
| dAdd _ _ = vFail | |
| dMul (DInt x) (DInt y) = vReturn $ DInt (x * y) | |
| dMul _ _ = vFail | |
| dSub (DInt x) (DInt y) = vReturn $ DInt (x - y) | |
| dSub _ _ = vFail | |
| {- order -} | |
| dEq :: D -> D -> V | |
| dEq x y = if x == y then vReturn x else vFail | |
| dLt :: D -> D -> V | |
| dLt (DInt x) (DInt y) = if x < y then vReturn $ DInt y else vFail | |
| dLt _ _ = vFail | |
| {- syntax -} | |
| data E = EFail | ENull | EInt Int | EAlt [E] | ESeq [E] | ENot E | EIfThenElse E E E | EAdd E E | EMul E E | ESub E E | EEq E E | ELt E E | |
| deriving (Show) | |
| eval :: E -> V | |
| eval EFail = vFail | |
| eval ENull = vReturn DNull | |
| eval (EInt x) = vReturn $ DInt x | |
| eval (EAlt es) = vAlt (map eval es) | |
| eval (ESeq es) = vSeq (map eval es) | |
| eval (ENot e) = vNot (eval e) | |
| eval (EIfThenElse eCond eOk eFail) = vJoin [vBind (\_ -> eval eOk) (eval eCond), eval eFail] | |
| eval (EAdd e1 e2) = vBind2 dAdd (eval e1) (eval e2) | |
| eval (EMul e1 e2) = vBind2 dMul (eval e1) (eval e2) | |
| eval (ESub e1 e2) = vBind2 dSub (eval e1) (eval e2) | |
| eval (EEq e1 e2) = vBind2 dEq (eval e1) (eval e2) | |
| eval (ELt e1 e2) = vBind2 dLt (eval e1) (eval e2) | |
| testE = ELt (EAdd (EAlt [EInt 1, EInt 2, EInt 3]) (EAlt [EInt 4, EInt 5, EInt 6])) | |
| (EAlt [EInt 4, EInt 5, EInt 6, EInt 7]) |
Виж Icon. А иначе нищо повече от List монада :) eval оценява само чисти изрази, което е почти безмислено, но е все пак прост пример.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
А това какво е? :)