Skip to content

Instantly share code, notes, and snippets.

@teo-tsirpanis
Forked from ctaggart/AstRcd.fs
Last active October 22, 2017 16:40
Show Gist options
  • Save teo-tsirpanis/5876f041e3e127b067e56a5b62ec2edf to your computer and use it in GitHub Desktop.
Save teo-tsirpanis/5876f041e3e127b067e56a5b62ec2edf to your computer and use it in GitHub Desktop.
Generating F# code using its AST
module Fantomas.AstRcd
open System
open Microsoft.FSharp.Compiler.Ast
open Microsoft.FSharp.Compiler.Range
type ParsedImplFileInputRcd = {
File: string
IsScript: bool
QualName: QualifiedNameOfFile
Pragmas: ScopedPragma list
HashDirectives: ParsedHashDirective list
Modules: SynModuleOrNamespace list
IsLastCompiland: bool
IsExe: bool}
type ParsedImplFileInput with
member x.ToRcd
with get() =
let (ParsedImplFileInput(file, isScript, qualName, pragmas, hashDirectives, modules, (isLastCompiland, isExe))) = x
{ File = file; IsScript = isScript; QualName = qualName; Pragmas = pragmas; HashDirectives = hashDirectives; Modules = modules; IsLastCompiland = isLastCompiland; IsExe = isExe }
type ParsedImplFileInputRcd with
member x.FromRcd
with get() = ParsedImplFileInput(x.File, x.IsScript, x.QualName, x.Pragmas, x.HashDirectives, x.Modules, (x.IsLastCompiland, x.IsExe))
type SynModuleOrNamespaceRcd = {
Id: LongIdent
IsModule: bool
IsRecursive: bool
Decls: SynModuleDecls
XmlDoc: PreXmlDoc
Attribs: SynAttributes
Access: SynAccess option
Range: range }
type SynModuleOrNamespace with
member x.ToRcd
with get() =
let (SynModuleOrNamespace(id, isRecursive, isModule, decls, xmlDoc, attribs, access, range)) = x
{ Id = id; IsRecursive = isRecursive; IsModule = isModule; Decls = decls; XmlDoc = xmlDoc; Attribs = attribs; Access = access; Range = range }
type SynModuleOrNamespaceRcd with
member x.FromRcd
with get() = SynModuleOrNamespace(x.Id, x.IsRecursive, x.IsModule, x.Decls, x.XmlDoc, x.Attribs, x.Access, x.Range)
type SynTypeDefnRcd = {
Info: SynComponentInfo
Repr: SynTypeDefnRepr
Members: SynMemberDefns
Range: range }
type SynTypeDefn with
member x.ToRcd
with get() =
let (TypeDefn(info, repr, members, range)) = x
{ Info = info; Repr = repr; Members = members; Range = range }
type SynTypeDefnRcd with
member x.FromRcd
with get() = TypeDefn(x.Info, x.Repr, x.Members, x.Range)
type SynComponentInfoRcd = {
Attribs: SynAttributes
TyParams: SynTyparDecl list
Constraints: SynTypeConstraint list
Id: LongIdent
XmlDoc: PreXmlDoc
PreferPostfix: bool
Access: SynAccess option
Range: range }
type SynComponentInfo with
member x.ToRcd
with get() =
let (ComponentInfo(attribs, typarams, constraints, id, xmldoc, preferPostfix, access, range)) = x
{ Attribs = attribs; TyParams = typarams; Constraints = constraints; Id = id; XmlDoc = xmldoc; PreferPostfix = preferPostfix; Access = access; Range = range }
type SynComponentInfoRcd with
member x.FromRcd
with get() = ComponentInfo(x.Attribs, x.TyParams, x.Constraints, x.Id, x.XmlDoc, x.PreferPostfix, x.Access, x.Range)
type SynTypeDefnReprObjectModelRcd = {
Kind: SynTypeDefnKind
Members: SynMemberDefns
Range: range }
type SynTypeDefnReprSimpleRcd = {
Repr: SynTypeDefnSimpleRepr
Range: range }
let internal failcase (x:Object) = failwithf "not expecting the disciminated union case of type %s" (x.GetType().FullName)
type SynTypeDefnRepr with
member x.ToObjectModelRcd
with get() =
match x with
| SynTypeDefnRepr.ObjectModel(kind, members, range) -> { Kind = kind; Members = members; Range = range }
| _ -> failcase x
member x.ToSimpleRcd
with get() =
match x with
| SynTypeDefnRepr.Simple(repr, range) -> { Repr = repr; Range = range }
| _ -> failcase x
type SynTypeDefnReprObjectModelRcd with
member x.FromRcd
with get() = SynTypeDefnRepr.ObjectModel(x.Kind, x.Members, x.Range)
type SynTypeDefnReprSimpleRcd with
member x.FromRcd
with get() = SynTypeDefnRepr.Simple(x.Repr, x.Range)
type SynBindingRcd = {
Access: SynAccess option
Kind: SynBindingKind
IsInline: bool
IsMutable: bool
Attribs: SynAttributes
XmlDoc: PreXmlDoc
ValData: SynValData
Pat: SynPat
ReturnInfo: SynBindingReturnInfo option
Expr: SynExpr
Range: range
Bind: SequencePointInfoForBinding }
type SynBinding with
member x.ToRcd
with get() =
let (Binding(access, kind, isInline, isMutable, attrs, xmlDoc, info, headPat, retTyOpt, rhsExpr, mBind, spBind)) = x
{ Access = access; Kind = kind; IsInline = isInline; IsMutable = isMutable; Attribs = attrs; XmlDoc = xmlDoc; ValData = info; Pat = headPat; ReturnInfo = retTyOpt; Expr = rhsExpr; Range = mBind; Bind = spBind }
type SynBindingRcd with
member x.FromRcd
with get() = Binding(x.Access, x.Kind, x.IsInline, x.IsMutable, x.Attribs, x.XmlDoc, x.ValData, x.Pat, x.ReturnInfo, x.Expr, x.Range, x.Bind)
let mkId name = Ident(name, range.Zero)
let mkQualifiedNameOfFile name = QualifiedNameOfFile(mkId name)
[<AutoOpen>]
module ConsoleApp.CreateAst
open Fantomas
open Microsoft.FSharp.Compiler.Ast
open Microsoft.FSharp.Compiler.Range
let createAst() =
// create member
let memberFlags : MemberFlags = {IsInstance = true; IsDispatchSlot = false; IsOverrideOrExplicitImpl = false; IsFinal = false; MemberKind = MemberKind.Member}
let b : SynBindingRcd =
{ Access = None
Kind = SynBindingKind.NormalBinding
IsInline = false
IsMutable = false
Attribs = SynAttributes.Empty
XmlDoc = PreXmlDoc.Empty
ValData = SynValData(Some memberFlags, SynValInfo([], SynArgInfo(SynAttributes.Empty, false, None)), None)
Pat = SynPat.LongIdent(LongIdentWithDots([mkId "x"; mkId "Points"], [range.Zero]), None, None, SynConstructorArgs.Pats[], None, range.Zero)
ReturnInfo = None
Expr = SynExpr.Const(SynConst.Int32 3, range.Zero)
Range = range.Zero
Bind = SequencePointInfoForBinding.NoSequencePointAtInvisibleBinding
}
// create Type
let ti : SynComponentInfoRcd =
{ Attribs = SynAttributes.Empty
TyParams = []
Constraints = []
Id = [mkId "Triangle"]
XmlDoc = PreXmlDoc.Empty
PreferPostfix = false
Access = None
Range = range.Zero
}
let ms : SynMemberDefns =
[
SynMemberDefn.ImplicitCtor(None, SynAttributes.Empty, [], None, range.Zero)
SynMemberDefn.Member(b.FromRcd, range.Zero)
]
let r : SynTypeDefnReprObjectModelRcd =
{ //Kind = SynTypeDefnKind.TyconClass
Kind = SynTypeDefnKind.TyconUnspecified
Members = ms
Range = range.Zero
}
let t : SynTypeDefnRcd =
{ Info = ti.FromRcd
Repr = r.FromRcd
Members = []
Range = range.Zero
}
// create module
let m : SynModuleOrNamespaceRcd =
{ Id = [mkId "Hello"]
IsModule = true
Decls = [SynModuleDecl.Types([t.FromRcd], range.Zero)]
XmlDoc = PreXmlDoc.Empty
Attribs = SynAttributes.Empty
Access = None
Range = range.Zero
}
// create file
let pi : ParsedImplFileInputRcd =
{ File = "Hello.fs"
IsScript = false
QualName = QualifiedNameOfFile(mkId "Hello")
Pragmas = []
HashDirectives = []
Modules = [m.FromRcd]
IsLastCompiland = true
}
let txt = formatAst (ParsedInput.ImplFile pi.FromRcd)
printfn "%s" txt
[<AutoOpen>]
module ConsoleApp.FormatFs
open System.IO
open Fantomas
let formatAst ast =
let cfg = { FormatConfig.FormatConfig.Default with StrictMode = true } // no comments
let noOriginalSourceCode = "//"
CodeFormatter.formatAST ast noOriginalSourceCode cfg
let formatFs() =
let s = File.ReadAllText @"C:\Projects\fantomas\src\ConsoleApplication1\Hello.fs"
let isFsi = false
let ast = CodeFormatter.parse isFsi s
let txt = formatAst ast
printfn "%s" txt
module Hello
type Triangle () =
member x.Points = 3
module Hello
type Triangle() =
member x.Points = 3
[<AutoOpen>]
module ConsoleApp.PrintAstInfo
open System.IO
open Fantomas
open Microsoft.FSharp.Compiler.Ast
let printAstInfo() =
let s = File.ReadAllText @"C:\Projects\fantomas\src\ConsoleApplication1\Hello.fs"
let isFsi = false
let ast = CodeFormatter.parse isFsi s
match ast with
| ParsedInput.ImplFile f ->
let fr = f.ToRcd
let m = fr.Modules.Head.ToRcd
printfn "module: %s" m.Id.Head.idText
match m.Decls.Head with
| SynModuleDecl.Types(types, _) ->
let t = types.Head.ToRcd
printfn "type: %s" t.Info.ToRcd.Id.Head.idText
let om = t.Repr.ToObjectModelRcd
let m1 = om.Members.[1] // [[0] is ImplicitCtor
match om.Members.[1] with
| SynMemberDefn.Member(b, _) ->
let br = b.ToRcd
match br.Pat with
| SynPat.LongIdent(id,_,_,_,_,_) ->
printfn "member: %s %s" id.Lid.[0].idText id.Lid.[1].idText
match br.Expr with
| SynExpr.Const(c,_) ->
match c with
| SynConst.Int32 i -> printfn "member value: %d" i
module: Hello
type: Triangle
member: x Points
member value: 3
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment