-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

-- The goal of the module is to build phi expression based on
-- pattern expression and set of substitutions by replacing
-- meta variables with appropriate meta values
module Builder
  ( buildExpressions,
    buildExpression,
    buildExpressionFromFunction,
    buildAttribute,
    buildBinding,
    contextualize
  )
where

import Ast
import qualified Data.Map.Strict as Map
import Matcher

contextualize :: Expression -> Expression -> Program -> Expression
contextualize :: Expression -> Expression -> Program -> Expression
contextualize Expression
ExGlobal Expression
_ (Program Expression
expr) = Expression
expr
contextualize Expression
ExThis Expression
expr Program
_ = Expression
expr
contextualize Expression
ExTermination Expression
_ Program
_ = Expression
ExTermination
contextualize (ExFormation [Binding]
bds) Expression
_ Program
_ = [Binding] -> Expression
ExFormation [Binding]
bds
contextualize (ExDispatch Expression
expr Attribute
attr) Expression
context Program
prog = Expression -> Attribute -> Expression
ExDispatch (Expression -> Expression -> Program -> Expression
contextualize Expression
expr Expression
context Program
prog) Attribute
attr
contextualize (ExApplication Expression
expr (BiTau Attribute
attr Expression
bexpr)) Expression
context Program
prog =
  let expr' :: Expression
expr' = Expression -> Expression -> Program -> Expression
contextualize Expression
expr Expression
context Program
prog
      bexpr' :: Expression
bexpr' = Expression -> Expression -> Program -> Expression
contextualize Expression
bexpr Expression
context Program
prog
   in Expression -> Binding -> Expression
ExApplication Expression
expr' (Attribute -> Expression -> Binding
BiTau Attribute
attr Expression
bexpr')

buildAttribute :: Attribute -> Subst -> Maybe Attribute
buildAttribute :: Attribute -> Subst -> Maybe Attribute
buildAttribute (AtMeta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvAttribute Attribute
attr) -> Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just Attribute
attr
  Maybe MetaValue
_ -> Maybe Attribute
forall a. Maybe a
Nothing
buildAttribute Attribute
attr Subst
_ = Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just Attribute
attr

-- Build binding
-- The function returns [Binding] because the BiMeta is always attached
-- to the list of bindings
buildBinding :: Binding -> Subst -> Maybe [Binding]
buildBinding :: Binding -> Subst -> Maybe [Binding]
buildBinding (BiTau Attribute
attr Expression
expr) Subst
subst = do
  Attribute
attribute <- Attribute -> Subst -> Maybe Attribute
buildAttribute Attribute
attr Subst
subst
  (Expression
expression, Expression
_) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr Subst
subst
  [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Attribute -> Expression -> Binding
BiTau Attribute
attribute Expression
expression]
buildBinding (BiVoid Attribute
attr) Subst
subst = do
  Attribute
attribute <- Attribute -> Subst -> Maybe Attribute
buildAttribute Attribute
attr Subst
subst
  [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Attribute -> Binding
BiVoid Attribute
attribute]
buildBinding (BiMeta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvBindings [Binding]
bds) -> [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Binding]
bds
  Maybe MetaValue
