{- |
Module      : Language.Scheme.Macro
Copyright   : Justin Ethier
Licence     : MIT (see LICENSE in the distribution)

Maintainer  : github.com/justinethier
Stability   : experimental
Portability : portable

husk scheme interpreter

A lightweight dialect of R5RS scheme.

This module contains code for hygienic macros.

During transformation, the following components are considered:
 - Pattern (part of a rule that matches input)
 - Transform (what the macro "expands" into)
 - Input (the actual code in the user's program)

At a high level, macro transformation is broken down into the following steps:

 1) Search for a rule that matches the input.
    During this process, any variables in the input are loaded into a temporary environment
 2) If a rule matches,
 3) Transform by walking the transform, inserting variables as needed

Remaining Work:

* Dotted lists are not 100% correctly implemented. In particular, the transformation should
  take into account whether the input was presented as a list or a pair, and replicate that
   in the output.

-}

module Language.Scheme.Macro
    (
      macroEval
    ) where
import Language.Scheme.Types
import Language.Scheme.Variables
import Control.Monad.Error
import Data.Array
import Debug.Trace -- Only req'd to support trace, can be disabled at any time...

{- Nice FAQ regarding macro's, points out some of the limitations of current implementation
http://community.schemewiki.org/?scheme-faq-macros -}


{- Consider high-level ideas from these articles (of all places):
 -
 -  http://en.wikipedia.org/wiki/Scheme_(programming_language)#Hygienic_macros
 -  http://en.wikipedia.org/wiki/Hygienic_macro
 - -}

{- |macroEval
Search for macro's in the AST, and transform any that are found.
There is also a special case (define-syntax) that loads new rules. -}
macroEval :: Env -> LispVal -> IOThrowsError LispVal

-- Special case, just load up the syntax rules
macroEval env (List [Atom "define-syntax", Atom keyword, syntaxRules@(List (Atom "syntax-rules" : (List _ : _)))]) = do
  {-
   - FUTURE: Issue #15: there really ought to be some error checking of the syntax rules, 
   -                    since they could be malformed...
  - As it stands now, there is no checking until the code attempts to perform a macro transformation.
  - At a minimum, should check identifiers to make sure each is an atom (see findAtom) 
  -}
  _ <- defineNamespacedVar env macroNamespace keyword syntaxRules
  return $ Nil "" -- Sentinal value

{-
-- Inspect a list of code, and transform as necessary
macroEval env (List (x@(List _) : xs)) = do
  first <- macroEval env x
  rest <- mapM (macroEval env) xs
  return $ List $ first : rest
-}

{- Inspect code for macros
 -
 - Only a list form is required because a pattern may only consist
 - of a list here. From the spec:
 -
 - "The <pattern> in a <syntax rule> is a list <pattern> that
begins with the keyword for the macro." 
 -
 -}
macroEval env lisp@(List (Atom x : _)) = do
  isDefined <- liftIO $ isNamespacedRecBound env macroNamespace x
  isDefinedAsVar <- liftIO $ isBound env x -- TODO: Not entirely correct; for example if a macro and var 
                                           -- are defined in same env with same name, which one should be selected?
  if isDefined && not isDefinedAsVar --(trace (show "mEval [" ++ show lisp ++ ", " ++ show x ++ "]: " ++ show isDefined) isDefined)
     then do
       (List (Atom "syntax-rules" : (List identifiers : rules))) <- getNamespacedVar env macroNamespace x
       -- Transform the input and then call macroEval again, since a macro may be contained within...
       macroEval env =<< macroTransform env (List identifiers) rules lisp
     else return lisp

-- No macro to process, just return code as it is...
macroEval _ lisp@(_) = return lisp

{-
 - Given input and syntax-rules, determine if any rule is a match and transform it.
 -
 - FUTURE: validate that the pattern's template and pattern are consistent 
 - (IE: no vars in transform that do not appear in matching pattern - csi "stmt1" case)
 -
 - Parameters:
 -  env - Higher level LISP environment
 -  identifiers - Literal identifiers - IE, atoms that should not be transformed
 -  rules - pattern/transform pairs to compare to input
 -  input - Code from the scheme application 
 -}
macroTransform :: Env -> LispVal -> [LispVal] -> LispVal -> IOThrowsError LispVal
macroTransform env identifiers (rule@(List _) : rs) input = do
  localEnv <- liftIO $ nullEnv -- Local environment used just for this invocation
  result <- matchRule env identifiers localEnv rule input
  case result of
    Nil _ -> macroTransform env identifiers rs input
    _ -> return result
-- Ran out of rules to match...
macroTransform _ _ _ input = throwError $ BadSpecialForm "Input does not match a macro pattern" input

-- Determine if the next element in a list matches 0-to-n times due to an ellipsis
macroElementMatchesMany :: LispVal -> Bool
macroElementMatchesMany (List (_ : ps)) = do
  if not (null ps)
     then case (head ps) of
                Atom "..." -> True
                _ -> False
     else False
macroElementMatchesMany _ = False

{- Given input, determine if that input matches any rules
@return Transformed code, or Nil if no rules match -}
matchRule :: Env -> LispVal -> Env -> LispVal -> LispVal -> IOThrowsError LispVal
matchRule outerEnv identifiers localEnv (List [pattern, template]) (List inputVar) = do
   let is = tail inputVar
   let p = case pattern of
              DottedList ds d -> case ds of
                                  (Atom l : ls) -> List [Atom l, DottedList ls d]
                                  _ -> pattern
              _ -> pattern
   case p of
      List (Atom _ : ps) -> do
        match <- loadLocal outerEnv localEnv identifiers (List ps) (List is) False False
        case match of
           Bool False -> return $ Nil ""
           _ -> do
--                bindings <- findBindings localEnv pattern
--                transformRule outerEnv (trace ("bindings = " ++ show bindings) localEnv) 0 (List []) template (List [])
                transformRule outerEnv localEnv 0 (List []) template (List [])
      _ -> throwError $ BadSpecialForm "Malformed rule in syntax-rules" p

matchRule _ _ _ rule input = do
  throwError $ BadSpecialForm "Malformed rule in syntax-rules" $ List [Atom "rule: ", rule, Atom "input: ", input]

-- Issue #30
{-------------------------
-- Just some test code, this needs to be more sophisticated than simply finding a list of them.
-- because we probably need to know the context - IE, (begin ... (lambda ...) (define ...) x) - x should
-- not be rewritten if it is the name of one of the lambda arguments
findBindings :: Env -> LispVal -> IOThrowsError LispVal
findBindings localEnv pattern@(List (_ : ps)) = searchForBindings localEnv (List ps) [] 

searchForBindings :: Env -> LispVal -> [LispVal] -> IOThrowsError LispVal
--env pattern@(List (List (Atom "lambda" : List bs : _) : ps)) bindings = searchForBindings env (List ps) (bindings ++ bs) 
--searchForBindings env pattern@(List (List (Atom "lambda" : List bs : _) : ps)) bindings = searchForBindings env (List ps) (bindings ++ bs) 
searchForBindings env pattern@(List (p : ps)) bindings = do
  newBindings <- searchForBindings env (List [p]) []
  case newBindings of
    List n -> searchForBindings env (List ps) (bindings ++ n)
    _ -> throwError $ Default "Unexpected error in searchForBindings" 
searchForBindings _ _ bindings = return $ List bindings
-------------------------}

{- loadLocal - Determine if pattern matches input, loading input into pattern variables as we go,
in preparation for macro transformation. -}
loadLocal :: Env -> Env -> LispVal -> LispVal -> LispVal -> Bool -> Bool -> IOThrowsError LispVal
loadLocal outerEnv localEnv identifiers pattern input hasEllipsis outerHasEllipsis = do
  case (pattern, input) of

       {- For vectors, just use list match for now, since vector input matching just requires a
       subset of that behavior. Should be OK since parser would catch problems with trying
       to add pair syntax to a vector declaration. -}
       ((Vector p), (Vector i)) -> do
         loadLocal outerEnv localEnv identifiers (List $ elems p) (List $ elems i) False outerHasEllipsis

       ((DottedList ps p), (DottedList is i)) -> do
         result <- loadLocal outerEnv localEnv identifiers (List ps) (List is) False outerHasEllipsis
         case result of
            Bool True -> loadLocal outerEnv localEnv identifiers p i False outerHasEllipsis
            _ -> return $ Bool False

       (List (p : ps), List (i : is)) -> do -- check first input against first pattern, recurse...

         let localHasEllipsis = macroElementMatchesMany pattern

         {- FUTURE: error if ... detected when there is an outer ... ????
         no, this should (eventually) be allowed. See scheme-faq-macros -}

         status <- checkLocal outerEnv localEnv identifiers (localHasEllipsis || outerHasEllipsis) p i
         case status of
              -- No match
              Bool False -> if localHasEllipsis
                                {- No match, must be finished with ...
                                Move past it, but keep the same input. -}
                                then do
                                        loadLocal outerEnv localEnv identifiers (List $ tail ps) (List (i : is)) False outerHasEllipsis
                                else return $ Bool False
              -- There was a match
              _ -> if localHasEllipsis
                      then loadLocal outerEnv localEnv identifiers pattern (List is) True outerHasEllipsis
                      else loadLocal outerEnv localEnv identifiers (List ps) (List is) False outerHasEllipsis

       -- Base case - All data processed
       (List [], List []) -> return $ Bool True

       -- Ran out of input to process
       (List (_ : ps), List []) -> do
                                 {- Ensure any patterns that are not present in the input still
                                 have their variables initialized so they are ready during trans. -}
                                 _ <- initializePatternVars localEnv "list" identifiers pattern
                                 if (macroElementMatchesMany pattern) && ((length ps) == 1)
                                           then return $ Bool True
                                           else return $ Bool False

       -- Pattern ran out, but there is still input. No match.
       (List [], _) -> return $ Bool False

       -- Check input against pattern (both should be single var)
       (_, _) -> checkLocal outerEnv localEnv identifiers (hasEllipsis || outerHasEllipsis) pattern input

{- Check pattern against input to determine if there is a match
 -
 - @param localEnv - Local variables for the macro, used during transform
 - @param hasEllipsis - Determine whether we are in a zero-or-many match.
 -                      Used for loading local vars and NOT for purposes of matching.
 - @param pattern - Pattern to match
 - @param input - Input to be matched
 -}
checkLocal :: Env -> Env -> LispVal -> Bool -> LispVal -> LispVal -> IOThrowsError LispVal
checkLocal _ _ _ _ (Bool pattern) (Bool input) = return $ Bool $ pattern == input
checkLocal _ _ _ _ (Number pattern) (Number input) = return $ Bool $ pattern == input
checkLocal _ _ _ _ (Float pattern) (Float input) = return $ Bool $ pattern == input
checkLocal _ _ _ _ (String pattern) (String input) = return $ Bool $ pattern == input
checkLocal _ _ _ _ (Char pattern) (Char input) = return $ Bool $ pattern == input
checkLocal outerEnv localEnv identifiers hasEllipsis (Atom pattern) input = do
  if hasEllipsis
     {- FUTURE: may be able to simplify both cases below by using a
     lambda function to store the 'save' actions -}

             -- Var is part of a 0-to-many match, store up in a list...
     then do isDefined <- liftIO $ isBound localEnv pattern
             isLexicallyDefinedVar <- liftIO $ isBound outerEnv pattern
             --
             -- If pattern is a literal identifier, need to ensure
             -- input matches that literal, or that (in this case)
             -- the literal is missing from the input (0 match)
             --
             isIdent <- findAtom (Atom pattern) identifiers
             case isIdent of
                Bool True -> do
                    case input of
                        Atom inpt -> do
                            if (pattern == inpt)  
                               then if isLexicallyDefinedVar == False 
                                       -- Var is not bound in outer code; proceed
                                       then do
                                         -- Set variable in the local environment
                                         _ <- addPatternVar isDefined $ Atom pattern
                                         return $ Bool True
                                       -- Var already bound in enclosing environment prior to evaluating macro.
                                       -- So... do not match it here.
                                       --
                                       -- See section 4.3.2 of R5RS, in particular:
                                       -- " If a literal identifier is inserted as a bound identifier then it is 
                                       --   in effect renamed to prevent inadvertent captures of free identifiers "
                                       else return $ Bool False
                               else return $ Bool False
                        -- Pattern/Input cannot match because input is not an atom
                        _ -> return $ Bool False
                -- No literal identifier, just load up the var
                _ -> do _ <- addPatternVar isDefined input
                        return $ Bool True
     --
     -- Simple var, try to load up into macro env
     --
     else do
         isIdent <- findAtom (Atom pattern) identifiers
         isLexicallyDefinedPatternVar <- liftIO $ isBound outerEnv pattern -- Var defined in scope outside macro
         case (isIdent) of
            -- Fail the match if pattern is a literal identifier and input does not match
            Bool True -> do
                case input of
                    Atom inpt -> do
                        -- Pattern/Input are atoms; both must match
                        if (pattern == inpt && (not isLexicallyDefinedPatternVar)) -- Regarding lex binding; see above, sec 4.3.2 from spec
                           then do _ <- defineVar localEnv pattern input
                                   return $ Bool True
                           else return $ (Bool False)
                    -- Pattern/Input cannot match because input is not an atom
                    _ -> return $ (Bool False)

            -- No literal identifier, just load up the var
            _ -> do _ <- defineVar localEnv pattern input
                    return $ Bool True
{- TODO:
 the issue with this is that sometimes the var needs to be preserved and not have its value directly inserted.
 the real fix is to rename any identifiers bound in the macro transform. for example, (let ((temp ...)) ...) should
 have the variable renamed to temp-1 (for example)


            _ -> case input of
                    Atom inpt -> do
                       isLexicallyDefinedInput <- liftIO $ isBound outerEnv inpt -- Var defined in scope outside macro
                       if isLexicallyDefinedInput
                           then do _ <- defineVar localEnv pattern (trace ("sec 4.3.2 for: " ++ inpt) (Nil inpt)) -- Var defined outside macro, flag as such for transform code
-- TODO: flag as such from the above ellipsis code as well            
                                   return $ Bool True
                           else do _ <- defineVar localEnv pattern input
                                   return $ Bool True
                    _ -> do _ <- defineVar localEnv pattern input
                            return $ Bool True
-}                            
    where
      addPatternVar isDefined val = do
             if isDefined
                then do v <- getVar localEnv pattern
                        case v of
                          (List vs) -> setVar localEnv pattern (List $ vs ++ [val])
                          _ -> throwError $ Default "Unexpected error in checkLocal (Atom)"
                else defineVar localEnv pattern (List [val])

checkLocal outerEnv localEnv identifiers hasEllipsis pattern@(Vector _) input@(Vector _) =
  loadLocal outerEnv localEnv identifiers pattern input False hasEllipsis

checkLocal outerEnv localEnv identifiers hasEllipsis pattern@(DottedList _ _) input@(DottedList _ _) =
  loadLocal outerEnv localEnv identifiers pattern input False hasEllipsis
-- throwError $ BadSpecialForm "Test" input
checkLocal outerEnv localEnv identifiers hasEllipsis pattern@(DottedList ps p) input@(List (i : is)) = do
  if (length ps) == (length is)
          {- Lists are same length, implying elements in both should be the same.
          Cast pair to a List for further processing -}
     then loadLocal outerEnv localEnv identifiers (List $ ps ++ [p]) input False hasEllipsis
          {- Idea here is that if we have a dotted list, the last component does not have to be provided
          in the input. So in that case just fill in an empty list for the missing component. -}
     else loadLocal outerEnv localEnv identifiers pattern (DottedList (i : is) (List [])) False hasEllipsis
checkLocal outerEnv localEnv identifiers hasEllipsis pattern@(List _) input@(List _) =
  loadLocal outerEnv localEnv identifiers pattern input False hasEllipsis

checkLocal _ _ _ _ _ _ = return $ Bool False

{- Transform input by walking the tranform structure and creating a new structure
with the same form, replacing identifiers in the tranform with those bound in localEnv -}
transformRule :: Env -> Env -> Int -> LispVal -> LispVal -> LispVal -> IOThrowsError LispVal

{-
 - Recursively transform a list
 -
 - Parameters:
 -
 - localEnv - Local variable environment
 - ellipsisIndex - Zero-or-more match variables are stored as a list.
 -     This is the index into the current value to read from list
 - result - Resultant value, must be a parameter as it mutates with each function call, so we pass it using CPS
 - transform - The macro transformation, we read it out one atom at a time, and rewrite it into result
 - ellipsisList - Temporarily holds value of the "outer" result while we process the
 -     zero-or-more match. Once that is complete we swap this value back into it's rightful place 
 -}
transformRule outerEnv localEnv ellipsisIndex (List result) transform@(List (List l : ts)) (List ellipsisList) = do
  if macroElementMatchesMany transform
     then do
             curT <- transformRule outerEnv localEnv (ellipsisIndex + 1) (List []) (List l) (List result)
             case curT of
               Nil _ -> if ellipsisIndex == 0
                                -- First time through and no match ("zero" case). Use tail to move past the "..."
                           then transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
                                -- Done with zero-or-more match, append intermediate results (ellipsisList) and move past the "..."
                           else transformRule outerEnv localEnv 0 (List $ ellipsisList ++ result) (List $ tail ts) (List [])
               -- Dotted list transform returned during processing...
               List [Nil _, List _] -> if ellipsisIndex == 0
                                -- First time through and no match ("zero" case). Use tail to move past the "..."
                           then transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
                                -- Done with zero-or-more match, append intermediate results (ellipsisList) and move past the "..."
                          else transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
               List _ -> transformRule outerEnv localEnv (ellipsisIndex + 1) (List $ result ++ [curT]) transform (List ellipsisList)
               _ -> throwError $ Default "Unexpected error"
     else do
             lst <- transformRule outerEnv localEnv ellipsisIndex (List []) (List l) (List ellipsisList)
             case lst of
                  List [Nil _, _] -> return lst
                  List _ -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [lst]) (List ts) (List ellipsisList)
                  Nil _ -> return lst
                  _ -> throwError $ BadSpecialForm "Macro transform error" $ List [lst, (List l), Number $ toInteger ellipsisIndex]

transformRule outerEnv localEnv ellipsisIndex (List result) transform@(List ((Vector v) : ts)) (List ellipsisList) = do
  if macroElementMatchesMany transform
     then do
             -- Idea here is that we need to handle case where you have (vector ...) - EG: (#(var step) ...)
             curT <- transformRule outerEnv localEnv (ellipsisIndex + 1) (List []) (List $ elems v) (List result)
             case curT of
               Nil _ -> if ellipsisIndex == 0
                                -- First time through and no match ("zero" case). Use tail to move past the "..."
                           then transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
                                -- Done with zero-or-more match, append intermediate results (ellipsisList) and move past the "..."
                           else transformRule outerEnv localEnv 0 (List $ ellipsisList ++ result) (List $ tail ts) (List [])
               List t -> transformRule outerEnv localEnv (ellipsisIndex + 1) (List $ result ++ [asVector t]) transform (List ellipsisList)
               _ -> throwError $ Default "Unexpected error in transformRule"
     else do lst <- transformRule outerEnv localEnv ellipsisIndex (List []) (List $ elems v) (List ellipsisList)
             case lst of
                  List l -> do
                      transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [asVector l]) (List ts) (List ellipsisList)
                  Nil _ -> return lst
                  _ -> throwError $ BadSpecialForm "transformRule: Macro transform error" $ List [(List ellipsisList), lst, (List [Vector v]), Number $ toInteger ellipsisIndex]

 where asVector lst = (Vector $ (listArray (0, length lst - 1)) lst)

