diff --git a/src/Fable.Transforms/Rust/Fable2Rust.fs b/src/Fable.Transforms/Rust/Fable2Rust.fs index 632adbd4f..ab190e507 100644 --- a/src/Fable.Transforms/Rust/Fable2Rust.fs +++ b/src/Fable.Transforms/Rust/Fable2Rust.fs @@ -619,6 +619,13 @@ module TypeInfo = -> true | _ -> false + // A reference-typed (non-struct) record or union. Such entities are Lrc-wrapped + // at the value level, so boxing/unboxing them to `obj` needs a smart-pointer + // coercion rather than the plain value-type box (see transformCast). + let isReferenceRecordOrUnion (com: IRustCompiler) (entRef: Fable.EntityRef) = + let ent = com.GetEntity(entRef) + (ent.IsFSharpRecord || ent.IsFSharpUnion) && not ent.IsValueType + // Checks whether the type needs a ref counted wrapper // such as Rc (or Arc in a multithreaded context) let shouldBeRefCountWrapped (com: IRustCompiler) ctx typ = @@ -632,12 +639,15 @@ module TypeInfo = // always not Rc-wrapped | Fable.Unit | Fable.Measure _ - | Fable.MetaType | Fable.Boolean | Fable.Char | Fable.Number _ -> None // should be Rc-wrapped + // MetaType (System.Type) is erased to Any and carries a boxed reflection + // object at runtime, so it must be Lrc-wrapped like Any (a bare `dyn Any` + // is unsized and cannot appear as a value/argument). + | Fable.MetaType | Fable.Any | Fable.Regex | Replacements.Util.Builtin(Replacements.Util.FSharpReference _) @@ -1128,7 +1138,11 @@ module TypeInfo = | Fable.Char -> primitiveType "char" | Fable.Boolean -> primitiveType "bool" | Fable.String -> transformStringType com ctx - | Fable.MetaType -> transformMetaType com ctx + // System.Type has no faithful runtime on Rust (reflection is a stub), so erase it + // to Any. This lets the NewRecord quotation deconstruction bind its type slot to the + // boxed value the quotation runtime returns; typeof-based reflection is unsupported + // regardless (see the disabled ReflectionTests). + | Fable.MetaType -> transformAnyType com ctx | Fable.Number(kind, _) -> transformNumberType com ctx kind | Fable.LambdaType(argType, returnType) -> let argTypes, returnType = ([ argType ], returnType) @@ -1184,6 +1198,52 @@ module TypeInfo = // built-in types | Replacements.Util.Builtin kind -> transformBuiltinType com ctx typ kind + // Typed quotation Expr<'T>: erase the type argument so it shares the untyped + // FSharpExpr runtime representation. This lets a typed quotation (e.g. <@ 42 @>) + // be matched directly against the Patterns active patterns, which operate on + // the untyped Expr. + | Fable.DeclaredType(entRef, _) when entRef.FullName = Types.fsharpExprGeneric -> + transformEntityType com ctx { entRef with FullName = Types.fsharpExpr } [] + + // UnionCaseInfo (from a NewUnionCase quotation deconstruction) is erased to the + // Rust-native FSharpUnionCaseInfo carrier so uci.Name/uci.Tag resolve to the + // quotation runtime accessors. We build the import path directly (rather than via + // transformEntityType) because that carrier type does not exist in FSharp.Core, so + // com.GetEntity on the renamed ref would fail; getEntityFullName imports the type + // from fable_library_rust purely by FullName. + | Fable.DeclaredType(entRef, _) when entRef.FullName = "Microsoft.FSharp.Reflection.UnionCaseInfo" -> + let entName = + getEntityFullName + com + ctx + { entRef with FullName = "Microsoft.FSharp.Quotations.FSharpUnionCaseInfo" } + + makeFullNamePathTy entName None + + // System.Reflection.MethodInfo (from a Call quotation deconstruction) is erased to + // the Rust-native FSharpMethodInfo carrier so mi.Name / mi.DeclaringType resolve to + // the quotation runtime accessors. Built directly by FullName (mirrors the + // UnionCaseInfo case) because that carrier type does not exist in FSharp.Core. + | Fable.DeclaredType(entRef, _) when entRef.FullName = "System.Reflection.MethodInfo" -> + let entName = + getEntityFullName com ctx { entRef with FullName = "Microsoft.FSharp.Quotations.FSharpMethodInfo" } + + makeFullNamePathTy entName None + + // System.Reflection.PropertyInfo is erased to the Rust-native FSharpPropertyInfo + // carrier, so p.Name / p.GetValue and FSharpValue.GetRecordField resolve to the + // reflection runtime. One carrier serves both reflection (GetRecordFields) and + // quotations (PropertyGet's propInfo), as in .NET. Built directly by FullName + // (mirrors the MethodInfo case) because that carrier does not exist in FSharp.Core. + | Fable.DeclaredType(entRef, _) when entRef.FullName = "System.Reflection.PropertyInfo" -> + let entName = + getEntityFullName + com + ctx + { entRef with FullName = "Microsoft.FSharp.Quotations.FSharpPropertyInfo" } + + makeFullNamePathTy entName None + // other declared types | Fable.DeclaredType(entRef, genArgs) -> transformEntityType com ctx entRef genArgs @@ -1559,6 +1619,17 @@ module Util = // unboxing value types or wrapped types | Fable.Any, t when isValueType com t || isWrappedType com t -> expr |> unboxValue com ctx t + // boxing a reference-typed record/union (Lrc-wrapped) to obj: coerce the + // smart pointer to `dyn Any` so its concrete pointee stays the struct. + | Fable.DeclaredType(entRef, _), Fable.Any when isReferenceRecordOrUnion com entRef -> + [ expr ] |> makeLibCall com ctx None "Native" "box_lrc" + + // unboxing obj back to a reference-typed record/union: downcast + re-wrap. + | Fable.Any, Fable.DeclaredType(entRef, genArgs) when isReferenceRecordOrUnion com entRef -> + let rawTy = transformEntityType com ctx entRef genArgs + let genArgsOpt = [ rawTy ] |> mkTypesGenericArgs + [ expr ] |> makeLibCall com ctx genArgsOpt "Native" "unbox_lrc" + // casts to generic param | _, Fable.GenericParam(name, _isMeasure, _constraints) -> makeCall (name :: "from" :: []) None [ expr ] // e.g. T::from(value) @@ -1849,9 +1920,13 @@ module Util = // bindings we must emit a valid placeholder value instead (it is only there to // satisfy definite-assignment and gets overwritten before it is ever read). match typ with - | Fable.Any -> + | Fable.Any + | Fable.MetaType -> // `dyn Any` is unsized, so `Native::null` (needs a sized `NullableRef`) does // not apply; use a valid boxed-unit placeholder of type `LrcPtr`. + // `MetaType` (System.Type) is now also represented as `LrcPtr`, + // so it must take this path too (the `_` branch would emit a null of an + // unsized `dyn Any`, which does not compile). makeLibCall com ctx None "Native" "getZeroObj" [] | _ -> // Only concrete (sized) `Lrc`-wrapped reference types can use the null-ref @@ -2060,10 +2135,84 @@ module Util = let fmt = makeFormatString parts makeFormatExpr com ctx fmt values + // Builds a rich reflection value for `typeof`. The emitted expression + // registers the record's field metadata + constructor/getter closures keyed by + // its concrete TypeId and returns a boxed RecordTypeInfo (the runtime value that + // a `System.Type` holds on the Rust target). This backs FSharpValue.MakeRecord, + // FSharpValue.GetRecordFields/GetRecordField and FSharpType.GetRecordFields. + let makeRecordTypeInfo (com: IRustCompiler) ctx r (entRef: Fable.EntityRef) genArgs (typ: Fable.Type) : Rust.Expr = + let ent = com.GetEntity(entRef) + let idents = getEntityFieldsAsIdents com ent + let objType = Fable.Any + let arrObjType = Fable.Array(objType, Fable.MutableArray) + + // tid = Reflection::type_id::() (concrete, unwrapped struct type) + let rawTy = transformEntityType com ctx entRef genArgs + let tidGenArgs = [ rawTy ] |> mkTypesGenericArgs + let tidExpr = makeLibCall com ctx tidGenArgs "Reflection" "type_id" [] + + // name + let nameExpr = makeStrConst ent.FullName |> transformExpr com ctx + + // field names: string[] + let fieldNamesExpr = + let names = idents |> List.map (fun ident -> makeStrConst ident.Name) + + Fable.Value(Fable.NewArray(Fable.ArrayValues names, Fable.String, Fable.MutableArray), None) + |> transformExpr com ctx + + // make: |vs: obj[]| box (Foo { X = unbox vs.[0]; Y = unbox vs.[1] }) + let makeExpr = + let vsIdent = makeTypedIdent arrObjType "vs" + + let ctorValues = + idents + |> List.mapi (fun i ident -> + let elem = + Fable.Get(Fable.IdentExpr vsIdent, Fable.ExprGet(makeIntConst i), objType, None) + + Fable.TypeCast(elem, ident.Type) // unbox to field type + ) + + let recordExpr = Fable.Value(Fable.NewRecord(ctorValues, entRef, genArgs), None) + let body = Fable.TypeCast(recordExpr, objType) // box the record + + Fable.Delegate([ vsIdent ], body, None, Fable.Tags.empty) + |> transformExpr com ctx + + // getters: (obj -> obj)[], each |o| box ((unbox o).Field) + let gettersExpr = + let getterFnType = Fable.DelegateType([ objType ], objType) + + let getters = + idents + |> List.map (fun ident -> + let oIdent = makeTypedIdent objType "o" + let recExpr = Fable.TypeCast(Fable.IdentExpr oIdent, typ) // unbox obj -> Foo + let fieldInfo = Fable.FieldInfo.Create(ident.Name, ident.Type) + let fieldGet = Fable.Get(recExpr, fieldInfo, ident.Type, None) + let body = Fable.TypeCast(fieldGet, objType) // box the field value + Fable.Delegate([ oIdent ], body, None, Fable.Tags.empty) + ) + + Fable.Value(Fable.NewArray(Fable.ArrayValues getters, getterFnType, Fable.MutableArray), None) + |> transformExpr com ctx + + makeLibCall com ctx None "Reflection" "recordType" [ tidExpr; nameExpr; fieldNamesExpr; makeExpr; gettersExpr ] + let makeTypeInfo (com: IRustCompiler) ctx r (typ: Fable.Type) : Rust.Expr = - let importName = getLibraryImportName com ctx "Reflection" "TypeId" - let genArgsOpt = transformGenArgs com ctx [ typ ] - makeFullNamePathExpr importName genArgsOpt + match typ with + | Fable.DeclaredType(entRef, genArgs) when (com.GetEntity(entRef)).IsFSharpRecord -> + makeRecordTypeInfo com ctx r entRef genArgs typ + | _ -> + // Non-record `System.Type` value: carry the concrete `TypeId`, boxed as + // `LrcPtr` so it flows through the same `obj` slot as record type + // infos. Emitting a bare `Reflection_::TypeId::` path is not a valid + // value expression, and comparing the boxed carrier's runtime `type_id()` + // (as `typeEquals` did) would make all non-record types compare equal. + let genArgsOpt = transformGenArgs com ctx [ typ ] + let tidExpr = makeLibCall com ctx genArgsOpt "Reflection" "type_id" [] + makeLibCall com ctx None "Native" "box_" [ tidExpr ] let transformValue (com: IRustCompiler) (ctx: Context) r value : Rust.Expr = let unimplemented () = @@ -3698,9 +3847,10 @@ module Util = mkUnitExpr () - | Fable.Quote _ -> - addError com [] None "Quotations are not yet supported for Rust target" - mkUnitExpr () + | Fable.Quote(body, _isTyped, _r) -> + // Lower the quoted body to runtime calls that build the quotation AST, + // then transform those like any other expression (mirrors JS/Python/Beam). + QuotationEmitter.emitQuotedExpr com body |> transformExpr com ctx let rec tryFindEntryPoint (com: IRustCompiler) decl : string list option = match decl with diff --git a/src/Fable.Transforms/Rust/Replacements.fs b/src/Fable.Transforms/Rust/Replacements.fs index 0af218b01..604d1db1d 100644 --- a/src/Fable.Transforms/Rust/Replacements.fs +++ b/src/Fable.Transforms/Rust/Replacements.fs @@ -490,8 +490,9 @@ let equals (com: ICompiler) ctx r (left: Expr) (right: Expr) = | Array _ -> Helper.LibCall(com, "Array", "equals", t, [ left; right ], ?loc = r) | List _ -> Helper.LibCall(com, "List", "equals", t, [ left; right ], ?loc = r) | IEnumerable -> Helper.LibCall(com, "Seq", "equals", t, [ left; right ], ?loc = r) - // | MetaType -> - // Helper.LibCall(com, "Reflection", "equals", t, [left; right], ?loc=r) + // System.Type is erased to a boxed reflection object (dyn Any, no PartialEq), + // so type-identity equality is compared on the carried TypeId at runtime. + | MetaType -> Helper.LibCall(com, "Reflection", "typeEquals", t, [ left; right ], ?loc = r) | HasReferenceEquality com _ -> referenceEquals com ctx r left right | Nullable _ -> // transforms null checks into option tests @@ -1298,10 +1299,13 @@ let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "GetHashCode", Some arg, _ -> objectHash com ctx r arg |> Some | "GetType", Some arg, _ -> if arg.Type = Any then - "Types can only be resolved at compile time. At runtime this will be same as `typeof`" - |> addWarning com ctx.InlinePath r - - makeTypeInfo r arg.Type |> Some + // Dynamic type of a boxed value: resolve via the runtime reflection + // registry (populated by typeof). Returns the concrete type's info + // when registered, else the value as an opaque placeholder. + Helper.LibCall(com, "Reflection", "getTypeFromObj", t, [ arg ], ?loc = r) + |> Some + else + makeTypeInfo r arg.Type |> Some | _ -> None let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -2875,14 +2879,66 @@ let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opti let systemEnv (com: ICompiler) (ctx: Context) - (_: SourceLocation option) - (_: Type) + (r: SourceLocation option) + (t: Type) (i: CallInfo) (_: Expr option) - (_: Expr list) + (args: Expr list) = match i.CompiledName with | "get_NewLine" -> Some(makeStrConst "\n") + | "GetEnvironmentVariable" -> + Helper.LibCall(com, "Environment", "getEnvironmentVariable", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "get_CurrentDirectory" -> + Helper.LibCall(com, "Environment", "getCurrentDirectory", t, [], ?loc = r) + |> Some + | _ -> None + +let paths (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + match i.CompiledName with + | "Combine" -> + match args with + | [ _; _ ] -> + Helper.LibCall(com, "Path", "combine2", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | [ _; _; _ ] -> + Helper.LibCall(com, "Path", "combine3", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | _ -> None + | "GetDirectoryName" -> + Helper.LibCall(com, "Path", "getDirectoryName", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "GetFileName" -> + Helper.LibCall(com, "Path", "getFileName", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "GetFileNameWithoutExtension" -> + Helper.LibCall(com, "Path", "getFileNameWithoutExtension", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "GetExtension" -> + Helper.LibCall(com, "Path", "getExtension", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "HasExtension" -> + Helper.LibCall(com, "Path", "hasExtension", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "GetTempPath" -> Helper.LibCall(com, "Path", "getTempPath", t, [], ?loc = r) |> Some + | "GetRandomFileName" -> Helper.LibCall(com, "Path", "getRandomFileName", t, [], ?loc = r) |> Some + | _ -> None + +let files (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + match i.CompiledName with + | "Exists" -> + Helper.LibCall(com, "File", "exists", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "WriteAllText" -> + Helper.LibCall(com, "File", "writeAllText", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "ReadAllText" -> + Helper.LibCall(com, "File", "readAllText", t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | "Delete" -> + Helper.LibCall(com, "File", "delete", t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None // Initial support, making at least InvariantCulture compile-able @@ -3617,6 +3673,8 @@ let private replacedModules = Types.timespan, timeSpans "System.Timers.Timer", timers "System.Environment", systemEnv + "System.IO.File", files + "System.IO.Path", paths "System.Globalization.CultureInfo", globalization "System.Random", random "System.Threading.CancellationToken", cancels @@ -3695,13 +3753,34 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr fsharpType com methName r t info args else fsharpValue com methName r t info args - | "Microsoft.FSharp.Reflection.UnionCaseInfo" + | "Microsoft.FSharp.Reflection.UnionCaseInfo" -> + // UnionCaseInfo from a NewUnionCase quotation deconstruction is a Rust-native + // FSharpUnionCaseInfo carrier; route member access to the quotation runtime. + match thisArg, info.CompiledName with + | Some c, "get_Name" -> Helper.LibCall(com, "quotation", "unionCaseName", t, [ c ], ?loc = r) |> Some + | Some c, "get_Tag" -> Helper.LibCall(com, "quotation", "unionCaseTag", t, [ c ], ?loc = r) |> Some + | _ -> None | "System.Reflection.PropertyInfo" | "System.Reflection.ParameterInfo" | "System.Reflection.MethodBase" | "System.Reflection.MethodInfo" | "System.Reflection.MemberInfo" -> + // Name/DeclaringType are inherited from MemberInfo, so `mi.Name` / `mi.DeclaringType` + // on a Call quotation binding arrive here even though the binding's type is MethodInfo. + // Detect that carrier via the thisArg's Fable type and route to the quotation runtime: + // get_Name -> a dedicated accessor (not the generic reflection name()); DeclaringType + // -> the declaring-type fullname boxed as System.Type, so mi.DeclaringType.FullName works. + let isMethodInfoCarrier (c: Expr) = + match c.Type with + | DeclaredType(e, _) -> e.FullName = "System.Reflection.MethodInfo" + | _ -> false + match thisArg, info.CompiledName with + | Some c, "get_Name" when isMethodInfoCarrier c -> + Helper.LibCall(com, "quotation", "methodName", t, [ c ], ?loc = r) |> Some + | Some c, "get_DeclaringType" when isMethodInfoCarrier c -> + Helper.LibCall(com, "quotation", "methodDeclaringType", t, [ c ], ?loc = r) + |> Some | Some c, "get_Tag" -> makeStrConst "tag" |> getExpr r t c |> Some | Some c, "get_ReturnType" -> makeStrConst "returnType" |> getExpr r t c |> Some | Some c, "GetParameters" -> makeStrConst "parameters" |> getExpr r t c |> Some @@ -3714,9 +3793,12 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr match c with | Value(TypeInfo(exprType, _), loc) -> getTypeName com ctx loc exprType |> StringConstant |> makeValue r |> Some - | c -> Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) |> Some + // Runtime PropertyInfo (e.g. a record field info): read its carried name. + // Distinct from the generic type-name helper `name()` to avoid a clash. + | c -> Helper.LibCall(com, "Reflection", "propertyName", t, [ c ], ?loc = r) |> Some | _ -> None - | _ -> None + // F# Quotations + | typeName -> Quotations.tryQuotationCall "quotation" com ctx r t info thisArg args typeName let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = match ent.FullName with diff --git a/src/fable-library-rust/src/Async.rs b/src/fable-library-rust/src/Async.rs index b04f3eab4..bd539baea 100644 --- a/src/fable-library-rust/src/Async.rs +++ b/src/fable-library-rust/src/Async.rs @@ -165,8 +165,11 @@ pub mod Monitor_ { LOCKS.get_or_init(|| RwLock::new(HashSet::new())) } - pub fn enter(o: LrcPtr) { - let p = Arc::::as_ptr(&o) as usize; + // `?Sized` so a boxed `obj` (LrcPtr) can be locked on: casting to + // `*const ()` first discards the vtable of a fat pointer, leaving the data + // address, which is what identifies the lock. + pub fn enter(o: LrcPtr) { + let p = Arc::::as_ptr(&o) as *const () as usize; loop { let otherHasLock = try_init_and_get_locks().read().unwrap().get(&p).is_some(); if otherHasLock { @@ -178,8 +181,8 @@ pub mod Monitor_ { } } - pub fn exit(o: LrcPtr) { - let p = Arc::::as_ptr(&o) as usize; + pub fn exit(o: LrcPtr) { + let p = Arc::::as_ptr(&o) as *const () as usize; let hasRemoved = try_init_and_get_locks().write().unwrap().remove(&p); if (!hasRemoved) { panic!("Not removed {}", p) diff --git a/src/fable-library-rust/src/Environment.rs b/src/fable-library-rust/src/Environment.rs new file mode 100644 index 000000000..645e17d0e --- /dev/null +++ b/src/fable-library-rust/src/Environment.rs @@ -0,0 +1,21 @@ +#[cfg(not(feature = "no_std"))] +pub mod Environment_ { + use crate::Native_::NullableRef; + use crate::String_::{fromString, string}; + + // .NET's Environment.GetEnvironmentVariable returns null when the + // variable is not set, so we map a missing/invalid value to a null string. + pub fn getEnvironmentVariable(name: string) -> string { + match std::env::var(name.as_str()) { + Ok(value) => fromString(value), + Err(_) => ::null(), + } + } + + pub fn getCurrentDirectory() -> string { + match std::env::current_dir() { + Ok(path) => fromString(path.to_string_lossy().into_owned()), + Err(_) => string(""), + } + } +} diff --git a/src/fable-library-rust/src/Fable.Library.Rust.fsproj b/src/fable-library-rust/src/Fable.Library.Rust.fsproj index 0dffee411..30ccc1242 100644 --- a/src/fable-library-rust/src/Fable.Library.Rust.fsproj +++ b/src/fable-library-rust/src/Fable.Library.Rust.fsproj @@ -27,6 +27,8 @@ + + diff --git a/src/fable-library-rust/src/File.rs b/src/fable-library-rust/src/File.rs new file mode 100644 index 000000000..acdcfc42b --- /dev/null +++ b/src/fable-library-rust/src/File.rs @@ -0,0 +1,28 @@ +#[cfg(not(feature = "no_std"))] +pub mod File_ { + use crate::String_::{fromString, string}; + + pub fn exists(path: string) -> bool { + std::path::Path::new(path.as_str()).exists() + } + + pub fn writeAllText(path: string, contents: string) { + std::fs::write(path.as_str(), contents.as_str()) + .unwrap_or_else(|e| panic!("Could not write file '{}': {}", path.as_str(), e)) + } + + pub fn readAllText(path: string) -> string { + let contents = std::fs::read_to_string(path.as_str()) + .unwrap_or_else(|e| panic!("Could not read file '{}': {}", path.as_str(), e)); + fromString(contents) + } + + pub fn delete(path: string) { + // .NET File.Delete is a no-op when the file does not exist. + match std::fs::remove_file(path.as_str()) { + Ok(()) => {} + Err(e) if e.kind() == std::io::ErrorKind::NotFound => {} + Err(e) => panic!("Could not delete file '{}': {}", path.as_str(), e), + } + } +} diff --git a/src/fable-library-rust/src/Native.rs b/src/fable-library-rust/src/Native.rs index 42a249daf..a6c238300 100644 --- a/src/fable-library-rust/src/Native.rs +++ b/src/fable-library-rust/src/Native.rs @@ -704,6 +704,48 @@ pub mod Native_ { try_downcast::<_, T>(&o).unwrap().clone() } + // Boxing/unboxing for reference-typed (Lrc-wrapped) declared types such as + // records and unions. Unlike `box_`, which wraps the value in a fresh Lrc, + // these coerce the *same* smart pointer to `dyn Any`, so the boxed value's + // concrete pointee is the record/union struct itself. That lets a plain + // downcast recover it, and lets `TypeId::of::()` (computed at the typeof + // site) match the pointee's runtime type id for value-based reflection. + #[cfg(not(feature = "lrc_ptr"))] + pub fn box_lrc(o: LrcPtr) -> LrcPtr { + o + } + + // With the `lrc_ptr` feature LrcPtr is a wrapper without CoerceUnsized, so + // coerce the inner Rc/Arc (which has it) and re-wrap. Same allocation, so + // pointer identity and the pointee's runtime type id are both preserved. + #[cfg(feature = "lrc_ptr")] + pub fn box_lrc(o: LrcPtr) -> LrcPtr { + let inner: Lrc = Lrc::clone(&*o); + let coerced: Lrc = inner; + LrcPtr::from(coerced) + } + + pub fn unbox_lrc(o: LrcPtr) -> LrcPtr { + #[cfg(not(feature = "lrc_ptr"))] + let inner: Lrc = o; + #[cfg(feature = "lrc_ptr")] + let inner: Lrc = Lrc::clone(&*o); + + // Downcast the smart pointer itself rather than cloning the value, so + // box_lrc + unbox_lrc round-trips pointer identity (ReferenceEquals). + // SAFETY: the `is::` check guarantees the allocation's pointee is a T; + // casting the fat pointer to *const T only drops the vtable. This is what + // Rc::downcast does internally, done manually because Arc only offers a + // stable downcast for Send + Sync pointees. + if (*inner).is::() { + let raw = Lrc::into_raw(inner) as *const T; + let typed = unsafe { Lrc::from_raw(raw) }; + fromFluent(typed) + } else { + panic!("Invalid unbox") + } + } + pub fn ofObj(value: T) -> Option { if is_null(&value) { None:: diff --git a/src/fable-library-rust/src/Path.rs b/src/fable-library-rust/src/Path.rs new file mode 100644 index 000000000..d40f9d547 --- /dev/null +++ b/src/fable-library-rust/src/Path.rs @@ -0,0 +1,121 @@ +#[cfg(not(feature = "no_std"))] +pub mod Path_ { + use crate::String_::{fromString, string}; + + fn is_sep(c: char) -> bool { + c == '/' || c == '\\' + } + + // Index just after the last path separator, or 0 if none. + fn file_name_start(path: &str) -> usize { + match path.rfind(is_sep) { + Some(i) => i + 1, + None => 0, + } + } + + // .NET/JS-style: returns the substring after the last separator. + pub fn getFileName(path: string) -> string { + let s = path.as_str(); + fromString(s[file_name_start(s)..].to_string()) + } + + // Returns the directory portion (everything before the last separator), + // or an empty string when there is no separator. Trailing separators on + // the directory portion are trimmed, matching .NET semantics. + pub fn getDirectoryName(path: string) -> string { + let s = path.as_str(); + match s.rfind(is_sep) { + Some(i) => { + let dir = &s[..i]; + let dir = dir.trim_end_matches(is_sep); + fromString(dir.to_string()) + } + None => string(""), + } + } + + // Returns the extension including the leading dot, or an empty string. + // Matches Node's extname/.NET: a leading dot in the file name is not an + // extension (e.g. ".gitignore" has no extension). + pub fn getExtension(path: string) -> string { + let s = path.as_str(); + let name = &s[file_name_start(s)..]; + match name.rfind('.') { + Some(i) if i > 0 => fromString(name[i..].to_string()), + _ => string(""), + } + } + + pub fn getFileNameWithoutExtension(path: string) -> string { + let s = path.as_str(); + let name = &s[file_name_start(s)..]; + let stem = match name.rfind('.') { + Some(i) if i > 0 => &name[..i], + _ => name, + }; + fromString(stem.to_string()) + } + + pub fn hasExtension(path: string) -> bool { + let s = path.as_str(); + let name = &s[file_name_start(s)..]; + matches!(name.rfind('.'), Some(i) if i > 0) + } + + fn combine_str(a: &str, b: &str) -> String { + if a.is_empty() { + return b.to_string(); + } + if b.is_empty() { + return a.to_string(); + } + // .NET semantics: a rooted later argument discards the earlier one, + // e.g. Path.Combine("/foo", "/bar") == "/bar". + if b.starts_with(is_sep) { + return b.to_string(); + } + let a = a.trim_end_matches(is_sep); + format!("{}/{}", a, b) + } + + pub fn combine2(path1: string, path2: string) -> string { + fromString(combine_str(path1.as_str(), path2.as_str())) + } + + pub fn combine3(path1: string, path2: string, path3: string) -> string { + let ab = combine_str(path1.as_str(), path2.as_str()); + fromString(combine_str(&ab, path3.as_str())) + } + + pub fn getTempPath() -> string { + fromString(std::env::temp_dir().to_string_lossy().into_owned()) + } + + // Non-cryptographic randomness derived from the system clock and an + // atomic counter; good enough for unique temp file names. + fn rand_u64() -> u64 { + use core::sync::atomic::{AtomicU64, Ordering}; + static COUNTER: AtomicU64 = AtomicU64::new(0); + let nanos = std::time::SystemTime::now() + .duration_since(std::time::UNIX_EPOCH) + .map(|d| d.as_nanos() as u64) + .unwrap_or(0); + let c = COUNTER.fetch_add(1, Ordering::Relaxed); + let mut x = nanos ^ c.wrapping_mul(0x9E37_79B9_7F4A_7C15); + x ^= x >> 30; + x = x.wrapping_mul(0xBF58_476D_1CE4_E5B9); + x ^= x >> 27; + x = x.wrapping_mul(0x94D0_49BB_1331_11EB); + x ^= x >> 31; + x + } + + // Mirrors .NET's Path.GetRandomFileName(): 8 random hex chars, a dot, + // then 3 more random hex chars. + pub fn getRandomFileName() -> string { + let name = (rand_u64() as u32) & 0xFFFF_FFFF; + let ext = (rand_u64() as u32) & 0xFFF; + fromString(format!("{:08x}.{:03x}", name, ext)) + } +} diff --git a/src/fable-library-rust/src/Quotation.fs b/src/fable-library-rust/src/Quotation.fs new file mode 100644 index 000000000..f10f2e517 --- /dev/null +++ b/src/fable-library-rust/src/Quotation.fs @@ -0,0 +1,319 @@ +// F# quotation runtime for the Fable Rust target (functions). +// +// Authored in F# and transpiled by Fable so the FSharpExpr/FSharpVar types land at the +// right namespace and every mk*/is* signature matches what generated user code expects. +// The module is named `quotation_` to match the `libModule = "quotation"` import path. +module quotation_ + +open Microsoft.FSharp.Quotations + +// --- Var constructor + accessors --- + +let mkQuotVar (name: string) (typ: string) (isMutable: bool) : FSharpVar = + { + Name = name + Type = typ + IsMutable = isMutable + } + +let varGetName (v: FSharpVar) : string = v.Name +let varGetType (v: FSharpVar) : string = v.Type +let varGetIsMutable (v: FSharpVar) : bool = v.IsMutable + +// --- Expr constructors --- + +// Generic so callers can pass an unboxed literal (i32/bool/string/...); `box` erases +// it to obj. A non-generic obj parameter would require the caller to box, which the +// emitter does not do on statically typed targets. +let mkValue<'T> (value: 'T) (typ: string) : FSharpExpr = ExprValue(box value, typ) + +// A null-value node (no instance / null literal / empty option or list). +// The payload is a boxed sentinel (not a null literal, which the Rust target can't +// represent for an untyped obj); consumers distinguish null nodes by the type tag. +let mkNull (typ: string) : FSharpExpr = ExprValue(box 0, typ) + +let mkVar (v: FSharpVar) : FSharpExpr = ExprVarExpr v +let mkLambda (v: FSharpVar) (body: FSharpExpr) : FSharpExpr = ExprLambda(v, body) +let mkApplication (func: FSharpExpr) (arg: FSharpExpr) : FSharpExpr = ExprApplication(func, arg) +let mkLet (v: FSharpVar) (value: FSharpExpr) (body: FSharpExpr) : FSharpExpr = ExprLet(v, value, body) + +let mkIfThenElse (guard: FSharpExpr) (thenExpr: FSharpExpr) (elseExpr: FSharpExpr) : FSharpExpr = + ExprIfThenElse(guard, thenExpr, elseExpr) + +let mkCall (instance: FSharpExpr) (method: string) (args: FSharpExpr[]) (declaringType: string) : FSharpExpr = + ExprCall(instance, method, args, declaringType) + +let mkSequential (first: FSharpExpr) (second: FSharpExpr) : FSharpExpr = ExprSequential(first, second) + +// A correctly-typed empty argument array. Rust is statically typed, so an empty +// obj[] built by the emitter won't unify with the FSharpExpr[] parameters of +// mkCall/mkNewUnion/mkNewTuple (zero-arg calls like property getters, nullary +// union cases). The emitter routes empty expr-arrays here for the Rust target. +let emptyExprArray () : FSharpExpr[] = [||] + +let mkNewTuple (elements: FSharpExpr[]) : FSharpExpr = ExprNewTuple elements + +let mkNewUnion (typeName: string) (tag: int) (caseName: string) (fields: FSharpExpr[]) : FSharpExpr = + ExprNewUnion(typeName, tag, caseName, fields) + +let mkNewRecord (typeName: string) (fieldNames: string[]) (values: FSharpExpr[]) : FSharpExpr = + ExprNewRecord(typeName, fieldNames, values) + +// --- UnionCaseInfo accessors (backing uci.Name / uci.Tag on a NewUnionCase binding) --- + +let unionCaseName (u: FSharpUnionCaseInfo) : string = u.Name +let unionCaseTag (u: FSharpUnionCaseInfo) : int = u.Tag + +// --- MethodInfo accessors (backing mi.Name / mi.DeclaringType on a Call binding) --- + +// mi.Name -> string (dedicated accessor; distinct from the generic reflection name()). +let methodName (m: FSharpMethodInfo) : string = m.Name + +// mi.DeclaringType -> System.Type. Rust has no faithful System.Type runtime, so the +// declaring type is represented by its fullname string boxed as obj (System.Type erases +// to Any on Rust). mi.DeclaringType.FullName then routes to Reflection.fullName, which +// unboxes the string. +let methodDeclaringType (m: FSharpMethodInfo) : obj = box m.DeclaringType +let mkNewList (head: FSharpExpr) (tail: FSharpExpr) : FSharpExpr = ExprNewList(head, tail) +let mkTupleGet (e: FSharpExpr) (index: int) : FSharpExpr = ExprTupleGet(e, index) +let mkUnionTag (e: FSharpExpr) : FSharpExpr = ExprUnionTag e +let mkUnionField (e: FSharpExpr) (fieldIndex: int) : FSharpExpr = ExprUnionField(e, fieldIndex) +let mkFieldGet (e: FSharpExpr) (fieldName: string) : FSharpExpr = ExprFieldGet(e, fieldName) +let mkFieldSet (e: FSharpExpr) (fieldName: string) (value: FSharpExpr) : FSharpExpr = ExprFieldSet(e, fieldName, value) +let mkVarSet (target: FSharpExpr) (value: FSharpExpr) : FSharpExpr = ExprVarSet(target, value) + +// --- Type accessor --- + +let getType (e: FSharpExpr) : string = + match e with + | ExprValue(_, t) -> t + | ExprLambda(v, _) -> v.Type + | _ -> "obj" + +// --- Pattern helpers (return option, following the active-pattern convention) --- + +let isValue (e: FSharpExpr) = + match e with + | ExprValue(v, t) -> Some(v, t) + | _ -> None + +let isVar (e: FSharpExpr) = + match e with + | ExprVarExpr v -> Some v + | _ -> None + +let isLambda (e: FSharpExpr) = + match e with + | ExprLambda(v, b) -> Some(v, b) + | _ -> None + +let isApplication (e: FSharpExpr) = + match e with + | ExprApplication(f, a) -> Some(f, a) + | _ -> None + +let isLet (e: FSharpExpr) = + match e with + | ExprLet(v, value, body) -> Some(v, value, body) + | _ -> None + +let isIfThenElse (e: FSharpExpr) = + match e with + | ExprIfThenElse(g, t, el) -> Some(g, t, el) + | _ -> None + +let isCall (e: FSharpExpr) = + match e with + | ExprCall(instance, m, args, dt) -> + // A static/operator call carries the "novalue" node as its instance; + // expose it as None so Patterns.Call matches F#. The tag is distinct from + // "null", which is a genuine quoted null value. + let inst = + match instance with + | ExprValue(_, "novalue") -> None + | _ -> Some instance + + // Build the MethodInfo carrier from the stored compiled-name + declaring-type + // fullname, so the Call binding exposes the real F# shape (mi.Name / + // mi.DeclaringType.FullName). This is the SQLProvider linchpin: the declaring + // type distinguishes List.map from Array.map. + let mi: FSharpMethodInfo = + { + Name = m + DeclaringType = dt + } + + Some(inst, mi, List.ofArray args) + | _ -> None + +let isSequential (e: FSharpExpr) = + match e with + | ExprSequential(f, s) -> Some(f, s) + | _ -> None + +let isNewTuple (e: FSharpExpr) = + match e with + | ExprNewTuple els -> Some(List.ofArray els) + | _ -> None + +let isNewUnionCase (e: FSharpExpr) = + match e with + | ExprNewUnion(typeName, tag, caseName, fields) -> + // Return F#'s (UnionCaseInfo * Expr list) shape. The UnionCaseInfo carrier + // backs uci.Name/uci.Tag via unionCaseName/unionCaseTag. + let uci: FSharpUnionCaseInfo = + { + Name = caseName + Tag = tag + DeclaringType = typeName + } + + Some(uci, List.ofArray fields) + | _ -> None + +let isNewRecord (e: FSharpExpr) = + match e with + | ExprNewRecord(typeName, _names, values) -> + // Return F#'s (Type * Expr list) shape. Rust has no faithful System.Type runtime, + // so the type slot is erased to a boxed value (the record type name). The Rust + // compiler erases the pattern's System.Type slot to Any to match (see Replacements). + Some(box typeName, List.ofArray values) + | _ -> None + +let isTupleGet (e: FSharpExpr) = + match e with + | ExprTupleGet(inner, i) -> Some(inner, i) + | _ -> None + +let isFieldGet (e: FSharpExpr) = + match e with + | ExprFieldGet(inner, n) -> + // Return F#'s (Expr option * PropertyInfo * Expr list) shape, as JS/TS/Python do. + // A static property get carries the "novalue" node as its target (distinct from + // "null", a genuine quoted null); expose it as None so Patterns.PropertyGet matches + // F#. The third slot mirrors PropertyGet's indexer args, always empty here. + let inst = + match inner with + | ExprValue(_, "novalue") -> None + | _ -> Some inner + + let pi: FSharpPropertyInfo = { Name = n } + Some(inst, pi, ([]: FSharpExpr list)) + | _ -> None + +// --- Free variables --- + +let getFreeVars (e: FSharpExpr) : FSharpVar list = + let seen = System.Collections.Generic.HashSet() + let acc = ResizeArray() + + let rec walk (bound: Set) (e: FSharpExpr) = + match e with + | ExprVarExpr v -> + if not (bound.Contains v.Name) && seen.Add v.Name then + acc.Add v + | ExprLambda(v, body) -> walk (bound.Add v.Name) body + | ExprLet(v, value, body) -> + walk bound value + walk (bound.Add v.Name) body + | ExprApplication(f, a) -> + walk bound f + walk bound a + | ExprIfThenElse(g, t, el) -> + walk bound g + walk bound t + walk bound el + | ExprCall(_, _, args, _) -> + for a in args do + walk bound a + | ExprSequential(f, s) -> + walk bound f + walk bound s + | ExprNewTuple els -> + for el in els do + walk bound el + | ExprTupleGet(inner, _) -> walk bound inner + | ExprFieldGet(inner, _) -> walk bound inner + | _ -> () + + walk Set.empty e + List.ofSeq acc + +// --- Evaluation (structural cases + common operators; SQL translation deconstructs +// rather than evaluates, so this covers the tested subset). --- + +let private applyOperator (method: string) (args: obj list) : obj = + // Extract args positionally rather than binding them in the match: pattern-binding + // obj (Rc) variables makes Fable zero-initialize a fat pointer, which is + // invalid at runtime. Matching only on the method string avoids that. + // if/elif (not match): Fable-Rust would emit string literals as match patterns, + // which isn't valid Rust; an if-chain compiles to string == comparisons. + let i (n: int) : int = unbox (List.item n args) + let b (n: int) : bool = unbox (List.item n args) + + if method = "op_Addition" then + box (i 0 + i 1) + elif method = "op_Subtraction" then + box (i 0 - i 1) + elif method = "op_Multiply" then + box (i 0 * i 1) + elif method = "op_Division" then + box (i 0 / i 1) + elif method = "op_Modulus" then + box (i 0 % i 1) + elif method = "op_UnaryNegation" then + box (-(i 0)) + elif method = "op_Equality" then + box (i 0 = i 1) + elif method = "op_Inequality" then + box (i 0 <> i 1) + elif method = "op_LessThan" then + box (i 0 < i 1) + elif method = "op_LessThanOrEqual" then + box (i 0 <= i 1) + elif method = "op_GreaterThan" then + box (i 0 > i 1) + elif method = "op_GreaterThanOrEqual" then + box (i 0 >= i 1) + elif method = "op_BooleanAnd" then + box (b 0 && b 1) + elif method = "op_BooleanOr" then + box (b 0 || b 1) + elif method = "op_LogicalNot" then + box (not (b 0)) + else + failwithf "Cannot evaluate method: %s" method + +let evaluate (e: FSharpExpr) : obj = + let rec eval (env: Map) (e: FSharpExpr) : obj = + match e with + | ExprValue(v, _) -> v + | ExprVarExpr v -> Map.find v.Name env + | ExprLambda(v, body) -> box (fun (arg: obj) -> eval (Map.add v.Name arg env) body) + | ExprApplication(f, a) -> + let func = unbox obj> (eval env f) + func (eval env a) + | ExprLet(v, value, body) -> eval (Map.add v.Name (eval env value) env) body + | ExprIfThenElse(g, t, el) -> + if unbox (eval env g) then + eval env t + else + eval env el + | ExprSequential(a, b) -> + eval env a |> ignore + eval env b + | ExprCall(_, method, args, _) -> applyOperator method [ for a in args -> eval env a ] + // A tuple literal evaluates to a boxed obj[] of its evaluated elements, mirroring + // PHP (which produces a plain array). TupleGet then indexes into that array; without + // this arm `eval inner` on a tuple literal would fall through to failwith and there + // would be nothing indexable, so both arms are needed together. + | ExprNewTuple els -> box [| for el in els -> eval env el |] + | ExprTupleGet(inner, index) -> + // The match-bound `index` is a borrowed &i32 on Rust while the array Index + // operator wants an owned i32; `index + 0` forces an owned i32 rvalue (the + // arithmetic dereferences the borrow) so the indexing type-checks. + let i = index + 0 + (unbox (eval env inner)).[i] + | _ -> failwith "Cannot evaluate expression" + + eval Map.empty e diff --git a/src/fable-library-rust/src/QuotationTypes.fs b/src/fable-library-rust/src/QuotationTypes.fs new file mode 100644 index 000000000..d853a33b2 --- /dev/null +++ b/src/fable-library-rust/src/QuotationTypes.fs @@ -0,0 +1,65 @@ +// F# quotation AST types for the Fable Rust target. +// +// Declared in the Microsoft.FSharp.Quotations namespace with the *compiled* names +// (FSharpExpr / FSharpVar) that Fable maps the real FSharp.Core Quotations.Expr / .Var +// to on the Rust target. Using the compiled names (rather than Expr/Var) means no clash +// with FSharp.Core during F# type-checking, while still resolving to the same Rust path +// (Microsoft::FSharp::Quotations::FSharpExpr) that generated user code references. +namespace Microsoft.FSharp.Quotations + +type FSharpVar = + { + Name: string + Type: string + IsMutable: bool + } + +// Rust-native carrier for Microsoft.FSharp.Reflection.UnionCaseInfo. Fable-Rust +// erases the F# UnionCaseInfo type to this struct (see Fable2Rust.transformType), +// so `uci.Name`/`uci.Tag` on a NewUnionCase binding route to the accessors below. +type FSharpUnionCaseInfo = + { + Name: string + Tag: int + DeclaringType: string + } + +// Rust-native carrier for System.Reflection.MethodInfo. Fable-Rust erases the F# +// MethodInfo type to this struct (see Fable2Rust.transformType), so `mi.Name` and +// `mi.DeclaringType` on a Call quotation deconstruction route to the accessors in +// Quotation.fs. DeclaringType is stored as the declaring-type fullname string (the +// emitter fills it from declaringEntity.FullName, e.g. "...Collections.ListModule"). +type FSharpMethodInfo = + { + Name: string + DeclaringType: string + } + +// Rust-native carrier for System.Reflection.PropertyInfo. Fable-Rust erases the F# +// PropertyInfo type to this struct (see Fable2Rust.transformType), so it is the single +// carrier for both quotation deconstruction (PropertyGet's propInfo) and reflection +// (FSharpType.GetRecordFields), matching .NET where both yield the same PropertyInfo. +// It carries only the name, as a quotation knows nothing else about the property: the +// field getter is resolved from the reflection registry by name when a value is read, +// mirroring JS/TS where getValue(pi, v) reads v[pi.Name]. +type FSharpPropertyInfo = { Name: string } + +type FSharpExpr = + | ExprValue of value: obj * typ: string + | ExprVarExpr of var: FSharpVar + | ExprLambda of var: FSharpVar * body: FSharpExpr + | ExprApplication of func: FSharpExpr * arg: FSharpExpr + | ExprLet of var: FSharpVar * value: FSharpExpr * body: FSharpExpr + | ExprIfThenElse of guard: FSharpExpr * thenExpr: FSharpExpr * elseExpr: FSharpExpr + | ExprCall of instance: FSharpExpr * method: string * args: FSharpExpr[] * declaringType: string + | ExprSequential of first: FSharpExpr * second: FSharpExpr + | ExprNewTuple of elements: FSharpExpr[] + | ExprNewUnion of typeName: string * tag: int * caseName: string * fields: FSharpExpr[] + | ExprNewRecord of typeName: string * fieldNames: string[] * values: FSharpExpr[] + | ExprNewList of head: FSharpExpr * tail: FSharpExpr + | ExprTupleGet of expr: FSharpExpr * index: int + | ExprUnionTag of expr: FSharpExpr + | ExprUnionField of expr: FSharpExpr * fieldIndex: int + | ExprFieldGet of expr: FSharpExpr * fieldName: string + | ExprFieldSet of expr: FSharpExpr * fieldName: string * value: FSharpExpr + | ExprVarSet of target: FSharpExpr * value: FSharpExpr diff --git a/src/fable-library-rust/src/Reflection.rs b/src/fable-library-rust/src/Reflection.rs index 6a26cf05c..713b62ecc 100644 --- a/src/fable-library-rust/src/Reflection.rs +++ b/src/fable-library-rust/src/Reflection.rs @@ -1,11 +1,237 @@ pub mod Reflection_ { pub use core::any::TypeId; // re-export - //use crate::Native_::{LrcPtr}; + use crate::Microsoft::FSharp::Quotations::FSharpPropertyInfo; + use crate::Native_::{box_, Any, Func1, LrcPtr, Vec}; + use crate::NativeArray_::{array_from, Array}; use crate::String_::string; + #[cfg(not(feature = "no_std"))] + use core::cell::RefCell; + #[cfg(not(feature = "no_std"))] + use std::collections::HashMap; + pub fn name() -> string { // TODO: map some common type names to .NET type names string(core::any::type_name::()) } + + // The object (System.Object / obj) representation on the Rust target. + type obj = LrcPtr; + + // Compile-time helper emitted by `typeof` to obtain a concrete type id. + pub fn type_id() -> TypeId { + TypeId::of::() + } + + // PropertyInfo-like carrier for a single record field. + // `get` downcasts the boxed record and reads the field, returning it boxed. + #[derive(Clone)] + pub struct RecordFieldInfo { + pub name: string, + pub get: Func1, + } + + // Rich reflection info attached to `typeof`. Carries everything + // needed for MakeRecord (the `make` constructor closure) as well as + // GetRecordFields/GetRecordField (field names + per-field getters). + // This mirrors the JS/TS model where the reflected Type is an object + // carrying field metadata, so the same F# reflection code behaves the same. + #[derive(Clone)] + pub struct RecordTypeInfo { + pub tid: TypeId, + pub name: string, + pub fields: Array>, + pub make: Func1, obj>, + } + + // Registry mapping a record's *concrete* TypeId to its reflection info. + // Populated when `typeof` is evaluated. This is what makes + // value-based reflection (GetRecordFields(record)) possible: from a bare + // boxed record we can recover its runtime TypeId and look the info up. + // + // `thread_local!` is std-only, so under `no_std` there is no registry and + // the value-first entry points degrade (like exception catching does). + // Type-first reflection (typeof, MakeRecord, GetRecordElements) is + // unaffected, as those carry the info in the `System.Type` value itself. + #[cfg(not(feature = "no_std"))] + thread_local! { + static RECORD_REGISTRY: RefCell> = + RefCell::new(HashMap::new()); + } + + #[cfg(not(feature = "no_std"))] + fn registry_insert(tid: TypeId, info: RecordTypeInfo) { + RECORD_REGISTRY.with(|r| { + r.borrow_mut().insert(tid, info); + }); + } + + #[cfg(feature = "no_std")] + fn registry_insert(_tid: TypeId, _info: RecordTypeInfo) { + // no registry when no_std + } + + #[cfg(not(feature = "no_std"))] + fn registry_get(tid: &TypeId) -> Option { + RECORD_REGISTRY.with(|r| r.borrow().get(tid).cloned()) + } + + #[cfg(feature = "no_std")] + fn registry_get(_tid: &TypeId) -> Option { + None // no registry when no_std + } + + // Emitted by generated `typeof`. Builds the field metadata, registers + // the type by its concrete TypeId, and returns the boxed RecordTypeInfo + // (which is what a `System.Type` value holds on the Rust target). + pub fn recordType( + tid: TypeId, + name: string, + field_names: Array, + make: Func1, obj>, + getters: Array>, + ) -> obj { + let names: Vec = field_names.get().iter().cloned().collect(); + let gets: Vec> = getters.get().iter().cloned().collect(); + let fields_vec: Vec> = names + .into_iter() + .zip(gets.into_iter()) + .map(|(n, g)| LrcPtr::new(RecordFieldInfo { name: n, get: g })) + .collect(); + let info = RecordTypeInfo { + tid, + name, + fields: array_from(fields_vec), + make, + }; + registry_insert(tid, info.clone()); + box_(info) + } + + fn type_info_of(typ: &obj) -> RecordTypeInfo { + (**typ) + .downcast_ref::() + .expect("Type does not carry record reflection info") + .clone() + } + + // FSharpValue.MakeRecord(typ, values, ?bindingFlags) -> obj + pub fn makeRecord(typ: obj, values: Array, _flags: Option) -> obj { + let info = type_info_of(&typ); + (info.make)(values) + } + + // Resolves a field getter for a record value by property name, via the registry. + // The PropertyInfo carrier holds only a name (a quotation knows nothing more), so the + // getter is looked up here, mirroring JS/TS where getValue(pi, v) reads v[pi.Name]. + fn getterOf(record: &obj, name: &string) -> Func1 { + let tid = (**record).type_id(); + let info = registry_get(&tid).expect("Record type not registered; evaluate typeof first"); + let field = info + .fields + .get() + .iter() + .find(|f| &f.name == name) + .cloned() + .expect("Property not found on record type"); + field.get.clone() + } + + // FSharpType.GetRecordFields(typ, ?bindingFlags) -> PropertyInfo[] + pub fn getRecordElements(typ: obj, _flags: Option) -> Array> { + let info = type_info_of(&typ); + let props: Vec> = info + .fields + .get() + .iter() + .map(|f| LrcPtr::new(FSharpPropertyInfo { Name: f.name.clone() })) + .collect(); + array_from(props) + } + + // FSharpValue.GetRecordFields(record, ?bindingFlags) -> obj[] + pub fn getRecordFields(record: obj, _flags: Option) -> Array { + let tid = (*record).type_id(); + let info = registry_get(&tid).expect("Record type not registered; evaluate typeof first"); + let vals: Vec = info + .fields + .get() + .iter() + .map(|f| (f.get)(record.clone())) + .collect(); + array_from(vals) + } + + // FSharpValue.GetRecordField(record, propInfo) -> obj + pub fn getRecordField(record: obj, info: LrcPtr) -> obj { + let get = getterOf(&record, &info.Name); + get(record) + } + + // PropertyInfo.Name -> string (dedicated accessor; distinct from name()). + pub fn propertyName(info: LrcPtr) -> string { + info.Name.clone() + } + + // PropertyInfo.GetValue(record) -> obj + pub fn getValue(info: LrcPtr, record: obj) -> obj { + let get = getterOf(&record, &info.Name); + get(record) + } + + // FSharpType.IsRecord(typ) -> bool + pub fn isRecord(typ: obj, _flags: Option) -> bool { + (*typ).downcast_ref::().is_some() + } + + // System.Type.FullName. On Rust a `System.Type` value is a boxed carrier: a record + // type carries RecordTypeInfo (use its registered name), while a quotation-derived + // declaring type (from MethodInfo.DeclaringType) carries the boxed fullname string. + pub fn fullName(typ: obj) -> string { + if let Some(info) = (*typ).downcast_ref::() { + info.name.clone() + } else if let Some(s) = (*typ).downcast_ref::() { + s.clone() + } else { + crate::String_::string("") + } + } + + // obj.GetType() for a statically-erased value (static type = obj/Any). + // Reads the boxed value's *runtime* type id and returns the concrete type's + // registered reflection info, so `(box record : obj).GetType()` resolves to + // the real record type (not typeof) whenever that type was registered + // via a prior `typeof`. Falls back to returning the object itself as an + // opaque placeholder for unregistered types. + pub fn getTypeFromObj(o: obj) -> obj { + let tid = (*o).type_id(); + match registry_get(&tid) { + Some(info) => box_(info), + None => o, + } + } + + // System.Type equality (typeof = typeof). Compares the carried concrete + // TypeId when both operands are record type infos; otherwise falls back to + // comparing the boxed values' runtime type ids. + pub fn typeEquals(a: obj, b: obj) -> bool { + let ta = (*a).downcast_ref::(); + let tb = (*b).downcast_ref::(); + match (ta, tb) { + (Some(x), Some(y)) => x.tid == y.tid, + (None, None) => { + // Non-record `System.Type` values carry a boxed concrete `TypeId`. + // Downcast both and compare the *carried* ids; comparing the boxed + // carriers' runtime `type_id()` would always be `TypeId::of::()` + // and therefore make every non-record type compare equal. + match ((*a).downcast_ref::(), (*b).downcast_ref::()) { + (Some(x), Some(y)) => x == y, + _ => (*a).type_id() == (*b).type_id(), + } + } + // One record, one non-record: definitely different types. + _ => false, + } + } } diff --git a/src/fable-library-rust/src/lib.fs b/src/fable-library-rust/src/lib.fs index d207dc846..215ee790d 100644 --- a/src/fable-library-rust/src/lib.fs +++ b/src/fable-library-rust/src/lib.fs @@ -14,7 +14,9 @@ let _imports () = importAll "./Decimal.rs" importAll "./Format.rs" importAll "./Encoding.rs" + importAll "./Environment.rs" importAll "./Exception.rs" + importAll "./File.rs" importAll "./Guid.rs" importAll "./HashMap.rs" importAll "./HashSet.rs" @@ -22,6 +24,7 @@ let _imports () = importAll "./Native.rs" importAll "./NativeArray.rs" importAll "./Numeric.rs" + importAll "./Path.rs" importAll "./Random.rs" importAll "./Reflection.rs" importAll "./RegExp.rs" diff --git a/tests/Rust/Fable.Tests.Rust.fsproj b/tests/Rust/Fable.Tests.Rust.fsproj index c4e4ee646..14158ae8a 100644 --- a/tests/Rust/Fable.Tests.Rust.fsproj +++ b/tests/Rust/Fable.Tests.Rust.fsproj @@ -44,6 +44,7 @@ + @@ -58,10 +59,12 @@ + + @@ -71,6 +74,7 @@ + diff --git a/tests/Rust/tests/src/EnvironmentTests.fs b/tests/Rust/tests/src/EnvironmentTests.fs new file mode 100644 index 000000000..0d2437d45 --- /dev/null +++ b/tests/Rust/tests/src/EnvironmentTests.fs @@ -0,0 +1,22 @@ +// System.Environment reads process state, so the library module is std-only +// and these tests do not apply to no_std builds. +[] +module Fable.Tests.EnvironmentTests + +open Util.Testing +open System + +[] +let ``Environment.NewLine works`` () = + Environment.NewLine.Length > 0 + |> equal true + +[] +let ``Environment.GetEnvironmentVariable returns null for a missing variable`` () = + Environment.GetEnvironmentVariable("__FABLE_NON_EXISTENT_VAR__") + |> equal null + +[] +let ``Environment.CurrentDirectory works`` () = + Environment.CurrentDirectory.Length > 0 + |> equal true diff --git a/tests/Rust/tests/src/QuotationTests.fs b/tests/Rust/tests/src/QuotationTests.fs new file mode 100644 index 000000000..353a081eb --- /dev/null +++ b/tests/Rust/tests/src/QuotationTests.fs @@ -0,0 +1,356 @@ +module Fable.Tests.QuotationTests + +open Util.Testing +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns +open Microsoft.FSharp.Linq.RuntimeHelpers + +// NOTE: quotations are deconstructed through an untyped `Expr` parameter (helpers below +// take `(e: Expr)`); matching a typed `Expr<'T>` binding directly is not yet supported on +// Rust (see quotation notes). Binding the boxed `obj` payload out of a Value node now works +// (the getZeroObj fix); the type element is bound as a wildcard since the runtime models it +// as a string rather than System.Type. Array-valued nodes now deconstruct: NewTuple exposes +// its elements, NewUnionCase binds a real UnionCaseInfo (uci.Name / uci.Tag) plus its args, and +// NewRecord binds its (erased) type slot plus its args. The NewRecord type slot and +// UnionCaseInfo.GetFields() are not modelled (System.Type / PropertyInfo have no Rust runtime). + +let private lambdaVarName (e: Expr) = + match e with + | Lambda(v, _body) -> v.Name + | _ -> "?" + +let private letVarName (e: Expr) = + match e with + | Let(v, _value, _body) -> v.Name + | _ -> "?" + +let private isIfThenElseNode (e: Expr) = + match e with + | IfThenElse(_g, _t, _e) -> true + | _ -> false + +[] +let ``Evaluate a value`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 42 @> + unbox r |> equal 42 + +// Typed Expr<'T> matched directly (not routed through an (e: Expr) helper): the type +// argument is erased so the quotation shares the untyped FSharpExpr representation. + +[] +let ``Typed quotation matches Value directly`` () = + match <@ 42 @> with + | Value(v, _) -> unbox v |> equal 42 + | _ -> failwith "Expected Value" + +[] +let ``Typed quotation matches Lambda directly`` () = + match <@ fun (x: int) -> x + 1 @> with + | Lambda(v, _) -> v.Name |> equal "x" + | _ -> failwith "Expected Lambda" + +[] +let ``Lambda quotation exposes the parameter name`` () = + lambdaVarName <@ fun (x: int) -> x + 1 @> |> equal "x" + +[] +let ``Let quotation exposes the bound name`` () = + letVarName <@ let y = 5 in y + 1 @> |> equal "y" + +[] +let ``IfThenElse quotation deconstructs`` () = + isIfThenElseNode <@ if true then 1 else 2 @> |> equal true + +[] +let ``Evaluate addition`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 2 + 3 @> + unbox r |> equal 5 + +[] +let ``Evaluate subtraction`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 10 - 4 @> + unbox r |> equal 6 + +[] +let ``Evaluate comparison`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 5 > 3 @> + unbox r |> equal true + +[] +let ``Evaluate let binding`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let x = 10 in x + 5 @> + unbox r |> equal 15 + +[] +let ``Evaluate lambda application`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ (fun a -> a * 2) 21 @> + unbox r |> equal 42 + +[] +let ``Evaluate let-bound lambda`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let f = (fun x -> x + 1) in f 41 @> + unbox r |> equal 42 + +// --- Parity expansion (toward the Python 27) --- +// Binding the boxed obj payload out of a Value node previously tripped getZero on Rust; +// the getZeroObj / active-pattern fixes should now allow these. Type element bound as +// wildcard (`Value(v, _)`) to sidestep the System.Type-vs-string model difference. + +let private valueInt (e: Expr) = + match e with + | Value(v, _) -> unbox v + | _ -> -1 + +let private valueBool (e: Expr) = + match e with + | Value(v, _) -> unbox v + | _ -> false + +let private valueStr (e: Expr) = + match e with + | Value(v, _) -> unbox v + | _ -> "?" + +let private letBoundInt (e: Expr) = + match e with + | Let(_, Value(v, _), _) -> unbox v + | _ -> -1 + +let private seqSecondInt (e: Expr) = + match e with + | Sequential(_, Value(v, _)) -> unbox v + | _ -> -1 + +let private newTupleLen (e: Expr) = + match e with + | NewTuple(exprs) -> List.length exprs + | _ -> -1 + +let private isAppLambdaValue (e: Expr) = + match e with + | Application(Lambda _, Value _) -> true + | _ -> false + +let private lambdaVarBodyName (e: Expr) = + match e with + | Lambda(v, Var v2) -> v.Name + "/" + v2.Name + | _ -> "?" + +let private isLambdaIfThenElse (e: Expr) = + match e with + | Lambda(_, IfThenElse(_, _, _)) -> true + | _ -> false + +[] +let ``Value node binds int payload`` () = + valueInt <@ 42 @> |> equal 42 + +[] +let ``Value node binds bool payload`` () = + valueBool <@ true @> |> equal true + +[] +let ``Value node binds string payload`` () = + valueStr <@ "hello" @> |> equal "hello" + +[] +let ``Let binds value node payload`` () = + letBoundInt <@ let x = 5 in x @> |> equal 5 + +[] +let ``Sequential exposes second value payload`` () = + seqSecondInt <@ (); 42 @> |> equal 42 + +[] +let ``NewTuple exposes element count`` () = + newTupleLen <@ (1, 2, 3) @> |> equal 3 + +[] +let ``Application of lambda to value deconstructs`` () = + isAppLambdaValue <@ (fun x -> x) 42 @> |> equal true + +[] +let ``Lambda body Var refers to the parameter`` () = + lambdaVarBodyName <@ fun x -> x @> |> equal "x/x" + +[] +let ``Option match in quotation lowers to IfThenElse`` () = + isLambdaIfThenElse <@ fun (o: int option) -> match o with Some v -> v | None -> 0 @> |> equal true + +[] +let ``Literal match in quotation lowers to IfThenElse`` () = + isLambdaIfThenElse <@ fun (x: int) -> match x with 0 -> "zero" | _ -> "other" @> |> equal true + +[] +let ``Evaluate multiplication`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 6 * 7 @> + unbox r |> equal 42 + +[] +let ``Evaluate nested let bindings`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let x = 3 in let y = 4 in x * y @> + unbox r |> equal 12 + +[] +let ``Evaluate nested lambda`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ (fun x -> (fun y -> x + y)) 3 4 @> + unbox r |> equal 7 + +// --- NewUnionCase / NewRecord deconstruction --- + +type private MyRec = { X: int; Y: int } + +let private newUnionCaseName (e: Expr) = + match e with + | NewUnionCase(uci, _args) -> uci.Name + | _ -> "?" + +let private newUnionCaseArgCount (e: Expr) = + match e with + | NewUnionCase(_uci, args) -> List.length args + | _ -> -1 + +let private newUnionCaseTag (e: Expr) = + match e with + | NewUnionCase(uci, _args) -> uci.Tag + | _ -> -1 + +let private newRecordArgCount (e: Expr) = + match e with + | NewRecord(_t, args) -> List.length args + | _ -> -1 + +[] +let ``NewUnionCase exposes the case name`` () = + newUnionCaseName <@ Some 42 @> |> equal "Some" + +[] +let ``NewUnionCase exposes the argument count`` () = + newUnionCaseArgCount <@ Some 42 @> |> equal 1 + +[] +let ``NewUnionCase exposes the tag`` () = + newUnionCaseTag <@ Some 42 @> |> equal 1 + +[] +let ``NewRecord exposes the argument count`` () = + newRecordArgCount <@ ({ X = 1; Y = 2 }: MyRec) @> |> equal 2 + +// --- TupleGet evaluation (B3) --- +// A tuple-deconstructing let lowers to a NewTuple bound to a var, then TupleGet nodes +// pulling out each element. Evaluating it exercises both the ExprNewTuple arm (builds a +// boxed obj[]) and the ExprTupleGet arm (indexes into it). Before the fix, TupleGet +// returned the whole tuple, so `a`/`b` were the obj[] and `a + b` would not evaluate. + +[] +let ``Evaluate tuple-get picks the element at the index`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let (a, b) = (10, 20) in a + b @> + unbox r |> equal 30 + +[] +let ``Evaluate tuple-get picks the second element`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let (a, b, c) = (1, 2, 3) in b @> + unbox r |> equal 2 + +// --- Call deconstruction with MethodInfo (B1) --- +// Deconstructing a Call now binds a real MethodInfo: mi.Name is the compiled method name and +// mi.DeclaringType.FullName is the declaring module fullname. The declaring type is the +// SQLProvider linchpin: it distinguishes List.map from Array.map. MethodInfo erases to the +// Rust-native FSharpMethodInfo carrier; DeclaringType is the fullname string boxed as +// System.Type (System.Type erases to Any), read back via Reflection.fullName. + +let private callMethodName (e: Expr) = + match e with + | Call(_, mi, _) -> mi.Name + | _ -> "?" + +let private callDeclaringTypeName (e: Expr) = + match e with + | Call(_, mi, _) -> mi.DeclaringType.FullName + | _ -> "?" + +[] +let ``Call exposes the method name`` () = + callMethodName <@ List.map (fun x -> x + 1) [ 1 ] @> |> equal "Map" + +[] +let ``Call exposes the declaring type full name`` () = + callDeclaringTypeName <@ List.map (fun x -> x + 1) [ 1 ] @> + |> equal "Microsoft.FSharp.Collections.ListModule" + +[] +let ``Call distinguishes List.map from Array.map by declaring type`` () = + callDeclaringTypeName <@ Array.map (fun x -> x + 1) [| 1 |] @> + |> equal "Microsoft.FSharp.Collections.ArrayModule" + +[] +let ``Call binds MethodInfo directly`` () = + match <@ List.map (fun x -> x + 1) [ 1 ] @> with + | Call(_, mi, _) -> + mi.Name |> equal "Map" + mi.DeclaringType.FullName |> equal "Microsoft.FSharp.Collections.ListModule" + | _ -> failwith "Expected Call" + +// --- PropertyGet (isFieldGet) --- +// A property getter deconstructs as PropertyGet(instance, propInfo, indexerArgs), matching +// real F# quotations and the JS/TS/Python runtimes. System.Reflection.PropertyInfo erases to +// the shared FSharpPropertyInfo carrier, so pi.Name works here exactly as it does for the +// PropertyInfo values returned by FSharpType.GetRecordFields. + +type QuotPropHolder = + static member Version = 42 + +[] +let ``Option.Value access inside a quotation is a PropertyGet`` () = + let q = <@ fun (o: int option) -> o.Value @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +[] +let ``List.Head access inside a quotation is a PropertyGet`` () = + let q = <@ fun (xs: int list) -> xs.Head @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +// A static property carries the "novalue" no-instance sentinel as its target, which must +// surface as None rather than Some sentinelNode. +[] +let ``Static property access inside a quotation is a PropertyGet with no instance`` () = + let q = <@ QuotPropHolder.Version @> + + match q with + | PropertyGet(None, _, []) -> () + | _ -> failwith "Expected PropertyGet with no instance" + +[] +let ``PropertyGet exposes the property name`` () = + let q = <@ fun (o: int option) -> o.Value @> + + match q with + | Lambda(_, PropertyGet(_, pi, _)) -> pi.Name |> equal "Value" + | _ -> failwith "Expected Lambda with PropertyGet body" + +// --- Call instance slot (isCall) --- +// A static call carries the "novalue" no-instance sentinel as its instance, which must +// surface as None rather than Some sentinelNode — the isCall counterpart of the static +// PropertyGet test above. The instance case proves the sentinel is not over-applied. + +[] +let ``Static call inside a quotation has no instance`` () = + let q = <@ List.length [ 1; 2; 3 ] @> + + match q with + | Call(None, _mi, args) -> equal 1 (List.length args) + | _ -> failwith "Expected a static Call with no instance" + +[] +let ``Instance call inside a quotation has an instance`` () = + let q = <@ fun (s: string) -> s.Trim() @> + + match q with + | Lambda(_, Call(Some _, _mi, _)) -> () + | _ -> failwith "Expected Lambda with an instance Call body" diff --git a/tests/Rust/tests/src/RecordReflectionTests.fs b/tests/Rust/tests/src/RecordReflectionTests.fs new file mode 100644 index 000000000..bfa746282 --- /dev/null +++ b/tests/Rust/tests/src/RecordReflectionTests.fs @@ -0,0 +1,125 @@ +// Value-based reflection needs the type registry, which is std-only +// (it uses thread_local), so these tests do not apply to no_std builds. +[] +module Fable.Tests.RecordReflectionTests + +open Util.Testing +open Microsoft.FSharp.Reflection + +// Record reflection MVP for the Rust target. Mirrors the record-focused cases of +// the (disabled) ReflectionTests.fs / JS Main ReflectionTests.fs. Value comparisons +// are done after unbox<'T> rather than on boxed `obj` directly, because Rust has no +// structural equality on `dyn Any` (see report). Behaviour is otherwise equivalent. + +type TestRecord = { String: string; Int: int } +type OtherRecord = { Z: int } + +type SampleUnion = + | CaseA + | CaseB of int + +[] +let ``typeof and System.Type equality on records`` () = + (typeof = typeof) |> equal true + (typeof = typeof) |> equal false + +[] +let ``typeof and System.Type equality on non-record types`` () = + // A non-record `typeof` must materialize as a valid runtime value (a boxed + // TypeId), and equality must distinguish types rather than always being equal. + let t = typeof + ignore t + (typeof = typeof) |> equal true + (typeof = typeof) |> equal false + (typeof = typeof) |> equal true + (typeof = typeof) |> equal false + // Mixed record / non-record must not compare equal. + (typeof = typeof) |> equal false + +[] +let ``FSharpType.IsRecord works`` () = + FSharpType.IsRecord(typeof) |> equal true + +[] +let ``FSharpType.GetRecordFields exposes PropertyInfo names`` () = + let fields = FSharpType.GetRecordFields(typeof) + fields.Length |> equal 2 + fields.[0].Name |> equal "String" + fields.[1].Name |> equal "Int" + +[] +let ``FSharpValue.GetRecordFields returns boxed field values`` () = + // Value-based reflection resolves the type via the runtime registry, which is + // populated when typeof is evaluated (as the JS record test also does first). + FSharpType.IsRecord(typeof) |> equal true + let record = { String = "a"; Int = 1 } + let values = FSharpValue.GetRecordFields(record) + values.Length |> equal 2 + unbox values.[0] |> equal "a" + unbox values.[1] |> equal 1 + +[] +let ``FSharpValue.GetRecordField reads an individual field`` () = + let record = { String = "a"; Int = 1 } + let fields = FSharpType.GetRecordFields(typeof) + unbox (FSharpValue.GetRecordField(record, fields.[0])) |> equal "a" + unbox (FSharpValue.GetRecordField(record, fields.[1])) |> equal 1 + +[] +let ``PropertyInfo.GetValue reads a field from a boxed record`` () = + let record = { String = "a"; Int = 1 } + let fields = FSharpType.GetRecordFields(typeof) + unbox (fields.[0].GetValue(box record)) |> equal "a" + unbox (fields.[1].GetValue(box record)) |> equal 1 + +[] +let ``FSharpValue.MakeRecord round-trips`` () = + let record = { String = "a"; Int = 1 } + let values = FSharpValue.GetRecordFields(record) + let rebuilt = unbox (FSharpValue.MakeRecord(typeof, values)) + rebuilt |> equal record + +[] +let ``FSharp.Reflection: Record (end to end)`` () = + let record = { String = "a"; Int = 1 } + let recordTypeFields = FSharpType.GetRecordFields(typeof) + let recordValueFields = FSharpValue.GetRecordFields(record) + + FSharpType.IsRecord(typeof) |> equal true + recordTypeFields.Length |> equal 2 + + // field names line up with values (verified per-slot, unboxed) + recordTypeFields.[0].Name |> equal "String" + unbox recordValueFields.[0] |> equal "a" + recordTypeFields.[1].Name |> equal "Int" + unbox recordValueFields.[1] |> equal 1 + + // GetRecordField matches GetRecordFields per slot + unbox (FSharpValue.GetRecordField(record, recordTypeFields.[0])) |> equal "a" + unbox (FSharpValue.GetRecordField(record, recordTypeFields.[1])) |> equal 1 + + // MakeRecord reconstructs an equal record + unbox (FSharpValue.MakeRecord(typeof, recordValueFields)) |> equal record + +[] +let ``obj.GetType round-trips to the concrete record type`` () = + let record = { String = "a"; Int = 1 } + FSharpType.IsRecord(typeof) |> equal true // ensure registration + ((box record).GetType() = typeof) |> equal true + let rebuilt = + unbox (FSharpValue.MakeRecord((box record).GetType(), FSharpValue.GetRecordFields(record))) + rebuilt |> equal record + +// box_lrc/unbox_lrc coerce the same smart pointer rather than cloning the value, +// so a record boxed to obj and unboxed again is physically the same instance. +[] +let ``Boxing a record to obj and unboxing preserves reference identity`` () = + let r = + { + String = "a" + Int = 1 + } + + let o: obj = box r + let r2 = unbox o + System.Object.ReferenceEquals(r, r2) |> equal true diff --git a/tests/Rust/tests/src/SystemIOTests.fs b/tests/Rust/tests/src/SystemIOTests.fs new file mode 100644 index 000000000..4fcfadb38 --- /dev/null +++ b/tests/Rust/tests/src/SystemIOTests.fs @@ -0,0 +1,83 @@ +// System.IO needs a filesystem, so the library modules are std-only and +// these tests do not apply to no_std builds. +[] +module Fable.Tests.SystemIOTests + +open Util.Testing +open System.IO + +[] +let ``Path.Combine works with two parts`` () = + let combined = Path.Combine("foo", "bar") + Path.GetFileName(combined) |> equal "bar" + Path.GetDirectoryName(combined) |> equal "foo" + +[] +let ``Path.Combine works with three parts`` () = + let combined = Path.Combine("foo", "bar", "baz.txt") + Path.GetFileName(combined) |> equal "baz.txt" + Path.GetDirectoryName(combined) |> equal (Path.Combine("foo", "bar")) + +[] +let ``Path.Combine with a rooted second part uses the second part`` () = + // .NET: a rooted later argument discards the earlier one. + Path.Combine("/foo", "/bar") |> equal "/bar" + Path.Combine("foo", "/bar") |> equal "/bar" + +[] +let ``Path.GetDirectoryName works`` () = + Path.GetDirectoryName("temp/test.txt") + |> equal "temp" + +[] +let ``Path.GetExtension works`` () = + Path.GetExtension("temp/test.txt") + |> equal ".txt" + +[] +let ``Path.GetFileName works`` () = + Path.GetFileName("temp/test.txt") + |> equal "test.txt" + +[] +let ``Path.GetFileNameWithoutExtension works`` () = + Path.GetFileNameWithoutExtension("temp/test.txt") + |> equal "test" + +[] +let ``Path.HasExtension works`` () = + Path.HasExtension("temp/test.txt") + |> equal true + + Path.HasExtension("temp/test") + |> equal false + +[] +let ``Path.GetTempPath works`` () = + (Path.GetTempPath()).Length > 0 + |> equal true + +[] +let ``Path.GetRandomFileName works`` () = + (Path.GetRandomFileName()).Length > 0 + |> equal true + +[] +let ``File round-trip works`` () = + let file = Path.Combine(Path.GetTempPath(), Path.GetRandomFileName()) + File.Exists(file) |> equal false + + File.WriteAllText(file, "Hello World") + File.Exists(file) |> equal true + + File.ReadAllText(file) + |> equal "Hello World" + + File.Delete(file) + File.Exists(file) |> equal false + +[] +let ``File.Delete on a missing file is a no-op`` () = + // .NET semantics: deleting a non-existent file does not throw. + File.Delete("definitely-missing-file-xyz.tmp") + true |> equal true