module Compiler where

import Data.Char (isUpper)
import Data.Containers.ListUtils (nubOrd)
import Data.List

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

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

varnames :: PrlgStr -> [String]
varnames (CallS _ xs) = nubOrd $ concatMap varnames xs
varnames (LiteralS x)
  | varname x = [x]
  | otherwise = []

internPrlg :: [String] -> StrTable -> PrlgStr -> (StrTable, PrlgInt)
internPrlg stab = go
  where
    go t (LiteralS str)
      | str == "_" = (t, VoidI)
      | Just idx <- elemIndex str stab = VarI idx <$> strtablize t str
      | otherwise = 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

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 _) = [U (LocalRef x)]
compileArg VoidI = [U VoidRef]

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

compileClause :: Id -> Id -> PrlgInt -> Code
compileClause proveop andop = go
  where
    go :: PrlgInt -> Code
    go h@(CallI x args)
      | x == proveop
      , [head, goals] <- args =
        compileGoal head ++ seqGoals (compileGoals andop goals)
      | otherwise = compileGoal h ++ seqGoals []