transformRule outerEnv localEnv ellipsisIndex (List result) transform@(List (dl@(DottedList _ _) : ts)) (List ellipsisList) = do
  if macroElementMatchesMany transform
     then do
     -- Idea here is that we need to handle case where you have (pair ...) - EG: ((var . step) ...)
             curT <- transformDottedList outerEnv localEnv (ellipsisIndex + 1) (List []) (List [dl]) (List result)
             case curT of
               Nil _ -> if ellipsisIndex == 0
                                -- First time through and no match ("zero" case). Use tail to move past the "..."
                           then transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
                                -- Done with zero-or-more match, append intermediate results (ellipsisList) and move past the "..."
                           else transformRule outerEnv localEnv 0 (List $ ellipsisList ++ result) (List $ tail ts) (List [])
               {- This case is here because we need to process individual components of the pair to determine
               whether we are done with the match. It is similar to above but not exact... -}
               List [Nil _, List _] -> if ellipsisIndex == 0
                                -- First time through and no match ("zero" case). Use tail to move past the "..."
                           then transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
                                -- Done with zero-or-more match, append intermediate results (ellipsisList) and move past the "..."
                           else transformRule outerEnv localEnv 0 (List $ result) (List $ tail ts) (List [])
               List t -> transformRule outerEnv localEnv (ellipsisIndex + 1) (List $ result ++ t) transform (List ellipsisList)
               _ -> throwError $ Default "Unexpected error in transformRule"
     else do lst <- transformDottedList outerEnv localEnv ellipsisIndex (List []) (List [dl]) (List ellipsisList)
             case lst of
                  List [Nil _, List _] -> return lst
                  List l -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ l) (List ts) (List ellipsisList)
                  Nil _ -> return lst
                  _ -> throwError $ BadSpecialForm "transformRule: Macro transform error" $ List [(List ellipsisList), lst, (List [dl]), Number $ toInteger ellipsisIndex]


