e381960614
This PR adds the simproc String.reduceToSingleton`, which is disabled by default and turns `"c"` into `String.singleton 'c'`. Recall that the simproc `reduceSingleton`, which does the reverse, is part of the default `simp` set.
93 lines
4 KiB
Text
93 lines
4 KiB
Text
/-
|
|
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
|