<commit_before>module Lang.Lam.CPS.MonadicSemantics where

import FP
import MAAM
import Lang.Lam.CPS.Syntax
import Lang.Lam.CPS.Classes.Delta
import Lang.Lam.Syntax (SGName, LocNum)

type MonadCPS (δ :: *) μ m = 
  ( MonadFail (m δ μ)
  , MonadZero (m δ μ)
  , MonadPlus (m δ μ)
  , MonadStateE (Env μ) (m δ μ)
  , MonadStateE (Store δ μ) (m δ μ)
  , MonadStateE (LexicalTime μ Ψ) (m δ μ)
  , MonadStateE (DynamicTime μ Ψ) (m δ μ)
  , MonadStep (m δ μ)
  , Ord (LexicalTime μ Ψ)
  , Ord (DynamicTime μ Ψ)
  , Ord (Val δ μ)
  , SSC (m δ μ) SGCall
  )

type Analysis δ μ m =
  ( AAM μ
  , Delta δ
  , Δ δ μ
  , MonadCPS δ μ m
  , PartialOrder (SS (m δ μ) SGCall)
  , JoinLattice (SS (m δ μ) SGCall)
  , JoinLattice (Val δ μ)
  )

data M where
  M :: (Analysis δ μ m) => P δ -> P μ -> P m -> M

mP :: P m -> P δ -> μ -> P (m δ μ)
mP P P _ = P

new :: (Analysis δ μ m) => P δ -> μ -> SGName -> m δ μ (Addr μ)
new _ μ x = do
  lτ <- getP $ lexicalTimeP μ ψ
  dτ <- getP $ dynamicTimeP μ ψ
  return $ Addr x lτ dτ

bind :: (Analysis δ μ m) => P δ -> μ -> SGName -> Val δ μ -> m δ μ ()
bind δ μ x vD = do
  l <- new δ μ x
  modifyL (envL μ) $ pinsert x l
  modifyL (storeL δ μ) $ pinsertWith (\/) l vD

var :: (Analysis δ μ m) => P δ -> μ -> SGName -> m δ μ (Val δ μ)
var δ μ x = do
  e <- getL $ envL μ
  s <- getL $ storeL δ μ
  useMaybeZero $ index s *$ index e $ x

lam :: (Analysis δ μ m) => P δ -> μ -> [SGName] -> SGCall -> m δ μ (Val δ μ)
lam δ μ xs c = do
  e <- getP $ envP μ
  lτ <- getP $ lexicalTimeP μ ψ
  return $ clo δ $ Clo xs c e lτ

pico :: (Analysis δ μ m) => P δ -> μ -> SGPico -> m δ μ (Val δ μ)
pico δ _ (Lit l) = return $ lit δ l
pico δ μ (Var x) = var δ μ x

atom :: (Analysis δ μ m) => P δ -> μ -> SGAtom -> m δ μ (Val δ μ)
atom δ μ (Pico p) = pico δ μ p
atom δ μ (Prim o ax) = do
  op δ o <$> pico δ μ ax
atom δ μ (LamF x kx c) = lam δ μ [x, kx] c
atom δ μ (LamK x c) = lam δ μ [x] c

elimBoolM :: (Analysis δ μ m) => P δ -> Val δ μ -> m δ μ Bool
elimBoolM = msum .: elimBool

elimCloM :: (Analysis δ μ m) => P δ -> Val δ μ -> m δ μ (Clo μ)
elimCloM = msum .: elimClo

tickM :: (Analysis δ μ m) => P δ -> μ -> LocNum -> m δ μ ()
tickM δ μ cid = do
  _ <- getP $ envP μ
  _ <- getP $ storeP δ μ
  modifyL (lexicalTimeL μ ψ) $ tick (lexical μ) cid<commit_msg>sketched mcfa different clo creation functions<commit_after>module Lang.Lam.CPS.MonadicSemantics where

import FP
import MAAM
import Lang.Lam.CPS.Syntax
import Lang.Lam.CPS.Classes.Delta
import Lang.Lam.Syntax (SGName, LocNum)