-- Transform an atom by attempting to look it up as a var...
transformRule outerEnv localEnv ellipsisIndex (List result) transform@(List (Atom a : ts)) unused = do
  let hasEllipsis = macroElementMatchesMany transform
  isDefined <- liftIO $ isBound localEnv a
--  if (trace ("isDefined [" ++ show a ++ "]: " ++ show isDefined) hasEllipsis)
  if (hasEllipsis)
     then if isDefined
             then do 
                    -- get var
                    var <- getVar localEnv a
                    -- ensure it is a list
                    case var of
                      -- add all elements of the list into result
                      List v -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ v) (List $ tail ts) unused
{- TODO:                      Nil input -> do -- Var lexically defined outside of macro, load from there
--
-- TODO: this could be a problem, because we need to signal the end of the ... and do not want an infinite loop.
--       but we want the lexical value as well. need to think about this in more detail to get a truly workable solution
--
                                  v <- getVar outerEnv input
                                  transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [v]) (List $ tail ts) unused -}
                      v@(_) -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [v]) (List $ tail ts) unused
             else -- Matched 0 times, skip it
                  transformRule outerEnv localEnv ellipsisIndex (List result) (List $ tail ts) unused
     else do t <- if isDefined
                     then do
                             var <- getVar localEnv a
