-
-
Notifications
You must be signed in to change notification settings - Fork 88
/
Parser.fs
114 lines (87 loc) · 3.65 KB
/
Parser.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
module BuiltinExecution.Libs.Parser
open FSharp.Control.Tasks
open System.Threading.Tasks
open System.Text
open Prelude
open LibExecution.RuntimeTypes
open LibExecution.Builtin.Shortcuts
open LibTreeSitter
module VT = ValueType
module Dval = LibExecution.Dval
let constants : List<BuiltInConstant> = []
let packageFnType
(addlModules : List<string>)
(name : string)
(version : int)
: FQTypeName.FQTypeName =
FQTypeName.fqPackage
"Darklang"
([ "LanguageTools"; "Parser" ] @ addlModules)
name
version
let pointTypeName = packageFnType [] "Point" 0
let rangeTypeName = packageFnType [] "Range" 0
let parsedNodeTypeName = packageFnType [] "ParsedNode" 0
let fns : List<BuiltInFn> =
[ { name = fn "parserParseToSimplifiedTree" 0
typeParams = []
parameters = [ Param.make "sourceCode" TString "" ]
returnType = TCustomType(Ok(packageFnType [] "ParsedNode" 0), [])
description = "Parses some Darklang code"
fn =
(function
| _, _, [ DString sourceCode ] ->
let rec mapNodeAtCursor (cursor : TreeCursor) : Dval =
let mutable children = []
if cursor.GotoFirstChild() then
children <- children @ [ mapNodeAtCursor cursor ]
while cursor.GotoNextSibling() do
children <- children @ [ mapNodeAtCursor cursor ]
cursor.GotoParent() |> ignore<bool>
let fields =
let mapPoint (point : Point) =
let fields =
[ "row", DInt64 point.row; "column", DInt64 point.column ]
DRecord(pointTypeName, pointTypeName, [], Map fields)
let startPos = cursor.Current.StartPosition
let endPos = cursor.Current.EndPosition
let sourceRange =
let fields = [ "start", mapPoint startPos; "end_", mapPoint endPos ]
DRecord(rangeTypeName, rangeTypeName, [], Map fields)
let sourceText =
let lines = String.splitOnNewline sourceCode
if lines.Length = 0 then
""
else
match startPos.row with
| row when row = endPos.row ->
lines[row][startPos.column .. (endPos.column - 1)]
| _ ->
let firstLine = lines[startPos.row][startPos.column ..]
let middleLines =
if startPos.row + 1 <= endPos.row - 1 then
lines[startPos.row + 1 .. endPos.row - 1]
else
[]
let lastLine = lines[endPos.row][.. endPos.column - 1]
String.concat "\n" (firstLine :: middleLines @ [ lastLine ])
let fieldName =
if cursor.FieldName = null then
Dval.optionNone KTString
else
Dval.optionSome KTString (DString cursor.FieldName)
[ ("fieldName", fieldName)
("typ", DString cursor.Current.Kind)
("text", DString sourceText)
("sourceRange", sourceRange)
("children", DList(VT.customType parsedNodeTypeName [], children)) ]
DRecord(parsedNodeTypeName, parsedNodeTypeName, [], Map fields)
let parser = new Parser(Language = DarklangLanguage.create ())
let tree =
parser.Parse(Encoding.UTF8.GetBytes sourceCode, InputEncoding.Utf8, None)
tree.Root.Walk() |> mapNodeAtCursor |> Ply
| _ -> incorrectArgs ())
sqlSpec = NotQueryable
previewable = Impure
deprecated = NotDeprecated } ]
let contents = (fns, constants)