{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

-- NOTE Because this file will be used as the header of auto-generated macro programs,
--      it can't have any project-specific dependencies (such as `Fix`).
module Axel.Parse.AST where

import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.Semigroup ((<>))
import Data.Typeable (Typeable)

import System.IO.Unsafe (unsafePerformIO)

-- TODO `Expression` should probably be `Traversable`, use recursion schemes, etc.
--      I should provide `toFix` and `fromFix` functions for macros to take advantage of.
--      (Maybe all macros have the argument automatically `fromFix`-ed to make consumption simpler?)
data Expression
  = LiteralChar Char
  | LiteralInt Int
  | LiteralString String
  | SExpression [Expression]
  | Symbol String
  deriving (Eq, Show, Typeable)

-- ******************************
-- Internal utilities
-- ******************************
toAxel :: Expression -> String
toAxel (LiteralChar x) = ['{', x, '}']
toAxel (LiteralInt x) = show x
toAxel (LiteralString xs) = "\"" <> xs <> "\""
toAxel (SExpression xs) = "(" <> unwords (map toAxel xs) <> ")"
toAxel (Symbol x) = x

-- ******************************
-- Macro definition utilities
-- ******************************
{-# NOINLINE gensymCounter #-}
gensymCounter :: IORef Int
gensymCounter = unsafePerformIO $ newIORef 0

gensym :: IO Expression
gensym = do
  suffix <- readIORef gensymCounter
  let identifier = "aXEL_AUTOGENERATED_IDENTIFIER_" <> show suffix
  modifyIORef gensymCounter succ
  pure $ Symbol identifier

-- | This allows splice-unquoting of both `[Expression]`s and `SExpression`s, without requiring special syntax for each.
class ToExpressionList a where
  toExpressionList :: a -> [Expression]

instance ToExpressionList [Expression] where
  toExpressionList :: [Expression] -> [Expression]
  toExpressionList = id

-- | Because we do not have a way to statically ensure an `SExpression` is passed (and not another one of `Expression`'s constructors instead), we will error at compile-time if a macro attempts to splice-unquote inappropriately.
instance ToExpressionList Expression where
  toExpressionList :: Expression -> [Expression]
  toExpressionList (SExpression xs) = xs
  toExpressionList x =
    error
      (show x <>
       " cannot be splice-unquoted, because it is not an s-expression!")

programToTopLevelExpressions :: Expression -> [Expression]
programToTopLevelExpressions (SExpression (Symbol "begin":stmts)) = stmts
programToTopLevelExpressions _ =
  error "programToTopLevelExpressions must be passed a top-level program!"

topLevelExpressionsToProgram :: [Expression] -> Expression
topLevelExpressionsToProgram stmts = SExpression (Symbol "begin" : stmts)