module Compiler where

import Data.Char (isUpper)
import Data.Containers.ListUtils (nubOrd)
import Data.List
import qualified Data.Map as M

import Code (Code, Datum(..), Instr(..))
import IR (Id(..), PrlgInt(..), PrlgStr(..), StrTable(..), strtablize)

internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
internPrlg = go
  where
    go t (LiteralS str) = LiteralI <$> strtablize t str
    go t (CallS str ps) =
      let (t', i) = strtablize t str
       in CallI (Id i $ length ps) <$> mapAccumL go t' ps

varname :: String -> Bool
varname ('_':_) = True
varname (c:_) = isUpper c
varname _ = False

varIds :: StrTable -> PrlgInt -> [Int]
varIds st (CallI _ xs) = nubOrd $ concatMap (varIds st) xs
varIds (StrTable _ _ st) (LiteralI x)
  | Just s <- st M.!? x
  , varname s = [x]
  | otherwise = []

variablizePrlg :: Int -> [Int] -> PrlgInt -> PrlgInt
variablizePrlg void vs (CallI id ps) =
  CallI id $ map (variablizePrlg void vs) ps
variablizePrlg void vs (LiteralI i)
  | i == void = VoidI i
  | Just idx <- elemIndex i vs = VarI idx i
  | otherwise = LiteralI i

compileGoals :: Id -> PrlgInt -> [Code]
compileGoals andop = go
  where
    go p@(CallI x args)
      | x == andop = concatMap go args
    go x = [compileGoal x]

compileGoal :: PrlgInt -> Code
compileGoal (LiteralI x) = [U (Struct $ Id x 0)]
compileGoal x = compileArg x

compileArg :: PrlgInt -> Code
compileArg (CallI x args) = U (Struct x) : concatMap compileArg args
compileArg (LiteralI x) = [U (Atom x)]
compileArg (VarI x i) = [U (LocalRef x $ Just i)]
compileArg (VoidI i) = [U (VoidRef $ Just i)]

seqGoals :: [Code] -> Code
seqGoals [] = [NoGoal]
seqGoals [[Cut]] = [Cut, NoGoal]
seqGoals [x] = [Goal] ++ x ++ [LastCall]
seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs