Inject.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}

module Descript.BasicInj.Data.Atom.Inject
  ( PrimType (..)
  , InjSymbol (..)
  , isInjSymbol
  , forceToInjSymbol
  , isPrimInstance
  ) where

import Descript.Lex.Data.Atom
import Descript.Misc
import Data.Semigroup

-- | A type of built-in primitive.
data PrimType an
  = PrimTypeNumber an
  | PrimTypeString an
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

-- | An identifier for a built-in primitive or injected function.
data InjSymbol an
  = InjSymbol an String
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

instance Ann PrimType where
  getAnn (PrimTypeNumber ann) = ann
  getAnn (PrimTypeString ann) = ann

instance Ann InjSymbol where
  getAnn (InjSymbol ann _) = ann

instance EAnn InjSymbol where
  InjSymbol xKeyAnn xKeyStr `eappend` InjSymbol yKeyAnn yKeyStr
    | xKeyStr /= yKeyStr = error "Injected symbols have different content"
    | otherwise = InjSymbol (xKeyAnn <> yKeyAnn) xKeyStr

instance Printable PrimType where
  aprint (PrimTypeNumber _) = plex "#Number[]"
  aprint (PrimTypeString _) = plex "#String[]"

instance Printable InjSymbol where
  aprint (InjSymbol _ str) = plex $ '#' : str

instance (Show an) => Summary (PrimType an) where
  summary = pprintSummary

instance (Show an) => Summary (InjSymbol an) where
  summary = pprintSummary

-- | Whether the symbol refers to something injected - a primtive type
-- or an injected function.
isInjSymbol :: Symbol an -> Bool
isInjSymbol (Symbol _ ('#' : _)) = True
isInjSymbol (Symbol _ _) = False

-- | Assuming the symbol refers to something injected, converts it to an
-- injected symbol, making this reference explicit.
-- Raises an error otherwise.
forceToInjSymbol :: Symbol an -> InjSymbol an
forceToInjSymbol (Symbol ann ('#' : xs)) = InjSymbol ann xs
forceToInjSymbol (Symbol _ _) = error "Symbol doesn't refer to injected function."

-- | Whether the primitive is an instance of the type.
isPrimInstance :: Prim an1 -> PrimType an2 -> Bool
isPrimInstance (PrimNumber _ _) (PrimTypeNumber _) = True
isPrimInstance (PrimText _ _) (PrimTypeString _) = True
isPrimInstance _ _ = False