Refactor typechecking to use value types

.vscode/launch.json

@@ -20,9 +20,9 @@
       "type": "coreclr",
       "request": "launch",
       "preLaunchTask": "build-tests",
-      "program": "/home/dark/app/backend/Build/out/Tests/Debug/net7.0/linux-x64/Tests",
-      //"args": ["--filter-test-list", "HttpClient"],
-      "args": ["--filter-test-case", "response-string-text"],
+      "program": "/home/dark/app/backend/Build/out/Tests/Debug/net7.0/Tests",
+      "args": ["--filter-test-list", "eapply"],
+      // "args": ["--filter-test-case", "response-string-text"],
       "cwd": "${workspaceFolder}/backend",
       "stopAtEntry": false,
       "console": "internalConsole",

backend/serialization/vanilla_LibCloud-TraceCloudStorage-CloudStorageFormat_simple.json

@@ -68,7 +68,7 @@
       7,
       "testFn",
       2,
-      "CyUbRjC0vaw",
+      "fMP2hdPemZc",
       {
         "DError": [
           {

backend/src/BuiltinExecution/Libs/Json.fs

@@ -179,7 +179,9 @@ let rec serialize
 
         | TypeDeclaration.Record fields ->
           match dval with
-          | DRecord(actualTypeName, _, dvalMap) when actualTypeName = typeName ->
+          | DRecord(actualTypeName, _, _typeArgsTODO, dvalMap) when
+            actualTypeName = typeName
+            ->
             do!
               w.writeObject (fun () ->
                 dvalMap
@@ -198,7 +200,7 @@ let rec serialize
                     Types.substitute decl.typeParams typeArgs matchingFieldDef.typ
                   r typ dval))
 
-          | DRecord(actualTypeName, _, _) ->
+          | DRecord(actualTypeName, _, _typeArgsTODO, _) ->
             Exception.raiseInternal
               "Incorrect record type"
               [ "actual", actualTypeName; "expected", typeName ]
@@ -510,7 +512,7 @@ let parse
               |> Ply.List.flatten
               |> Ply.map Map.ofList
 
-            return DRecord(typeName, typeName, fields)
+            return DRecord(typeName, typeName, valueTypesTODO, fields)
       }
 
 

backend/src/BuiltinExecution/Libs/List.fs

@@ -44,7 +44,7 @@ module DvalComparator =
     | DUuid u1, DUuid u2 -> compare u1 u2
     | DBytes b1, DBytes b2 -> compare b1 b2
     | DDict o1, DDict o2 -> compareMaps (Map.toList o1) (Map.toList o2)
-    | DRecord(tn1, _, o1), DRecord(tn2, _, o2) ->
+    | DRecord(tn1, _, _typeArgsTODO1, o1), DRecord(tn2, _, _typeArgsTODO2, o2) ->
       let c = compare tn1 tn2
       if c = 0 then compareMaps (Map.toList o1) (Map.toList o2) else c
     | DEnum(tn1, _, c1, f1), DEnum(tn2, _, c2, f2) ->

backend/src/BuiltinExecution/Libs/NoModule.fs

@@ -32,7 +32,7 @@ let rec equals (a : Dval) (b : Dval) : bool =
       (fun k v ->
         Map.tryFind k b |> Option.map (equals v) |> Option.defaultValue false)
       a
-  | DRecord(tn1, _, a), DRecord(tn2, _, b) ->
+  | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) ->
     tn1 = tn2 // these should be the fully resolved type
     && Map.count a = Map.count b
     && Map.forall

backend/src/LibCloud/SqlCompiler.fs

@@ -139,11 +139,11 @@ let typecheckDval
   (types : Types)
   (dval : Dval)
   (expectedType : TypeReference)
-  =
+  : Ply<unit> =
   uply {
     let context = TypeChecker.DBQueryVariable(name, expectedType, None)
     match! TypeChecker.unify context types Map.empty expectedType dval with
-    | Ok() -> return ()
+    | Ok _typeSymbolTableTODO -> return ()
     | Error err -> raise (SqlCompilerRuntimeError err)
   }
 
@@ -630,10 +630,10 @@ let rec lambdaToSql
             | TUuid -> "uuid"
             | TUnit -> "bigint" // CLEANUP why is this bigint?
             | TVariable varName ->
-              match Map.get varName tst with
-              | Some found -> primitiveFieldType found
-              | None ->
-                error $"Could not resolve type variable in lambdaToSql: {varName}"
+              // match Map.get varName tst with
+              // | Some found -> primitiveFieldType found
+              // | None ->
+              error $"Could not resolve type variable in lambdaToSql: {varName}"
             | _ -> error $"We do not support this type of DB field yet: {t}"
 
           let fieldAccessPath = NEList.map escapeFieldname fieldAccessPath

backend/src/LibExecution/DvalReprDeveloper.fs

@@ -146,7 +146,7 @@ let toRepr (dv : Dval) : string =
         let long = String.concat $"{inl}, " (List.map (toRepr_ indent) l)
         $"({inl}{long}{nl})"
 
-    | DRecord(_, typeName, o) ->
+    | DRecord(_, typeName, _, o) ->
       let strs =
         o
         |> Map.toList

