/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
module

prelude
public import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Char
import Lean.Meta.StringLitProof

public section

namespace String
open Lean Meta Simp

def fromExpr? (e : Expr) : SimpM (Option String) := do
  return getStringValue? e

builtin_dsimproc [simp, seval] reduceAppend ((_ ++ _ : String)) := fun e => do
  unless e.isAppOfArity ``HAppend.hAppend 6 do return .continue
  let some a ← fromExpr? e.appFn!.appArg! | return .continue
  let some b ← fromExpr? e.appArg! | return .continue
  return .done <| toExpr (a ++ b)

private partial def reduceListChar (e : Expr) (s : String) : SimpM DStep := do
  if e.isAppOfArity ``List.nil 1 then
    return .done <| toExpr s
  else if e.isAppOfArity ``List.cons 3 then
    let some c ← Char.fromExpr? e.appFn!.appArg! | return .continue
    reduceListChar e.appArg! (s.push c)
  else
    return .continue

builtin_dsimproc [simp, seval] reduceOfList (String.ofList _) := fun e => do
  unless e.isAppOfArity ``String.ofList 1 do return .continue
  reduceListChar e.appArg! ""

builtin_dsimproc [simp, seval] reduceToList (String.toList _) := fun e => do
  unless e.isAppOfArity ``String.toList 1 do return .continue
  let some s ← fromExpr? e.appArg! | return .continue
  return .done <| toExpr s.toList

builtin_dsimproc [simp, seval] reducePush (String.push _ _) := fun e => do
  unless e.isAppOfArity ``String.push 2 do return .continue
  let some n ← fromExpr? e.appFn!.appArg! | return .continue
  let some m ← Char.fromExpr? e.appArg! | return .continue
  return .done <| toExpr (n.push m)

builtin_dsimproc [simp, seval] reduceSingleton (String.singleton _) := fun e => do
  unless e.isAppOfArity ``String.singleton 1 do return .continue
  let some c ← Char.fromExpr? e.appArg! | return .continue
  return .done <| toExpr (String.singleton c)

builtin_dsimproc_decl reduceToSingleton ((_ : String)) := fun e => do
  let some s ← fromExpr? e | return .continue
  let l := s.toList
  let [c] := l | return .continue
  return .done <| mkApp (mkConst ``String.singleton) (toExpr c)

@[inline] def reduceBinPred (declName : Name) (arity : Nat) (op : String → String → Bool) (e : Expr) : SimpM Step := do
  unless e.isAppOfArity declName arity do return .continue
  let some n ← fromExpr? e.appFn!.appArg! | return .continue
  let some m ← fromExpr? e.appArg! | return .continue
  evalPropStep e (op n m)


@[inline] def reduceBoolPred (declName : Name) (arity : Nat) (op : String → String → Bool) (e : Expr) : SimpM DStep := do
  unless e.isAppOfArity declName arity do return .continue
  let some n ← fromExpr? e.appFn!.appArg! | return .continue
  let some m ← fromExpr? e.appArg! | return .continue
  return .done <| toExpr (op n m)

builtin_simproc [simp, seval] reduceLT  (( _ : String) < _)  := reduceBinPred ``LT.lt 4 (. < .)
builtin_simproc [simp, seval] reduceLE  (( _ : String) ≤ _)  := reduceBinPred ``LE.le 4 (. ≤ .)
builtin_simproc [simp, seval] reduceGT  (( _ : String) > _)  := reduceBinPred ``GT.gt 4 (. > .)
builtin_simproc [simp, seval] reduceGE  (( _ : String) ≥ _)  := reduceBinPred ``GE.ge 4 (. ≥ .)

builtin_simproc [simp, seval] reduceEq (( _ : String) = _) := fun e => do
  unless e.isAppOfArity ``Eq 3 do return .continue
  let some n ← fromExpr? e.appFn!.appArg! | return .continue
  let some m ← fromExpr? e.appArg! | return .continue
  evalEqPropStep e (n = m) (mkStringLitNeProof n m)

builtin_simproc [simp, seval] reduceNe (( _ : String) ≠ _) := fun e => do
  unless e.isAppOfArity ``Ne 3 do return .continue
  let some n ← fromExpr? e.appFn!.appArg! | return .continue
  let some m ← fromExpr? e.appArg! | return .continue
  evalNePropStep e (n ≠ m) (mkStringLitNeProof n m)
builtin_dsimproc [simp, seval] reduceBEq  (( _ : String) == _)  := reduceBoolPred ``BEq.beq 4 (. == .)
builtin_dsimproc [simp, seval] reduceBNe  (( _ : String) != _)  := reduceBoolPred ``bne 4 (. != .)

end String