module Compiler where

import Data.List
import Interpreter (Code, Datum(..), Id(..), Instr(..), StrTable, strtablize)

data PrlgStr
  = CallS String [PrlgStr]
  | LiteralS String
  deriving (Show)

data PrlgInt
  = CallI Id [PrlgInt]
  | LiteralI Int --split off vars here later
  deriving (Show)

strtablizePrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
strtablizePrlg = 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

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)]

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

compileRule :: Id -> Id -> PrlgInt -> Code
compileRule 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 []