--                             if ellipsisIndex > 0--(trace ("var = " ++ show a ++ " lex = " ++ isLexicallyDefinedVar) ellipsisIndex) > 0
--                             case (trace ("var = " ++ show var) var) of
                             case (var) of
                               Nil input -> do
                                                   v <- getVar outerEnv input
                                                   return v
                               _ -> if ellipsisIndex > 0--(trace ("var = " ++ show a) ellipsisIndex) > 0
                                       then do case var of
                                                 List v -> if (length v) > (ellipsisIndex - 1)
                                                              then return $ v !! (ellipsisIndex - 1)
                                                              else return $ Nil ""
                                                 _ -> throwError $ Default "Unexpected error in transformRule"
                                       else return var
                     else return $ Atom a
--             case (trace ("t = " ++ show t) t) of
             case t of
               Nil _ -> return t
               _ -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [t]) (List ts) unused

-- Transform anything else as itself...
transformRule outerEnv localEnv ellipsisIndex (List result) (List (t : ts)) (List ellipsisList) = do
  transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [t]) (List ts) (List ellipsisList)

-- Base case - empty transform
transformRule _ _ _ result@(List _) (List []) _ = do
  return result

-- Transform is a single var, just look it up.
transformRule _ localEnv _ _ (Atom transform) _ = do
  v <- getVar localEnv transform
  return v