_ -> Maybe [Binding]
forall a. Maybe a
Nothing
buildBinding (BiMetaDelta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvBytes String
bytes) -> [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [String -> Binding
BiDelta String
bytes]
  Maybe MetaValue
_ -> Maybe [Binding]
forall a. Maybe a
Nothing
buildBinding (BiMetaLambda String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvFunction String
func) -> [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [String -> Binding
BiLambda String
func]
  Maybe MetaValue
_ -> Maybe [Binding]
forall a. Maybe a
Nothing
buildBinding Binding
binding Subst
_ = [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Binding
binding]

-- Build bindings that may contain meta binding (BiMeta)
buildBindings :: [Binding] -> Subst -> Maybe [Binding]
buildBindings :: [Binding] -> Subst -> Maybe [Binding]
buildBindings [] Subst
_ = [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just []
buildBindings (Binding
bd : [Binding]
rest) Subst
subst = do
  [Binding]
first <- Binding -> Subst -> Maybe [Binding]
buildBinding Binding
bd Subst
subst
  [Binding]
bds <- [Binding] -> Subst -> Maybe [Binding]
buildBindings [Binding]
rest Subst
subst
  [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just ([Binding]
first [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
bds)

buildExpressionWithTails :: Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails :: Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails Expression
expr [] Subst
_ = Expression
expr
buildExpressionWithTails Expression
expr (Tail
tail : [Tail]
rest) Subst
subst = case Tail
tail of
  TaApplication Binding
taus -> Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails (Expression -> Binding -> Expression
ExApplication Expression
expr Binding
taus) [Tail]
rest Subst
subst
  TaDispatch Attribute
attr -> Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails (Expression -> Attribute -> Expression
ExDispatch Expression
expr Attribute
attr) [Tail]
rest Subst
subst

-- Build meta expression with given substitution
-- It returns tuple (X, Y)
-- where X is built expression and Y is context of X
-- If meta expression is built from MvExpression, is has
-- context from original Program. It have default context otherwise
buildExpression :: Expression -> Subst -> Maybe (Expression, Expression)
buildExpression :: Expression -> Subst -> Maybe (Expression, Expression)
buildExpression (ExDispatch Expression
expr Attribute
attr) Subst
subst = do
  (Expression
dispatched, Expression
scope) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr Subst
subst
  Attribute
attr <- Attribute -> Subst -> Maybe Attribute
buildAttribute Attribute
attr Subst
subst
  (Expression, Expression) -> Maybe (Expression, Expression)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Attribute -> Expression
ExDispatch Expression
dispatched Attribute
attr, Expression
scope)
buildExpression (ExApplication Expression
expr (BiTau Attribute
battr Expression
bexpr)) Subst
subst = do
  (Expression
applied, Expression
scope) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr Subst
subst
  [Binding
binding] <- Binding -> Subst -> Maybe [Binding]
buildBinding (Attribute -> Expression -> Binding
BiTau Attribute
battr Expression
bexpr) Subst
subst
  (Expression, Expression) -> Maybe (Expression, Expression)
forall a. a -> Maybe a
Just (Expression -> Binding -> Expression
ExApplication Expression
applied Binding
binding, Expression
scope)
buildExpression (ExApplication Expression
_ Binding
_) Subst
_ = Maybe (Expression, Expression)
forall a. Maybe a
Nothing
buildExpression (ExFormation [Binding]
bds) Subst
subst = do
  [Binding]
bds' <- [Binding] -> Subst -> Maybe [Binding]
buildBindings [Binding]
bds Subst
subst
  (Expression, Expression) -> Maybe (Expression, Expression)
forall a. a -> Maybe a
Just ([Binding] -> Expression
ExFormation [Binding]
bds', Expression
defaultScope)
buildExpression (ExMeta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvExpression Expression
expr Expression
scope) -> (Expression, Expression) -> Maybe (Expression, Expression)
forall a. a -> Maybe a
Just (Expression
expr, Expression
scope)
  Maybe MetaValue
_ -> Maybe (Expression, Expression)
forall a. Maybe a
Nothing
buildExpression (ExMetaTail Expression
expr String
meta) Subst
subst = do
  let (Subst Map String MetaValue
mp) = Subst
subst
  (Expression
expression, Expression
scope) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr Subst
subst
  case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
    Just (MvTail [Tail]
tails) -> (Expression, Expression) -> Maybe (Expression, Expression)
forall a. a -> Maybe a
Just (Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails Expression
expression [Tail]
tails Subst
subst, Expression
scope)
    Maybe MetaValue
_ -> Maybe (Expression, Expression)
forall a. Maybe a
Nothing
buildExpression Expression
expr Subst
_ = (Expression, Expression) -> Maybe (Expression, Expression)
forall a. a -> Maybe a
Just (Expression
expr, Expression
defaultScope)

buildExpressionFromFunction :: String -> [Expression] -> Subst -> Program -> Maybe Expression
buildExpressionFromFunction :: String -> [Expression] -> Subst -> Program -> Maybe Expression
buildExpressionFromFunction String
"contextualize" [Expression
expr, Expression
context] Subst
subst Program
prog = do
  (Expression
expr', Expression
_) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr Subst
subst
  (Expression
context', Expression
_) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
context Subst
subst
  Expression -> Maybe Expression
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Expression -> Program -> Expression
contextualize Expression
expr' Expression
context' Program
prog)
buildExpressionFromFunction String
"scope" [Expression
expr] Subst
subst Program
prog = do
  (Expression
expr', Expression
scope) <- Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr Subst
subst
  Expression -> Maybe Expression
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
scope
buildExpressionFromFunction String
_ [Expression]
_ Subst
_ Program
_ = Maybe Expression
forall a. Maybe a
Nothing

-- Build a several expression from one expression and several substitutions
buildExpressions :: Expression -> [Subst] -> Maybe [(Expression, Expression)]
buildExpressions :: Expression -> [Subst] -> Maybe [(Expression, Expression)]
buildExpressions Expression
expr = (Subst -> Maybe (Expression, Expression))
-> [Subst] -> Maybe [(Expression, Expression)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Expression -> Subst -> Maybe (Expression, Expression)
buildExpression Expression
expr)