module AST where

import qualified Data.Map.Strict as Map
import Data.Maybe

import Data.List


data Program = Program [Value]

type Name = String

data Value
    = VList [Value]
    | VNum Int
    | VString String
    | VName Name
    | VQuoted Value
    | VDeclare Name
    | VDefine Name Value
    | VLambda [Name] Value
    | VLambdaRec Name [Name] Value
    | VLet [(Name, Value)] Value
    | VBuiltin String
    | VEllipsis
  deriving (Eq, Ord)


instance Show Program where
    show (Program l) = intercalate "\n" $ map show l

instance Show Value where
    show (VList es) = '(' : intercalate " " (map show es) ++ ")"
    show (VNum i) = show i
    show (VString s) = show s
    show (VName n) = n
    show (VQuoted e) = '\'' : show e
    show (VDeclare n) = "(declare " ++ n ++ ")"
    show (VDefine n v) = "(define " ++ n ++ " " ++ show v ++ ")"
    show (VLambda as v) = "(lambda (" ++ intercalate " " as ++ ") " ++ show v ++ ")"
    show (VLambdaRec rn as v) = "(lambdarec " ++ rn ++ " (" ++ intercalate " " as ++ ") " ++ show v ++ ")"
    show (VLet ps v) = "(let (" ++ intercalate " " ["(" ++ n ++ " " ++ show w ++ ")" | (n, w) <- ps] ++ ") " ++ show v ++ ")"
    show (VBuiltin str) = "[[builtin " ++ str ++ "]]"
    show VEllipsis = "..."


fromVName :: Value -> Maybe Name
fromVName (VName s) = Just s
fromVName _ = Nothing

fromVNum :: Value -> Maybe Int
fromVNum (VNum i) = Just i
fromVNum _ = Nothing

fromVString :: Value -> Maybe String
fromVString (VString s) = Just s
fromVString _ = Nothing

replaceNames :: Map.Map Name Value -> Value -> Value
replaceNames mp origValue =
    case origValue of
        VList vs -> VList (map (replaceNames mp) vs)
        VName n -> fromMaybe origValue (Map.lookup n mp)
        VDefine n v -> VDefine n (replaceNames mp v)
        VLambda as v -> VLambda as (replaceNames (foldr Map.delete mp as) v)
        VLambdaRec rn as v -> VLambdaRec rn as (replaceNames (foldr Map.delete mp (rn : as)) v)
        VLet [] v -> VLet [] (replaceNames mp v)
        VLet ((n, d) : pairs) v ->
            let VLet pairs' v' = replaceNames (Map.delete n mp) (VLet pairs v)
            in VLet ((n, replaceNames mp d) : pairs') v'
        VNum _ -> origValue
        VString _ -> origValue
        VQuoted _ -> origValue
        VDeclare _ -> origValue
        VBuiltin _ -> origValue
        VEllipsis -> origValue