-- If transforming into a scalar, just return the transform directly...
-- Not sure if this is strictly desirable, but does not break any tests so we'll go with it for now.
transformRule _ _ _ _ transform _ = do -- OLD CODE: result transform unused = do
  return transform -- OLD CODE:  throwError $ BadSpecialForm "An error occurred during macro transform" $ List [(Number $ toInteger ellipsisIndex), result, transform, unused]

transformDottedList :: Env -> Env -> Int -> LispVal -> LispVal -> LispVal -> IOThrowsError LispVal
transformDottedList outerEnv localEnv ellipsisIndex (List result) (List (DottedList ds d : ts)) (List ellipsisList) = do
          lsto <- transformRule outerEnv localEnv ellipsisIndex (List []) (List ds) (List ellipsisList)
          case lsto of
            List lst -> do
                           r <- transformRule outerEnv localEnv ellipsisIndex (List []) (List [d]) (List ellipsisList)
                           case r of
                                -- Trailing symbol in the pattern may be neglected in the transform, so skip it...
                                List [List []] -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [List lst]) (List ts) (List ellipsisList)
                                --
                                -- FUTURE: Issue #9 - the transform needs to be as follows:
                                --
                                {- - transform into a list if original input was a list - code is below but commented-out
                                - transform into a dotted list if original input was a dotted list -}
                                --
                                {- Could implement this by calling a new function on input (ds?) that goes through it and
                                looks up each atom that it finds, looking for its src. The src (or Nil?) would then be returned
                                and used here to determine what type of transform is used. -}
                                --
{- List [rst] -> transformRule localEnv ellipsisIndex (List $ result ++ [List $ lst ++ [rst]]) (List ts) (List ellipsisList)
List [rst] -> transformRule localEnv ellipsisIndex (List $ result ++ [DottedList lst rst]) (List ts) (List ellipsisList) -}
                                List [rst] -> do
                                                 src <- lookupPatternVarSrc localEnv $ List ds
                                                 case src of
                                                    String "pair" -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [DottedList lst rst]) (List ts) (List ellipsisList)
                                                    _ -> transformRule outerEnv localEnv ellipsisIndex (List $ result ++ [List $ lst ++ [rst]]) (List ts) (List ellipsisList)
                                _ -> throwError $ BadSpecialForm "Macro transform error processing pair" $ DottedList ds d
            Nil _ -> return $ List [Nil "", List ellipsisList]
            _ -> throwError $ BadSpecialForm "Macro transform error processing pair" $ DottedList ds d

