Treat arity-0 externs and exports as values

Author: pchalamet

samples/types-showcase.fss

@@ -20,7 +20,7 @@ type Subscription =
 
 
 let scores =
-    Map.empty 0
+    Map.empty
     |> Map.add "math" 20
     |> Map.add "science" 18
 

src/FScript.Language/Eval.fs

@@ -449,9 +449,17 @@ module Eval =
                         | Some _ -> VUnionCtor(typeName, caseName)
                     caseName, value))
 
+        let externContext =
+            { Apply = applyFunctionValue evalExpr typeDefs unknownSpan }
+
         let mutable env : Env =
             (builtinIgnore :: externs)
-            |> List.fold (fun acc ext -> acc.Add(ext.Name, VExternal (ext, []))) Map.empty
+            |> List.fold (fun acc ext ->
+                if ext.Arity = 0 then
+                    let value = ext.Impl externContext []
+                    acc.Add(ext.Name, value)
+                else
+                    acc.Add(ext.Name, VExternal (ext, []))) Map.empty
         env <-
             constructorValues
             |> List.fold (fun acc (name, value) -> acc.Add(name, value)) env

src/FScript.Runtime/MapExterns.fs

@@ -5,11 +5,11 @@ open FScript.Language
 module MapExterns =
     let empty : ExternalFunction =
         { Name = "Map.empty"
-          Scheme = Forall([ 0 ], TFun(TVar 0, TStringMap (TVar 0)))
-          Arity = 1
+          Scheme = Forall([ 0 ], TStringMap (TVar 0))
+          Arity = 0
           Impl = fun _ -> function
-              | [ _ ] -> VStringMap Map.empty
-              | _ -> raise (HostCommon.evalError "Map.empty expects one argument") }
+              | [] -> VStringMap Map.empty
+              | _ -> raise (HostCommon.evalError "Map.empty expects no arguments") }
 
     let add : ExternalFunction =
         { Name = "Map.add"

src/FScript.Runtime/ScriptHost.fs

@@ -8,6 +8,7 @@ module ScriptHost =
         { TypeDefs: Map<string, Type>
           Env: Env
           ExportedFunctionNames: string list
+          ExportedValueNames: string list
           LastValue: Value }
 
     let private isCallable value =
@@ -28,17 +29,29 @@ module ScriptHost =
         let program = FScript.parse source
         let typed = FScript.inferWithExterns externs program
         let state = Eval.evalProgramWithExternsState externs typed
-        let functionNames =
+        let exportedNames =
             declaredExportedNames typed
+            |> List.distinct
+            |> List.sort
+
+        let functionNames =
+            exportedNames
             |> List.filter (fun name ->
                 match state.Env.TryFind name with
                 | Some value -> isCallable value
                 | None -> false)
-            |> List.distinct
-            |> List.sort
+
+        let valueNames =
+            exportedNames
+            |> List.filter (fun name ->
+                match state.Env.TryFind name with
+                | Some value -> not (isCallable value)
+                | None -> false)
+
         { TypeDefs = state.TypeDefs
           Env = state.Env
           ExportedFunctionNames = functionNames
+          ExportedValueNames = valueNames
           LastValue = state.LastValue }
 
     let loadFile (externs: ExternalFunction list) (path: string) : LoadedScript =
@@ -47,9 +60,23 @@ module ScriptHost =
     let listFunctions (loaded: LoadedScript) : string list =
         loaded.ExportedFunctionNames
 
+    let listValues (loaded: LoadedScript) : string list =
+        loaded.ExportedValueNames
+
+    let getValue (loaded: LoadedScript) (valueName: string) : Value =
+        if not (loaded.ExportedValueNames |> List.contains valueName) then
+            raise (HostCommon.evalError $"Unknown exported value '{valueName}'")
+        else
+            match loaded.Env.TryFind valueName with
+            | Some value -> value
+            | None -> raise (HostCommon.evalError $"Unknown exported value '{valueName}'")
+
     let invoke (loaded: LoadedScript) (functionName: string) (args: Value list) : Value =
         if not (loaded.ExportedFunctionNames |> List.contains functionName) then
-            raise (HostCommon.evalError $"Unknown exported function '{functionName}'")
+            if loaded.ExportedValueNames |> List.contains functionName then
+                raise (HostCommon.evalError $"'{functionName}' is a value and cannot be invoked")
+            else
+                raise (HostCommon.evalError $"Unknown exported function '{functionName}'")
         else
             match loaded.Env.TryFind functionName with
             | Some fnValue when isCallable fnValue ->

tests/FScript.Language.Tests/HostExternTests.fs

@@ -14,11 +14,20 @@ type HostExternTests () =
 
     [<Test>]
     member _.``Map externs support CRUD`` () =
-        let script = "Map.empty 0 |> Map.add \"a\" 1 |> Map.tryGet \"a\""
+        let script = "Map.empty |> Map.add \"a\" 1 |> Map.tryGet \"a\""
         match Helpers.evalWithExterns externs script with
         | VOption (Some (VInt 1L)) -> ()
         | _ -> Assert.Fail("Expected Some 1")
 
+    [<Test>]
+    member _.``Map.empty behaves as a value and cannot be invoked`` () =
+        match Helpers.evalWithExterns externs "Map.empty |> Map.count" with
+        | VInt 0L -> ()
+        | _ -> Assert.Fail("Expected empty map count 0")
+
+        let act () = Helpers.evalWithExterns externs "Map.empty ()" |> ignore
+        act |> should throw typeof<TypeException>
+
     [<Test>]
     member _.``Map.ofList builds map from tuple list`` () =
         let script = "Map.ofList [(\"a\", 1); (\"b\", 2)] |> Map.tryGet \"b\""

tests/FScript.Runtime.Tests/MapExternsTests.fs

@@ -9,7 +9,7 @@ open FScript.Runtime.Tests.HostTestHelpers
 type MapExternsTests () =
     [<Test>]
     member _.``map externs perform CRUD`` () =
-        let m0 = invoke MapExterns.empty [ VUnit ]
+        let m0 = invoke MapExterns.empty []
         let m1 = invoke MapExterns.add [ VString "a"; VInt 1L; m0 ]
         let found = invoke MapExterns.tryGet [ VString "a"; m1 ]
         let count = invoke MapExterns.count [ m1 ]

tests/FScript.Runtime.Tests/ScriptHostTests.fs

@@ -25,6 +25,25 @@ type ScriptHostTests () =
         | VInt 7L -> ()
         | _ -> Assert.Fail("Expected closure invocation result 7")
 
+    [<Test>]
+    member _.``script_host exposes exported values separately from functions`` () =
+        let externs = Registry.all { RootDirectory = Directory.GetCurrentDirectory() }
+        let loaded = ScriptHost.loadSource externs "export let version = \"1.0\"\nexport let add x y = x + y"
+
+        Assert.That(ScriptHost.listFunctions loaded, Does.Contain("add"))
+        Assert.That(ScriptHost.listValues loaded, Does.Contain("version"))
+
+        match ScriptHost.getValue loaded "version" with
+        | VString "1.0" -> ()
+        | _ -> Assert.Fail("Expected exported value")
+
+    [<Test>]
+    member _.``script_host rejects invocation of exported value`` () =
+        let externs = Registry.all { RootDirectory = Directory.GetCurrentDirectory() }
+        let loaded = ScriptHost.loadSource externs "export let version = \"1.0\""
+        let act () = ScriptHost.invoke loaded "version" [ VUnit ] |> ignore
+        Assert.Throws<EvalException>(TestDelegate act) |> ignore
+
     [<Test>]
     member _.``script_host hides non-exported functions`` () =
         let externs = Registry.all { RootDirectory = Directory.GetCurrentDirectory() }