{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

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

-- This module represents Ast tree for parsed phi-calculus program
module Ast where

import GHC.Generics (Generic)

newtype Program = Program Expression -- Q -> expr
  deriving (Program -> Program -> Bool
(Program -> Program -> Bool)
-> (Program -> Program -> Bool) -> Eq Program
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Program -> Program -> Bool
== :: Program -> Program -> Bool
$c/= :: Program -> Program -> Bool
/= :: Program -> Program -> Bool
Eq, Int -> Program -> ShowS
[Program] -> ShowS
Program -> String
(Int -> Program -> ShowS)
-> (Program -> String) -> ([Program] -> ShowS) -> Show Program
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Program -> ShowS
showsPrec :: Int -> Program -> ShowS
$cshow :: Program -> String
show :: Program -> String
$cshowList :: [Program] -> ShowS
showList :: [Program] -> ShowS
Show)

data Expression
  = ExFormation [Binding] -- [bindings]
  | ExThis
  | ExGlobal -- Q
  | ExTermination -- T
  | ExMeta String -- !e
  | ExApplication Expression Binding -- expr(attr -> expr)
  | ExDispatch Expression Attribute -- expr.attr
  | ExMetaTail Expression String -- expr * !t
  deriving (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
/= :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expression -> ShowS
showsPrec :: Int -> Expression -> ShowS
$cshow :: Expression -> String
show :: Expression -> String
$cshowList :: [Expression] -> ShowS
showList :: [Expression] -> ShowS
Show, (forall x. Expression -> Rep Expression x)
-> (forall x. Rep Expression x -> Expression) -> Generic Expression
forall x. Rep Expression x -> Expression
forall x. Expression -> Rep Expression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Expression -> Rep Expression x
from :: forall x. Expression -> Rep Expression x
$cto :: forall x. Rep Expression x -> Expression
to :: forall x. Rep Expression x -> Expression
Generic)

data Binding
  = BiTau Attribute Expression -- attr -> expr
  | BiMeta String -- !B
  | BiDelta Bytes -- Δ ⤍ 1F-2A
  | BiVoid Attribute -- attr ↦ ?
  | BiLambda String -- λ ⤍ Function
  | BiMetaLambda String -- λ ⤍ !F
  deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
/= :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binding -> ShowS
showsPrec :: Int -> Binding -> ShowS
$cshow :: Binding -> String
show :: Binding -> String
$cshowList :: [Binding] -> ShowS
showList :: [Binding] -> ShowS
Show, (forall x. Binding -> Rep Binding x)
-> (forall x. Rep Binding x -> Binding) -> Generic Binding
forall x. Rep Binding x -> Binding
forall x. Binding -> Rep Binding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Binding -> Rep Binding x
from :: forall x. Binding -> Rep Binding x
$cto :: forall x. Rep Binding x -> Binding
to :: forall x. Rep Binding x -> Binding
Generic)

data Bytes
  = BtEmpty -- --
  | BtOne String -- 1F-
  | BtMany [String] -- 00-01-02-...04
  | BtMeta String -- !b
  deriving (Bytes -> Bytes -> Bool
(Bytes -> Bytes -> Bool) -> (Bytes -> Bytes -> Bool) -> Eq Bytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes -> Bytes -> Bool
== :: Bytes -> Bytes -> Bool
$c/= :: Bytes -> Bytes -> Bool
/= :: Bytes -> Bytes -> Bool
Eq, Int -> Bytes -> ShowS
[Bytes] -> ShowS
Bytes -> String
(Int -> Bytes -> ShowS)
-> (Bytes -> String) -> ([Bytes] -> ShowS) -> Show Bytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bytes -> ShowS
showsPrec :: Int -> Bytes -> ShowS
$cshow :: Bytes -> String
show :: Bytes -> String
$cshowList :: [Bytes] -> ShowS
showList :: [Bytes] -> ShowS
Show, (forall x. Bytes -> Rep Bytes x)
-> (forall x. Rep Bytes x -> Bytes) -> Generic Bytes
forall x. Rep Bytes x -> Bytes
forall x. Bytes -> Rep Bytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes -> Rep Bytes x
from :: forall x. Bytes -> Rep Bytes x
$cto :: forall x. Rep Bytes x -> Bytes
to :: forall x. Rep Bytes x -> Bytes
Generic)

data Attribute
  = AtLabel String -- attr
  | AtAlpha Integer -- α1
  | AtPhi -- φ
  | AtRho -- ρ
  | AtLambda -- λ, used only in yaml conditions
  | AtDelta -- Δ, used only in yaml conditions
  | AtMeta String -- !a
  deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
/= :: Attribute -> Attribute -> Bool
Eq, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attribute -> ShowS
showsPrec :: Int -> Attribute -> ShowS
$cshow :: Attribute -> String
show :: Attribute -> String
$cshowList :: [Attribute] -> ShowS
showList :: [Attribute] -> ShowS
Show, (forall x. Attribute -> Rep Attribute x)
-> (forall x. Rep Attribute x -> Attribute) -> Generic Attribute
forall x. Rep Attribute x -> Attribute
forall x. Attribute -> Rep Attribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Attribute -> Rep Attribute x
from :: forall x. Attribute -> Rep Attribute x
$cto :: forall x. Rep Attribute x -> Attribute
to :: forall x. Rep Attribute x -> Attribute
Generic)

countNodes :: Program -> Integer
countNodes :: Program -> Integer
countNodes (Program Expression
expr) = Expression -> Integer
countNodes' Expression
expr
  where
    countNodes' :: Expression -> Integer
    countNodes' :: Expression -> Integer
countNodes' Expression
ExGlobal = Integer
1
    countNodes' Expression
ExTermination = Integer
1
    countNodes' Expression
ExThis = Integer
1
    countNodes' (ExApplication Expression
expr' (BiTau Attribute
attr Expression
bexpr')) = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expression -> Integer
countNodes' Expression
expr' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expression -> Integer
countNodes' Expression
bexpr'
    countNodes' (ExDispatch Expression
expr' Attribute
attr) = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expression -> Integer
countNodes' Expression
expr'
    countNodes' (ExFormation [Binding]
bds) = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Binding -> Integer) -> [Binding] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\case BiTau Attribute
attr Expression
expr' -> Expression -> Integer
countNodes' Expression
expr'; Binding
_ -> Integer
1) [Binding]
bds)
    countNodes' Expression
_ = Integer
0