type MonadCPS (δ :: *) μ m = 
  ( MonadFail (m δ μ)
  , MonadZero (m δ μ)
  , MonadPlus (m δ μ)
  , MonadStateE (Env μ) (m δ μ)
  , MonadStateE (Store δ μ) (m δ μ)
  , MonadStateE (LexicalTime μ Ψ) (m δ μ)
  , MonadStateE (DynamicTime μ Ψ) (m δ μ)
  , MonadStep (m δ μ)
  , Ord (LexicalTime μ Ψ)
  , Ord (DynamicTime μ Ψ)
  , Ord (Val δ μ)
  , SSC (m δ μ) SGCall
  )

type Analysis δ μ m =
  ( AAM μ
  , Delta δ
  , Δ δ μ
  , MonadCPS δ μ m
  , PartialOrder (SS (m δ μ) SGCall)
  , JoinLattice (SS (m δ μ) SGCall)
  , JoinLattice (Val δ μ)
  )

data M where
  M :: (Analysis δ μ m) => P δ -> P μ -> P m -> M

mP :: P m -> P δ -> μ -> P (m δ μ)
mP P P _ = P

new :: (Analysis δ μ m) => P δ -> μ -> SGName -> m δ μ (Addr μ)
new _ μ x = do
  lτ <- getP $ lexicalTimeP μ ψ
  dτ <- getP $ dynamicTimeP μ ψ
  return $ Addr x lτ dτ

bind :: (Analysis δ μ m) => P δ -> μ -> SGName -> Val δ μ -> m δ μ ()
bind δ μ x vD = do
  l <- new δ μ x
  modifyL (envL μ) $ pinsert x l
  modifyL (storeL δ μ) $ pinsertWith (\/) l vD

var :: (Analysis δ μ m) => P δ -> μ -> SGName -> m δ μ (Val δ μ)
var δ μ x = do
  e <- getL $ envL μ
  s <- getL $ storeL δ μ
  useMaybeZero $ index s *$ index e $ x

createClosureLinked :: (Analysis δ μ m) => P δ -> μ -> [SGName] -> SGCall -> Env μ -> m δ μ (Val δ μ)
createClosureLinked δ μ xs c ρ = undefined

createClosureCopied :: (Analysis δ μ m) => P δ -> μ -> [SGName] -> SGCall -> Env μ -> m δ μ (Val δ μ)
createClosureCopied δ μ xs c ρ = undefined

lam :: (Analysis δ μ m) => P δ -> μ -> [SGName] -> SGCall -> m δ μ (Val δ μ)
lam δ μ xs c = do
  ρ <- getP $ envP μ
  lτ <- getP $ lexicalTimeP μ ψ
  return $ clo δ $ Clo xs c ρ lτ

pico :: (Analysis δ μ m) => P δ -> μ -> SGPico -> m δ μ (Val δ μ)
pico δ _ (Lit l) = return $ lit δ l
pico δ μ (Var x) = var δ μ x

atom :: (Analysis δ μ m) => P δ -> μ -> SGAtom -> m δ μ (Val δ μ)
atom δ μ (Pico p) = pico δ μ p
atom δ μ (Prim o ax) = do
  op δ o <$> pico δ μ ax
atom δ μ (LamF x kx c) = lam δ μ [x, kx] c
atom δ μ (LamK x c) = lam δ μ [x] c

elimBoolM :: (Analysis δ μ m) => P δ -> Val δ μ -> m δ μ Bool
elimBoolM = msum .: elimBool

elimCloM :: (Analysis δ μ m) => P δ -> Val δ μ -> m δ μ (Clo μ)
elimCloM = msum .: elimClo

tickM :: (Analysis δ μ m) => P δ -> μ -> LocNum -> m δ μ ()
tickM δ μ cid = do
  _ <- getP $ envP μ
  _ <- getP $ storeP δ μ
  modifyL (lexicalTimeL μ ψ) $ tick (lexical μ) cid
{'fraction_non_alphanumeric': 0.1410125025620004, 'fraction_numerical': 0.0, 'mean_word_length': 2.1729518855656695, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 103, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7470025', 'n_tokens_mistral': 2549, 'n_tokens_neox': 2122, 'n_words': 950}