reify/reflect

reify-reflect.hs

{-

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>