Fix #660: Option.fold & bump version

RELEASE_NOTES_COMPILER.md

@@ -1,3 +1,7 @@
+### 0.7.34
+
+* Fix #660: `Option.fold` and `Option.foldBack`
+
 ### 0.7.33
 
 * Add operator `enum`

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

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";
 

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"

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<TargetInvocationException> 
+                | ex -> let exMsg = if ex.GetType() = typeof<TargetInvocationException>
                                     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

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)

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

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<T>(arg: T, defaultValue: T) {
-  return arg == null ? defaultValue : arg;
+export function defaultArg<T,U>(arg: T, defaultValue: T, f?: (x:T)=>U) {
+  return arg == null ? defaultValue : (f != null ? f(arg) : arg);
 }

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
 
+[<NoEquality; NoComparison>]
+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
+
+[<Test>]
+let ``Option.fold works II``() = // See #660
+    folding1 (FoldA (Some (FoldB 1))) [] |> equal [1]
+
+[<Test>]
+let ``Option.foldBack works II``() = // See #660
+    folding2 (FoldA (Some (FoldB 1))) [] |> equal [1]
+
 [<Test>]
 let ``Option.toArray works``() =
     None |> Option.toArray |> equal [||]