Merge pull request #5366 from unisonweb/topic/jit-optimize

parser-typechecker/src/Unison/Codebase/Runtime.hs

@@ -29,6 +29,13 @@ type Error = P.Pretty P.ColorText
 
 type Term v = Term.Term v ()
 
+data CompileOpts = COpts
+  { profile :: Bool
+  }
+
+defaultCompileOpts :: CompileOpts
+defaultCompileOpts = COpts { profile = False }
+
 data Runtime v = Runtime
   { terminate :: IO (),
     evaluate ::
@@ -37,6 +44,7 @@ data Runtime v = Runtime
       Term v ->
       IO (Either Error ([Error], Term v)),
     compileTo ::
+      CompileOpts ->
       CL.CodeLookup v IO () ->
       PPE.PrettyPrintEnv ->
       Reference ->

scheme-libs/racket/unison-runtime.rkt

@@ -140,27 +140,28 @@
 ; Uses racket pretty printing machinery to instead generate a file
 ; containing the given code, and which executes the main definition on
 ; loading. This file can then be built with `raco exe`.
-(define (write-module srcf main-ref icode)
+(define (write-module prof srcf main-ref icode)
   (call-with-output-file
     srcf
     (lambda (port)
       (parameterize ([print-as-expression #t])
         (display "#lang racket/base\n\n" port)
 
-        (for ([expr (build-intermediate-module #:profile #f main-ref icode)])
+        (for ([expr (build-intermediate-module #:profile prof main-ref icode)])
           (pretty-print expr port 1)
           (newline port))
         (newline port)))
     #:exists 'replace))
 
 ; Decodes input and writes a module to the specified file.
-(define (do-generate srcf)
+(define (do-generate prof srcf)
   (define-values (icode main-ref) (decode-input (current-input-port)))
-  (write-module srcf main-ref icode))
+  (write-module prof srcf main-ref icode))
 
 (define generate-to (make-parameter #f))
 (define show-version (make-parameter #f))
 (define use-port-num (make-parameter #f))
+(define enable-profiling (make-parameter #f))
 
 (define (handle-command-line)
   (command-line
@@ -177,6 +178,10 @@
        file
        "generate code to <file>"
        (generate-to file)]
+    #:once-each
+    [("--profile")
+     "enable profiling"
+     (enable-profiling #t)]
     #:args remaining
     (list->vector remaining)))
 
@@ -185,7 +190,7 @@
     (current-command-line-arguments sub-args))
   (cond
     [(show-version) (displayln "unison-runtime version 0.0.11")]
-    [(generate-to) (do-generate (generate-to))]
+    [(generate-to) (do-generate (enable-profiling) (generate-to))]
     [(use-port-num)
      (match (string->number (use-port-num))
        [port

scheme-libs/racket/unison/math.rkt

@@ -19,6 +19,8 @@
   builtin-Float.max:termlink
   builtin-Float.min
   builtin-Float.min:termlink
+  builtin-Float.sqrt
+  builtin-Float.sqrt:termlink
   builtin-Float.tan
   builtin-Float.tan:termlink
   builtin-Float.tanh
@@ -130,6 +132,9 @@
 (define-unison-builtin
   (builtin-Float.pow n m) (expt n m))
 
+(define-unison-builtin
+  (builtin-Float.sqrt x) (sqrt x))
+
 (define (EXPF n) (exp n))
 (define ABSF abs)
 (define ACOS acos)

scheme-libs/racket/unison/primops.ss

@@ -49,6 +49,8 @@
   builtin-Float.max:termlink
   builtin-Float.min
   builtin-Float.min:termlink
+  builtin-Float.sqrt
+  builtin-Float.sqrt:termlink
   builtin-Float.tan
   builtin-Float.tan:termlink
   builtin-Float.tanh

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -660,9 +660,10 @@ loop e = do
             TodoI -> handleTodo
             TestI testInput -> Tests.handleTest testInput
             ExecuteI main args -> handleRun False main args
-            MakeStandaloneI output main -> doCompile False output main
-            CompileSchemeI output main ->
-              doCompile True (Text.unpack output) main
+            MakeStandaloneI output main ->
+              doCompile False False output main
+            CompileSchemeI prof output main ->
+              doCompile prof True (Text.unpack output) main
             ExecuteSchemeI main args -> handleRun True main args
             IOTestI main -> Tests.handleIOTest main
             IOTestAllI -> Tests.handleAllIOTests
@@ -984,7 +985,8 @@ inputDescription input =
     MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm)
     ExecuteSchemeI nm args ->
       pure $ "run.native " <> Text.unwords (HQ.toText nm : fmap Text.pack args)
-    CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> fi)
+    CompileSchemeI pr fi nm ->
+      pure ("compile.native " <> HQ.toText nm <> " " <> fi <> if pr then " profile" else "")
     CreateAuthorI id name -> pure ("create.author " <> NameSegment.toEscapedText id <> " " <> name)
     ClearI {} -> pure "clear"
     DocToMarkdownI name -> pure ("debug.doc-to-markdown " <> Name.toText name)
@@ -1462,8 +1464,8 @@ searchBranchScored names0 score queries =
             pair qn =
               (\score -> (Just score, result)) <$> score qn (Name.toText name)
 
-doCompile :: Bool -> String -> HQ.HashQualified Name -> Cli ()
-doCompile native output main = do
+doCompile :: Bool -> Bool -> String -> HQ.HashQualified Name -> Cli ()
+doCompile profile native output main = do
   Cli.Env {codebase, runtime, nativeRuntime} <- ask
   let theRuntime
         | native = nativeRuntime
@@ -1473,9 +1475,10 @@ doCompile native output main = do
       outf
         | native = output
         | otherwise = output <> ".uc"
+      copts = Runtime.defaultCompileOpts { Runtime.profile = profile }
   whenJustM
     ( liftIO $
-        Runtime.compileTo theRuntime codeLookup ppe ref outf
+        Runtime.compileTo theRuntime copts codeLookup ppe ref outf
     )
     (Cli.returnEarly . EvaluationFailure)
 

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -175,8 +175,8 @@ data Input
     MakeStandaloneI String (HQ.HashQualified Name)
   | -- execute an IO thunk using scheme
     ExecuteSchemeI (HQ.HashQualified Name) [String]
-  | -- compile to a scheme file
-    CompileSchemeI Text (HQ.HashQualified Name)
+  | -- compile to a scheme file; profiling flag
+    CompileSchemeI Bool Text (HQ.HashQualified Name)
   | TestI TestInput
   | CreateAuthorI NameSegment {- identifier -} Text {- name -}
   | -- Display provided definitions.

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -3033,21 +3033,37 @@ compileScheme =
     "compile.native"
     []
     I.Hidden
-    [("definition to compile", Required, exactDefinitionTermQueryArg), ("output file", Required, filePathArg)]
+    [ ("definition to compile", Required, exactDefinitionTermQueryArg),
+      ("output file", Required, filePathArg),
+      ("profile", Optional, profileArg)
+    ]
     ( P.wrapColumn2
-        [ ( makeExample compileScheme ["main", "file"],
+        [ ( makeExample compileScheme ["main", "file", "profile"],
             "Creates stand alone executable via compilation to"
               <> "scheme. The created executable will have the effect"
-              <> "of running `!main`."
+              <> "of running `!main`. Providing `profile` as a third"
+              <> "argument will enable profiling."
           )
         ]
     )
     $ \case
-      [main, file] ->
-        Input.CompileSchemeI . Text.pack
-          <$> unsupportedStructuredArgument compileScheme "a file name" file
-          <*> handleHashQualifiedNameArg main
-      args -> wrongArgsLength "exactly two arguments" args
+      [main, file] -> mkCompileScheme False file main
+      [main, file, prof] -> do
+        unsupportedStructuredArgument compileScheme "profile" prof
+          >>= \case
+            "profile" -> mkCompileScheme True file main
+            parg ->
+              Left . P.text $
+                "I expected the third argument to be `profile`, but"
+                  <> " instead recieved `"
+                  <> Text.pack parg
+                  <> "`."
+      args -> wrongArgsLength "two or three arguments" args
+  where
+    mkCompileScheme pf fn mn =
+      Input.CompileSchemeI pf . Text.pack
+        <$> unsupportedStructuredArgument compileScheme "a file name" fn
+        <*> handleHashQualifiedNameArg mn
 
 createAuthor :: InputPattern
 createAuthor =
@@ -3691,6 +3707,15 @@ remoteNamespaceArg =
       fzfResolver = Nothing
     }
 
+profileArg :: ArgumentType
+profileArg =
+  ArgumentType
+    { typeName = "profile",
+      suggestions = \_input _cb _http _p ->
+        pure [Line.simpleCompletion "profile"],
+      fzfResolver = Nothing
+    }
+
 data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | AllProjects
   deriving stock (Eq, Ord, Show)
 

unison-runtime/src/Unison/Runtime/Interface.hs

@@ -74,7 +74,7 @@ import System.Process
 import Unison.Builtin.Decls qualified as RF
 import Unison.Codebase.CodeLookup (CodeLookup (..))
 import Unison.Codebase.MainTerm (builtinIOTestTypes, builtinMain)
-import Unison.Codebase.Runtime (Error, Runtime (..))
+import Unison.Codebase.Runtime (CompileOpts (..), Error, Runtime (..))
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import Unison.ConstructorReference qualified as RF
 import Unison.DataDeclaration (Decl, declFields, declTypeDependencies)
@@ -637,27 +637,29 @@ racoErrMsg c = \case
 nativeCompile ::
   FilePath ->
   IORef EvalCtx ->
+  CompileOpts ->
   CodeLookup Symbol IO () ->
   PrettyPrintEnv ->
   Reference ->
   FilePath ->
   IO (Maybe Error)
-nativeCompile executable ctxVar cl ppe base path = tryM $ do
+nativeCompile executable ctxVar copts cl ppe base path = tryM $ do
   ctx <- readIORef ctxVar
   (tyrs, tmrs) <- collectRefDeps cl base
   (ctx, codes) <- loadDeps cl ppe ctx tyrs tmrs
   Just ibase <- pure $ baseToIntermed ctx base
-  nativeCompileCodes executable codes ibase path
+  nativeCompileCodes copts executable codes ibase path
 
 interpCompile ::
   Text ->
   IORef EvalCtx ->
+  CompileOpts ->
   CodeLookup Symbol IO () ->
   PrettyPrintEnv ->
   Reference ->
   FilePath ->
   IO (Maybe Error)
-interpCompile version ctxVar cl ppe rf path = tryM $ do
+interpCompile version ctxVar _copts cl ppe rf path = tryM $ do
   ctx <- readIORef ctxVar
   (tyrs, tmrs) <- collectRefDeps cl rf
   (ctx, _) <- loadDeps cl ppe ctx tyrs tmrs
@@ -927,12 +929,13 @@ nativeEvalInContext executable ppe ctx serv port codes base = do
     `UnliftIO.catch` ucrError
 
 nativeCompileCodes ::
+  CompileOpts ->
   FilePath ->
   [(Reference, SuperGroup Symbol)] ->
   Reference ->
   FilePath ->
   IO ()
-nativeCompileCodes executable codes base path = do
+nativeCompileCodes copts executable codes base path = do
   ensureRuntimeExists executable
   ensureRacoExists
   genDir <- getXdgDirectory XdgCache "unisonlanguage/racket-tmp"
@@ -950,7 +953,11 @@ nativeCompileCodes executable codes base path = do
         throwIO $ PE callStack (runtimeErrMsg (cmdspec p) (Right e))
       racoError (e :: IOException) =
         throwIO $ PE callStack (racoErrMsg (makeRacoCmd RawCommand) (Right e))
-      p = ucrCompileProc executable ["-G", srcPath]
+      dargs = ["-G", srcPath]
+      pargs
+        | profile copts = "--profile" : dargs
+        | otherwise = dargs
+      p = ucrCompileProc executable pargs
       makeRacoCmd :: (FilePath -> [String] -> a) -> a
       makeRacoCmd f = f "raco" ["exe", "-o", path, srcPath]
   withCreateProcess p callout