backend/src/LibExecution/DvalReprInternalQueryable.fs

@@ -138,7 +138,7 @@ let rec private toJsonV0
           let typ = Types.substitute decl.typeParams typeArgs typeRef
           do! writeDval typ dv
 
-        | TypeDeclaration.Record fields, DRecord(_, _, dm) ->
+        | TypeDeclaration.Record fields, DRecord(_, _, _, dm) ->
           let fields = NEList.toList fields
           do!
             w.writeObject (fun () ->
@@ -318,7 +318,8 @@ let parseJsonV0 (types : Types) (typ : TypeReference) (str : string) : Ply<Dval>
                   dval |> Ply.map (fun dval -> f.name, dval))
                 |> Ply.List.flatten
                 // TYPESCLEANUP: I don't think the original is name right here?
-                |> Ply.map (fun mapped -> DRecord(typeName, typeName, Map mapped))
+                |> Ply.map (fun mapped ->
+                  DRecord(typeName, typeName, valueTypesTODO, Map mapped))
             else
               return
                 Exception.raiseInternal

backend/src/LibExecution/DvalReprInternalRoundtrippable.fs

@@ -253,12 +253,13 @@ module FormatV0 =
     | DRecord of
       runtimeTypeName : TypeName.TypeName *
       sourceTypeName : TypeName.TypeName *
-      DvalMap
+      typeArgs : List<ValueType.ValueType> *
+      fields : DvalMap
     | DEnum of
       runtimeTypeName : TypeName.TypeName *
       sourceTypeName : TypeName.TypeName *
       caseName : string *
-      List<Dval>
+      fields : List<Dval>
 
     | DError of RuntimeError // CLEANUP remove
 
@@ -286,8 +287,13 @@ module FormatV0 =
     | DTuple(first, second, theRest) ->
       RT.DTuple(toRT first, toRT second, List.map toRT theRest)
     | DDict o -> RT.DDict(Map.map toRT o)
-    | DRecord(typeName, original, o) ->
-      RT.DRecord(TypeName.toRT typeName, TypeName.toRT original, Map.map toRT o)
+    | DRecord(typeName, original, typeArgs, o) ->
+      RT.DRecord(
+        TypeName.toRT typeName,
+        TypeName.toRT original,
+        List.map ValueType.toRT typeArgs,
+        Map.map toRT o
+      )
     | DBytes bytes -> RT.DBytes bytes
     | DEnum(typeName, original, caseName, fields) ->
       RT.DEnum(
@@ -322,8 +328,13 @@ module FormatV0 =
     | RT.DTuple(first, second, theRest) ->
       DTuple(fromRT first, fromRT second, List.map fromRT theRest)
     | RT.DDict o -> DDict(Map.map fromRT o)
-    | RT.DRecord(typeName, original, o) ->
-      DRecord(TypeName.fromRT typeName, TypeName.fromRT original, Map.map fromRT o)
+    | RT.DRecord(typeName, original, typeArgs, o) ->
+      DRecord(
+        TypeName.fromRT typeName,
+        TypeName.fromRT original,
+        List.map ValueType.fromRT typeArgs,
+        Map.map fromRT o
+      )
     | RT.DBytes bytes -> DBytes bytes
     | RT.DEnum(typeName, original, caseName, fields) ->
       DEnum(
@@ -374,7 +385,7 @@ module Test =
       List.all isRoundtrippableDval fields
     | RT.DList(_, dvals) -> List.all isRoundtrippableDval dvals
     | RT.DDict map -> map |> Map.values |> List.all isRoundtrippableDval
-    | RT.DRecord(_, _, map) -> map |> Map.values |> List.all isRoundtrippableDval
+    | RT.DRecord(_, _, _, map) -> map |> Map.values |> List.all isRoundtrippableDval
     | RT.DUuid _ -> true
     | RT.DTuple(v1, v2, rest) -> List.all isRoundtrippableDval (v1 :: v2 :: rest)
     | RT.DDB _

backend/src/LibExecution/Interpreter.fs

@@ -340,7 +340,7 @@ let rec eval'
                     return v
                   else
                     match r with
-                    | DRecord(typeName, original, m) ->
+                    | DRecord(typeName, original, _valueTypesTODO, m) ->
                       if Map.containsKey k m then
                         return errStr id $"Duplicate field `{k}` in {typeStr}"
                       else
@@ -350,13 +350,20 @@ let rec eval'
                         let check =
                           TypeChecker.unify context types Map.empty fieldType v
                         match! check with
-                        | Ok() -> return DRecord(typeName, original, Map.add k v m)
+                        | Ok _typeSymbolTableTODO ->
+                          return
+                            DRecord(
+                              typeName,
+                              original,
+                              valueTypesTODO,
+                              Map.add k v m
+                            )
                         | Error e -> return err id e
                     | _ -> return errStr id "Expected a record in typecheck"
               })
-            (DRecord(aliasTypeName, typeName, Map.empty)) // use the alias name here
+            (DRecord(aliasTypeName, typeName, valueTypesTODO, Map.empty)) // use the alias name here
         match result with
