From ae7a933ca973163fb993adf6c14b932a504d73e5 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Tue, 24 Sep 2024 11:25:35 -0400 Subject: [PATCH 1/5] Implement sqrt on the JIT --- scheme-libs/racket/unison/math.rkt | 5 +++++ scheme-libs/racket/unison/primops.ss | 2 ++ 2 files changed, 7 insertions(+) diff --git a/scheme-libs/racket/unison/math.rkt b/scheme-libs/racket/unison/math.rkt index 654ac6944d..e6d8d47fa7 100644 --- a/scheme-libs/racket/unison/math.rkt +++ b/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) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 712727499f..c089140c5b 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/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 From 6994352321f502c50dd8c307f53236d994b4acb4 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Tue, 24 Sep 2024 11:27:39 -0400 Subject: [PATCH 2/5] Add a flag to compile.native that enables profiling --- .../src/Unison/Codebase/Runtime.hs | 8 +++++ scheme-libs/racket/unison-runtime.rkt | 15 ++++++---- .../src/Unison/Codebase/Editor/HandleInput.hs | 17 ++++++----- .../src/Unison/Codebase/Editor/Input.hs | 4 +-- .../src/Unison/CommandLine/InputPatterns.hs | 30 +++++++++++++++---- .../src/Unison/Runtime/Interface.hs | 18 +++++++---- 6 files changed, 67 insertions(+), 25 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Runtime.hs b/parser-typechecker/src/Unison/Codebase/Runtime.hs index 2669df121f..b9c92aec5e 100644 --- a/parser-typechecker/src/Unison/Codebase/Runtime.hs +++ b/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 -> diff --git a/scheme-libs/racket/unison-runtime.rkt b/scheme-libs/racket/unison-runtime.rkt index bdeb20532e..da1ddb5ed0 100644 --- a/scheme-libs/racket/unison-runtime.rkt +++ b/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 " (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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 22c81c0d70..a26b5e41ae 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -656,9 +656,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 @@ -979,7 +980,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) @@ -1440,8 +1442,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 @@ -1451,9 +1453,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) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index e736c618bd..4c619fdb5c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/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. diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 38d24809de..9ab42a0a4a 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2991,21 +2991,32 @@ 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 + Input.CompileSchemeI False . Text.pack <$> unsupportedStructuredArgument compileScheme "a file name" file <*> handleHashQualifiedNameArg main - args -> wrongArgsLength "exactly two arguments" args + [main, file, profile] -> + mk + <$> unsupportedStructuredArgument compileScheme "profile" profile + <*> unsupportedStructuredArgument compileScheme "a file name" file + <*> handleHashQualifiedNameArg main + where + mk _ fn mn = Input.CompileSchemeI True (Text.pack fn) mn + args -> wrongArgsLength "two or three arguments" args + createAuthor :: InputPattern createAuthor = @@ -3647,6 +3658,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) diff --git a/unison-runtime/src/Unison/Runtime/Interface.hs b/unison-runtime/src/Unison/Runtime/Interface.hs index 17527e2061..ea51842da1 100644 --- a/unison-runtime/src/Unison/Runtime/Interface.hs +++ b/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 (Error, CompileOpts (..), 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,10 @@ 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 From 29515f891c6892c2fc99b5840bca59f10ec007f4 Mon Sep 17 00:00:00 2001 From: dolio Date: Tue, 24 Sep 2024 15:28:44 +0000 Subject: [PATCH 3/5] automatically run ormolu --- unison-runtime/src/Unison/Runtime/Interface.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/unison-runtime/src/Unison/Runtime/Interface.hs b/unison-runtime/src/Unison/Runtime/Interface.hs index ea51842da1..103242c8d4 100644 --- a/unison-runtime/src/Unison/Runtime/Interface.hs +++ b/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, CompileOpts (..), 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) @@ -954,8 +954,9 @@ nativeCompileCodes copts executable codes base path = do racoError (e :: IOException) = throwIO $ PE callStack (racoErrMsg (makeRacoCmd RawCommand) (Right e)) dargs = ["-G", srcPath] - pargs | profile copts = "--profile" : dargs - | otherwise = dargs + pargs + | profile copts = "--profile" : dargs + | otherwise = dargs p = ucrCompileProc executable pargs makeRacoCmd :: (FilePath -> [String] -> a) -> a makeRacoCmd f = f "raco" ["exe", "-o", path, srcPath] From 35ebd7becf6d5f854f0c43338aef7339f6d9cf74 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Tue, 24 Sep 2024 12:01:48 -0400 Subject: [PATCH 4/5] Tweak profile argument handling --- .../src/Unison/CommandLine/InputPatterns.hs | 25 +++++++++++-------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9ab42a0a4a..2b95e12963 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -3004,19 +3004,22 @@ compileScheme = ] ) $ \case - [main, file] -> - Input.CompileSchemeI False . Text.pack - <$> unsupportedStructuredArgument compileScheme "a file name" file - <*> handleHashQualifiedNameArg main - [main, file, profile] -> - mk - <$> unsupportedStructuredArgument compileScheme "profile" profile - <*> unsupportedStructuredArgument compileScheme "a file name" file - <*> handleHashQualifiedNameArg main - where - mk _ fn mn = Input.CompileSchemeI True (Text.pack fn) mn + [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 = From 23d157e9ffd6d9a37e0746e2df3ad98eca1d539b Mon Sep 17 00:00:00 2001 From: dolio Date: Tue, 24 Sep 2024 16:02:50 +0000 Subject: [PATCH 5/5] automatically run ormolu --- .../src/Unison/CommandLine/InputPatterns.hs | 30 ++++++++++--------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 2b95e12963..0cb5bcb527 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2991,9 +2991,10 @@ compileScheme = "compile.native" [] I.Hidden - [("definition to compile", Required, exactDefinitionTermQueryArg), - ("output file", Required, filePathArg), - ("profile", Optional, profileArg)] + [ ("definition to compile", Required, exactDefinitionTermQueryArg), + ("output file", Required, filePathArg), + ("profile", Optional, profileArg) + ] ( P.wrapColumn2 [ ( makeExample compileScheme ["main", "file", "profile"], "Creates stand alone executable via compilation to" @@ -3006,20 +3007,21 @@ compileScheme = $ \case [main, file] -> mkCompileScheme False file main [main, file, prof] -> do - unsupportedStructuredArgument compileScheme "profile" prof >>= - \case + 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 <> "`." + 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 - + mkCompileScheme pf fn mn = + Input.CompileSchemeI pf . Text.pack + <$> unsupportedStructuredArgument compileScheme "a file name" fn + <*> handleHashQualifiedNameArg mn createAuthor :: InputPattern createAuthor =