diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 930019c..383651b 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -8,12 +8,6 @@ "dotnet-format" ] }, - "fantomas-tool": { - "version": "5.0.0-alpha-002", - "commands": [ - "fantomas" - ] - }, "fantomas": { "version": "6.0.5", "commands": [ @@ -21,4 +15,4 @@ ] } } -} \ No newline at end of file +} diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 5c27ed0..542be3c 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -55,7 +55,7 @@ jobs: # https://github.com/dotnet/fsharp/issues/12320 dotnet pack --configuration $(configuration) --output=$(Build.ArtifactStagingDirectory) # Check code format. Fantomas for F#, dotnet-format for C# - dotnet tool run fantomas --check --recurse . + dotnet tool run fantomas --check . dotnet tool run dotnet-format --check - task: PublishTestResults@2 condition: always() diff --git a/src/Feersum.CompilerServices/Binding/Binder.fs b/src/Feersum.CompilerServices/Binding/Binder.fs index d52c4f7..f6d9b4f 100644 --- a/src/Feersum.CompilerServices/Binding/Binder.fs +++ b/src/Feersum.CompilerServices/Binding/Binder.fs @@ -146,15 +146,13 @@ module private BinderCtx = let private incEnvSize = function | None -> Some(1) - | Some (size) -> Some(size + 1) + | Some(size) -> Some(size + 1) /// Transofmr the name to make it safe for .NET. let mangleName name = let mangleNamePart = id - name - |> Seq.map (mangleNamePart) - |> String.concat "::" + name |> Seq.map (mangleNamePart) |> String.concat "::" /// Create a new binder context for the given root scope let createForGlobalScope scope libs name = @@ -187,19 +185,18 @@ module private BinderCtx = /// Lookup a given ID in the binder scope let rec tryFindBinding ctx id = - Scope.find ctx.Scope id - |> Option.orElseWith (fun () -> parentLookup ctx id) + Scope.find ctx.Scope id |> Option.orElseWith (fun () -> parentLookup ctx id) and private parentLookup ctx id = match ctx.Parent with - | Some (parent) -> + | Some(parent) -> match tryFindBinding parent id with - | Some (outer) -> + | Some(outer) -> match outer with - | Captured (_) - | Arg (_) - | Local (_) - | Environment (_) -> + | Captured(_) + | Arg(_) + | Local(_) + | Environment(_) -> ctx.Captures <- outer :: ctx.Captures ctx.HasDynamicEnv <- true Some(StorageRef.Captured(outer)) @@ -256,11 +253,7 @@ module private BinderCtx = /// Convert the binder context into a bound root around the given expression let intoRoot ctx expr = - let env = - if ctx.HasDynamicEnv then - Some([]) - else - None + let env = if ctx.HasDynamicEnv then Some([]) else None { Body = expr Locals = ctx.LocalCount @@ -291,14 +284,14 @@ module private Impl = "Only expect single ID after dot" match formal.Kind with - | AstNodeKind.Ident (id) -> (formals, true, Some(id)) + | AstNodeKind.Ident(id) -> (formals, true, Some(id)) | _ -> ctx.Diagnostics.Emit BinderDiagnostics.patternBindError formal.Location "Expected ID after dot" acc else match formal.Kind with | AstNodeKind.Dot -> (formals, true, None) - | AstNodeKind.Ident (id) -> (id :: formals, false, None) + | AstNodeKind.Ident(id) -> (id :: formals, false, None) | _ -> ctx.Diagnostics.Emit BinderDiagnostics.patternBindError @@ -312,7 +305,7 @@ module private Impl = if sawDot then match dotted with - | Some (d) -> BoundFormals.DottedList(fmls, d) + | Some(d) -> BoundFormals.DottedList(fmls, d) | None -> ctx.Diagnostics.Emit BinderDiagnostics.patternBindError @@ -332,8 +325,8 @@ module private Impl = /// * Any of the list patterns supported by `bindFormalsList` let private bindFormals ctx formals = match formals.Kind with - | AstNodeKind.Ident (id) -> BoundFormals.Simple(id) - | AstNodeKind.Form (formals) -> bindFormalsList ctx formals + | AstNodeKind.Ident(id) -> BoundFormals.Simple(id) + | AstNodeKind.Form(formals) -> bindFormalsList ctx formals | _ -> "Unrecognised formal parameter list. Must be an ID or list pattern" |> ctx.Diagnostics.Emit BinderDiagnostics.invalidParameterPattern formals.Location @@ -346,7 +339,7 @@ module private Impl = // Bind each of the definitions let parseBindingSpec decl bindings = match decl with - | { Kind = AstNodeKind.Form (binding) } -> + | { Kind = AstNodeKind.Form(binding) } -> match binding with | [ { Kind = AstNodeKind.Ident id }; body ] -> (id, body) :: bindings | _ -> @@ -357,7 +350,7 @@ module private Impl = bindings match node with - | { Kind = AstNodeKind.Form (decls) } -> List.foldBack (parseBindingSpec) decls [] + | { Kind = AstNodeKind.Form(decls) } -> List.foldBack (parseBindingSpec) decls [] | _ -> ctx.Diagnostics.Emit BinderDiagnostics.letBindError node.Location "Expected binding list" [] @@ -379,10 +372,7 @@ module private Impl = match node.Kind with | AstNodeKind.Error -> ice "Attempt to bind an error node." | AstNodeKind.Constant c -> BoundLiteral.FromConstant c |> BoundExpr.Literal - | AstNodeKind.Vector v -> - List.map (bindDatum ctx) v - |> BoundLiteral.Vector - |> BoundExpr.Literal + | AstNodeKind.Vector v -> List.map (bindDatum ctx) v |> BoundLiteral.Vector |> BoundExpr.Literal | AstNodeKind.ByteVector bv -> BoundExpr.Literal(BoundLiteral.ByteVector bv) | AstNodeKind.Dot -> ctx.Diagnostics.Emit BinderDiagnostics.patternBindError node.Location "Unexpected dot" @@ -407,10 +397,7 @@ module private Impl = | AstNodeKind.Form f | AstNodeKind.Seq f -> List.map (bindDatum ctx) f |> BoundDatum.Compound | AstNodeKind.Quoted q -> bindDatum ctx q |> BoundDatum.Quoted - | AstNodeKind.Vector v -> - List.map (bindDatum ctx) v - |> BoundLiteral.Vector - |> BoundDatum.SelfEval + | AstNodeKind.Vector v -> List.map (bindDatum ctx) v |> BoundLiteral.Vector |> BoundDatum.SelfEval | AstNodeKind.ByteVector v -> BoundLiteral.ByteVector v |> BoundDatum.SelfEval | AstNodeKind.Error -> ctx.Diagnostics.Emit BinderDiagnostics.malformedDatum node.Location "invalid item in quoted expression" @@ -429,14 +416,13 @@ module private Impl = | _ -> BoundExpr.SequencePoint(inner, expr.Location) and private bindSequence ctx exprs = - List.map (bindWithSequencePoint ctx) exprs - |> BoundExpr.Seq + List.map (bindWithSequencePoint ctx) exprs |> BoundExpr.Seq and private bindApplication ctx head rest node = let applicant = bindInContext ctx head match applicant with - | BoundExpr.Load (StorageRef.Macro m) -> + | BoundExpr.Load(StorageRef.Macro m) -> match Macros.macroApply m node with | Ok ast -> bindInContext ctx ast | Result.Error diag -> @@ -452,15 +438,13 @@ module private Impl = idx + 1 match formals with - | BoundFormals.Simple (id) -> addFormal 0 id |> ignore - | BoundFormals.List (fmls) -> (List.fold addFormal 0 fmls) |> ignore - | BoundFormals.DottedList (fmls, dotted) -> + | BoundFormals.Simple(id) -> addFormal 0 id |> ignore + | BoundFormals.List(fmls) -> (List.fold addFormal 0 fmls) |> ignore + | BoundFormals.DottedList(fmls, dotted) -> let nextFormal = (List.fold addFormal 0 fmls) addFormal nextFormal dotted |> ignore - let boundBody = - bindSequence lambdaCtx body - |> BinderCtx.intoRoot lambdaCtx + let boundBody = bindSequence lambdaCtx body |> BinderCtx.intoRoot lambdaCtx BoundExpr.Lambda(formals, boundBody) @@ -482,8 +466,7 @@ module private Impl = and private bindLibrary ctx location (library: LibraryDefinition) = // Process `(import ...)` let libCtx = - library.LibraryName - |> BinderCtx.createForGlobalScope Map.empty ctx.Libraries + library.LibraryName |> BinderCtx.createForGlobalScope Map.empty ctx.Libraries let imports = library.Declarations @@ -511,7 +494,7 @@ module private Impl = // Process `(export ...)` declarations. let lookupExport id extId = match BinderCtx.tryFindBinding libCtx id with - | Some (x) -> Some((extId, x)) + | Some(x) -> Some((extId, x)) | _ -> sprintf "Could not find exported item %s" id |> Diagnostic.Create BinderDiagnostics.missingExport location @@ -538,9 +521,7 @@ module private Impl = library.LibraryName, library.LibraryName |> BinderCtx.mangleName, exports, - List.append imports boundBodies - |> BoundExpr.Seq - |> BinderCtx.intoRoot libCtx + List.append imports boundBodies |> BoundExpr.Seq |> BinderCtx.intoRoot libCtx ) and private bindForm ctx (form: AstNode list) node = @@ -548,15 +529,15 @@ module private Impl = illFormedInCtx ctx node.Location formName match form with - | { Kind = AstNodeKind.Ident ("if") } :: body -> + | { Kind = AstNodeKind.Ident("if") } :: body -> let b = bindWithSequencePoint ctx match body with | [ cond; ifTrue; ifFalse ] -> BoundExpr.If((b cond), (b ifTrue), Some(b ifFalse)) | [ cond; ifTrue ] -> BoundExpr.If((b cond), (b ifTrue), None) | _ -> illFormed "if" - | { Kind = AstNodeKind.Ident ("begin") } :: body -> bindSequence ctx body - | { Kind = AstNodeKind.Ident ("define") } :: body -> + | { Kind = AstNodeKind.Ident("begin") } :: body -> bindSequence ctx body + | { Kind = AstNodeKind.Ident("define") } :: body -> match body with | [ { Kind = AstNodeKind.Ident id } ] -> let storage = BinderCtx.addBinding ctx id @@ -565,7 +546,7 @@ module private Impl = let storage = BinderCtx.addBinding ctx id let value = bindInContext ctx value BoundExpr.Store(storage, Some(value)) - | ({ Kind = AstNodeKind.Form ({ Kind = AstNodeKind.Ident id } :: formals) }) :: body -> + | ({ Kind = AstNodeKind.Form({ Kind = AstNodeKind.Ident id } :: formals) }) :: body -> // Add the binding for this lambda to the scope _before_ lowering // the body. This makes recursive calls possible. BinderCtx.addBinding ctx id |> ignore @@ -577,19 +558,18 @@ module private Impl = let storage = (BinderCtx.tryFindBinding ctx id).Value BoundExpr.Store(storage, Some(lambda)) | _ -> illFormed "define" - | { Kind = AstNodeKind.Ident ("lambda") } :: body -> + | { Kind = AstNodeKind.Ident("lambda") } :: body -> match body with | formals :: body -> let boundFormals = bindFormals ctx formals bindLambdaBody ctx boundFormals body | _ -> illFormed "lambda" - | { Kind = AstNodeKind.Ident ("let") } :: body -> + | { Kind = AstNodeKind.Ident("let") } :: body -> bindLet ctx "let" body node.Location (fun bindingSpecs -> // Bind the body of each binding spec first let decls = - bindingSpecs - |> List.map (fun (id, body) -> (id, bindInContext ctx body)) + bindingSpecs |> List.map (fun (id, body) -> (id, bindInContext ctx body)) // Once the bodies are bound, we can create assignments and // initialise the environment @@ -600,7 +580,7 @@ module private Impl = BoundExpr.Store(storage, Some(body))) boundDecls) - | { Kind = AstNodeKind.Ident ("let*") } :: body -> + | { Kind = AstNodeKind.Ident("let*") } :: body -> bindLet ctx "let*" @@ -612,8 +592,8 @@ module private Impl = let body = bindInContext ctx body let storage = BinderCtx.addBinding ctx id BoundExpr.Store(storage, Some(body)))) - | ({ Kind = AstNodeKind.Ident ("letrec") } as head) :: body - | ({ Kind = AstNodeKind.Ident ("letrec*") } as head) :: body -> + | ({ Kind = AstNodeKind.Ident("letrec") } as head) :: body + | ({ Kind = AstNodeKind.Ident("letrec*") } as head) :: body -> bindLet ctx "letrec" body node.Location (fun bindingSpecs -> @@ -630,20 +610,20 @@ module private Impl = let rec checkUses location = function - | Application (app, args) -> + | Application(app, args) -> checkUses location app List.iter (checkUses location) args - | If (cond, cons, els) -> + | If(cond, cons, els) -> checkUses location cond checkUses location cons Option.iter (checkUses location) els - | Seq (exprs) -> List.iter (checkUses location) exprs + | Seq(exprs) -> List.iter (checkUses location) exprs | Lambda _ -> () - | Load (s) -> checkStorage location s - | Store (s, v) -> + | Load(s) -> checkStorage location s + | Store(s, v) -> checkStorage location s Option.iter (checkUses location) v - | SequencePoint (inner, _) -> checkUses location inner + | SequencePoint(inner, _) -> checkUses location inner | _ -> () and checkStorage location s = @@ -670,21 +650,21 @@ module private Impl = BoundExpr.Store(storage, Some(bound))) boundDecls) - | { Kind = AstNodeKind.Ident ("let-syntax") } :: body -> + | { Kind = AstNodeKind.Ident("let-syntax") } :: body -> bindLet ctx "let-syntax" body node.Location (fun bindingSpecs -> Seq.iter (fun (id, syntaxRules) -> match Macros.parseSyntaxRules id syntaxRules with - | Ok (macro) -> BinderCtx.addMacro ctx id macro + | Ok(macro) -> BinderCtx.addMacro ctx id macro | Result.Error e -> ctx.Diagnostics.Add e) bindingSpecs []) - | { Kind = AstNodeKind.Ident ("set!") + | { Kind = AstNodeKind.Ident("set!") Location = l } :: body -> match body with - | [ { Kind = AstNodeKind.Ident (id) }; value ] -> + | [ { Kind = AstNodeKind.Ident(id) }; value ] -> let value = bindInContext ctx value match BinderCtx.tryFindBinding ctx id with @@ -695,33 +675,33 @@ module private Impl = BoundExpr.Error | _ -> illFormed "set!" - | { Kind = AstNodeKind.Ident ("quote") } :: body -> + | { Kind = AstNodeKind.Ident("quote") } :: body -> match body with | [ item ] -> bindQuoted ctx item | _ -> illFormed "quote" - | { Kind = AstNodeKind.Ident ("define-syntax") } :: body -> + | { Kind = AstNodeKind.Ident("define-syntax") } :: body -> match body with - | [ { Kind = AstNodeKind.Ident (id) }; syntaxRules ] -> + | [ { Kind = AstNodeKind.Ident(id) }; syntaxRules ] -> match Macros.parseSyntaxRules id syntaxRules with - | Ok (macro) -> + | Ok(macro) -> BinderCtx.addMacro ctx id macro BoundExpr.Quoted(BoundDatum.Ident id) | Result.Error e -> ctx.Diagnostics.Add e BoundExpr.Error | _ -> illFormed "define-syntax" - | { Kind = AstNodeKind.Ident ("define-library") } :: body -> + | { Kind = AstNodeKind.Ident("define-library") } :: body -> match body with | name :: body -> match Libraries.parseLibraryDefinition name body with - | Ok (library, diags) -> + | Ok(library, diags) -> ctx.Diagnostics.Append diags bindLibrary ctx node.Location library | Result.Error diags -> ctx.Diagnostics.Append diags BoundExpr.Error | _ -> illFormed "define-library" - | { Kind = AstNodeKind.Ident ("import") } :: body -> + | { Kind = AstNodeKind.Ident("import") } :: body -> body |> List.map (fun item -> Libraries.parseImport ctx.Diagnostics item @@ -730,7 +710,7 @@ module private Impl = |> Result.map (BinderCtx.importLibrary ctx >> BoundExpr.Import) |> Result.okOr BoundExpr.Error) |> BoundExpr.Seq - | { Kind = AstNodeKind.Ident ("case") } :: body -> unimpl "Case expressions not yet implemented" + | { Kind = AstNodeKind.Ident("case") } :: body -> unimpl "Case expressions not yet implemented" | head :: rest -> bindApplication ctx head rest node | [] -> BoundExpr.Literal BoundLiteral.Null @@ -742,9 +722,7 @@ module Binder = /// /// The root scope contains the global functions available to the program. let scopeFromLibraries (libs: seq>) = - libs - |> Seq.collect (fun lib -> lib.Exports) - |> Map.ofSeq + libs |> Seq.collect (fun lib -> lib.Exports) |> Map.ofSeq /// The empty scope let emptyScope = Map.empty diff --git a/src/Feersum.CompilerServices/Binding/Libraries.fs b/src/Feersum.CompilerServices/Binding/Libraries.fs index 4e7e23b..5ae0bd8 100644 --- a/src/Feersum.CompilerServices/Binding/Libraries.fs +++ b/src/Feersum.CompilerServices/Binding/Libraries.fs @@ -57,7 +57,8 @@ type LibrarySignature<'a> = module private Utils = /// Map the exports in a given library signature let mapExports mapper signature = - { signature with Exports = signature.Exports |> mapper } + { signature with + Exports = signature.Exports |> mapper } /// Recognise a list of strings as a library name let parseLibraryName (diags: DiagnosticBag) name = @@ -80,8 +81,8 @@ module private Utils = let parseNameElement element = match element.Kind with - | AstNodeKind.Constant (SyntaxConstant.Number (namePart)) -> Ok(namePart |> sprintf "%g") - | AstNodeKind.Ident (namePart) -> + | AstNodeKind.Constant(SyntaxConstant.Number(namePart)) -> Ok(namePart |> sprintf "%g") + | AstNodeKind.Ident(namePart) -> if Seq.exists (isInvalidChar) (namePart.ToCharArray()) then "Library names should not contain complex characters" |> Diagnostic.Create LibraryDiagnostics.improperLibraryName element.Location @@ -101,20 +102,18 @@ module private Utils = /// Try and parse a node as an identifier let parseIdentifier = function - | { Kind = AstNodeKind.Ident (id) } -> Ok(id) + | { Kind = AstNodeKind.Ident(id) } -> Ok(id) | node -> Result.Error(Diagnostic.Create LibraryDiagnostics.invalidLibraryName node.Location "Expected identifier") /// Parse a list of identifiers into a list of strings let parseIdentifierList idents = - idents - |> List.map parseIdentifier - |> Result.collect + idents |> List.map parseIdentifier |> Result.collect /// Parse a library declaration form let rec parseLibraryDeclaration (diags: DiagnosticBag) declaration = match declaration.Kind with - | AstNodeKind.Form ({ Kind = AstNodeKind.Ident (special) } :: body) -> + | AstNodeKind.Form({ Kind = AstNodeKind.Ident(special) } :: body) -> parseLibraryDeclarationForm diags declaration.Location special body | _ -> diags.Emit LibraryDiagnostics.malformedLibraryDecl declaration.Location "Expected library declaration" @@ -122,14 +121,8 @@ module private Utils = and parseLibraryDeclarationForm diags position special body = match special with - | "export" -> - body - |> List.choose (parseExportDeclaration diags) - |> LibraryDeclaration.Export - | "import" -> - body - |> List.map (parseImportDeclaration diags) - |> LibraryDeclaration.Import + | "export" -> body |> List.choose (parseExportDeclaration diags) |> LibraryDeclaration.Export + | "import" -> body |> List.map (parseImportDeclaration diags) |> LibraryDeclaration.Import | "begin" -> LibraryDeclaration.Begin body | s -> sprintf "Unrecognised library declaration %s" s @@ -139,13 +132,13 @@ module private Utils = and tryParseRename rename = match rename with - | [ { Kind = AstNodeKind.Ident (int) }; { Kind = AstNodeKind.Ident (ext) } ] -> Ok({ From = int; To = ext }) + | [ { Kind = AstNodeKind.Ident(int) }; { Kind = AstNodeKind.Ident(ext) } ] -> Ok({ From = int; To = ext }) | _ -> Result.Error("invalid rename") and parseExportDeclaration diags export = match export.Kind with - | AstNodeKind.Ident (plain) -> Some(ExportSet.Plain plain) - | AstNodeKind.Form ({ Kind = AstNodeKind.Ident ("rename") } :: rename) -> + | AstNodeKind.Ident(plain) -> Some(ExportSet.Plain plain) + | AstNodeKind.Form({ Kind = AstNodeKind.Ident("rename") } :: rename) -> match rename |> tryParseRename with | Ok renamed -> Some(ExportSet.Renamed renamed) | Result.Error e -> @@ -158,21 +151,21 @@ module private Utils = and parseImportDeclaration diags import = let parseImportForm parser fromSet body resultCollector = match parser body with - | Ok (bound) -> resultCollector (parseImportDeclaration diags fromSet, bound) - | Result.Error (diag) -> + | Ok(bound) -> resultCollector (parseImportDeclaration diags fromSet, bound) + | Result.Error(diag) -> diags.Add(diag) ImportSet.Error match import.Kind with - | AstNodeKind.Form ({ Kind = AstNodeKind.Ident ("only") } :: (fromSet :: filters)) -> + | AstNodeKind.Form({ Kind = AstNodeKind.Ident("only") } :: (fromSet :: filters)) -> parseImportForm (parseIdentifierList) fromSet filters ImportSet.Only - | AstNodeKind.Form ({ Kind = AstNodeKind.Ident ("except") } :: (fromSet :: filters)) -> + | AstNodeKind.Form({ Kind = AstNodeKind.Ident("except") } :: (fromSet :: filters)) -> parseImportForm (parseIdentifierList) fromSet filters ImportSet.Except - | AstNodeKind.Form ({ Kind = AstNodeKind.Ident ("rename") } :: (fromSet :: renames)) -> + | AstNodeKind.Form({ Kind = AstNodeKind.Ident("rename") } :: (fromSet :: renames)) -> let parseRenames renames = let parseRename node = match node with - | { Kind = AstNodeKind.Form (f) } -> + | { Kind = AstNodeKind.Form(f) } -> tryParseRename (f) |> Result.mapError (Diagnostic.Create LibraryDiagnostics.malformedLibraryDecl node.Location) | _ -> @@ -183,11 +176,11 @@ module private Utils = renames |> List.map parseRename |> Result.collect parseImportForm (parseRenames) fromSet renames ImportSet.Renamed - | AstNodeKind.Form ([ { Kind = AstNodeKind.Ident ("prefix") }; fromSet; prefix ]) -> + | AstNodeKind.Form([ { Kind = AstNodeKind.Ident("prefix") }; fromSet; prefix ]) -> parseImportForm (parseIdentifier) fromSet prefix ImportSet.Prefix | _ -> match parseLibraryName diags import with - | Ok (name) -> ImportSet.Plain name + | Ok(name) -> ImportSet.Plain name | Result.Error _ -> ImportSet.Error @@ -206,11 +199,7 @@ module Libraries = /// Recursively check a library name matches let rec matchLibraryName left right = match (left, right) with - | (l :: lrest, r :: rrest) -> - if l = r then - matchLibraryName lrest rrest - else - false + | (l :: lrest, r :: rrest) -> if l = r then matchLibraryName lrest rrest else false | ([], []) -> true | _ -> false @@ -218,24 +207,24 @@ module Libraries = let rec resolveImport libraries = function | ImportSet.Error -> Result.Error "invalid import set" - | ImportSet.Except (inner, except) -> + | ImportSet.Except(inner, except) -> resolveImport libraries inner |> Result.map (mapExports (List.filter (fun (id, _) -> List.contains id except |> not))) - | ImportSet.Only (inner, only) -> + | ImportSet.Only(inner, only) -> resolveImport libraries inner |> Result.map (mapExports (List.filter (fun (id, _) -> List.contains id only))) | ImportSet.Plain lib -> match Seq.tryFind (fun signature -> matchLibraryName lib signature.LibraryName) libraries with - | Some (signature) -> Ok(signature) + | Some(signature) -> Ok(signature) | _ -> lib |> prettifyLibraryName |> sprintf "Could not find library %s" |> Result.Error - | ImportSet.Prefix (inner, prefix) -> + | ImportSet.Prefix(inner, prefix) -> resolveImport libraries inner |> Result.map (mapExports (List.map (fun (name, storage) -> (prefix + name, storage)))) - | ImportSet.Renamed (inner, renames) -> + | ImportSet.Renamed(inner, renames) -> let processRenames (name, storage) = match List.tryFind (fun (x: SymbolRename) -> x.From = name) renames with | Some rename -> (rename.To, storage) diff --git a/src/Feersum.CompilerServices/Binding/Lower.fs b/src/Feersum.CompilerServices/Binding/Lower.fs index 259d0bf..2ce47bb 100644 --- a/src/Feersum.CompilerServices/Binding/Lower.fs +++ b/src/Feersum.CompilerServices/Binding/Lower.fs @@ -10,16 +10,13 @@ type private CaptureConversionCtx = /// expression. The returned list only contains _directly_ captured values. let rec private findCaptured = function - | Application (app, args) -> List.append (findCaptured app) (List.collect findCaptured args) - | If (cond, cons, els) -> + | Application(app, args) -> List.append (findCaptured app) (List.collect findCaptured args) + | If(cond, cons, els) -> (findCaptured cond) |> List.append (findCaptured cons) - |> List.append ( - Option.map findCaptured els - |> Option.defaultValue [] - ) - | Seq (exprs) -> List.collect findCaptured exprs - | Lambda (formals, body) -> + |> List.append (Option.map findCaptured els |> Option.defaultValue []) + | Seq(exprs) -> List.collect findCaptured exprs + | Lambda(formals, body) -> let isFree = function | Arg _ @@ -27,10 +24,8 @@ let rec private findCaptured = | _ -> false body.Captures |> List.filter isFree - | Store (_, v) -> - Option.map findCaptured v - |> Option.defaultValue [] - | SequencePoint (inner, _) -> findCaptured inner + | Store(_, v) -> Option.map findCaptured v |> Option.defaultValue [] + | SequencePoint(inner, _) -> findCaptured inner | e -> [] /// Finds all local variables in the given node. This is later used to compact @@ -42,21 +37,16 @@ let rec private findLocals node = | _ -> Set.empty match node with - | Load (storage) -> fromStorage storage - | Application (app, args) -> Set.union (findLocals app) (Seq.map (findLocals) args |> Set.unionMany) - | If (cond, cons, els) -> + | Load(storage) -> fromStorage storage + | Application(app, args) -> Set.union (findLocals app) (Seq.map (findLocals) args |> Set.unionMany) + | If(cond, cons, els) -> (findLocals cond) |> Set.union (findLocals cons) - |> Set.union ( - Option.map (findLocals) els - |> Option.defaultValue Set.empty - ) - | Seq (exprs) -> Seq.map (findLocals) exprs |> Set.unionMany - | SequencePoint (inner, _) -> findLocals inner - | Store (storage, v) -> - let inner = - Option.map (findLocals) v - |> Option.defaultValue Set.empty + |> Set.union (Option.map (findLocals) els |> Option.defaultValue Set.empty) + | Seq(exprs) -> Seq.map (findLocals) exprs |> Set.unionMany + | SequencePoint(inner, _) -> findLocals inner + | Store(storage, v) -> + let inner = Option.map (findLocals) v |> Option.defaultValue Set.empty Set.union (fromStorage storage) inner | e -> Set.empty @@ -74,23 +64,18 @@ let private mappingsForExpr expr = let uncapturedLocals = Set.difference (findLocals expr) captured let localReWrites = - uncapturedLocals - |> Seq.indexed - |> Seq.map (fun (i, s) -> (s, Local i)) + uncapturedLocals |> Seq.indexed |> Seq.map (fun (i, s) -> (s, Local i)) - Seq.append captureReWrites localReWrites - |> Map.ofSeq + Seq.append captureReWrites localReWrites |> Map.ofSeq /// Re-write a storage location to move captured values to the environment. let rec private rewriteStorage ctx = function | Captured s -> match ctx.Parent with - | Some (parent) -> Captured(rewriteStorage parent s) + | Some(parent) -> Captured(rewriteStorage parent s) | None -> ice "Capture chain does not match nesting" - | s -> - Map.tryFind s ctx.Mappings - |> Option.defaultValue s + | s -> Map.tryFind s ctx.Mappings |> Option.defaultValue s /// Re-write the environment size, if needed. let private rewriteEnv env mappings = @@ -121,11 +106,11 @@ let private rewriteLocals locals mappings = let rec private rewriteExpression ctx = function | Load s -> Load(rewriteStorage ctx s) - | Store (s, v) -> Store(rewriteStorage ctx s, Option.map (rewriteExpression ctx) v) - | Application (app, args) -> Application(rewriteExpression ctx app, List.map (rewriteExpression ctx) args) - | If (cond, cons, els) -> + | Store(s, v) -> Store(rewriteStorage ctx s, Option.map (rewriteExpression ctx) v) + | Application(app, args) -> Application(rewriteExpression ctx app, List.map (rewriteExpression ctx) args) + | If(cond, cons, els) -> If(rewriteExpression ctx cond, rewriteExpression ctx cons, Option.map (rewriteExpression ctx) els) - | Seq (exprs) -> + | Seq(exprs) -> // This pair of functions allows us to flatten out nested sequences into // a simpler representation. let consolidate = @@ -144,9 +129,9 @@ let rec private rewriteExpression ctx = |> Seq.map ((rewriteExpression ctx) >> unfurl) |> List.concat |> consolidate - | Lambda (formals, root) -> Lambda(formals, (rewriteRoot (Some(ctx)) root)) - | SequencePoint (inner, location) -> SequencePoint((rewriteExpression ctx inner), location) - | Library (name, mangledName, exports, body) -> Library(name, mangledName, exports, rewriteRoot None body) + | Lambda(formals, root) -> Lambda(formals, (rewriteRoot (Some(ctx)) root)) + | SequencePoint(inner, location) -> SequencePoint((rewriteExpression ctx inner), location) + | Library(name, mangledName, exports, body) -> Library(name, mangledName, exports, rewriteRoot None body) | e -> e /// Re-write an expression tree root. This node represents a top level @@ -157,7 +142,7 @@ and private rewriteRoot parent root = // context so needs to be done before we create a derived `ctx`. let captures = match parent with - | Some (ctx) -> List.map (rewriteStorage ctx) root.Captures + | Some(ctx) -> List.map (rewriteStorage ctx) root.Captures | _ -> root.Captures // find out what is captured let ctx = @@ -175,4 +160,5 @@ and private rewriteRoot parent root = /// Lower a bound tree to a form better suited for the emit phase. let lower (ast: BoundSyntaxTree) = - { ast with Root = rewriteRoot None ast.Root } + { ast with + Root = rewriteRoot None ast.Root } diff --git a/src/Feersum.CompilerServices/Binding/Macros.fs b/src/Feersum.CompilerServices/Binding/Macros.fs index 7950a9c..3fe9cf9 100644 --- a/src/Feersum.CompilerServices/Binding/Macros.fs +++ b/src/Feersum.CompilerServices/Binding/Macros.fs @@ -74,8 +74,7 @@ module Macros = /// Create an error result with a diagnostic at `location` let private errAt location message = - Diagnostic.Create macroExpansionError location message - |> Result.Error + Diagnostic.Create macroExpansionError location message |> Result.Error /// Parse a (a ... . b) or (a ...) form. This is used to parse both patterns and /// templates for transformers. @@ -101,7 +100,7 @@ module Macros = let (element, rest) = match rest with - | { Kind = AstNodeKind.Ident (id) } :: rest when id = elipsis -> + | { Kind = AstNodeKind.Ident(id) } :: rest when id = elipsis -> (element |> Result.map onRepeated, rest) | _ -> (element |> Result.map onSingle, rest) @@ -138,7 +137,7 @@ module Macros = match ast.Kind with | AstNodeKind.Form g -> matchForm patterns None g | _ -> Result.Error() - | MacroPattern.DottedForm (patterns, tail) -> + | MacroPattern.DottedForm(patterns, tail) -> match ast.Kind with | AstNodeKind.Form g -> matchForm patterns (Some(tail)) g | _ -> Result.Error() @@ -162,14 +161,12 @@ module Macros = /// is forwarded to `matchRepeated`. and private matchForm patterns maybeTail syntax = match patterns with - | MacroPattern.Repeat (repeat) :: pats -> matchRepeated repeat pats maybeTail syntax [] + | MacroPattern.Repeat(repeat) :: pats -> matchRepeated repeat pats maybeTail syntax [] | headPat :: patterns -> match syntax with | head :: rest -> macroMatch headPat head - |> Result.bind (fun vars -> - matchForm patterns maybeTail rest - |> Result.map (MacroBindings.Union vars)) + |> Result.bind (fun vars -> matchForm patterns maybeTail rest |> Result.map (MacroBindings.Union vars)) | [] -> Result.Error() | [] -> match maybeTail with @@ -198,7 +195,10 @@ module Macros = /// to backtracking. and private matchRepeated repeat patterns maybeTail syntax repeatedBindings = match matchForm patterns maybeTail syntax with - | Ok vars -> Ok { vars with Repeated = repeatedBindings |> List.rev } + | Ok vars -> + Ok + { vars with + Repeated = repeatedBindings |> List.rev } | _ -> match syntax with | head :: syntax -> @@ -221,9 +221,9 @@ module Macros = | Quoted q -> (Result.Ok q, 0) | Subst v -> match List.tryFind (fun (id, _) -> id = v) bindings.Bindings with - | Some (_, syntax) -> (Result.Ok syntax, 1) + | Some(_, syntax) -> (Result.Ok syntax, 1) | None -> (Result.Error(sprintf "Reference to unbound substitution %s" v), 0) - | Form (location, templateElements) -> + | Form(location, templateElements) -> let elements = List.map (fun t -> macroExpandElement t bindings) templateElements let substs = List.sumBy (getCount) elements @@ -249,15 +249,11 @@ module Macros = function | (Result.Error _, 0) :: rest -> collectRepeat rest | (Result.Error e, n) :: _ -> Result.Error e - | (Result.Ok node, _) :: rest -> - collectRepeat rest - |> Result.map (fun rest -> node :: rest) + | (Result.Ok node, _) :: rest -> collectRepeat rest |> Result.map (fun rest -> node :: rest) | [] -> Result.Ok [] let repeated = - bindings.Repeated - |> List.map (macroExpandTemplate t) - |> collectRepeat + bindings.Repeated |> List.map (macroExpandTemplate t) |> collectRepeat (repeated, 0) @@ -323,14 +319,14 @@ module Macros = | MacroPattern.Variable v -> [ v ] | MacroPattern.Repeat r -> findBound r | MacroPattern.Form body -> Seq.map (findBound) body |> List.concat - | MacroPattern.DottedForm (body, extra) -> + | MacroPattern.DottedForm(body, extra) -> List.append (Seq.map (findBound) body |> List.concat) (findBound extra) | _ -> [] /// Parse a single macro transformer from a syntax node let private parseTransformer id elip literals = function - | { Kind = AstNodeKind.Form ([ pat; template ]) } -> + | { Kind = AstNodeKind.Form([ pat; template ]) } -> parsePattern elip literals pat |> Result.bind (fun pat -> let bound = findBound pat @@ -343,7 +339,7 @@ module Macros = let private parseTransformers id elip literals body = List.map (function - | { Kind = AstNodeKind.Ident (id) } -> Ok(id) + | { Kind = AstNodeKind.Ident(id) } -> Ok(id) | n -> errAt n.Location "Expected an identifier in macro literals") literals |> Result.collect @@ -354,9 +350,9 @@ module Macros = /// Parse the body of a syntax rules form. let private parseSyntaxRulesBody id loc syntax = match syntax with - | { Kind = AstNodeKind.Ident (elip) } :: { Kind = AstNodeKind.Form (literals) } :: body -> + | { Kind = AstNodeKind.Ident(elip) } :: { Kind = AstNodeKind.Form(literals) } :: body -> parseTransformers id elip literals body - | { Kind = AstNodeKind.Form (literals) } :: body -> parseTransformers id "..." literals body + | { Kind = AstNodeKind.Form(literals) } :: body -> parseTransformers id "..." literals body | _ -> errAt loc "Ill-formed syntax rules." |> Result.map (fun transformers -> { Name = id @@ -365,6 +361,6 @@ module Macros = /// Parse a syntax rules expression into a macro definition. let public parseSyntaxRules id syntaxRulesSyn = match syntaxRulesSyn with - | { Kind = AstNodeKind.Form ({ Kind = AstNodeKind.Ident ("syntax-rules") } :: body) } -> + | { Kind = AstNodeKind.Form({ Kind = AstNodeKind.Ident("syntax-rules") } :: body) } -> parseSyntaxRulesBody id syntaxRulesSyn.Location body | _ -> errAt syntaxRulesSyn.Location "Expected `syntax-rules` special form" diff --git a/src/Feersum.CompilerServices/Compile/Builtins.fs b/src/Feersum.CompilerServices/Compile/Builtins.fs index 660690e..4d05652 100644 --- a/src/Feersum.CompilerServices/Compile/Builtins.fs +++ b/src/Feersum.CompilerServices/Compile/Builtins.fs @@ -78,9 +78,7 @@ module private ExternUtils = let exports = ty.Fields |> findExported (fun x -> Field(x.Name)) - let builtins = - ty.Methods - |> findExported (fun x -> Method(x.Name)) + let builtins = ty.Methods |> findExported (fun x -> Method(x.Name)) let reExports = ty.CustomAttributes @@ -89,10 +87,7 @@ module private ExternUtils = let exportedItem = let id = unpackStringArg attr 2 - if unpackBoolArg attr 3 then - Method(id) - else - Field(id) + if unpackBoolArg attr 3 then Method(id) else Field(id) let libTy = attr.ConstructorArguments[1].Value :?> TypeReference @@ -100,25 +95,19 @@ module private ExternUtils = else None) - Seq.concat [ exports - builtins - reExports ] - |> List.ofSeq + Seq.concat [ exports; builtins; reExports ] |> List.ofSeq /// Try to convert a given type definition into a library signature. let tryGetSignatureFromType (ty: TypeDefinition) = ty.CustomAttributes |> Seq.tryPick (fun attr -> if attr.AttributeType.Name = "LispLibraryAttribute" then - Some(attr.ConstructorArguments[0].Value :?> CustomAttributeArgument []) + Some(attr.ConstructorArguments[0].Value :?> CustomAttributeArgument[]) else None) |> Option.map (fun name -> (ty, - { LibraryName = - name - |> Seq.map (fun a -> a.Value.ToString()) - |> List.ofSeq + { LibraryName = name |> Seq.map (fun a -> a.Value.ToString()) |> List.ofSeq Exports = getExports ty })) // -------------------- Builtin Macro Definitions ----------------------------- @@ -133,7 +122,7 @@ module private BuiltinMacros = icef "Error in builtin macro: %A" errs match node with - | { Kind = AstNodeKind.Seq ([ n ]) } -> n + | { Kind = AstNodeKind.Seq([ n ]) } -> n | n -> n |> Macros.parseSyntaxRules id |> Result.unwrap @@ -197,11 +186,7 @@ module private BuiltinMacros = let coreMacros = { LibraryName = [ "feersum"; "builtin"; "macros" ] Exports = - [ macroAnd - macroOr - macroWhen - macroUnless - macroCond ] + [ macroAnd; macroOr; macroWhen; macroUnless; macroCond ] |> List.map (fun m -> (m.Name, StorageRef.Macro(m))) } // ------------------------ Public Builtins API -------------------------------- @@ -217,21 +202,17 @@ module Builtins = let getType name = externAssms |> Seq.pick (fun (assm: AssemblyDefinition) -> - assm.MainModule.Types - |> Seq.tryFind (fun x -> x.FullName = name)) + assm.MainModule.Types |> Seq.tryFind (fun x -> x.FullName = name)) let getImportedType name = - getType name - |> lispAssm.MainModule.ImportReference + getType name |> lispAssm.MainModule.ImportReference let getResolvedType name = (getImportedType name).Resolve() let getCtorBy pred typeName = let ty = getResolvedType typeName - ty.GetConstructors() - |> Seq.find pred - |> lispAssm.MainModule.ImportReference + ty.GetConstructors() |> Seq.find pred |> lispAssm.MainModule.ImportReference let getSingleCtor = getCtorBy (fun _ -> true) @@ -243,24 +224,17 @@ module Builtins = // bound generic instance. let objTy = lispAssm.MainModule.TypeSystem.Object - let genericArgs = - [| objTy.MakeArrayType() :> TypeReference - objTy |] + let genericArgs = [| objTy.MakeArrayType() :> TypeReference; objTy |] let funcTy = - (getType "System.Func`2") - .MakeGenericInstanceType(genericArgs) - .Resolve() + (getType "System.Func`2").MakeGenericInstanceType(genericArgs).Resolve() let funcCtor = lispAssm.MainModule.ImportReference(funcTy.GetConstructors() |> Seq.head) |> makeHostInstanceGeneric genericArgs let funcInvoke = - lispAssm.MainModule.ImportReference( - funcTy.GetMethods() - |> Seq.find (fun m -> m.Name = "Invoke") - ) + lispAssm.MainModule.ImportReference(funcTy.GetMethods() |> Seq.find (fun m -> m.Name = "Invoke")) |> makeHostInstanceGeneric genericArgs let getMethod typeName methodName = @@ -298,14 +272,11 @@ module Builtins = let loadReferencedSignatures (name: string) = /// Folds a sequence of references into a single pair of lists let combineSignatures sigs = - sigs - |> Seq.fold (fun (tys, sigs) (t, s) -> (t :: tys, s :: sigs)) ([], []) + sigs |> Seq.fold (fun (tys, sigs) (t, s) -> (t :: tys, s :: sigs)) ([], []) use assm = Mono.Cecil.AssemblyDefinition.ReadAssembly(name, assmReadParams) - assm.MainModule.Types - |> Seq.choose tryGetSignatureFromType - |> combineSignatures + assm.MainModule.Types |> Seq.choose tryGetSignatureFromType |> combineSignatures /// The core library signature let loadCoreSignatures target = @@ -319,15 +290,13 @@ module Builtins = let importCore (targetAssm: AssemblyDefinition) target = let coreAssemblies = - target.LispCoreLocation - :: target.MSCoreLibLocations + target.LispCoreLocation :: target.MSCoreLibLocations |> List.map (fun x -> AssemblyDefinition.ReadAssembly(x, assmReadParams)) try loadCoreTypes targetAssm coreAssemblies finally - coreAssemblies - |> List.iter (fun assm -> (assm :> IDisposable).Dispose()) + coreAssemblies |> List.iter (fun assm -> (assm :> IDisposable).Dispose()) /// Load the assembly and retrieve the name from it. let getAssemblyName (path: string) = diff --git a/src/Feersum.CompilerServices/Compile/Compiler.fs b/src/Feersum.CompilerServices/Compile/Compiler.fs index aa63262..696b4b7 100644 --- a/src/Feersum.CompilerServices/Compile/Compiler.fs +++ b/src/Feersum.CompilerServices/Compile/Compiler.fs @@ -36,19 +36,19 @@ module private EnvUtils = /// Get the local variable used to store the current method's environment let getLocal = function - | Standard (local, _, _) -> local |> Some + | Standard(local, _, _) -> local |> Some | _ -> None /// Get the type part of the environment info. let rec getType = function - | Standard (_, ty, _) -> ty + | Standard(_, ty, _) -> ty | Link inner -> getType inner /// Get the parent of the given environment. let rec getParent = function - | Standard (_, _, parent) -> parent + | Standard(_, _, parent) -> parent | Link inner -> Some(inner) /// Type to Hold Context While Emitting IL @@ -89,9 +89,7 @@ module private Utils = /// Set the attributes on a given method to mark it as compiler generated code let markAsCompilerGenerated (core: CoreTypes) (method: MethodDefinition) = let addSimpleAttr (attrCtor: MethodReference) = - attrCtor - |> CustomAttribute - |> method.CustomAttributes.Add + attrCtor |> CustomAttribute |> method.CustomAttributes.Add addSimpleAttr core.CompGenCtor addSimpleAttr core.NonUserCodeCtor @@ -99,9 +97,7 @@ module private Utils = /// Mark a type as compiler generated. let markTypeAsCompilerGenerated (core: CoreTypes) (ty: TypeDefinition) = - core.CompGenCtor - |> CustomAttribute - |> ty.CustomAttributes.Add + core.CompGenCtor |> CustomAttribute |> ty.CustomAttributes.Add /// Mark the assembly as supporting debugging let markAsDebuggable (core: CoreTypes) (assm: AssemblyDefinition) = @@ -213,7 +209,7 @@ module private Utils = let export = Map.tryFind id ctx.Exports match export with - | Some (exportedName) -> + | Some(exportedName) -> markWithExportedName ctx.Core newField exportedName newField.Attributes <- newField.Attributes ||| FieldAttributes.Public () @@ -270,7 +266,7 @@ module private Utils = captured |> Option.iter ( Seq.iter (function - | Environment (idx, Arg a) -> + | Environment(idx, Arg a) -> ctx.IL.Emit(OpCodes.Ldloc, envLocal) ctx.IL.Emit(OpCodes.Ldarg, argToParam ctx a) ctx.IL.Emit(OpCodes.Stfld, ty.Fields[idx]) @@ -288,28 +284,28 @@ module private Utils = /// to read and write values from a captured environment. let rec private walkCaptureChain ctx envInfo from f = match from with - | StorageRef.Captured (from) -> + | StorageRef.Captured(from) -> let parent = match envInfo with - | Standard (_, ty, parent) -> + | Standard(_, ty, parent) -> ctx.IL.Emit(OpCodes.Ldfld, ty.Fields[ty.Fields.Count - 1]) parent |> Option.unwrap | Link l -> l walkCaptureChain ctx parent from f - | StorageRef.Environment (idx, _) -> f envInfo idx + | StorageRef.Environment(idx, _) -> f envInfo idx | _ -> icef "Unexpected storage in capture chain %A" from /// Given an environment at the top of the stack emit a load of the slot `idx` let private readFromEnv ctx envInfo (idx: int) = match envInfo with - | Standard (_, ty, _) -> ctx.IL.Emit(OpCodes.Ldfld, ty.Fields[idx]) + | Standard(_, ty, _) -> ctx.IL.Emit(OpCodes.Ldfld, ty.Fields[idx]) | Link l -> icef "Attempt to read from link environment %A at index %d" l idx /// Given an environment at the top of the stack emit a store to the slot `idx` let private writeToEnv ctx (temp: VariableDefinition) envInfo (idx: int) = match envInfo with - | Standard (_, ty, _) -> + | Standard(_, ty, _) -> ctx.IL.Emit(OpCodes.Ldloc, temp) ctx.IL.Emit(OpCodes.Stfld, ty.Fields[idx]) | Link l -> icef "Attempt to write to link environment %A at index %d" l idx @@ -331,7 +327,7 @@ module private Utils = match expr with | BoundExpr.Nop -> emitUnspecified ctx | BoundExpr.Error -> ice "Attempt to lower an error expression" - | BoundExpr.SequencePoint (inner, location) -> + | BoundExpr.SequencePoint(inner, location) -> let pos = ctx.IL.Body.Instructions.Count recurse inner @@ -361,7 +357,7 @@ module private Utils = doc.LanguageVendorGuid <- Guid("98378869-1abf-441b-9307-3bcca9a024cd") // TODO: Set HashAlgorithm here, and store the SHA1 of the // debug document. - ctx.DebugDocuments[ s.Source ] <- doc + ctx.DebugDocuments[s.Source] <- doc let point = Cil.SequencePoint(ins, doc) point.StartLine <- int s.Line @@ -371,20 +367,20 @@ module private Utils = ctx.IL.Body.Method.DebugInformation.SequencePoints.Add point | BoundExpr.Literal l -> emitLiteral ctx l | BoundExpr.Seq s -> emitSequence ctx tail s - | BoundExpr.Application (ap, args) -> emitApplication ctx tail ap args - | BoundExpr.Store (storage, maybeVal) -> + | BoundExpr.Application(ap, args) -> emitApplication ctx tail ap args + | BoundExpr.Store(storage, maybeVal) -> // TODO: Could we just elide the whole definition if there is no value. // If we have nothing to store it would save a lot of code. In the // case we are storing to a field we _might_ need to call // `emitField` still. match maybeVal with - | Some (expr) -> emitExpression ctx false expr + | Some(expr) -> emitExpression ctx false expr | None -> ctx.IL.Emit(OpCodes.Ldnull) ctx.IL.Emit(OpCodes.Dup) writeTo ctx storage | BoundExpr.Load storage -> readFrom ctx storage - | BoundExpr.If (cond, ifTrue, maybeIfFalse) -> + | BoundExpr.If(cond, ifTrue, maybeIfFalse) -> let lblTrue = ctx.IL.Create(OpCodes.Nop) let lblNotBool = ctx.IL.Create(OpCodes.Nop) let lblEnd = ctx.IL.Create(OpCodes.Nop) @@ -438,11 +434,11 @@ module private Utils = // block. Or stop using `nops` all over the place as // labels and instead. ctx.IL.Append(lblEnd) - | BoundExpr.Lambda (formals, body) -> emitLambda ctx formals body - | BoundExpr.Library (name, mangledName, exports, body) -> emitLibrary ctx name mangledName exports body + | BoundExpr.Lambda(formals, body) -> emitLambda ctx formals body + | BoundExpr.Library(name, mangledName, exports, body) -> emitLibrary ctx name mangledName exports body | BoundExpr.Import name -> match Map.tryFind name ctx.Initialisers with - | Some (initialiser) -> ctx.IL.Emit(OpCodes.Call, initialiser) + | Some(initialiser) -> ctx.IL.Emit(OpCodes.Call, initialiser) | None -> emitUnspecified ctx | BoundExpr.Quoted quoted -> emitQuoted ctx quoted @@ -486,12 +482,7 @@ module private Utils = ctx.IL.Emit(OpCodes.Box, ctx.Assm.MainModule.TypeSystem.Double) | BoundLiteral.Str s -> ctx.IL.Emit(OpCodes.Ldstr, s) | BoundLiteral.Boolean b -> - ctx.IL.Emit( - if b then - OpCodes.Ldc_I4_1 - else - OpCodes.Ldc_I4_0 - ) + ctx.IL.Emit(if b then OpCodes.Ldc_I4_1 else OpCodes.Ldc_I4_0) ctx.IL.Emit(OpCodes.Box, ctx.Assm.MainModule.TypeSystem.Boolean) | BoundLiteral.Character c -> @@ -558,22 +549,22 @@ module private Utils = and writeTo ctx storage = match storage with | StorageRef.Macro m -> icef "Can't re-define macro %s" m.Name - | StorageRef.Global (mangledPrefix, loc) -> + | StorageRef.Global(mangledPrefix, loc) -> match loc with | Method id -> icef "Can't re-define builtin %s" id | Field id -> let field = getField ctx mangledPrefix id ctx.IL.Emit(OpCodes.Stsfld, field) - | StorageRef.Local (idx) -> ctx.IL.Emit(OpCodes.Stloc, idx |> localToVariable ctx) - | StorageRef.Arg (idx) -> ctx.IL.Emit(OpCodes.Starg, idx |> argToParam ctx) - | StorageRef.Environment (idx, _) -> + | StorageRef.Local(idx) -> ctx.IL.Emit(OpCodes.Stloc, idx |> localToVariable ctx) + | StorageRef.Arg(idx) -> ctx.IL.Emit(OpCodes.Starg, idx |> argToParam ctx) + | StorageRef.Environment(idx, _) -> let temp = makeTemp ctx ctx.Assm.MainModule.TypeSystem.Object ctx.IL.Emit(OpCodes.Stloc, temp) ctx.IL.Emit(OpCodes.Ldloc, getEnvironment ctx) writeToEnv ctx temp (ctx.Environment |> Option.unwrap) idx - | StorageRef.Captured (from) -> + | StorageRef.Captured(from) -> let temp = makeTemp ctx ctx.Assm.MainModule.TypeSystem.Object ctx.IL.Emit(OpCodes.Stloc, temp) @@ -586,7 +577,7 @@ module private Utils = and readFrom ctx storage = match storage with | StorageRef.Macro m -> icef "Invalid macro application %s" m.Name - | StorageRef.Global (ty, loc) -> + | StorageRef.Global(ty, loc) -> match loc with | Method id -> let meth = getExternMethod ctx ty id @@ -594,12 +585,12 @@ module private Utils = | Field id -> let field = getField ctx ty id ctx.IL.Emit(OpCodes.Ldsfld, field) - | StorageRef.Local (idx) -> ctx.IL.Emit(OpCodes.Ldloc, idx |> localToVariable ctx) - | StorageRef.Arg (idx) -> ctx.IL.Emit(OpCodes.Ldarg, idx |> argToParam ctx) - | StorageRef.Environment (idx, _) -> + | StorageRef.Local(idx) -> ctx.IL.Emit(OpCodes.Ldloc, idx |> localToVariable ctx) + | StorageRef.Arg(idx) -> ctx.IL.Emit(OpCodes.Ldarg, idx |> argToParam ctx) + | StorageRef.Environment(idx, _) -> ctx.IL.Emit(OpCodes.Ldloc, getEnvironment ctx) readFromEnv ctx (ctx.Environment |> Option.unwrap) idx - | StorageRef.Captured (from) -> + | StorageRef.Captured(from) -> // start at the parent environment, and walk up ctx.IL.Emit(OpCodes.Ldarg_0) walkCaptureChain ctx (getParentEnv ctx |> Option.unwrap) from (readFromEnv ctx) @@ -652,7 +643,9 @@ module private Utils = args |> ignore - if tail then ctx.IL.Emit(OpCodes.Tail) + if tail then + ctx.IL.Emit(OpCodes.Tail) + ctx.IL.Emit(OpCodes.Callvirt, ctx.Core.FuncObjInvoke) /// Emit a Lambda Reference @@ -677,7 +670,7 @@ module private Utils = | Some env -> // load the this pointer match env with - | Standard (local, _, _) -> ctx.IL.Emit(OpCodes.Ldloc, local) + | Standard(local, _, _) -> ctx.IL.Emit(OpCodes.Ldloc, local) | Link _ -> ctx.IL.Emit(OpCodes.Ldarg_0) emitMethodToInstanceFunc ctx method @@ -701,8 +694,7 @@ module private Utils = if hasEnv ctx then MethodAttributes.Public else - MethodAttributes.Public - ||| MethodAttributes.Static + MethodAttributes.Public ||| MethodAttributes.Static let methodDecl = MethodDefinition(name, attrs, ctx.Assm.MainModule.TypeSystem.Object) @@ -719,7 +711,7 @@ module private Utils = match formals with | Simple id -> addParam id | List fmls -> Seq.iter addParam fmls - | DottedList (fmls, dotted) -> + | DottedList(fmls, dotted) -> Seq.iter addParam fmls addParam dotted @@ -735,9 +727,7 @@ module private Utils = let buildEnv envSize = let parentTy = ctx.Environment |> Option.map (EnvUtils.getType) - let envTy = - sprintf "<%s>$Env" name - |> makeEnvironmentType ctx.Assm parentTy envSize + let envTy = sprintf "<%s>$Env" name |> makeEnvironmentType ctx.Assm parentTy envSize markTypeAsCompilerGenerated ctx.Core envTy @@ -767,7 +757,7 @@ module private Utils = ) match envSize with - | Some (0) -> ctx.Environment |> Option.map Link + | Some(0) -> ctx.Environment |> Option.map Link | Some caps -> buildEnv caps |> Some | None -> None @@ -786,7 +776,7 @@ module private Utils = match ctx.Environment with | Some e -> match e with - | Standard (local, ty, parent) -> initialiseEnvironment ctx local ty parent root.EnvMappings + | Standard(local, ty, parent) -> initialiseEnvironment ctx local ty parent root.EnvMappings | Link _ -> () | None -> () @@ -804,14 +794,10 @@ module private Utils = // If we have an environment tell the debugger about it ctx.Environment |> Option.bind (EnvUtils.getLocal) - |> Option.iter (fun env -> - VariableDebugInformation(env, "capture-environment") - |> scope.Variables.Add) + |> Option.iter (fun env -> VariableDebugInformation(env, "capture-environment") |> scope.Variables.Add) ctx.Locals - |> List.iteri (fun idx var -> - VariableDebugInformation(var, sprintf "local%d" idx) - |> scope.Variables.Add) + |> List.iteri (fun idx var -> VariableDebugInformation(var, sprintf "local%d" idx) |> scope.Variables.Add) methodDecl.DebugInformation.Scope <- scope @@ -908,7 +894,7 @@ module private Utils = (sprintf "Expected exactly %d arguments" expectedArgCount) List.fold unpackArg 0 fmls |> ignore - | DottedList (fmls, dotted) -> + | DottedList(fmls, dotted) -> let expectedArgCount = List.length fmls raiseArgCountMismatch @@ -963,7 +949,7 @@ module private Utils = |> Seq.fold (fun state (name, storage) -> match storage with - | StorageRef.Global (mangled, item) -> + | StorageRef.Global(mangled, item) -> let (exports, reExports) = state if mangled = mangledName then @@ -1055,11 +1041,7 @@ module Compilation = let name = let stem = Path.GetFileNameWithoutExtension(outputName) - AssemblyNameDefinition( - stem, - options.Version - |> Option.defaultValue (Version(1, 0)) - ) + AssemblyNameDefinition(stem, options.Version |> Option.defaultValue (Version(1, 0))) use resolver = new DefaultAssemblyResolver() List.iter (resolver.AddSearchDirectory) target.MSCoreLibLocations @@ -1128,8 +1110,7 @@ module Compilation = let mainMethod = MethodDefinition( "Main", - MethodAttributes.Public - ||| MethodAttributes.Static, + MethodAttributes.Public ||| MethodAttributes.Static, assm.MainModule.TypeSystem.Int32 ) @@ -1146,7 +1127,7 @@ module Compilation = let mutable writerParams = WriterParameters() match symbolStream with - | Some (stream) -> + | Some(stream) -> writerParams.SymbolStream <- stream writerParams.WriteSymbols <- true writerParams.SymbolWriterProvider <- PortablePdbWriterProvider() @@ -1175,10 +1156,7 @@ module Compilation = let (refTys, allLibs) = options.References |> Seq.map (Builtins.loadReferencedSignatures) - |> Seq.append ( - Seq.singleton - <| Builtins.loadCoreSignatures target - ) + |> Seq.append (Seq.singleton <| Builtins.loadCoreSignatures target) |> Seq.fold (fun (tys, sigs) (aTys, aSigs) -> (List.append tys aTys, List.append sigs aSigs)) ([], []) let scope = @@ -1262,10 +1240,9 @@ module Compilation = let result = compile options outputStream (Path.GetFileName(output)) (symbols |> Option.ofObj) ast - if result.Diagnostics.IsEmpty - && options.OutputType = OutputType.Exe then + if result.Diagnostics.IsEmpty && options.OutputType = OutputType.Exe then match result.EmittedAssemblyName with - | Some (assemblyName) -> Runtime.writeRuntimeConfig options output assemblyName outDir + | Some(assemblyName) -> Runtime.writeRuntimeConfig options output assemblyName outDir | None -> () result.Diagnostics diff --git a/src/Feersum.CompilerServices/Compile/MonoHelpers.fs b/src/Feersum.CompilerServices/Compile/MonoHelpers.fs index 8170821..4058943 100644 --- a/src/Feersum.CompilerServices/Compile/MonoHelpers.fs +++ b/src/Feersum.CompilerServices/Compile/MonoHelpers.fs @@ -28,12 +28,7 @@ let createCtor (assm: AssemblyDefinition) builder = ) let objConstructor = - assm - .MainModule - .TypeSystem - .Object - .Resolve() - .GetConstructors() + assm.MainModule.TypeSystem.Object.Resolve().GetConstructors() |> Seq.find (fun x -> x.Parameters.Count = 0) |> assm.MainModule.ImportReference diff --git a/src/Feersum.CompilerServices/Diagnostics.fs b/src/Feersum.CompilerServices/Diagnostics.fs index 287faac..1954ba6 100644 --- a/src/Feersum.CompilerServices/Diagnostics.fs +++ b/src/Feersum.CompilerServices/Diagnostics.fs @@ -53,7 +53,7 @@ type Diagnostic = | Missing -> sprintf "feersum: %s: %s" d.MessagePrefix d.FormattedMessage | Point p -> sprintf "%s(%d,%d): %s: %s" (p.Source |> normaliseName) p.Line p.Col d.MessagePrefix d.FormattedMessage - | Span (s, e) -> + | Span(s, e) -> // If both points are on the same line then we can use the a more // compact format. if s.Line = e.Line then @@ -121,6 +121,4 @@ module Diagnostics = /// Write the diagnostics to the standard error let dumpDiagnostics diags = - diags - |> List.rev - |> Seq.iter (fun x -> eprintfn "%s" (x.ToString())) + diags |> List.rev |> Seq.iter (fun x -> eprintfn "%s" (x.ToString())) diff --git a/src/Feersum.CompilerServices/Eval.fs b/src/Feersum.CompilerServices/Eval.fs index bac43b6..b464960 100644 --- a/src/Feersum.CompilerServices/Eval.fs +++ b/src/Feersum.CompilerServices/Eval.fs @@ -38,13 +38,10 @@ let evalWith options ast = try Ok(mainMethod.Invoke(null, Array.empty)) - with - | :? TargetInvocationException as ex -> + with :? TargetInvocationException as ex -> // Unwrap target invocation exceptions a little to make the REPL a // bit of a nicer experience - ExceptionDispatchInfo - .Capture(ex.InnerException) - .Throw() + ExceptionDispatchInfo.Capture(ex.InnerException).Throw() Error([]) diff --git a/src/Feersum.CompilerServices/LegacySyntax.fs b/src/Feersum.CompilerServices/LegacySyntax.fs index e700795..dfef7a5 100644 --- a/src/Feersum.CompilerServices/LegacySyntax.fs +++ b/src/Feersum.CompilerServices/LegacySyntax.fs @@ -95,10 +95,11 @@ module LegacyParse = let block, blockRef = createParserForwardedToRef () let blockBody = - choice [ block - skipMany1 (skipNoneOf "|#") - attempt (skipChar '|' >>. skipNoneOf "#") - skipChar '#' ] + choice + [ block + skipMany1 (skipNoneOf "|#") + attempt (skipChar '|' >>. skipNoneOf "#") + skipChar '#' ] blockRef.Value <- between (skipString "#|") (skipString "|#") (skipMany blockBody) @@ -168,27 +169,23 @@ module LegacyParse = let private parseChar = let namedChar = - choice [ stringReturn "alarm" '\u0007' - stringReturn "backspace" '\u0008' - stringReturn "delete" '\u007F' - stringReturn "escape" '\u001B' - stringReturn "newline" '\u000A' - stringReturn "null" '\u0000' - stringReturn "return" '\u000D' - stringReturn "space" ' ' - stringReturn "tab" '\u0009' ] + choice + [ stringReturn "alarm" '\u0007' + stringReturn "backspace" '\u0008' + stringReturn "delete" '\u007F' + stringReturn "escape" '\u001B' + stringReturn "newline" '\u000A' + stringReturn "null" '\u0000' + stringReturn "return" '\u000D' + stringReturn "space" ' ' + stringReturn "tab" '\u0009' ] let hexChar = attempt (skipChar 'x' >>. hexScalarValue) - spannedNode - (Character >> Constant) - (skipString @"#\" - >>. (namedChar <|> hexChar <|> anyChar)) + spannedNode (Character >> Constant) (skipString @"#\" >>. (namedChar <|> hexChar <|> anyChar)) let inline private isIdentifierChar c = - isAsciiLetter c - || isDigit c - || isAnyOf "!$%&*/:<=>?@^_~+-." c + isAsciiLetter c || isDigit c || isAnyOf "!$%&*/:<=>?@^_~+-." c let private parseIdent = let simpleIdent = many1SatisfyL isIdentifierChar "identifier" @@ -200,8 +197,7 @@ module LegacyParse = spannedNode Ident (simpleIdent <|> identLiteral) let private parseDot = - (skipChar '.' - >>? notFollowedBy (satisfy isIdentifierChar)) + (skipChar '.' >>? notFollowedBy (satisfy isIdentifierChar)) |> spannedNodeOfKind Dot let private parseQuoted = skipAnyOf "’'" >>. parseForm |> spannedNode Quoted @@ -209,14 +205,15 @@ module LegacyParse = let private parseAtom = // The order is important here. Numbers have higher priority than // symbols / identifiers. The `.` token must come before identifier. - choice [ parseStr - parseVec - parseByteVec - parseChar - parseNum - parseBool - parseDot - parseIdent ] + choice + [ parseStr + parseVec + parseByteVec + parseChar + parseNum + parseBool + parseDot + parseIdent ] let private parseApplication = between (skipChar '(') (expectCharClosing ')') (many parseForm) @@ -228,18 +225,14 @@ module LegacyParse = let private parse: Parser = let problem = sprintf "unexpected character %c" - (many ( - parseForm - <|> ((skipUnrecognised problem) >>% errorNode) - )) - .>> eof + (many (parseForm <|> ((skipUnrecognised problem) >>% errorNode))) .>> eof |> spannedNode Seq /// Unpack a `ParseResult` into a Plain `Result` let private unpack = function - | Success (node, s, _) -> (node, s.Diagnostics.Take) - | Failure (mess, err, s) -> + | Success(node, s, _) -> (node, s.Diagnostics.Take) + | Failure(mess, err, s) -> s.Diagnostics.Emit LegacySyntaxDiagnostics.fparsecFailure (Point(TextPoint.FromExternal(err.Position))) mess s.Diagnostics.Emit @@ -251,18 +244,15 @@ module LegacyParse = /// Read a single expression from the named input text let readExpr1 name line : (AstNode * Diagnostic list) = - runParserOnString parse State.Empty name line - |> unpack + runParserOnString parse State.Empty name line |> unpack /// Read a single expression from the input text let readExpr = readExpr1 "repl" /// Read an expression from source code on disk let parseFile path : (AstNode * Diagnostic list) = - runParserOnFile parse State.Empty path Encoding.UTF8 - |> unpack + runParserOnFile parse State.Empty path Encoding.UTF8 |> unpack /// Read an expression from a stream of source code let parseStream name stream : (AstNode * Diagnostic list) = - runParserOnStream parse State.Empty name stream Encoding.UTF8 - |> unpack + runParserOnStream parse State.Empty name stream Encoding.UTF8 |> unpack diff --git a/src/Feersum.CompilerServices/Scope.fs b/src/Feersum.CompilerServices/Scope.fs index 394df90..369471b 100644 --- a/src/Feersum.CompilerServices/Scope.fs +++ b/src/Feersum.CompilerServices/Scope.fs @@ -25,7 +25,8 @@ module Scope = let insert scope id value = let entry = { Value = value; Id = id } - { scope with Entries = entry :: scope.Entries } + { scope with + Entries = entry :: scope.Entries } /// Create a scope from the initial environment map let fromMap map = Map.fold insert empty map diff --git a/src/Feersum.CompilerServices/Syntax/Lex.fs b/src/Feersum.CompilerServices/Syntax/Lex.fs index 9ea41c9..06084e5 100644 --- a/src/Feersum.CompilerServices/Syntax/Lex.fs +++ b/src/Feersum.CompilerServices/Syntax/Lex.fs @@ -61,20 +61,7 @@ type private LexState = /// Charcters, other than alphabetics, that can start an identifier. let private specialInitial = - [ '!' - '$' - '%' - '&' - '*' - '/' - ':' - '<' - '=' - '>' - '?' - '^' - '_' - '~' ] + [ '!'; '$'; '%'; '&'; '*'; '/'; ':'; '<'; '='; '>'; '?'; '^'; '_'; '~' ] |> Set.ofList /// Characters that can appear after an explicit sign at the beginning of @@ -132,10 +119,7 @@ let public tokenise input name = // then we _may_ be parsing `+.`, `-.`, or `.`. Only `.` is not // actually an identifier. Handle that case here rather than // having two separate states for dot after sign and plain dot. - if lexeme = "." then - TokenKind.Dot - else - TokenKind.Identifier + if lexeme = "." then TokenKind.Dot else TokenKind.Identifier | Number | NumberSuffix -> TokenKind.Number | Bool _ -> TokenKind.Boolean @@ -179,11 +163,7 @@ let public tokenise input name = | '+' -> Some(LexState.PerculiarIdentifierSeenSign) | '"' -> Some(LexState.String) | '|' -> Some(LexState.LiteralIdentifier) - | c when - Char.IsLetter(c) - || (Set.contains c specialInitial) - -> - Some(LexState.Identifier) + | c when Char.IsLetter(c) || (Set.contains c specialInitial) -> Some(LexState.Identifier) | c when Char.IsDigit(c) -> Some(LexState.Number) | _ -> Some(LexState.Error) | SingleLineComment -> @@ -219,9 +199,11 @@ let public tokenise input name = Some(LexState.MultiLineDone) | _ -> Some(LexState.InMultiLine n) | Identifier -> - if Char.IsLetterOrDigit c - || Set.contains c specialInitial - || Set.contains c specialSubsequent then + if + Char.IsLetterOrDigit c + || Set.contains c specialInitial + || Set.contains c specialSubsequent + then Some(LexState.Identifier) else None @@ -248,12 +230,9 @@ let public tokenise input name = | c when Char.IsDigit(c) -> Some(LexState.NumberSuffix) | _ -> None | Number -> - if Char.IsDigit(c) then - Some(LexState.Number) - else if c = '.' then - Some(LexState.NumberSuffix) - else - None + if Char.IsDigit(c) then Some(LexState.Number) + else if c = '.' then Some(LexState.NumberSuffix) + else None | NumberSuffix -> if Char.IsDigit(c) then Some(LexState.NumberSuffix) @@ -281,12 +260,8 @@ let public tokenise input name = Some(LexState.CharHex) else None - | CharNamed -> - if Char.IsLetter(c) then - Some(LexState.CharNamed) - else - None - | Bool (next, suffix) -> + | CharNamed -> if Char.IsLetter(c) then Some(LexState.CharNamed) else None + | Bool(next, suffix) -> if c = next then Some(LexState.ComplexToken(suffix, TokenKind.Boolean)) else @@ -295,13 +270,9 @@ let public tokenise input name = match c with | c when Char.IsWhiteSpace(c) -> Some(LexState.Whitespace) | _ -> None - | ComplexToken (remaining, kind) -> + | ComplexToken(remaining, kind) -> match remaining with - | [ single ] -> - if c = single then - Some(LexState.SimpleToken kind) - else - None + | [ single ] -> if c = single then Some(LexState.SimpleToken kind) else None | expected :: rest -> if c = expected then Some(LexState.ComplexToken(rest, kind)) @@ -331,9 +302,7 @@ let public tokenise input name = yield tokenForState (lexeme.ToString()) state (TextLocation.Point(TextPoint.FromParts(name, line, col))) lexeme <- lexeme.Clear().Append(char) - state <- - nextTransition Start char - |> Option.defaultValue Error + state <- nextTransition Start char |> Option.defaultValue Error | Some next -> state <- next lexeme <- lexeme.Append(char) diff --git a/src/Feersum.CompilerServices/Syntax/Parse.fs b/src/Feersum.CompilerServices/Syntax/Parse.fs index 5dedd55..f3419be 100644 --- a/src/Feersum.CompilerServices/Syntax/Parse.fs +++ b/src/Feersum.CompilerServices/Syntax/Parse.fs @@ -77,7 +77,8 @@ module private ParserState = /// Buffer a raw diagnostic at this position let bufferDiagnosticRaw state diagnostic = - { state with ParserState.Diagnostics = (diagnostic :: state.Diagnostics) } + { state with + ParserState.Diagnostics = (diagnostic :: state.Diagnostics) } /// Buffer a diagnostic at the current token in the parser state. let bufferDiagnostic state diagKind message = @@ -86,14 +87,12 @@ module private ParserState = | Some token -> token.Location | _ -> Missing - Diagnostic.Create diagKind pos message - |> bufferDiagnosticRaw state + Diagnostic.Create diagKind pos message |> bufferDiagnosticRaw state /// Finalise the parse state let finalise (builder: GreenNodeBuilder) rootKind state = let root = - builder.BuildRoot(rootKind |> SyntaxUtils.astToGreen) - |> SyntaxNode.CreateRoot + builder.BuildRoot(rootKind |> SyntaxUtils.astToGreen) |> SyntaxNode.CreateRoot { Diagnostics = state.Diagnostics Root = root } @@ -169,10 +168,7 @@ let private parseConstant (builder: GreenNodeBuilder) state = let private skipAtmosphere (builder: GreenNodeBuilder) state = let mutable state = state - while lookingAtAny - [ TokenKind.Whitespace - TokenKind.Comment ] - state do + while lookingAtAny [ TokenKind.Whitespace; TokenKind.Comment ] state do state <- eat builder AstKind.ATMOSPHERE state state @@ -187,9 +183,7 @@ let rec private parseQuote (builder: GreenNodeBuilder) state = builder.StartNode(AstKind.QUOTED_DATUM |> SyntaxUtils.astToGreen) let state = - state - |> expect builder TokenKind.Quote AstKind.QUOTE - |> parseExpr builder + state |> expect builder TokenKind.Quote AstKind.QUOTE |> parseExpr builder builder.FinishNode() state @@ -203,12 +197,7 @@ and private parseAtom builder state = and private parseFormTail builder state = let mutable state = state - while not ( - lookingAtAny - [ TokenKind.EndOfFile - TokenKind.CloseBracket ] - state - ) do + while not (lookingAtAny [ TokenKind.EndOfFile; TokenKind.CloseBracket ] state) do state <- parseExpr builder state let state = expect builder TokenKind.CloseBracket AstKind.CLOSE_PAREN state @@ -289,13 +278,11 @@ let readRaw mode name (line: string) = /// Read a sequence of expressions as a program from the given `input`. let readProgram name input = - readRaw Program name input - |> ParseResult.map (fun x -> new Program(x)) + readRaw Program name input |> ParseResult.map (fun x -> new Program(x)) /// Read a single expression from the named input `line`. let readExpr1 name line = - readRaw Script name line - |> ParseResult.map (fun x -> new ScriptProgram(x)) + readRaw Script name line |> ParseResult.map (fun x -> new ScriptProgram(x)) /// Read a single expression from the input `line` using an implicit name. let readExpr = readExpr1 "repl" diff --git a/src/Feersum.CompilerServices/Syntax/SyntaxShim.fs b/src/Feersum.CompilerServices/Syntax/SyntaxShim.fs index 7622506..f977e17 100644 --- a/src/Feersum.CompilerServices/Syntax/SyntaxShim.fs +++ b/src/Feersum.CompilerServices/Syntax/SyntaxShim.fs @@ -10,11 +10,7 @@ type LegacyNodeKind<'a> = Feersum.CompilerServices.Syntax.AstNodeKind<'a> let rec transformExpr (doc: TextDocument) (expr: Expression) : LegacyNode = let kind = match expr with - | Form f -> - f.Body - |> Seq.map (transformExpr doc) - |> List.ofSeq - |> LegacyNodeKind.Form + | Form f -> f.Body |> Seq.map (transformExpr doc) |> List.ofSeq |> LegacyNodeKind.Form | _ -> // TODO: All the other node kinds LegacyNodeKind.Error @@ -25,10 +21,7 @@ let rec transformExpr (doc: TextDocument) (expr: Expression) : LegacyNode = /// Transform a program into a legacy AST let transformProgram (doc: TextDocument) (prog: Program) : LegacyNode = let body = - prog.Body - |> Seq.map (transformExpr doc) - |> List.ofSeq - |> LegacyNodeKind.Seq + prog.Body |> Seq.map (transformExpr doc) |> List.ofSeq |> LegacyNodeKind.Seq { Kind = body Location = TextDocument.rangeToLocation doc prog.SyntaxRange } diff --git a/src/Feersum.CompilerServices/Syntax/Tree.fs b/src/Feersum.CompilerServices/Syntax/Tree.fs index 652f8d5..bed4fe6 100644 --- a/src/Feersum.CompilerServices/Syntax/Tree.fs +++ b/src/Feersum.CompilerServices/Syntax/Tree.fs @@ -117,12 +117,8 @@ module private Utils = let cookIdentifier (token: SyntaxToken) = let tokenText = token.Green.Text - if - tokenText.StartsWith('|') - && tokenText.EndsWith('|') - then - tokenText[1 .. (tokenText.Length - 2)] - |> cookString + if tokenText.StartsWith('|') && tokenText.EndsWith('|') then + tokenText[1 .. (tokenText.Length - 2)] |> cookString else tokenText @@ -142,16 +138,14 @@ type AstItem internal (red: NodeOrToken) = /// Get the Syntax range of the item member public _.SyntaxRange = - red - |> NodeOrToken.consolidate (fun n -> n.Range) (fun t -> t.Range) + red |> NodeOrToken.consolidate (fun n -> n.Range) (fun t -> t.Range) member _.Text = red |> NodeOrToken.consolidate (fun n -> n.Green.ToString()) (fun t -> t.Green.Text) override _.ToString() = - red - |> NodeOrToken.consolidate (fun n -> n.ToString()) (fun t -> t.ToString()) + red |> NodeOrToken.consolidate (fun n -> n.ToString()) (fun t -> t.ToString()) // *********** TOKENS @@ -297,10 +291,7 @@ type ScriptProgram internal (red: SyntaxNode) = inherit AstNode(red) - member _.Body = - red.Children() - |> Seq.choose (Expression.TryCast) - |> Seq.tryExactlyOne + member _.Body = red.Children() |> Seq.choose (Expression.TryCast) |> Seq.tryExactlyOne static member TryCast(red: SyntaxNode) = if red.Kind = (AstKind.PROGRAM |> astToGreen) then diff --git a/src/Feersum.CompilerServices/Text.fs b/src/Feersum.CompilerServices/Text.fs index bf924b2..40eaa1f 100644 --- a/src/Feersum.CompilerServices/Text.fs +++ b/src/Feersum.CompilerServices/Text.fs @@ -30,7 +30,7 @@ type public TextLocation = /// before any text represented by this locaiton. member x.Start = match x with - | Span (s, _) -> s + | Span(s, _) -> s | Point p -> p | Missing -> TextPoint.FromParts("missing", 0, 0) @@ -38,7 +38,7 @@ type public TextLocation = /// after any text represented by this location. member x.End = match x with - | Span (_, e) -> e + | Span(_, e) -> e | Point p -> p | Missing -> TextPoint.FromParts("missing", 0, 0) @@ -59,8 +59,8 @@ module public TextDocument = let private offsetToLineCol lines offset = match List.tryFindIndex (fun x -> x > offset) lines with - | Some (0) -> (1, offset) - | Some (idx) -> (idx, offset - lines[idx - 1]) + | Some(0) -> (1, offset) + | Some(idx) -> (idx, offset - lines[idx - 1]) | None -> let lineCount = List.length lines diff --git a/src/Feersum.CompilerServices/Utils.fs b/src/Feersum.CompilerServices/Utils.fs index 3489908..d936e90 100644 --- a/src/Feersum.CompilerServices/Utils.fs +++ b/src/Feersum.CompilerServices/Utils.fs @@ -45,9 +45,7 @@ module Result = /// then `Ok` is returned with the inner values as a list. If any result is /// `Error` the first such is returned. let collect results = - results - |> collectAll - |> Result.mapError (List.head) + results |> collectAll |> Result.mapError (List.head) /// Extract the value from a result, or fallback to a default value. let okOr fallback = @@ -68,4 +66,4 @@ module Option = let ofResult = function | Result.Ok o -> Some(o) - | Error () -> None + | Error() -> None diff --git a/src/Feersum.Stage1/Program.fs b/src/Feersum.Stage1/Program.fs index c9fd72c..488211e 100644 --- a/src/Feersum.Stage1/Program.fs +++ b/src/Feersum.Stage1/Program.fs @@ -36,23 +36,15 @@ let main argv = let args = parser.Parse(argv) - let buildConfig = - args.TryGetResult Configuration - |> Option.defaultValue Release + let buildConfig = args.TryGetResult Configuration |> Option.defaultValue Release - let outputType = - args.TryGetResult OutputType - |> Option.defaultValue Exe + let outputType = args.TryGetResult OutputType |> Option.defaultValue Exe let options = { CompilationOptions.Create buildConfig outputType with - Version = - args.TryGetResult AssemblyVersion - |> Option.map Version.Parse + Version = args.TryGetResult AssemblyVersion |> Option.map Version.Parse References = args.GetResults Reference - GenerateDepsFiles = - (args.TryGetResult GenerateDeps) - |> Option.defaultValue true + GenerateDepsFiles = (args.TryGetResult GenerateDeps) |> Option.defaultValue true MsCorePaths = args.GetResults CoreLibPath } let diags = diff --git a/src/Feersum/ParseRepl.fs b/src/Feersum/ParseRepl.fs index 4993535..23c9e10 100644 --- a/src/Feersum/ParseRepl.fs +++ b/src/Feersum/ParseRepl.fs @@ -7,8 +7,7 @@ open Feersum.CompilerServices.Syntax open Feersum.CompilerServices.Syntax.Parse let private read () = - ReadLine.Read("[]> ") - |> Parse.readProgram "repl.scm" + ReadLine.Read("[]> ") |> Parse.readProgram "repl.scm" let private print (result: ParseResult) = if ParseResult.hasErrors result then diff --git a/src/Feersum/Program.fs b/src/Feersum/Program.fs index 136d370..b1abc44 100644 --- a/src/Feersum/Program.fs +++ b/src/Feersum/Program.fs @@ -48,7 +48,7 @@ let private compileAll (options: CompilationOptions) output sources = let outputPath = match output with - | Some (path) -> path + | Some(path) -> path | None -> Path.ChangeExtension(mainSource, options.DefaultExtension) match Compilation.compileFiles options outputPath sources with @@ -78,25 +78,15 @@ let main argv = printVersion () exit 0 - let buildConfig = - args.TryGetResult Configuration - |> Option.defaultValue Release + let buildConfig = args.TryGetResult Configuration |> Option.defaultValue Release - let outputType = - args.TryGetResult OutputType - |> Option.defaultValue Exe + let outputType = args.TryGetResult OutputType |> Option.defaultValue Exe let options = { CompilationOptions.Create buildConfig outputType with - Version = - args.TryGetResult AssemblyVersion - |> Option.map Version.Parse - References = - args.GetResults Reference - |> List.append coreReferences - GenerateDepsFiles = - (args.TryGetResult GenerateDeps) - |> Option.defaultValue true + Version = args.TryGetResult AssemblyVersion |> Option.map Version.Parse + References = args.GetResults Reference |> List.append coreReferences + GenerateDepsFiles = (args.TryGetResult GenerateDeps) |> Option.defaultValue true MsCorePaths = args.GetResults CoreLibPath } match args.GetResult(Compile, defaultValue = []), args.TryGetResult(Output) with @@ -106,7 +96,7 @@ let main argv = | [ "parserepl" ], None -> runParserRepl () 0 - | [], Some (output) -> + | [], Some(output) -> eprintfn "No source files provided for output %s" output exit -1 | files, output -> compileAll options output files diff --git a/src/Feersum/Repl.fs b/src/Feersum/Repl.fs index c99b52c..2e345e7 100644 --- a/src/Feersum/Repl.fs +++ b/src/Feersum/Repl.fs @@ -33,8 +33,8 @@ let rec private repl evaluator = match (read >> evaluator) () with | Result.Ok _ -> () | Result.Error diags -> dumpDiagnostics (diags) - with - | ex -> eprintfn "Exception: %A" ex + with ex -> + eprintfn "Exception: %A" ex repl evaluator @@ -45,6 +45,8 @@ let runRepl () = ReadLine.HistoryEnabled <- true printVersion () - let options = { defaultScriptOptions with References = coreReferences } + let options = + { defaultScriptOptions with + References = coreReferences } evalWith options >> Result.map print |> repl diff --git a/test/Feersum.Tests/EvalTests.fs b/test/Feersum.Tests/EvalTests.fs index 4816aab..e801853 100644 --- a/test/Feersum.Tests/EvalTests.fs +++ b/test/Feersum.Tests/EvalTests.fs @@ -27,14 +27,7 @@ let ``Evaluate atoms`` () = [] let ``Evaluate lists`` () = - Assert.Equal( - "132", - feeri ( - Seq [ Boolean false |> constant - Number 132.0 |> constant ] - |> node - ) - ) + Assert.Equal("132", feeri (Seq [ Boolean false |> constant; Number 132.0 |> constant ] |> node)) Assert.Equal("#t", feeri (Seq [ Boolean true |> constant ] |> node)) @@ -47,11 +40,13 @@ let ``Evaluate lambdas returns`` () = Assert.Equal( "123", feeri ( - Form [ Form [ Ident "lambda" |> node - Form [ Ident "x" |> node ] |> node - Ident "x" |> node ] - |> node - Number 123.0 |> constant ] + Form + [ Form + [ Ident "lambda" |> node + Form [ Ident "x" |> node ] |> node + Ident "x" |> node ] + |> node + Number 123.0 |> constant ] |> node ) ) @@ -61,28 +56,17 @@ let ``Evaluate builtins`` () = Assert.Equal( "19", feeri ( - Form [ Ident "+" |> node - Number 10.0 |> constant - Number 9.0 |> constant ] + Form [ Ident "+" |> node; Number 10.0 |> constant; Number 9.0 |> constant ] |> node ) ) - Assert.Equal( - "901", - feeri ( - Form [ Ident "+" |> node - Number 901.0 |> constant ] - |> node - ) - ) + Assert.Equal("901", feeri (Form [ Ident "+" |> node; Number 901.0 |> constant ] |> node)) Assert.Equal( "90", feeri ( - Form [ Ident "*" |> node - Number 10.0 |> constant - Number 9.0 |> constant ] + Form [ Ident "*" |> node; Number 10.0 |> constant; Number 9.0 |> constant ] |> node ) ) @@ -90,12 +74,11 @@ let ``Evaluate builtins`` () = Assert.Equal( "901", feeri ( - Form [ Ident "+" |> node - Form [ Ident "*" |> node - Number 100.0 |> constant - Number 9.0 |> constant ] - |> node - Number 1.0 |> constant ] + Form + [ Ident "+" |> node + Form [ Ident "*" |> node; Number 100.0 |> constant; Number 9.0 |> constant ] + |> node + Number 1.0 |> constant ] |> node ) ) @@ -103,9 +86,7 @@ let ``Evaluate builtins`` () = Assert.Equal( "1", feeri ( - Form [ Ident "-" |> node - Number 10.0 |> constant - Number 9.0 |> constant ] + Form [ Ident "-" |> node; Number 10.0 |> constant; Number 9.0 |> constant ] |> node ) ) @@ -113,9 +94,7 @@ let ``Evaluate builtins`` () = Assert.Equal( "2", feeri ( - Form [ Ident "/" |> node - Number 16.0 |> constant - Number 8.0 |> constant ] + Form [ Ident "/" |> node; Number 16.0 |> constant; Number 8.0 |> constant ] |> node ) ) @@ -154,14 +133,7 @@ let ``evaluate artithemtic ops`` expr result = let ``comp ops return true for simple cases`` op = Assert.Equal("#t", feeri (Form [ Ident op |> node ] |> node)) - Assert.Equal( - "#t", - feeri ( - Form [ Ident op |> node - Number 123.456 |> constant ] - |> node - ) - ) + Assert.Equal("#t", feeri (Form [ Ident op |> node; Number 123.456 |> constant ] |> node)) [] [] diff --git a/test/Feersum.Tests/LexTests.fs b/test/Feersum.Tests/LexTests.fs index 71d3e18..a9e161c 100644 --- a/test/Feersum.Tests/LexTests.fs +++ b/test/Feersum.Tests/LexTests.fs @@ -7,8 +7,7 @@ open Feersum.CompilerServices.Syntax.Lex open Feersum.CompilerServices.Text let private p name line col = - TextPoint.FromParts(name, line, col) - |> TextLocation.Point + TextPoint.FromParts(name, line, col) |> TextLocation.Point /// Grab the kind from a syntax token pair. let private getKind token = @@ -101,13 +100,7 @@ let ``Lexer lex single token`` (token, kind) = let (line, col) = token - |> Seq.fold - (fun (line, col) char -> - if char = '\n' then - (line + 1, 0) - else - (line, col + 1)) - (1, 0) + |> Seq.fold (fun (line, col) char -> if char = '\n' then (line + 1, 0) else (line, col + 1)) (1, 0) Assert.Equal( [ { Kind = kind diff --git a/test/Feersum.Tests/LibraryTests.fs b/test/Feersum.Tests/LibraryTests.fs index 52aa730..3d11d68 100644 --- a/test/Feersum.Tests/LibraryTests.fs +++ b/test/Feersum.Tests/LibraryTests.fs @@ -10,35 +10,17 @@ let ``Match library names`` () = Assert.True(matchLibraryName [] []) Assert.True(matchLibraryName [ "test" ] [ "test" ]) - Assert.True( - matchLibraryName [ "scheme"; "base" ] [ - "scheme" - "base" - ] - ) + Assert.True(matchLibraryName [ "scheme"; "base" ] [ "scheme"; "base" ]) - Assert.False( - matchLibraryName [ "scheme" ] [ - "scheme" - "base" - ] - ) + Assert.False(matchLibraryName [ "scheme" ] [ "scheme"; "base" ]) - Assert.False( - matchLibraryName [ "scheme"; "base" ] [ - "scheme" - ] - ) + Assert.False(matchLibraryName [ "scheme"; "base" ] [ "scheme" ]) [] let ``pretty names`` () = Assert.Equal("()", prettifyLibraryName []) - Assert.Equal( - "(test library)", - prettifyLibraryName [ "test" - "library" ] - ) + Assert.Equal("(test library)", prettifyLibraryName [ "test"; "library" ]) Assert.Equal("(foo)", prettifyLibraryName [ "foo" ]) diff --git a/test/Feersum.Tests/MacroTests.fs b/test/Feersum.Tests/MacroTests.fs index bbc6664..c9744df 100644 --- a/test/Feersum.Tests/MacroTests.fs +++ b/test/Feersum.Tests/MacroTests.fs @@ -12,9 +12,7 @@ open Feersum.CompilerServices.Text let private parse pattern literals = - match (readSingleNode pattern) - |> parsePattern "..." literals - with + match (readSingleNode pattern) |> parsePattern "..." literals with | Result.Ok p -> p | Result.Error e -> failwithf "Could not parse macro pattern %A" e @@ -43,10 +41,7 @@ let rec private pp syntax = match syntax.Kind with | Constant c -> ppConst c | Ident id -> id - | Form f -> - List.map (pp) f - |> String.concat " " - |> sprintf "(%s)" + | Form f -> List.map (pp) f |> String.concat " " |> sprintf "(%s)" | x -> failwithf "unsupported syntax kind %A" x let private assertMatches pattern syntax = @@ -143,13 +138,11 @@ let ``simple form patterns`` () = Assert.Equal( MacroBindings.Empty, assertMatches - (MacroPattern.Form [ MacroPattern.Constant(Boolean false) - MacroPattern.Constant(Str "frob") - MacroPattern.Constant(Number 123.56) ]) - (Form [ constant (Boolean false) - constant (Str "frob") - number 123.56 ] - |> node) + (MacroPattern.Form + [ MacroPattern.Constant(Boolean false) + MacroPattern.Constant(Str "frob") + MacroPattern.Constant(Number 123.56) ]) + (Form [ constant (Boolean false); constant (Str "frob"); number 123.56 ] |> node) ) let testNode = (number 123.4) @@ -200,9 +193,7 @@ let ``macro parse tests`` pattern syntax shouldMatch = [] let ``custom elipsis patterns`` () = - let pattern = - parsePattern ":::" [] (readSingleNode "(a :::)") - |> Result.unwrap + let pattern = parsePattern ":::" [] (readSingleNode "(a :::)") |> Result.unwrap Assert.Equal(MacroPattern.Form [ MacroPattern.Repeat(MacroPattern.Variable "a") ], pattern) diff --git a/test/Feersum.Tests/SpecTests.fs b/test/Feersum.Tests/SpecTests.fs index 6465c0b..41e4474 100644 --- a/test/Feersum.Tests/SpecTests.fs +++ b/test/Feersum.Tests/SpecTests.fs @@ -61,15 +61,11 @@ let private runExampleAsync host (exePath: string) = // p.StartInfo.RedirectStandardInput <- true p.StartInfo.RedirectStandardOutput <- true p.StartInfo.RedirectStandardError <- true - p.StartInfo.Environment[ "FEERSUM_TESTING" ] <- "test-sentinel" + p.StartInfo.Environment["FEERSUM_TESTING"] <- "test-sentinel" Assert.True(p.Start()) task { - let! output = - Task.WhenAll( - [| p.StandardOutput.ReadToEndAsync() - p.StandardError.ReadToEndAsync() |] - ) + let! output = Task.WhenAll([| p.StandardOutput.ReadToEndAsync(); p.StandardError.ReadToEndAsync() |]) let! exit = p.WaitForExitAsync() @@ -89,7 +85,7 @@ let private parseDirectives (sourcePath: string) = let m = Regex.Match(line, ";+\s*!(depends):(.+)") if m.Success then - Some((m.Groups[ 1 ].Value.ToLowerInvariant(), m.Groups[2].Value)) + Some((m.Groups[1].Value.ToLowerInvariant(), m.Groups[2].Value)) else None else @@ -103,10 +99,8 @@ let private parseDirectives (sourcePath: string) = let public getRunTestData () = executableSpecs |> Seq.collect (fun spec -> - [ [| spec :> obj - BuildConfiguration.Debug :> obj |] - [| spec :> obj - BuildConfiguration.Release :> obj |] ]) + [ [| spec :> obj; BuildConfiguration.Debug :> obj |] + [| spec :> obj; BuildConfiguration.Release :> obj |] ]) [] [] @@ -114,12 +108,10 @@ let rec ``spec tests compile and run`` specPath configuration = let sourcePath = Path.Join(specDir, specPath) let options = - { (CompilationOptions.Create configuration Exe) with GenerateDepsFiles = true } + { (CompilationOptions.Create configuration Exe) with + GenerateDepsFiles = true } - let binDir = - [| specBin - options.Configuration |> string |] - |> Path.Combine + let binDir = [| specBin; options.Configuration |> string |] |> Path.Combine let shouldFail = sourcePath.Contains "fail" @@ -175,13 +167,11 @@ let rec ``spec tests compile and run`` specPath configuration = if not shouldFail then failwithf "Compilation error: %A" diags - (diags |> diagSanitiser) - .ShouldMatchSnapshot(snapshotId) + (diags |> diagSanitiser).ShouldMatchSnapshot(snapshotId) } let public getParseTestData () = - Seq.append librarySpecs executableSpecs - |> Seq.map (fun x -> [| x |]) + Seq.append librarySpecs executableSpecs |> Seq.map (fun x -> [| x |]) [] [] @@ -198,9 +188,7 @@ let ``Test new lexer`` s = task { let! sourceText = File.ReadAllTextAsync(Path.Join(specDir, s)) - let lexer = - (Lex.tokenise sourceText "test.scm") - .GetEnumerator() + let lexer = (Lex.tokenise sourceText "test.scm").GetEnumerator() let mutable bail = 0 let mutable errors = 0 diff --git a/test/Feersum.Tests/SyntaxTests.fs b/test/Feersum.Tests/SyntaxTests.fs index b13f67a..08f1040 100644 --- a/test/Feersum.Tests/SyntaxTests.fs +++ b/test/Feersum.Tests/SyntaxTests.fs @@ -17,9 +17,7 @@ let sanitise = [] let ``parse seqs`` () = Assert.Equal( - Seq [ Number 1.0 |> Constant |> node - Number 23.0 |> Constant |> node ] - |> node, + Seq [ Number 1.0 |> Constant |> node; Number 23.0 |> Constant |> node ] |> node, readMany "1 23" |> sanitise ) @@ -27,9 +25,11 @@ let ``parse seqs`` () = Assert.Equal(Seq [] |> node, readMany "" |> sanitise) Assert.Equal( - Seq [ Form [ Ident "+" |> node - Number 12.0 |> Constant |> node - Number 34.0 |> Constant |> node ] + Seq + [ Form + [ Ident "+" |> node + Number 12.0 |> Constant |> node + Number 34.0 |> Constant |> node ] |> node Boolean false |> Constant |> node ] |> node, diff --git a/test/Feersum.Tests/SyntaxTestsNew.fs b/test/Feersum.Tests/SyntaxTestsNew.fs index ea17e86..212ac8d 100644 --- a/test/Feersum.Tests/SyntaxTestsNew.fs +++ b/test/Feersum.Tests/SyntaxTestsNew.fs @@ -163,7 +163,7 @@ let ``identifier literals`` raw (cooked: string) = Assert.Equal(AstKind.IDENTIFIER, identTok |> getTokenKind) match script.Body with - | Some (Symbol s) -> Assert.Equal(cooked, s.CookedValue) + | Some(Symbol s) -> Assert.Equal(cooked, s.CookedValue) | _ -> failwithf "Expected identifier but got %A" script.Body // [] @@ -199,11 +199,7 @@ let ``parse block comments`` () = Assert.Equal(AstKind.CONSTANT, readSingle "#| this is a comment |#1" |> getKind) Assert.Equal(AstKind.CONSTANT, readSingle "1#| this is a comment |#" |> getKind) - Assert.Equal( - AstKind.CONSTANT, - readSingle "#| this #| is a |# comment |#1" - |> getKind - ) + Assert.Equal(AstKind.CONSTANT, readSingle "#| this #| is a |# comment |#1" |> getKind) // [] // [] @@ -256,10 +252,7 @@ let ``syntax shim test`` () = let tree = readProgram doc.Path body |> ParseResult.toResult - |> Result.map (fun x -> - x.Body - |> Seq.map (SyntaxShim.transformExpr doc) - |> Seq.exactlyOne) + |> Result.map (fun x -> x.Body |> Seq.map (SyntaxShim.transformExpr doc) |> Seq.exactlyOne) |> Result.unwrap printfn "@%A" tree.Location diff --git a/test/Feersum.Tests/SyntaxUtils.fs b/test/Feersum.Tests/SyntaxUtils.fs index 4a33405..2745760 100644 --- a/test/Feersum.Tests/SyntaxUtils.fs +++ b/test/Feersum.Tests/SyntaxUtils.fs @@ -42,8 +42,8 @@ let public basedStreamName basePath = /// Transform a location with the given Path Re-Writer let public sanitiseLocationWith rewriter = function - | Point (p) -> Point(rewriter p) - | Span (s, e) -> Span(rewriter s, rewriter e) + | Point(p) -> Point(rewriter p) + | Span(s, e) -> Span(rewriter s, rewriter e) | Missing -> Missing /// Location Re-writer that uses the `fixedStreamName` Path Re-writer @@ -61,16 +61,17 @@ let rec public sanitiseNodeWith rewriter (node: AstNode) = and private sanitiseKind rewriter = function - | Form (f) -> List.map (sanitiseNodeWith rewriter) f |> Form - | Seq (s) -> List.map (sanitiseNodeWith rewriter) s |> Seq - | Quoted (q) -> sanitiseNodeWith rewriter q |> Quoted - | Vector (v) -> List.map (sanitiseNodeWith rewriter) v |> Vector + | Form(f) -> List.map (sanitiseNodeWith rewriter) f |> Form + | Seq(s) -> List.map (sanitiseNodeWith rewriter) s |> Seq + | Quoted(q) -> sanitiseNodeWith rewriter q |> Quoted + | Vector(v) -> List.map (sanitiseNodeWith rewriter) v |> Vector | other -> other /// Transofrm a diagnostics list with the given Location Re-Writer `rewriter` let public sanitiseDiagnosticsWith rewriter (diags: Diagnostic list) = let sanitiseDiag d = - { d with Diagnostic.Location = rewriter (d.Location) } + { d with + Diagnostic.Location = rewriter (d.Location) } List.map (sanitiseDiag) diags