reify/reflect
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
{- | |
Examples: | |
> reify @Int $ eval $ A (reflect (abs :: Int -> Int)) (I (-9)) | |
9 | |
> reify @Int $ eval $ A (A (reflect ((*) :: Int -> Int -> Int)) (reflect @Int 3)) (reflect @Int 5) | |
15 | |
> reify @[Int] $ eval $ A (reflect (reverse :: [E] -> [E])) (reflect ([1..3] :: [Int])) | |
[3,2,1] | |
> reify @[Int] $ eval $ A (A (reflect (map :: (E -> E) -> [E] -> [E])) (reflect @(Int -> Int) (* 2))) (reflect ([1..3] :: [Int])) | |
[2,4,6] | |
Using an instance of Eq/Ord for E: | |
> reify @Int $ eval $ A (reflect (minimum :: [E] -> E)) (reflect ([4,5,2,7] :: [Int])) | |
2 | |
Work with functor-like data structures (Maybe, []). | |
> reify @(Maybe Int) $ eval $ A (reflect (Just :: Int -> Maybe Int)) (I (-9)) | |
Just (-9) | |
> reify @Int $ eval $ A (reflect (maybe 0 (+2) :: Maybe Int -> Int)) (reflect (Just 5 :: Maybe Int)) | |
7 | |
> reify @Int $ eval $ If (reflect False) (I 1) (I 0) | |
0 | |
-} | |
{-# language TypeApplications, ScopedTypeVariables, FlexibleInstances #-} | |
import Data.Dynamic | |
import qualified Data.Map as M | |
import Data.Map (Map) | |
import Data.Maybe | |
data E = A E E | |
| F (E -> E) | |
| I Int | |
| D { undyn :: Dynamic } | |
| If E E E | |
instance Eq E where | |
(==) (I x) (I y) = (==) x y | |
instance Ord E where | |
compare (I x) (I y) = compare x y | |
class Reflect t where | |
reflect :: t -> E | |
reify :: E -> t | |
instance Reflect Int where | |
reflect = I | |
reify (I i) = i | |
instance (Reflect i, Reflect o) => Reflect (i -> o) where | |
reflect f = F (reflect @o . f . reify) | |
reify (F f) = reify @o . f . reflect | |
instance Reflect E where | |
reflect = id | |
reify = id | |
instance Reflect Bool where | |
reflect = D . toDyn | |
reify = flip fromDyn (error "wrong type") . undyn | |
instance {-# overlappable #-} (Typeable f, Functor f,Reflect a) => Reflect (f a) where | |
reflect = D . toDyn . fmap reflect | |
reify (D dyn) = fmap reify (fromDyn dyn (error "wrong type")) | |
eval (A f x) = (reify (eval f)) (eval x) | |
eval (If x a b) = if reify (eval x) then eval a else eval b | |
eval e = e | |
env :: Map String E | |
env = M.fromList [ | |
("Just", reflect (Just :: E -> Maybe E)), | |
("True", reflect (True :: Bool)), | |
("False", reflect (False :: Bool)), | |
("Nothing", reflect (Nothing :: Maybe E)), | |
("fromMaybe", reflect (fromMaybe :: E -> Maybe E -> E)), | |
("maybe", reflect (maybe :: E -> (E -> E) -> Maybe E -> E)), | |
("*",reflect ((*) :: Int -> Int -> Int)) | |
] | |
prim :: String -> E | |
prim k = fromJust $ M.lookup k env | |
-- todo: | |
-- parser <https://hackage.haskell.org/package/parser-combinators-1.3.0/docs/Control-Monad-Combinators-Expr.html#v:makeExprParser> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment