module Koak.AST where

newtype Const = Const { fromConst :: Double }
  deriving Show

newtype Var = Var { fromVar :: String }
  deriving Show

data FnDef =
  FnDef
  { fnDefName :: String
  , fnDefArgs :: [Var]
  , fnDefBody :: Expr
  }

data Expr
  = ExprConst Const
  | ExprIfThenElse Expr Expr Expr

data KDef = KDefFnDef FnDef

type Stmt = [KDef]







{-# LANGUAGE OverloadedStrings, RecursiveDo #-}

module Koak.AST.LLVM where

import Data.String

 -- llvm-hs-pure
import qualified LLVM.AST.Constant as C ( Constant ( Float ) )
import qualified LLVM.AST.Float    as F ( SomeFloat ( Double ) )
import qualified LLVM.AST.Operand  as O ( Operand ( ConstantOperand ) )
import LLVM.AST.Name ( Name(..) )
import LLVM.AST.Type ( Type( FloatingPointType )
                     , FloatingPointType ( DoubleFP )
                     )
import LLVM.IRBuilder.Monad
import LLVM.IRBuilder.Module ( function
                             , ParameterName(..)
                             , buildModule
                             )
import LLVM.IRBuilder.Instruction ( ret, br, phi, condBr, fcmp )

import qualified LLVM.AST.FloatingPointPredicate as P

import Control.Monad.Fix

import Koak.AST

typeDouble :: Type
typeDouble = FloatingPointType DoubleFP

constToOperand :: Const -> O.Operand
constToOperand (Const value) = O.ConstantOperand $ C.Float $ F.Double value

-- exprToBuilder :: MonadFix m => Expr -> IRBuilderT m O.Operand
exprToBuilder :: Expr -> IRBuilder O.Operand
exprToBuilder (ExprConst const) = do
  return $ constToOperand const
exprToBuilder (ExprIfThenElse ifExpr thenExpr elseExpr) = mdo
  entryBlock <- block
  test <- exprToBuilder ifExpr
  cond <- fcmp P.OLT test (O.ConstantOperand (C.Float $ F.Double 0))
  condBr cond thenBlock elseBlock
  thenBlock <- block
  resThen <- exprToBuilder thenExpr
  br exitBlock
  elseBlock <- block
  resElse <- exprToBuilder elseExpr
  br exitBlock
  exitBlock <- block
  res <- phi [(resThen, thenBlock), (resElse, elseBlock)]
  return res

-- fnDefToBuilder :: FnDef -> IRBuilder O.Operand
fnDefToBuilder (FnDef name args body) = buildModule "exampleModule" $ mdo
  function (stringToName name) (fmap varToParam args) typeDouble $ \arr -> do
    -- block >>= br
    exprToBuilder (ExprConst (Const 4)) >>= ret


varToParam :: Var -> (Type, ParameterName)
varToParam (Var name) = (typeDouble, stringToParamName name)

stringToParamName :: String -> ParameterName
stringToParamName = ParameterName . fromString

stringToName :: String -> Name
stringToName = Name . fromString