Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
OceanOak committed Sep 24, 2024
1 parent e94a305 commit 4cae2c1
Show file tree
Hide file tree
Showing 75 changed files with 10,435 additions and 9,169 deletions.
6 changes: 3 additions & 3 deletions backend/src/BuiltinDarkInternal/Libs/DBs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ let fns : List<BuiltInFn> =
[ { name = fn "darkInternalCanvasDBList" 0
typeParams = []
parameters = [ Param.make "canvasID" TUuid "" ]
returnType = TList TInt64
returnType = TList TInt64 // TODO: should this be a TUInt64?
description = "Returns a list of toplevel ids of dbs in <param canvasName>"
fn =
(function
Expand All @@ -33,14 +33,14 @@ let fns : List<BuiltInFn> =
{ name = fn "darkInternalCanvasDBUnlocked" 0
typeParams = []
parameters = [ Param.make "canvasID" TUuid "" ]
returnType = TList TInt64
returnType = TList TUInt64
description = "Get a list of unlocked DBs"
fn =
(function
| _, _, [ DUuid canvasID ] ->
uply {
let! unlocked = UserDB.unlocked canvasID
return unlocked |> List.map int64 |> List.map DInt64 |> Dval.list KTInt64
return unlocked |> List.map DUInt64 |> Dval.list KTUInt64
}
| _ -> incorrectArgs ())
sqlSpec = NotQueryable
Expand Down
42 changes: 33 additions & 9 deletions backend/src/BuiltinExecution/Libs/Parser.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -33,7 +35,21 @@ let fns : List<BuiltInFn> =
let byteIndexToCharIndex (byteIndex : int) (text : string) : int =
let bytes = Encoding.UTF8.GetBytes(text)
let subText = Encoding.UTF8.GetString(bytes, 0, byteIndex)
subText.Length
StringInfo.ParseCombiningCharacters(subText).Length

let getUnicodeAwareSubstring
(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 = []
Expand All @@ -48,8 +64,9 @@ let fns : List<BuiltInFn> =

let fields =
let mapPoint (point : Point) =
let pointRow = point.row + 1
let fields =
[ "row", DInt64 point.row; "column", DInt64 point.column ]
[ "row", DInt64 pointRow; "column", DInt64 point.column ]
DRecord(pointTypeName, pointTypeName, [], Map fields)

let startPos = cursor.Current.StartPosition
Expand All @@ -59,26 +76,33 @@ let fns : List<BuiltInFn> =
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
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 ->
lines[row][startCharIndex .. (endCharIndex - 1)]
getUnicodeAwareSubstring startLine startCharIndex endCharIndex
| _ ->
let firstLine = lines[startPos.row][startCharIndex..]
let firstLine =
getUnicodeAwareSubstring
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 ->
getUnicodeAwareSubstring line 0 line.Length)
else
[]
let lastLine = lines[endPos.row][.. (endCharIndex - 1)]

let lastLine = getUnicodeAwareSubstring endLine 0 endCharIndex
String.concat "\n" (firstLine :: middleLines @ [ lastLine ])

let fieldName =
Expand Down
3 changes: 3 additions & 0 deletions backend/src/LibExecution/PackageIDs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
45 changes: 43 additions & 2 deletions backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs
Original file line number Diff line number Diff line change
Expand Up @@ -163,9 +163,49 @@ module MatchPattern =


module Expr =
let replaceEscapeSequences (s : string) : string =
s
|> 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(@"\\", "\\")

let replaceHex (text : string) : string =
// matches hexadecimal escape sequences (e.g. `\x01`)
let regex = System.Text.RegularExpressions.Regex(@"\\x([0-9A-Fa-f]{2})")

regex.Replace(
text,
fun (m : System.Text.RegularExpressions.Match) ->
// Groups[1] refers to the first captured group (the two hex digits)
m.Groups[1].Value
|> fun hex -> System.Convert.ToByte(hex, 16)
|> char
|> string
)

let replaceUnicode (text : string) : string =
// matches unicode escape sequences (e.g. `\u0001`)
let regex = System.Text.RegularExpressions.Regex(@"\\u([0-9A-Fa-f]{4})")

regex.Replace(
text,
fun (m : System.Text.RegularExpressions.Match) ->
// Groups[1] refers to the first captured group (the four hex digits)
m.Groups[1].Value
|> fun hex -> System.Convert.ToInt32(hex, 16)
|> char
|> string
)

let rec toRT (e : PT.Expr) : RT.Expr =
match e with
| PT.EChar(id, char) -> RT.EChar(id, char)
| PT.EChar(id, char) -> RT.EChar(id, char |> replaceEscapeSequences)
| PT.EInt64(id, num) -> RT.EInt64(id, num)
| PT.EUInt64(id, num) -> RT.EUInt64(id, num)
| PT.EInt8(id, num) -> RT.EInt8(id, num)
Expand Down Expand Up @@ -350,7 +390,8 @@ module Expr =

and stringSegmentToRT (segment : PT.StringSegment) : RT.StringSegment =
match segment with
| PT.StringText text -> RT.StringText text
| PT.StringText text ->
text |> replaceEscapeSequences |> replaceHex |> replaceUnicode |> RT.StringText
| PT.StringInterpolation expr -> RT.StringInterpolation(toRT expr)


Expand Down
2 changes: 1 addition & 1 deletion backend/src/Prelude/Prelude.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 -> ""
Expand Down
12 changes: 6 additions & 6 deletions backend/testfiles/execution/cloud/_events.dark
Original file line number Diff line number Diff line change
Expand Up @@ -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}" ]
Loading

0 comments on commit 4cae2c1

Please sign in to comment.