unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-04 21:57:25 +03:00
Code Issues Projects Releases Wiki Activity

ucm run: do not set up interactive environment

Browse Source
This commit is contained in:
Vladislav Zavialov 2019-12-13 00:50:53 +03:00
parent 9eb245eaf0
commit 5e08e0a09e
8 changed files with 151 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CONTRIBUTORS.markdown
View File

@ -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)

10
parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs
View File

@ -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

41
parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -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

50
parser-typechecker/src/Unison/Codebase/Execute.hs Normal file
View File

@ -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

64
parser-typechecker/src/Unison/Codebase/MainTerm.hs Normal file
View File

@ -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]

18
parser-typechecker/src/Unison/Codebase/Runtime.hs
View File

@ -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

2
parser-typechecker/unison-parser-typechecker.cabal
View File

@ -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

3
parser-typechecker/unison/Main.hs
View File

@ -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