wip

backend/src/BuiltinExecution/Libs/Parser.fs

@@ -3,6 +3,8 @@ module BuiltinExecution.Libs.Parser
 open FSharp.Control.Tasks
 open System.Threading.Tasks
 open System.Text
+open System.Globalization
+open System
 
 open Prelude
 open LibExecution.RuntimeTypes
@@ -20,6 +22,99 @@ let pointTypeName = FQTypeName.fqPackage IDs.point
 let rangeTypeName = FQTypeName.fqPackage IDs.range
 let parsedNodeTypeName = FQTypeName.fqPackage IDs.parsedNode
 
+let parse (sourceCode : string) : Dval =
+  // This was added to handle EGCs correctly
+  let byteIndexToCharIndex (byteIndex : int) (text : string) : int =
+    let bytes = Encoding.UTF8.GetBytes(text)
+    let subText = Encoding.UTF8.GetString(bytes, 0, byteIndex)
+    StringInfo.ParseCombiningCharacters(subText).Length
+
+  let processLine (line : string) (startIndex : int) (endIndex : int) =
+    let textElements = StringInfo.GetTextElementEnumerator(line)
+    let mutable result = ""
+    let mutable currentIndex = 0
+    while textElements.MoveNext() do
+      if currentIndex >= startIndex && currentIndex < endIndex then
+        result <- result + (textElements.GetTextElement())
+      currentIndex <- currentIndex + 1
+    result
+
+  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 pointRow = point.row + 1
+        let fields = [ "row", DInt64 pointRow; "column", DInt64 point.column ]
+        DRecord(pointTypeName, pointTypeName, [], Map fields)
+
+      let startPos = cursor.Current.StartPosition
+      let endPos = cursor.Current.EndPosition
+
+      let range =
+        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
+          let startLine = lines[startPos.row]
+          let endLine = lines[endPos.row]
+          let startCharIndex = byteIndexToCharIndex startPos.column startLine
+          let endCharIndex = byteIndexToCharIndex endPos.column endLine
+
+          match startPos.row with
+          | row when row = endPos.row ->
+            processLine startLine startCharIndex endCharIndex
+          | _ ->
+            let firstLine = processLine startLine startCharIndex startLine.Length
+            let middleLines =
+              if startPos.row + 1 <= endPos.row - 1 then
+                lines[startPos.row + 1 .. endPos.row - 1]
+                |> List.map (fun line -> processLine line 0 line.Length)
+              else
+                []
+            let lastLine = processLine endLine 0 endCharIndex
+            String.concat "\n" (firstLine :: middleLines @ [ lastLine ])
+
+      let stringToHex (input: string) =
+        let bytes = Encoding.UTF8.GetBytes(input)
+        BitConverter.ToString(bytes)
+
+      debuG "sourceTextHex" (stringToHex sourceText)
+
+
+      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)
+        ("range", range)
+        ("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
+
 let fns : List<BuiltInFn> =
   [ { name = fn "parserParseToSimplifiedTree" 0
       typeParams = []
@@ -28,80 +123,7 @@ let fns : List<BuiltInFn> =
       description = "Parses some Darklang code"
       fn =
         (function
-        | _, _, [ DString sourceCode ] ->
-          // This was added to handle EGCs correctly
-          let byteIndexToCharIndex (byteIndex : int) (text : string) : int =
-            let bytes = Encoding.UTF8.GetBytes(text)
-            let subText = Encoding.UTF8.GetString(bytes, 0, byteIndex)
-            subText.Length
-
-          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 range =
-                let fields = [ "start", mapPoint startPos; "end_", mapPoint endPos ]
-                DRecord(rangeTypeName, rangeTypeName, [], Map fields)
-
-              let startCharIndex = byteIndexToCharIndex startPos.column sourceCode
-              let endCharIndex = byteIndexToCharIndex endPos.column sourceCode
-
-              let sourceText =
-                let lines = String.splitOnNewline sourceCode
-                if lines.Length = 0 then
-                  ""
-                else
-                  match startPos.row with
-                  | row when row = endPos.row ->
-                    lines[row][startCharIndex .. (endCharIndex - 1)]
-                  | _ ->
-                    let firstLine = lines[startPos.row][startCharIndex..]
-                    let middleLines =
-                      if startPos.row + 1 <= endPos.row - 1 then
-                        lines[startPos.row + 1 .. endPos.row - 1]
-                      else
-                        []
-                    let lastLine = lines[endPos.row][.. (endCharIndex - 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)
-                ("range", range)
-                ("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
+        | _, _, [ DString sourceCode ] -> (parse sourceCode) |> Ply
         | _ -> incorrectArgs ())
       sqlSpec = NotQueryable
       previewable = Impure

backend/src/LibExecution/PackageIDs.fs

@@ -383,6 +383,9 @@ module Fn =
       let parseSingleTestFromFile =
         p [] "parseSingleTestFromFile" "53f3fbc6-25fd-427a-ab0d-ba0559543c99"
 
+      let parseTestFile =
+        p [] "parseTestFile" "95dc8d95-dd38-4df2-aaac-9e78187a17be"
+
   // what we expose to the outside world
   let idForName
     (owner : string)

backend/src/LibExecution/ProgramTypesToDarkTypes.fs

@@ -921,6 +921,9 @@ module Expr =
             Exception.raiseInternal "Invalid record update" [ "update", update ])
       PT.ERecordUpdate(uint64 id, fromDT record, updates)
 
+    | DEnum(_, _, [], "EConstant", [ DInt64 id; name ]) ->
+      PT.EConstant(uint64 id, NameResolution.fromDT FQConstantName.fromDT name)
+
     | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ]
 
 
@@ -987,6 +990,7 @@ module Const =
     | DEnum(_, _, [], "CBool", [ DBool b ]) -> PT.Const.CBool b
     | DEnum(_, _, [], "CString", [ DString s ]) -> PT.Const.CString s
     | DEnum(_, _, [], "CChar", [ DChar c ]) -> PT.Const.CChar c
+    | DEnum(_, _, [], "CChar", [ DString c ]) -> PT.Const.CChar c
     | DEnum(_, _, [], "CFloat", [ sign; DString w; DString f ]) ->
       PT.Const.CFloat(Sign.fromDT sign, w, f)
     | DEnum(_, _, [], "CUnit", []) -> PT.Const.CUnit

backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs

@@ -165,7 +165,20 @@ module MatchPattern =
 module Expr =
   let rec toRT (e : PT.Expr) : RT.Expr =
     match e with
-    | PT.EChar(id, char) -> RT.EChar(id, char)
+    | PT.EChar(id, char) ->
+      let char =
+        char
+        |> fun s -> s.Replace(@"\t", "\t")
+        |> fun s -> s.Replace(@"\n", "\n")
+        |> fun s -> s.Replace(@"\r", "\r")
+        |> fun s -> s.Replace(@"\b", "\b")
+        |> fun s -> s.Replace(@"\f", "\f")
+        |> fun s -> s.Replace(@"\v", "\v")
+        |> fun s -> s.Replace(@"\""", "\"")
+        |> fun s -> s.Replace(@"\'", "'")
+        |> fun s -> s.Replace(@"\\", "\\")
+
+      RT.EChar(id, char)
     | PT.EInt64(id, num) -> RT.EInt64(id, num)
     | PT.EUInt64(id, num) -> RT.EUInt64(id, num)
     | PT.EInt8(id, num) -> RT.EInt8(id, num)
@@ -350,7 +363,28 @@ module Expr =
 
   and stringSegmentToRT (segment : PT.StringSegment) : RT.StringSegment =
     match segment with
-    | PT.StringText text -> RT.StringText text
+    | PT.StringText text ->
+      text
+      |> fun s ->
+        System.Text.RegularExpressions.Regex.Replace(s, @"\\x([0-9A-Fa-f]{2})",
+          fun m ->
+            let hexValue = System.Convert.ToByte(m.Groups[1].Value, 16)
+            string (char hexValue))
+      |> fun s ->
+        System.Text.RegularExpressions.Regex.Replace(s, @"\\u([0-9A-Fa-f]{4})",
+          fun m ->
+            let unicodeValue = System.Convert.ToInt32(m.Groups[1].Value, 16)
+            string (char unicodeValue))
+      |> fun s -> s.Replace(@"\t", "\t")
+      |> fun s -> s.Replace(@"\n", "\n")
+      |> fun s -> s.Replace(@"\r", "\r")
+      |> fun s -> s.Replace(@"\b", "\b")
+      |> fun s -> s.Replace(@"\f", "\f")
+      |> fun s -> s.Replace(@"\v", "\v")
+      |> fun s -> s.Replace(@"\""", "\"")
+      |> fun s -> s.Replace(@"\'", "'")
+      |> fun s -> s.Replace(@"\\", "\\")
+      |> RT.StringText
     | PT.StringInterpolation expr -> RT.StringInterpolation(toRT expr)
 
 

backend/src/LibTreeSitter/TreeSitter.fs

@@ -194,6 +194,7 @@ type Node(handle : Native.TsNode) =
   override _.ToString() =
     let cPtr = Native.ts_node_string.Invoke(handle)
     try
+      // check on this
       Marshal.PtrToStringAnsi(cPtr)
     finally
       Marshal.FreeHGlobal(cPtr)

backend/src/Prelude/Prelude.fs

@@ -290,7 +290,7 @@ let readFloat (f : float) : (Sign * string * string) =
 let makeFloat (sign : Sign) (whole : string) (fraction : string) : float =
   try
     if whole <> "" then assert_ "non-zero string" [] (whole[0] <> '-')
-    if whole <> "0" then assertRe $"makefloat" "[1-9][0-9]*" whole
+    if whole <> "0" then assertRe $"makefloat" "0*[0-9]+" whole
     let sign =
       match sign with
       | Positive -> ""

backend/src/Prelude/String.fs

@@ -30,6 +30,8 @@ let lengthInEgcs (s : string) : int =
   System.Globalization.StringInfo(s).LengthInTextElements
 
 let normalize (s : string) : string = s.Normalize()
+// let normalize (s : string) : string =
+//   s.Normalize(System.Text.NormalizationForm.FormC)
 
 let equalsCaseInsensitive (s1 : string) (s2 : string) : bool =
   System.String.Equals(s1, s2, System.StringComparison.InvariantCultureIgnoreCase)

backend/testfiles/execution/cloud/_events.dark

@@ -4,18 +4,18 @@
 type FruitRecord = { fruits: List<String> }
 
 // getQueue works
-Builtin.testGetQueue_v0 "TestWorker" = []
+Builtin.testGetQueue "TestWorker" = []
 
 // emit works
 (let _ = Builtin.emit "value" "TestWorker"
- let queue = Builtin.testGetQueue_v0 "TestWorker"
+ let queue = Builtin.testGetQueue "TestWorker"
  queue) = [ "\"value\"" ]
 
 // emit works with mixed values
 (let _ = Builtin.emit "value" "TestWorker"
  let _ = Builtin.emit 1 "TestWorker"
  let _ = Builtin.emit (FruitRecord { fruits = [ "apple"; "banana" ] }) "TestWorker"
- let queue = Builtin.testGetQueue_v0 "TestWorker"
- Stdlib.List.sort queue) = [ "\"value\""
-                               "1"
-                               "FruitRecord {\n  fruits: [\n    \"apple\", \"banana\"\n  ]\n}" ]
+ let queue = Builtin.testGetQueue "TestWorker"
+ Stdlib.List.sort queue) = [  "\"value\""
+                              "1"
+                              "FruitRecord {\n  fruits: [\n    \"apple\", \"banana\"\n  ]\n}" ]