{-# LANGUAGE OverloadedStrings #-}

module Language.Del.Ops (loadOps) where

import Language.Del.AST
import Language.Del.AstUtils
import Language.Del.CompileDefs

loadOpsExpr :: Expr -> Artifact Expr
loadOpsExpr e@(Apply hd rest) =
    case hd of
         Id "+" -> return $ Add rest
         Id "*" -> return $ Mul rest
         Id "-" -> createSub rest
         Id "/" -> binop "/" Div
         Id "^" -> binop "^" Pow
         Id "<" -> binop "<" Lt
         Id ">" -> binop ">" Gt
         Id "<=" -> binop "<=" LtE
         Id ">=" -> binop ">=" GtE
         Id "if" -> createIf rest
         Id "$" -> createNative rest
         _ -> return e
    where binop opname ctor =
              if length rest == 2
                 then return $ ctor (rest !! 0) (rest !! 1)
                 else Failure $ BadArity opname 2 (length rest)
          createSub exprs =
              case exprs of
                   [x] -> return $ Negate x
                   [x, y] -> return $ Sub x y
                   _ -> Failure $ BadArity "-" 2 (length exprs) 
          createIf exprs =
              if length exprs == 3
                 then return $ If (rest !! 0) (rest !! 1) (rest !! 2)
                 else Failure $ BadArity "if" 3 (length exprs)
          createNative exprs =
              case exprs of
                   [] -> Failure $ BadArity "$" 1 (length exprs)
                   (name:args) ->
                       case name of
                            Id n -> return $ NativeCall n args
                            _ -> Failure $ BadNativeName name  e
loadOpsExpr e = return e

loadOpsDef :: Def -> Artifact Def
loadOpsDef (Def n ret a b) = mapexprM loadOpsExpr b >>= return . Def n ret a

loadOps :: AST -> Artifact AST
loadOps = mapastM loadOpsDef