From 5e08e0a09e74762e00254a262813c45cf3463a46 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Fri, 13 Dec 2019 00:50:53 +0300 Subject: [PATCH] ucm run: do not set up interactive environment --- CONTRIBUTORS.markdown | 1 + .../Unison/Codebase/Editor/HandleCommand.hs | 10 +-- .../src/Unison/Codebase/Editor/HandleInput.hs | 41 ++++-------- .../src/Unison/Codebase/Execute.hs | 50 +++++++++++++++ .../src/Unison/Codebase/MainTerm.hs | 64 +++++++++++++++++++ .../src/Unison/Codebase/Runtime.hs | 18 ++++++ .../unison-parser-typechecker.cabal | 2 + parser-typechecker/unison/Main.hs | 3 +- 8 files changed, 151 insertions(+), 38 deletions(-) create mode 100644 parser-typechecker/src/Unison/Codebase/Execute.hs create mode 100644 parser-typechecker/src/Unison/Codebase/MainTerm.hs diff --git a/CONTRIBUTORS.markdown b/CONTRIBUTORS.markdown index 69d9376cd..141784f81 100644 --- a/CONTRIBUTORS.markdown +++ b/CONTRIBUTORS.markdown @@ -32,3 +32,4 @@ The format for this list: name, GitHub handle, and then optional blurb about wha * Florian Thurm (@0xflotus) * Evan Burchard (@evanburchard) * Alvaro Carrasco (@alvaroc1) +* Vladislav Zavialov (@int-index) diff --git a/parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs b/parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs index 8a72a5ab2..223bead5c 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs @@ -43,7 +43,6 @@ import qualified Unison.UnisonFile as UF import Unison.Util.Free ( Free ) import qualified Unison.Util.Free as Free import Unison.Var ( Var ) -import qualified Unison.Var as Var import qualified Unison.Result as Result import Unison.FileParsers ( parseAndSynthesizeFile , synthesizeFile' @@ -167,13 +166,8 @@ commandLine config awaitInput setBranchRef rt notifyUser codebase = eval1 :: PPE.PrettyPrintEnv -> Term.AnnotatedTerm v Ann -> _ eval1 ppe tm = do let codeLookup = Codebase.toCodeLookup codebase - let uf = UF.UnisonFile mempty mempty mempty - (Map.singleton UF.RegularWatch [(Var.nameds "result", tm)]) - selfContained <- Codebase.makeSelfContained' codeLookup uf - r <- Runtime.evaluateWatches codeLookup ppe Runtime.noCache rt selfContained - pure $ r <&> \(_,map) -> - let [(_loc, _kind, _hash, _src, value, _isHit)] = Map.elems map - in Term.amap (const Parser.External) value + r <- Runtime.evaluateTerm codeLookup ppe rt tm + pure $ r <&> Term.amap (const Parser.External) evalUnisonFile :: PPE.PrettyPrintEnv -> UF.TypecheckedUnisonFile v Ann -> _ evalUnisonFile ppe (UF.discardTypes -> unisonFile) = do diff --git a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs index eee6ecea6..5b04e81b3 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs @@ -21,6 +21,8 @@ module Unison.Codebase.Editor.HandleInput (loop, loopState0, LoopState(..), pars import Unison.Prelude +import Unison.Codebase.MainTerm ( nullaryMain, mainTypes, getMainTerm ) +import qualified Unison.Codebase.MainTerm as MainTerm import Unison.Codebase.Editor.Command import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Output @@ -99,7 +101,7 @@ import Unison.Codebase.TermEdit (TermEdit(..)) import qualified Unison.Codebase.TermEdit as TermEdit import qualified Unison.Typechecker as Typechecker import qualified Unison.PrettyPrintEnv as PPE -import Unison.Runtime.IOSource ( isTest, ioReference ) +import Unison.Runtime.IOSource ( isTest ) import qualified Unison.Runtime.IOSource as IOSource import qualified Unison.Util.Star3 as Star3 import qualified Unison.Util.Pretty as P @@ -2257,17 +2259,6 @@ basicNames0' = do prettyPrintNames00 = currentAndExternalNames0 pure (parseNames00, prettyPrintNames00) --- {IO} () -ioUnit :: Ord v => a -> Type v a -ioUnit a = Type.effect a [Type.ref a ioReference] (Type.ref a DD.unitRef) - --- '{IO} () -nullaryMain :: Ord v => a -> Type v a -nullaryMain a = Type.arrow a (Type.ref a DD.unitRef) (ioUnit a) - -mainTypes :: Ord v => a -> [Type v a] -mainTypes a = [nullaryMain a] - -- Given a typechecked file with a main function called `mainName` -- of the type `'{IO} ()`, adds an extra binding which -- forces the `main` function. @@ -2281,23 +2272,15 @@ addRunMain -> Action' m v (Maybe (TypecheckedUnisonFile v Ann)) addRunMain mainName Nothing = do parseNames0 <- basicParseNames0 - case HQ.fromString mainName of - Nothing -> pure Nothing - Just hq -> do - -- note: not allowing historical search - let refs = Names3.lookupHQTerm hq (Names3.Names parseNames0 mempty) - let a = External - case toList refs of - [] -> pure Nothing - [Referent.Ref ref] -> do - typ <- eval $ LoadTypeOfTerm ref - case typ of - Just typ | Typechecker.isSubtype typ (nullaryMain a) -> do - let runMain = DD.forceTerm a a (Term.ref a ref) - let v = Var.named (HQ.toText hq) - pure . Just $ UF.typecheckedUnisonFile mempty mempty [[(v, runMain, typ)]] mempty - _ -> pure Nothing - _ -> pure Nothing + let loadTypeOfTerm ref = eval $ LoadTypeOfTerm ref + mainToFile <$> getMainTerm loadTypeOfTerm parseNames0 mainName + where + mainToFile (MainTerm.NotAFunctionName _) = Nothing + mainToFile (MainTerm.NotFound _) = Nothing + mainToFile (MainTerm.BadType _) = Nothing + mainToFile (MainTerm.Success hq tm typ) = Just $ + let v = Var.named (HQ.toText hq) in + UF.typecheckedUnisonFile mempty mempty [[(v, tm, typ)]] mempty addRunMain mainName (Just uf) = do let components = join $ UF.topLevelComponents uf let mainComponent = filter ((\v -> Var.nameStr v == mainName) . view _1) components diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/parser-typechecker/src/Unison/Codebase/Execute.hs new file mode 100644 index 000000000..9dbbeaae3 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/Execute.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Execute a computation of type '{IO} () that has been previously added to +-- the codebase, without setting up an interactive environment. +-- +-- This allows one to run standalone applications implemented in the Unison +-- language. + +module Unison.Codebase.Execute where + +import Unison.Prelude + +import Unison.Codebase.MainTerm ( getMainTerm ) +import qualified Unison.Codebase.MainTerm as MainTerm +import qualified Unison.Codebase as Codebase +import Unison.Parser ( Ann ) +import qualified Unison.Codebase.Runtime as Runtime +import Unison.Codebase.Runtime ( Runtime ) +import Unison.Var ( Var ) +import qualified Unison.PrettyPrintEnv as PPE +import qualified Unison.Names3 as Names3 +import qualified Unison.Codebase.Branch as Branch +import System.Exit (die) +import Control.Exception (finally) + +execute + :: Var v + => Codebase.Codebase IO v Ann + -> Runtime v + -> String + -> IO () +execute codebase runtime mainName = + (`finally` Runtime.terminate runtime) $ do + root <- Codebase.getRootBranch codebase + let parseNames0 = Names3.makeAbsolute0 (Branch.toNames0 (Branch.head root)) + loadTypeOfTerm = Codebase.getTypeOfTerm codebase + mt <- getMainTerm loadTypeOfTerm parseNames0 mainName + case mt of + MainTerm.NotAFunctionName s -> die ("Not a function name: " ++ s) + MainTerm.NotFound s -> die ("Not found: " ++ s) + MainTerm.BadType s -> die (s ++ " is not of type '{IO} ()") + MainTerm.Success _ tm _ -> do + let codeLookup = Codebase.toCodeLookup codebase + ppe = PPE.PrettyPrintEnv (const Nothing) (const Nothing) + void $ Runtime.evaluateTerm codeLookup ppe runtime tm diff --git a/parser-typechecker/src/Unison/Codebase/MainTerm.hs b/parser-typechecker/src/Unison/Codebase/MainTerm.hs new file mode 100644 index 000000000..6fa65d2f3 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/MainTerm.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Find a computation of type '{IO} () in the codebase. +module Unison.Codebase.MainTerm where + +import Unison.Prelude + +import Unison.Parser ( Ann ) +import qualified Unison.Parser as Parser +import qualified Unison.Term as Term +import Unison.Var ( Var ) +import qualified Unison.DataDeclaration as DD +import qualified Unison.HashQualified as HQ +import qualified Unison.Referent as Referent +import qualified Unison.Names3 as Names3 +import Unison.Reference ( Reference ) +import qualified Unison.Type as Type +import Unison.Type ( Type ) +import qualified Unison.Typechecker as Typechecker +import Unison.Runtime.IOSource ( ioReference ) + +data MainTerm v + = NotAFunctionName String + | NotFound String + | BadType String + | Success HQ.HashQualified (Term.AnnotatedTerm v Ann) (Type v Ann) + +getMainTerm + :: (Monad m, Var v) + => (Reference -> m (Maybe (Type v Ann))) + -> Names3.Names0 + -> String + -> m (MainTerm v) +getMainTerm loadTypeOfTerm parseNames0 mainName = + case HQ.fromString mainName of + Nothing -> pure (NotAFunctionName mainName) + Just hq -> do + let refs = Names3.lookupHQTerm hq (Names3.Names parseNames0 mempty) + let a = Parser.External + case toList refs of + [Referent.Ref ref] -> do + typ <- loadTypeOfTerm ref + case typ of + Just typ | Typechecker.isSubtype typ (nullaryMain a) -> do + let tm = DD.forceTerm a a (Term.ref a ref) + return (Success hq tm typ) + _ -> pure (BadType mainName) + _ -> pure (NotFound mainName) + +-- {IO} () +ioUnit :: Ord v => a -> Type.Type v a +ioUnit a = Type.effect a [Type.ref a ioReference] (Type.ref a DD.unitRef) + +-- '{IO} () +nullaryMain :: Ord v => a -> Type.Type v a +nullaryMain a = Type.arrow a (Type.ref a DD.unitRef) (ioUnit a) + +mainTypes :: Ord v => a -> [Type v a] +mainTypes a = [nullaryMain a] diff --git a/parser-typechecker/src/Unison/Codebase/Runtime.hs b/parser-typechecker/src/Unison/Codebase/Runtime.hs index cd7b1b5c7..9b3b015ab 100644 --- a/parser-typechecker/src/Unison/Codebase/Runtime.hs +++ b/parser-typechecker/src/Unison/Codebase/Runtime.hs @@ -10,12 +10,14 @@ import qualified Unison.ABT as ABT import qualified Data.Map as Map import qualified Data.Set as Set import qualified Unison.Codebase.CodeLookup as CL +import qualified Unison.Codebase as Codebase import Unison.UnisonFile ( UnisonFile ) import qualified Unison.Term as Term import Unison.Term ( Term , AnnotatedTerm ) import Unison.Var ( Var ) +import qualified Unison.Var as Var import Unison.Reference ( Reference ) import qualified Unison.Reference as Reference import qualified Unison.UnisonFile as UF @@ -110,3 +112,19 @@ evaluateWatches code ppe evaluationCache rt uf = do Nothing -> Nothing Just v -> Just (Term.var (ABT.annotation t) v) go _ = Nothing + +evaluateTerm + :: (Var v, Monoid a) + => CL.CodeLookup v IO a + -> PPE.PrettyPrintEnv + -> Runtime v + -> Term.AnnotatedTerm v a + -> IO (Either Error (ABT.Term (Term.F v () ()) v ())) +evaluateTerm codeLookup ppe rt tm = do + let uf = UF.UnisonFile mempty mempty mempty + (Map.singleton UF.RegularWatch [(Var.nameds "result", tm)]) + selfContained <- Codebase.makeSelfContained' codeLookup uf + r <- evaluateWatches codeLookup ppe noCache rt selfContained + pure $ r <&> \(_,map) -> + let [(_loc, _kind, _hash, _src, value, _isHit)] = Map.elems map + in value diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 36b135b97..79f6bee42 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -75,6 +75,8 @@ library Unison.Codebase.TranscriptParser Unison.Codebase.TypeEdit Unison.Codebase.Watch + Unison.Codebase.Execute + Unison.Codebase.MainTerm Unison.CommandLine Unison.CommandLine.DisplayValues Unison.CommandLine.InputPattern diff --git a/parser-typechecker/unison/Main.hs b/parser-typechecker/unison/Main.hs index ae5706496..c8a8e6df9 100644 --- a/parser-typechecker/unison/Main.hs +++ b/parser-typechecker/unison/Main.hs @@ -7,6 +7,7 @@ module Main where import Unison.Prelude import System.Directory ( getCurrentDirectory, getHomeDirectory ) import System.Environment ( getArgs ) +import Unison.Codebase.Execute ( execute ) import qualified Unison.Codebase.FileCodebase as FileCodebase import qualified Unison.CommandLine.Main as CommandLine import qualified Unison.Runtime.Rt1IO as Rt1 @@ -85,7 +86,7 @@ main = do ["init"] -> FileCodebase.initCodebaseAndExit mcodepath "run" : [mainName] -> do theCodebase <- FileCodebase.getCodebaseOrExit mcodepath - launch currentDir configFilePath theCodebase [Right $ Input.ExecuteI mainName, Right Input.QuitI] + execute theCodebase Rt1.runtime mainName "run.file" : file : [mainName] | isDotU file -> do e <- safeReadUtf8 file case e of