ShapeIndexedGraph.hs

{-# LANGUAGE GADTs, DataKinds, KindSignatures #-}

-- | Shape-Indexed Graphs with Adaptive Rewriting
--
-- Extends Hoopl's shape-indexed control flow graphs with adaptive
-- rewriting strategies inspired by neural architecture search and
-- reinforcement learning.

module ShapeIndexedGraph where

import Data.Kind (Type)

-- | Open/Closed shape indices (from Hoopl)
data O  -- Open: single entry/exit point
data C  -- Closed: multiple labeled entry/exit points

-- | Simple instruction nodes
data Insn (e :: Type) (x :: Type) where
  Label  :: String -> Insn C O
  Assign :: String -> Int -> Insn O O
  Branch :: String -> Insn O C

-- | Block structure preserving shape invariants
data Block (e :: Type) (x :: Type) where
  BFirst  :: Insn C O -> Block C O
  BMiddle :: Insn O O -> Block O O
  BLast   :: Insn O C -> Block O C
  BCat    :: Block O O -> Block O O -> Block O O
  BClosed :: Block C O -> Block O C -> Block C C

-- | Rewrite strategy with confidence scores (RL-inspired)
data RewriteStrategy = RewriteStrategy
  { strategyName :: String
  , confidence   :: Double  -- learned confidence in [0,1]
  , priority     :: Int     -- exploration priority
  }

-- | Adaptive rewrite: container-polymorphic strategy bank (higher-kinded)
data AdaptiveRewrite (f :: Type -> Type) = AdaptiveRewrite
  { strategies :: f RewriteStrategy
  , temperature :: Double  -- softmax temperature for exploration
  }

-- | Select rewrite strategy using softmax-like scoring (exploration vs exploitation)
selectStrategy :: Foldable f => AdaptiveRewrite f -> IO RewriteStrategy
selectStrategy (AdaptiveRewrite strats temp) =
  case bestByScore strats of
    Nothing -> fail "selectStrategy: no strategies configured"
    Just s  -> return s
  where
    bestByScore :: Foldable t => t RewriteStrategy -> Maybe RewriteStrategy
    bestByScore = foldl' step Nothing

    step :: Maybe RewriteStrategy -> RewriteStrategy -> Maybe RewriteStrategy
    step Nothing candidate = Just candidate
    step (Just best) candidate
      | score candidate > score best = Just candidate
      | otherwise = Just best

    score :: RewriteStrategy -> Double
    score s = confidence s / temp

-- | Example: constant folding with learned confidence
constantFoldStrategy :: RewriteStrategy
constantFoldStrategy = RewriteStrategy "ConstFold" 0.95 1

-- | Example: dead code elimination with learned confidence
deadCodeStrategy :: RewriteStrategy
deadCodeStrategy = RewriteStrategy "DeadCode" 0.87 2

-- | Adaptive rewriter combining multiple strategies
adaptiveRewriter :: AdaptiveRewrite []
adaptiveRewriter = AdaptiveRewrite
  [constantFoldStrategy, deadCodeStrategy]
  1.0  -- temperature

-- | Demonstration
demo :: IO ()
demo = do
  putStrLn "=== Shape-Indexed Adaptive Rewriting ==="
  strategy <- selectStrategy adaptiveRewriter
  putStrLn $ "Selected strategy: " ++ strategyName strategy
  putStrLn $ "Confidence: " ++ show (confidence strategy)