transformDottedList _ _ _ _ _ _ = throwError $ Default "Unexpected error in transformDottedList"

-- Find an atom in a list; non-recursive (IE, a sub-list will not be inspected)
findAtom :: LispVal -> LispVal -> IOThrowsError LispVal
findAtom (Atom target) (List (Atom a : as)) = do
  if target == a
     then return $ Bool True
     else findAtom (Atom target) (List as)
findAtom _ (List (badtype : _)) = throwError $ TypeMismatch "symbol" badtype
findAtom _ _ = return $ Bool False

{- Initialize any pattern variables as an empty list.
 - That way a zero-match case can be identified later during transformation.
 -
 - Input:
 -  localEnv - Local environment that contains variables
 -  src - Input source, required because a pair in the pattern may be matched by either a list or a pair,
 -        and the transform needs to know this...
 -  identifiers - Literal identifiers that are transformed as themselves
 -  pattern - Pattern portion of the syntax rule 
 -}
initializePatternVars :: Env -> String -> LispVal -> LispVal -> IOThrowsError LispVal
initializePatternVars localEnv src identifiers pattern@(List _) = do
    case pattern of
        List (p : ps) -> do _ <- initializePatternVars localEnv src identifiers p
                            initializePatternVars localEnv src identifiers $ List ps
        List [] -> return $ Bool True
        _ -> return $ Bool True

initializePatternVars localEnv src identifiers (DottedList ps p) = do
    _ <- initializePatternVars localEnv src identifiers $ List ps
    initializePatternVars localEnv src identifiers p

initializePatternVars localEnv src identifiers (Vector v) = do
    initializePatternVars localEnv src identifiers $ List $ elems v

initializePatternVars localEnv src identifiers (Atom pattern) =
       {- FUTURE:
       there is code to attempt to flag "src" here, but it is not
       wire up correctly. In fact, the whole design here probably
       needs to be rethinked. -}
    do _ <- defineNamespacedVar localEnv "src" pattern $ String src
       isDefined <- liftIO $ isBound localEnv pattern
       found <- findAtom (Atom pattern) identifiers
       case found of
            (Bool False) -> if not isDefined -- Set variable in the local environment
                               then do
                                        defineVar localEnv pattern (List [])
                               else do
                                        return $ Bool True
             -- Ignore identifiers since they are just passed along as-is
            _ -> return $ Bool True

initializePatternVars _ _ _ _ =
    return $ Bool True

-- Find the first pattern var that reports being from a src, or False if none
lookupPatternVarSrc :: Env -> LispVal -> IOThrowsError LispVal
lookupPatternVarSrc localEnv pattern@(List _) = do
    case pattern of
        List (p : ps) -> do result <- lookupPatternVarSrc localEnv p
                            case result of
                              Bool False -> lookupPatternVarSrc localEnv $ List ps
                              _ -> return result
        List [] -> return $ Bool False
        _ -> return $ Bool False

lookupPatternVarSrc localEnv (DottedList ps p) = do
    result <- lookupPatternVarSrc localEnv $ List ps
    case result of
        Bool False -> lookupPatternVarSrc localEnv p
        _ -> return result

lookupPatternVarSrc localEnv (Vector v) = do
    lookupPatternVarSrc localEnv $ List $ elems v

lookupPatternVarSrc localEnv (Atom pattern) =
    do isDefined <- liftIO $ isNamespacedBound localEnv "src" pattern
       if isDefined then getNamespacedVar localEnv "src" pattern
                    else return $ Bool False

lookupPatternVarSrc _ _ =
    return $ Bool False