From cb2b065faae0a8e556279fada24c50456134a110 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Fri, 20 Jan 2017 01:05:50 +0100 Subject: [PATCH] Fix #660: `Option.fold` & bump version --- RELEASE_NOTES_COMPILER.md | 4 ++ RELEASE_NOTES_CORE.md | 4 ++ src/fable/Fable.Client.Node/ts/options.ts | 2 +- src/fable/Fable.Client.Node/ts/package.json | 18 +++--- src/fable/Fable.Compiler/FSharp2Fable.Util.fs | 4 +- src/fable/Fable.Compiler/FSharp2Fable.fs | 11 ++-- src/fable/Fable.Compiler/Replacements.fs | 55 +++++++------------ src/fable/Fable.Core/ts/Util.ts | 4 +- src/tests/Main/UnionTypeTests.fs | 25 +++++++++ 9 files changed, 74 insertions(+), 53 deletions(-) diff --git a/RELEASE_NOTES_COMPILER.md b/RELEASE_NOTES_COMPILER.md index 4eadb32a5f..8acf2de247 100644 --- a/RELEASE_NOTES_COMPILER.md +++ b/RELEASE_NOTES_COMPILER.md @@ -1,3 +1,7 @@ +### 0.7.34 + +* Fix #660: `Option.fold` and `Option.foldBack` + ### 0.7.33 * Add operator `enum` diff --git a/RELEASE_NOTES_CORE.md b/RELEASE_NOTES_CORE.md index 566e6f6a3a..650b9677be 100644 --- a/RELEASE_NOTES_CORE.md +++ b/RELEASE_NOTES_CORE.md @@ -1,3 +1,7 @@ +### 0.7.25 + +* Fix #660: `Option.fold` and `Option.foldBack` + ### 0.7.24 * Fixed serialization of maps with string keys: #659 diff --git a/src/fable/Fable.Client.Node/ts/options.ts b/src/fable/Fable.Client.Node/ts/options.ts index b81ccee2c8..66e11d0ac7 100644 --- a/src/fable/Fable.Client.Node/ts/options.ts +++ b/src/fable/Fable.Client.Node/ts/options.ts @@ -1,7 +1,7 @@ import * as fs from "fs"; import * as path from "path"; import * as commandLineArgs from "command-line-args"; -import * as commandLineUsage from "command-line-usage"; +import * as commandLineUsage from "command-line-usage/lib/command-line-usage"; import * as semver from "semver"; import * as json5 from "json5"; diff --git a/src/fable/Fable.Client.Node/ts/package.json b/src/fable/Fable.Client.Node/ts/package.json index 3beee599c4..6584ad3df0 100644 --- a/src/fable/Fable.Client.Node/ts/package.json +++ b/src/fable/Fable.Client.Node/ts/package.json @@ -7,21 +7,21 @@ "fable": "./index.js" }, "dependencies": { - "babel-core": "^6.18.2", - "babel-dts-generator": "^0.6.2", + "babel-core": "^6.21.0", + "babel-dts-generator": "^0.6.3", "babel-plugin-transform-class-properties": "^6.19.0", - "babel-plugin-transform-flow-strip-types": "^6.18.0", + "babel-plugin-transform-flow-strip-types": "^6.21.0", "babel-preset-es2015": "^6.18.0", "babel-template": "^6.16.0", "babel-traverse": "^6.21.0", "babel-types": "^6.21.0", "chokidar": "^1.6.1", - "command-line-args": "^3.0.3", - "command-line-usage": "^3.0.7", - "json5": "^0.5.0", - "resolve": "^1.1.7", - "rollup": "^0.36.3", - "rollup-plugin-commonjs": "^5.0.5", + "command-line-args": "^3.0.5", + "command-line-usage": "^4.0.0", + "json5": "^0.5.1", + "resolve": "^1.2.0", + "rollup": "^0.41.4", + "rollup-plugin-commonjs": "^7.0.0", "rollup-plugin-hypothetical": "^1.2.1", "rollup-plugin-node-resolve": "^2.0.0", "semver": "^5.3.0" diff --git a/src/fable/Fable.Compiler/FSharp2Fable.Util.fs b/src/fable/Fable.Compiler/FSharp2Fable.Util.fs index 4a9576590a..ad40068b8a 100644 --- a/src/fable/Fable.Compiler/FSharp2Fable.Util.fs +++ b/src/fable/Fable.Compiler/FSharp2Fable.Util.fs @@ -1174,7 +1174,7 @@ module Util = emitMeth.Invoke(emitInstance, args) |> unbox |> Some with | :? AST.FableError as err -> raise err - | ex -> let exMsg = if ex.GetType() = typeof + | ex -> let exMsg = if ex.GetType() = typeof then ex.InnerException.Message else ex.Message sprintf "Error when invoking %s.%s" emitFsType.TypeDefinition.DisplayName emitMethName @@ -1373,7 +1373,7 @@ module Util = Fable.Value Fable.This let makeValueFrom com ctx r typ role (v: FSharpMemberOrFunctionOrValue) = - if typ = Fable.Unit then Fable.Value Fable.Null else + if typ = Fable.Unit then Fable.Wrapped(Fable.Value Fable.Null, Fable.Unit) else let owner = tryEnclosingEntity v let i = buildApplyInfoFrom com ctx r typ ([], []) (None, []) owner v match v with diff --git a/src/fable/Fable.Compiler/FSharp2Fable.fs b/src/fable/Fable.Compiler/FSharp2Fable.fs index d5d0465b4d..75aa5b20cc 100644 --- a/src/fable/Fable.Compiler/FSharp2Fable.fs +++ b/src/fable/Fable.Compiler/FSharp2Fable.fs @@ -414,15 +414,16 @@ and private transformExprWithRole (role: Role) (com: IFableCompiler) ctx fsExpr FableError("Cannot resolve locally inlined value: " + var.DisplayName, range) |> raise | BasicPatterns.Application(Transform com ctx callee, _typeArgs, args) -> - let args = List.map (transformExprWithRole AppliedArgument com ctx) args + let args2 = List.map (transformExprWithRole AppliedArgument com ctx) args let typ, range = makeType com ctx.typeArgs fsExpr.Type, makeRangeFrom fsExpr if callee.Type.FullName = "Fable.Core.Applicable" then - match args with - | [Fable.Value(Fable.TupleConst args)] -> args - | args -> args + match args, args2 with + | [arg], _ when isUnit arg.Type -> [] + | _, [Fable.Value(Fable.TupleConst args2)] -> args2 + | _, args2 -> args2 |> List.map (makeDelegate com None) |> fun args -> Fable.Apply(callee, args, Fable.ApplyMeth, typ, range) - else makeApply range typ callee args + else makeApply range typ callee args2 | BasicPatterns.IfThenElse (Transform com ctx guardExpr, Transform com ctx thenExpr, Transform com ctx elseExpr) -> Fable.IfThenElse (guardExpr, thenExpr, elseExpr, makeRangeFrom fsExpr) diff --git a/src/fable/Fable.Compiler/Replacements.fs b/src/fable/Fable.Compiler/Replacements.fs index c3de0a76e1..2c613cde71 100644 --- a/src/fable/Fable.Compiler/Replacements.fs +++ b/src/fable/Fable.Compiler/Replacements.fs @@ -454,6 +454,7 @@ module private AstPass = let fableCoreLib com (i: Fable.ApplyInfo) = let destruct = function | Fable.Value(Fable.TupleConst exprs) -> exprs + | expr when expr.Type = Fable.Unit -> [] | expr -> [expr] match i.methodName with | Naming.StartsWith "import" _ -> @@ -681,7 +682,7 @@ module private AstPass = | "toSingle" | "toDouble" | "toDecimal" -> toFloat com info args |> Some | "toChar" -> toChar com info args.Head |> Some | "toString" -> toString com info args.Head |> Some - | "toEnum" -> args.Head |> Some + | "toEnum" -> args.Head |> Some | "createDictionary" -> GlobalCall("Map", None, true, args) |> makeCall r typ |> Some | "createSet" -> @@ -1022,17 +1023,13 @@ module private AstPass = let options (com: ICompiler) (i: Fable.ApplyInfo) = // Prevent functions being run twice, see #198 - let wrapInLet f expr = - let ident = com.GetUniqueVar() |> makeIdent - [ - Fable.VarDeclaration(ident, expr, false) - f(Fable.Value(Fable.IdentValue ident)) - ] - |> fun exprs -> Fable.Sequential(exprs, i.range) - let toArray r optExpr = - // "$0 != null ? [$0]: []" - let makeArray exprs = Fable.ArrayConst(Fable.ArrayValues exprs, genArg i.returnType) |> Fable.Value - Fable.IfThenElse(makeEqOp r [optExpr; Fable.Value Fable.Null] BinaryUnequal, makeArray [optExpr], makeArray [], r) + let runIfSome r expr defValue f = + CoreLibCall("Util", Some "defaultArg", false, [expr; defValue; f]) + |> makeCall r Fable.Any + let toArray r arg = + let ident = makeIdent "x" + makeLambdaExpr [ident] (makeArray Fable.Any [Fable.IdentValue ident |> Fable.Value]) + |> runIfSome r arg (makeArray Fable.Any []) let getCallee() = match i.callee with Some c -> c | None -> i.args.Head match i.methodName with | "none" -> Fable.Null |> Fable.Value |> Some @@ -1049,35 +1046,25 @@ module private AstPass = | "map" | "bind" -> // emit i "$1 != null ? $0($1) : $1" i.args |> Some let f, arg = i.args.Head, i.args.Tail.Head - arg |> wrapInLet (fun e -> - Fable.IfThenElse( - makeEqOp i.range [e; Fable.Value Fable.Null] BinaryUnequal, - Fable.Apply(f, [e], Fable.ApplyMeth, Fable.Any, i.range), - e, i.range)) - |> Some + runIfSome i.range arg (Fable.Value Fable.Null) f |> Some | "filter" -> - // emit i "$1 != null && $0($1) ? $1 : null" i.args |> Some - let f, arg = i.args.Head, i.args.Tail.Head - arg |> wrapInLet (fun e -> - let cond = - [ makeEqOp i.range [e; Fable.Value Fable.Null] BinaryUnequal - Fable.Apply(f, [e], Fable.ApplyMeth, Fable.Any, i.range) ] - |> makeLogOp i.range <| LogicalAnd - Fable.IfThenElse(cond, e, Fable.Value Fable.Null, i.range)) + let filter, arg = i.args.Head, i.args.Tail.Head + "x => $0(x) ? x : null" + |> makeEmit None Fable.Any [filter] + |> runIfSome i.range arg (Fable.Value Fable.Null) |> Some - | "toArray" -> toArray i.range i.args.Head |> Some + | "toArray" -> + toArray i.range i.args.Head |> Some | "foldBack" -> - let opt = wrapInLet (fun e -> toArray i.range e) i.args.Tail.Head + let opt = toArray None i.args.Tail.Head let args = i.args.Head::opt::i.args.Tail.Tail - CoreLibCall("Seq", Some "foldBack", false, deleg com i args) - |> makeCall i.range i.returnType |> Some + ccall com i "Seq" "foldBack" (deleg com i args) |> Some | meth -> let args = let args = List.rev i.args - wrapInLet (fun e -> toArray i.range e) args.Head - |> fun argsHead -> List.rev (argsHead::args.Tail) - CoreLibCall("Seq", Some meth, false, deleg com i args) - |> makeCall i.range i.returnType |> Some + let opt = toArray None args.Head + List.rev (opt::args.Tail) + ccall com i "Seq" meth (deleg com i args) |> Some let timeSpans com (i: Fable.ApplyInfo) = // let callee = match i.callee with Some c -> c | None -> i.args.Head diff --git a/src/fable/Fable.Core/ts/Util.ts b/src/fable/Fable.Core/ts/Util.ts index 603031eb82..28e3acfaa5 100644 --- a/src/fable/Fable.Core/ts/Util.ts +++ b/src/fable/Fable.Core/ts/Util.ts @@ -338,6 +338,6 @@ export function randomNext(min: number, max: number) { return Math.floor(Math.random() * (max - min)) + min; } -export function defaultArg(arg: T, defaultValue: T) { - return arg == null ? defaultValue : arg; +export function defaultArg(arg: T, defaultValue: T, f?: (x:T)=>U) { + return arg == null ? defaultValue : (f != null ? f(arg) : arg); } \ No newline at end of file diff --git a/src/tests/Main/UnionTypeTests.fs b/src/tests/Main/UnionTypeTests.fs index 550274adab..701d170605 100644 --- a/src/tests/Main/UnionTypeTests.fs +++ b/src/tests/Main/UnionTypeTests.fs @@ -328,6 +328,31 @@ let ``Option.foldBack works``() = (None, 5) ||> Option.foldBack (*) |> equal 5 (Some 7, 5) ||> Option.foldBack (*) |> equal 35 +[] +type FoldTest = +| FoldA of FoldTest option +| FoldB of int + +let rec folding1 test acc = + let f2 (opt:FoldTest option) acc = Option.fold (fun a b -> folding1 b a) acc opt + match test with + | FoldA d -> f2 d acc + | FoldB i -> i::acc + +let rec folding2 test acc = + let f2 (opt:FoldTest option) acc = Option.foldBack folding2 opt acc + match test with + | FoldA d -> f2 d acc + | FoldB i -> i::acc + +[] +let ``Option.fold works II``() = // See #660 + folding1 (FoldA (Some (FoldB 1))) [] |> equal [1] + +[] +let ``Option.foldBack works II``() = // See #660 + folding2 (FoldA (Some (FoldB 1))) [] |> equal [1] + [] let ``Option.toArray works``() = None |> Option.toArray |> equal [||]