diff --git a/library/Init/Data/Array/Basic.lean b/library/Init/Data/Array/Basic.lean index 97ee094c63..d75cd7df23 100644 --- a/library/Init/Data/Array/Basic.lean +++ b/library/Init/Data/Array/Basic.lean @@ -444,7 +444,7 @@ else instance [HasBeq α] : HasBeq (Array α) := ⟨fun a b => isEqv a b HasBeq.beq⟩ --- TODO(Leo): justify termination using wf-rec, and use `fswap` +-- TODO(Leo): justify termination using wf-rec, and use `swap` partial def reverseAux : Array α → Nat → Array α | a, i => let n := a.size; diff --git a/library/Init/Lean/Elaborator/Basic.lean b/library/Init/Lean/Elaborator/Basic.lean index f23602b2be..4db6697582 100644 --- a/library/Init/Lean/Elaborator/Basic.lean +++ b/library/Init/Lean/Elaborator/Basic.lean @@ -123,7 +123,7 @@ match attrParamSyntaxToIdentifier arg with def declareBuiltinElab (env : Environment) (addFn : Name) (kind : SyntaxNodeKind) (declName : Name) : IO Environment := let name := `_regBuiltinTermElab ++ declName; let type := Expr.app (mkConst `IO) (mkConst `Unit); -let val := mkCApp addFn [toExpr kind, toExpr declName, mkConst declName]; +let val := mkCApp addFn #[toExpr kind, toExpr declName, mkConst declName]; let decl := Declaration.defnDecl { name := name, lparams := [], type := type, value := val, hints := ReducibilityHints.opaque, isUnsafe := false }; match env.addAndCompile {} decl with -- TODO: pretty print error diff --git a/library/Init/Lean/Expr.lean b/library/Init/Lean/Expr.lean index 95d21ef300..2dea39b678 100644 --- a/library/Init/Lean/Expr.lean +++ b/library/Init/Lean/Expr.lean @@ -74,10 +74,10 @@ attribute [extern "lean_expr_mk_proj"] Expr.proj @[extern "lean_expr_local"] constant Expr.local (n : Name) (pp : Name) (ty : Expr) (bi : BinderInfo) : Expr := default _ -def mkApp (fn : Expr) (args : List Expr) : Expr := +def mkApp (fn : Expr) (args : Array Expr) : Expr := args.foldl Expr.app fn -def mkCApp (fn : Name) (args : List Expr) : Expr := +def mkCApp (fn : Name) (args : Array Expr) : Expr := mkApp (Expr.const fn []) args namespace Expr @@ -159,12 +159,14 @@ def getAppNumArgsAux : Expr → Nat → Nat def getAppNumArgs (e : Expr) : Nat := getAppNumArgsAux e 0 -def getAppArgsAux : Expr → List Expr → List Expr -| Expr.app f a, as => getAppArgsAux f (a::as) -| e, as => as +private def getAppArgsAux : Expr → Array Expr → Nat → Array Expr +| Expr.app f a, as, i => getAppArgsAux f (as.set! i a) (i-1) +| _, as, _ => as -@[inline] def getAppArgs (e : Expr) : List Expr := -getAppArgsAux e [] +@[inline] def getAppArgs (e : Expr) : Array Expr := +let dummy := Expr.sort Level.zero; +let nargs := e.getAppNumArgs; +getAppArgsAux e (mkArray nargs dummy) (nargs-1) def isAppOf (e : Expr) (n : Name) : Bool := match e.getAppFn with diff --git a/library/Init/Lean/Parser/Parser.lean b/library/Init/Lean/Parser/Parser.lean index d1c4995fb0..0fcaac1caf 100644 --- a/library/Init/Lean/Parser/Parser.lean +++ b/library/Init/Lean/Parser/Parser.lean @@ -1443,7 +1443,7 @@ do tables ← tablesRef.get; def declareBuiltinParser (env : Environment) (addFnName : Name) (refDeclName : Name) (declName : Name) : IO Environment := let name := `_regBuiltinParser ++ declName; let type := Expr.app (mkConst `IO) (mkConst `Unit); -let val := mkCApp addFnName [mkConst refDeclName, toExpr declName, mkConst declName]; +let val := mkCApp addFnName #[mkConst refDeclName, toExpr declName, mkConst declName]; let decl := Declaration.defnDecl { name := name, lparams := [], type := type, value := val, hints := ReducibilityHints.opaque, isUnsafe := false }; match env.addAndCompile {} decl with -- TODO: pretty print error diff --git a/library/Init/Lean/TypeClass/Context.lean b/library/Init/Lean/TypeClass/Context.lean index e37cf04fcb..a92306ae5e 100644 --- a/library/Init/Lean/TypeClass/Context.lean +++ b/library/Init/Lean/TypeClass/Context.lean @@ -186,12 +186,20 @@ if e.hasMVar then eFind (λ t => eIsMeta t || (t.isConst && t.constLevels.any uHasTmpMVar)) e else false -partial def slowWhnfApp : Expr → List Expr → Expr -| (Expr.lam _ _ d b), (arg::args) => slowWhnfApp (b.instantiate1 arg) args -| f, args => mkApp f args +partial def slowWhnfApp (args : Array Expr) : Expr → Nat → Expr +| f@(Expr.lam _ _ d b), i => + if h : i < args.size then + slowWhnfApp (b.instantiate1 (args.get ⟨i, h⟩)) (i+1) + else + f +| f, i => + if h : i < args.size then + slowWhnfApp (Expr.app f (args.get ⟨i, h⟩)) (i+1) + else + f partial def slowWhnf : Expr → Expr -| e => if e.isApp then slowWhnfApp (slowWhnf e.getAppFn) e.getAppArgs else e +| e => if e.isApp then slowWhnfApp e.getAppArgs (slowWhnf e.getAppFn) 0 else e partial def eUnify : Expr → Expr → EState String Context Unit | e₁, e₂ => @@ -206,8 +214,11 @@ partial def eUnify : Expr → Expr → EState String Context Unit else if e₁.isFVar && e₂.isFVar && e₁.fvarName == e₂.fvarName then pure () else if e₁.isConst && e₂.isConst && e₁.constName == e₂.constName then List.mfor₂ uUnify e₁.constLevels e₂.constLevels - else if e₁.isApp && e₂.isApp && e₁.getAppArgs.length == e₂.getAppArgs.length then - eUnify e₁.getAppFn e₂.getAppFn *> List.mfor₂ eUnify e₁.getAppArgs e₂.getAppArgs + else if e₁.isApp && e₂.isApp && e₁.getAppNumArgs == e₂.getAppNumArgs then do + let args₁ := e₁.getAppArgs; + let args₂ := e₂.getAppArgs; + eUnify e₁.getAppFn e₂.getAppFn; + args₁.size.mfor $ fun i => eUnify (args₁.get! i) (args₂.get! i) else if e₁.isForall && e₂.isForall then do eUnify e₁.bindingDomain e₂.bindingDomain; eUnify e₁.bindingBody e₂.bindingBody diff --git a/library/Init/Lean/TypeClass/Synth.lean b/library/Init/Lean/TypeClass/Synth.lean index 170638320c..30496f0e2a 100644 --- a/library/Init/Lean/TypeClass/Synth.lean +++ b/library/Init/Lean/TypeClass/Synth.lean @@ -114,7 +114,7 @@ do let mvarType := ctx.eInfer mvar; partial def introduceMVars (lctx : LocalContext) (locals : Array Expr) : Context → Expr → Expr → Array Expr → Context × Expr × Expr × Array Expr | ctx, instVal, Expr.pi _ info domain body, mvars => do let ⟨mvar, ctx⟩ := (Context.eNewMeta $ lctx.mkForall locals domain).run ctx; - let arg := mkApp mvar locals.toList; -- TODO(dselsam): rm toList + let arg := mkApp mvar locals; let instVal := Expr.app instVal arg; let instType := body.instantiate1 arg; let mvars := if info.isInstImplicit then mvars.push mvar else mvars; @@ -260,7 +260,7 @@ def collectEReplacements (env : Environment) (lctx : LocalContext) (locals : Arr | Expr.pi _ _ d b, arg::args, ctx, eReplacements, fArgs => if isOutParam d then let ⟨eMeta, ctx⟩ := (Context.eNewMeta $ lctx.mkForall locals d).run ctx; - let fArg : Expr := mkApp eMeta locals.toList; + let fArg : Expr := mkApp eMeta locals; collectEReplacements (b.instantiate1 fArg) args ctx (eReplacements.push (eMeta, arg)) (fArgs.push fArg) else collectEReplacements (b.instantiate1 arg) args ctx eReplacements (fArgs.push arg) @@ -283,8 +283,8 @@ else match env.find f.constName with | none => panic! "found constant not in the environment" | some cInfo => cInfo.instantiateTypeUnivParams CLevels.toList; - let (ctx, eReplacements, fArgs) := collectEReplacements env lctx locals fType fArgs ctx #[] #[]; - (ctx, lctx.mkForall locals $ mkApp f fArgs.toList, uReplacements, eReplacements) + let (ctx, eReplacements, fArgs) := collectEReplacements env lctx locals fType fArgs.toList ctx #[] #[]; -- TODO: avoid fArgs.toList + (ctx, lctx.mkForall locals $ mkApp f fArgs, uReplacements, eReplacements) def synth (goalType₀ : Expr) (fuel : Nat := 100000) : TCMethod Expr := do env ← get >>= λ ϕ => pure ϕ.env; diff --git a/tests/compiler/expr.lean.expected.out b/tests/compiler/expr.lean.expected.out index 310795574f..eb65391f2e 100644 --- a/tests/compiler/expr.lean.expected.out +++ b/tests/compiler/expr.lean.expected.out @@ -1,3 +1,3 @@ f a b hash: 3753749717 -[a, b] +#[a, b] diff --git a/tests/lean/typeclass_context.lean b/tests/lean/typeclass_context.lean index aa21762e5f..87afaf0a28 100644 --- a/tests/lean/typeclass_context.lean +++ b/tests/lean/typeclass_context.lean @@ -15,12 +15,12 @@ open Lean.TypeClass.Context def testEUnify1 : EState String Context Expr := do t ← EState.fromState $ eNewMeta (mkConst "Term"); -eUnify (mkApp (mkConst "f") [mkConst "a"]) t; +eUnify (mkApp (mkConst "f") #[mkConst "a"]) t; get >>= λ (ctx : Context) => pure $ ctx.eInstantiate t def testEUnify2 : EState String Context Expr := do t ← EState.fromState $ eNewMeta (mkConst "Term"); -eUnify (mkApp (mkConst "f") [mkConst "a"]) (mkApp (mkConst "f") [t]); +eUnify (mkApp (mkConst "f") #[mkConst "a"]) (mkApp (mkConst "f") #[t]); get >>= λ (ctx : Context) => pure $ ctx.eInstantiate t def testEUnify3 : EState String Context Expr := do @@ -58,7 +58,7 @@ get >>= λ (ctx : Context) => pure $ ctx.eInstantiate t₂ def testEAssign1 : EState String Context Expr := do t ← EState.fromState $ eNewMeta (mkConst "Term"); -EState.fromState $ eAssign t $ mkApp (mkConst "f") [mkConst "a"]; +EState.fromState $ eAssign t $ mkApp (mkConst "f") #[mkConst "a"]; get >>= λ (ctx : Context) => pure $ ctx.eInstantiate t def testClash1 : EState String Context Expr := do @@ -66,15 +66,15 @@ eUnify (mkConst "f") (mkConst "g"); pure $ default _ def testClash2 : EState String Context Expr := do -eUnify (mkApp (mkConst "f") [mkConst "a"]) (mkApp (mkConst "g") [mkConst "a"]); +eUnify (mkApp (mkConst "f") #[mkConst "a"]) (mkApp (mkConst "g") #[mkConst "a"]); pure $ default _ def testClash3 : EState String Context Expr := do -eUnify (mkApp (mkConst "f") [mkConst "a"]) (mkApp (mkConst "f") [mkConst "b"]); +eUnify (mkApp (mkConst "f") #[mkConst "a"]) (mkApp (mkConst "f") #[mkConst "b"]); pure $ default _ def testClash4 : EState String Context Expr := do -eUnify (mkApp (mkConst "f") [mkConst "a"]) (mkApp (mkConst "f") []); +eUnify (mkApp (mkConst "f") #[mkConst "a"]) (mkApp (mkConst "f") #[]); pure $ default _ def testChain1 : EState String Context Expr := do @@ -87,12 +87,12 @@ get >>= λ (ctx : Context) => pure $ ctx.eInstantiate t₁ def testAlphaNorm1 : EState String Context Expr := do t₁ ← EState.fromState $ eNewMeta (mkConst "Term"); t₂ ← EState.fromState $ eNewMeta (mkConst "Term"); -pure $ αNorm $ mkApp (mkConst "f") [t₁, t₂] +pure $ αNorm $ mkApp (mkConst "f") #[t₁, t₂] def testAlphaNorm2 : EState String Context Expr := do t₁ ← EState.fromState $ eNewMeta (mkConst "Term"); t₂ ← EState.fromState $ eNewMeta (mkConst "Term"); -pure $ αNorm $ mkApp (mkConst "f") [t₂, t₁] +pure $ αNorm $ mkApp (mkConst "f") #[t₂, t₁] def testAlphaNorm3 : EState String Context Expr := do pure $ αNorm (mkConst "f") @@ -100,7 +100,7 @@ pure $ αNorm (mkConst "f") def testAlphaNorm4 : EState String Context Expr := do t₁ ← EState.fromState $ eNewMeta (mkConst "Term"); t₂ ← EState.fromState $ eNewMeta (mkConst "Term"); -pure $ αNorm $ Expr.pi "foo" BinderInfo.default (mkApp (mkConst "f") [t₂]) (mkApp (mkConst "g") [t₁]) +pure $ αNorm $ Expr.pi "foo" BinderInfo.default (mkApp (mkConst "f") #[t₂]) (mkApp (mkConst "g") #[t₁]) #eval testEUnify1.run {} #eval testEUnify2.run {}