-        | DRecord(_, _, fields) ->
+        | DRecord(_, _, _valueTypesTODO, fields) ->
           if Map.count fields = Map.count expectedFields then
             return result
           else
@@ -368,7 +375,7 @@ let rec eval'
     | ERecordUpdate(id, baseRecord, updates) ->
       let! baseRecord = eval state tst st baseRecord
       match baseRecord with
-      | DRecord(typeName, _, _) ->
+      | DRecord(typeName, _, _valueTypesTODO, _) ->
         let typeStr = TypeName.toString typeName
         let types = ExecutionState.availableTypes state
         match! recordMaybe types typeName with
@@ -388,14 +395,16 @@ let rec eval'
                   | _, "", _ -> return errStr id $"Empty key for value `{v}`"
                   | _, _, _ when not (Map.containsKey k expectedFields) ->
                     return errStr id $"Unexpected field `{k}` in {typeStr}"
-                  | DRecord(typeName, original, m), k, v ->
+                  | DRecord(typeName, original, _valueTypesTODO, m), k, v ->
                     let fieldType = Map.find k expectedFields
                     let context =
                       TypeChecker.RecordField(typeName, k, fieldType, None)
                     match!
                       TypeChecker.unify context types Map.empty fieldType v
                     with
-                    | Ok() -> return DRecord(typeName, original, Map.add k v m)
+                    | Ok _typeSymbolTableTODO ->
+                      return
+                        DRecord(typeName, original, valueTypesTODO, Map.add k v m)
                     | Error rte -> return DError(SourceID(state.tlid, id), rte)
                   | _ ->
                     return
@@ -443,7 +452,7 @@ let rec eval'
         return errStr id "Field name is empty"
       else
         match obj with
-        | DRecord(_, typeName, o) ->
+        | DRecord(_, typeName, _, o) ->
           match Map.tryFind field o with
           | Some v -> return v
           | None ->
@@ -771,7 +780,7 @@ let rec eval'
                         match!
                           TypeChecker.unify context types Map.empty enumFieldType v
                         with
-                        | Ok() ->
+                        | Ok _typeSymbolTableTODO ->
                           match r with
                           | DEnum(typeName, original, caseName, existing) ->
                             return
@@ -931,10 +940,7 @@ and callFn
       | Some fn ->
         match checkArgsLength fn with
         | Error errMsg -> return DError(sourceID, RuntimeError.oldError errMsg)
-        | Ok() ->
-          let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map
-          let updatedTypeSymbolTable = Map.mergeFavoringRight tst newlyBoundTypeArgs
-          return! execFn state updatedTypeSymbolTable desc callerID fn typeArgs args
+        | Ok() -> return! execFn state tst desc callerID fn typeArgs args
   }
 
 
@@ -966,17 +972,13 @@ and execFn
             executingFnName = Some fnDesc
             callstack = Set.add fnDesc state.callstack }
 
-      let fnRecord = (state.tlid, fnDesc, id) in
+      let fnRecord = (state.tlid, fnDesc, id)
 
       let types = ExecutionState.availableTypes state
 
-      let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map
-      let typeSymbolTable = Map.mergeFavoringRight tst typeArgsResolvedInFn
-
-      match! TypeChecker.checkFunctionCall types typeSymbolTable fn args with
+      match! TypeChecker.checkFunctionCall types tst fn typeArgs args with
       | Error rte -> return DError(sourceID, rte)
-      | Ok() ->
-
+      | Ok tst ->
         let! result =
           match fn.fn with
           | BuiltInFunction f ->
@@ -1032,14 +1034,12 @@ and execFn
               |> NEList.map2 (fun dv p -> (p.name, dv)) args
               |> Map.ofNEList
               |> withGlobals state
-            eval state typeSymbolTable symTable body
+            eval state tst symTable body
 
         if Dval.isFake result then
           return result
         else
-          match!
-            TypeChecker.checkFunctionReturnType types typeSymbolTable fn result
-          with
+          match! TypeChecker.checkFunctionReturnType types tst fn result with
           | Error rte -> return DError(sourceID, rte)
-          | Ok() -> return result
+          | Ok _typeSymbolTableTODO -> return result
   }

backend/src/LibExecution/LibExecution.fsproj

@@ -13,6 +13,7 @@
     <None Include="paket.references" />
     <Compile Include="DarkDateTime.fs" />
     <Compile Include="RuntimeTypes.fs" />
+    <Compile Include="Types.fs" />
     <Compile Include="DvalDecoder.fs" />
     <Compile Include="NameResolutionError.fs" />
     <Compile Include="RuntimeTypesAst.fs" />

backend/src/LibExecution/NameResolutionError.fs

@@ -82,7 +82,7 @@ module RTE =
 
     let fromDT (dv : RT.Dval) : Error =
       match dv with
-      | RT.DRecord(_, _, m) ->
+      | RT.DRecord(_, _, _, m) ->
         let errorType = m |> D.field "errorType" |> ErrorType.fromDT
         let nameType = m |> D.field "nameType" |> NameType.fromDT
         let names = m |> D.stringListField "names"