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

compiles with no warnings, still gotta fill in a couple functions:

Browse Source 
Runtime.evaluateWatches, and FileParser todo for generrating a UnisonFile from the stanzas.
Also need the implementation of Runtime interface for the Haskell runtime
This commit is contained in:
Paul Chiusano 2019-02-07 21:42:20 -05:00
parent e96683981a
commit 076faf186e
11 changed files with 29 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
parser-typechecker/src/Unison/Codebase/CodeLookup.hs
View File

@ -1,17 +1,12 @@
module Unison.Codebase.CodeLookup where
import Control.Applicative
import Data.Map ( Map )
import qualified Data.Map as Map
import Control.Monad.IO.Class ( MonadIO )
import Unison.UnisonFile ( UnisonFile )
import qualified Unison.UnisonFile as UF
import qualified Unison.Term as Term
import Unison.Term ( Term
, AnnotatedTerm
)
import Unison.Term ( AnnotatedTerm )
import Unison.Var ( Var )
import Unison.Reference ( Reference )
import qualified Unison.Reference as Reference
import qualified Unison.Typechecker.TypeLookup as TL

2
parser-typechecker/src/Unison/Codebase/CommandLine.hs
View File

@ -61,7 +61,7 @@ import Unison.NamePrinter (prettyName,
styleHashQualified
)
import Unison.Parser (Ann)
import Unison.Parser (startingLine, endingLine)
import Unison.Parser (startingLine)
import qualified Unison.PrettyPrintEnv as PPE
import Unison.PrintError (prettyParseError,
prettyTypecheckedFile,

2
parser-typechecker/src/Unison/Codebase/Editor/Actions.hs
View File

@ -222,7 +222,7 @@ loop s = Free.unfold' (evalStateT (maybe (Left ()) Right <$> runMaybeT (go *> ge
unnameAll currentBranchName' nameTarget name success
SlurpFileI allowUpdates -> case uf of
Nothing -> respond NoUnisonFile
Just uf'@(UF.TypecheckedUnisonFile datas effects _ _) -> do
Just uf' -> do
let collisionHandler = if allowUpdates
then Editor.updateCollisionHandler
else Editor.addCollisionHandler

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

@ -1,26 +1,21 @@
{-#LANGUAGE RankNTypes#-}
module Unison.Codebase.Runtime where
import Control.Applicative
import Data.Map ( Map )
import qualified Data.Map as Map
import Control.Monad.IO.Class ( MonadIO )
import Unison.Codebase ( Codebase, Decl )
import Unison.Codebase ( Codebase )
import qualified Unison.Codebase.CodeLookup as CL
import Unison.UnisonFile ( UnisonFile )
import qualified Unison.UnisonFile as UF
import qualified Unison.Term as Term
import Unison.Term ( Term
, AnnotatedTerm
)
import Unison.Var ( Var )
import Unison.Reference ( Reference )
import qualified Unison.Reference as Reference
data Runtime v = Runtime
{ terminate :: forall m. MonadIO m => m ()
, evaluate
:: forall a b m
:: forall a m
. (MonadIO m, Monoid a)
=> CL.CodeLookup m v a
-> AnnotatedTerm v a
@ -41,4 +36,4 @@ evaluateWatches :: (Var v, MonadIO m)
-> Runtime v
-> UnisonFile v a
-> m (Map v (a, Term v))
evaluateWatches evaluationCache rt uf = error "todo"
evaluateWatches _evaluationCache _rt _uf = error "todo"

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

@ -12,7 +12,6 @@ import Data.Bytes.Get ( getWord8
)
import Data.Bytes.Put ( runPutS )
import Data.ByteString ( ByteString )
import Data.Text ( Text )
import Network.Socket
import System.IO.Streams ( InputStream
, OutputStream
@ -22,16 +21,13 @@ import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.ByteString as BSS
import qualified System.IO.Streams.Network as N
import qualified System.Process as P
import Unison.Codebase ( Codebase )
import qualified Unison.Codebase as Codebase
import Unison.Codebase.Runtime ( Runtime(..))
import Unison.Codebase.CodeLookup ( CodeLookup )
import qualified Unison.Codebase.Runtime as Runtime
import qualified Unison.Codebase.Serialization.V0
as Szn
import qualified Unison.Codecs as Codecs
import Unison.Term ( AnnotatedTerm, Term )
import Unison.UnisonFile ( UnisonFile )
import Unison.Var ( Var )
javaRuntime :: (Var v, MonadIO m) => (forall g. MonadGet g => g v) -> Int -> m (Runtime v)
@ -52,7 +48,7 @@ javaRuntime getv suggestedPort = do
pure $ (reverse acc, term)
x -> fail $ "Unexpected byte in JVM output: " ++ show x
feedme
:: forall v a b m. (Var v, MonadIO m, Monoid a)
:: forall v a m. (Var v, MonadIO m, Monoid a)
=> (forall g. MonadGet g => g v)
-> InputStream ByteString
-> OutputStream ByteString

6
parser-typechecker/src/Unison/Codebase/Watch.hs
View File

@ -27,14 +27,8 @@ import System.FSNotify ( Event(Added, Modified)
, watchTree
, withManager
)
import Unison.Names ( Names )
import qualified Unison.TermPrinter as TermPrinter
import Unison.Term ( Term )
import qualified Unison.PrettyPrintEnv as PPE
import Unison.Util.TQueue ( TQueue )
import qualified Unison.Util.TQueue as TQueue
import qualified Unison.Util.Pretty as P
import Unison.Var ( Var )
-- import Debug.Trace
watchDirectory' :: FilePath -> IO (IO (), IO (FilePath, UTCTime))

23
parser-typechecker/src/Unison/FileParser.hs
View File

@ -5,7 +5,7 @@ module Unison.FileParser where
import qualified Unison.ABT as ABT
import qualified Data.Set as Set
import Control.Applicative
import Control.Monad (void, guard)
import Control.Monad (guard)
import Control.Monad.Reader (local, ask)
import Data.Either (partitionEithers)
import Data.List (foldl')
@ -39,7 +39,7 @@ file = do
-- push names onto the stack ahead of existing names
local (UF.names env `mappend`) $ do
names <- ask
stanzas <- sepBy semi stanza
_stanzas <- sepBy semi stanza
let terms = error "todo - create terms and watches from the stanzas"
watches = []
uf = UnisonFile (UF.datas env) (UF.effects env) terms watches
@ -58,8 +58,8 @@ file = do
-- which parses as [(Woot.x, 42), (Woot.y, 17)]
data Stanza v
= WatchBinding Ann String ((Ann, v), AnnotatedTerm v Ann)
| WatchExpression Ann String (AnnotatedTerm v Ann)
= WatchBinding Ann ((Ann, v), AnnotatedTerm v Ann)
| WatchExpression Ann (AnnotatedTerm v Ann)
| Binding ((Ann, v), (AnnotatedTerm v Ann))
| Bindings [((Ann, v), AnnotatedTerm v Ann)]
@ -67,22 +67,19 @@ stanza :: Var v => P v (Stanza v)
stanza = watchExpression <|> binding <|> namespace
where
watchExpression = do
(ann, msg) <- watched
(WatchExpression ann msg <$> TermParser.blockTerm)
<|> (WatchBinding ann msg <$> TermParser.binding)
ann <- watched
(WatchExpression ann <$> TermParser.blockTerm)
<|> (WatchBinding ann <$> TermParser.binding)
binding = Binding <$> TermParser.binding
namespace = tweak <$> TermParser.namespaceBlock where
tweak ns = Bindings (TermParser.toBindings [ns])
watched :: Var v => P v (Ann, String)
watched :: Var v => P v Ann
watched = P.try $ do
op <- optional (L.payload <$> P.lookAhead symbolyId)
guard (op == Just ">")
cur <- P.lookAhead anyToken
let a = ann cur
(curLine, lineContents) <- currentLine
_ <- anyToken -- consume the '>' token
pure (a, lineContents)
tok <- anyToken
pure (ann tok)
terminateTerm :: Var v => AnnotatedTerm v Ann -> AnnotatedTerm v Ann
terminateTerm e@(Term.LetRecNamedAnnotatedTop' top a bs body@(Term.Var' v))

9
parser-typechecker/src/Unison/FileParsers.hs
View File

@ -4,12 +4,10 @@
module Unison.FileParsers where
import Control.Monad (foldM, join)
import Control.Monad (foldM)
import Control.Monad.Trans (lift)
import Control.Monad.State (evalStateT)
import Control.Monad.Writer (tell)
import Data.Bytes.Put (runPutS)
import Data.ByteString (ByteString)
import qualified Data.Foldable as Foldable
import Data.Map (Map)
import qualified Data.Map as Map
@ -21,7 +19,6 @@ import qualified Data.Sequence as Seq
import Data.Text (Text, unpack)
import qualified Unison.ABT as ABT
import qualified Unison.Blank as Blank
import qualified Unison.Codecs as Codecs
import Unison.DataDeclaration (DataDeclaration',
EffectDeclaration')
import qualified Unison.Name as Name
@ -107,7 +104,7 @@ synthesizeFile
synthesizeFile preexistingTypes preexistingNames unisonFile = do
let
-- substitute builtins into the datas/effects/body of unisonFile
uf@(UnisonFile dds0 eds0 terms watches) = unisonFile
uf@(UnisonFile dds0 eds0 _terms _watches) = unisonFile
term0 = UF.uberTerm uf
localNames = UF.toNames uf
localTypes = UF.declsToTypeLookup uf
@ -129,7 +126,7 @@ synthesizeFile preexistingTypes preexistingNames unisonFile = do
Result notes mayType =
evalStateT (Typechecker.synthesizeAndResolve env0) tdnrTerm
-- If typechecking succeeded, reapply the TDNR decisions to user's term:
Result (convertNotes notes) mayType >>= \typ -> do
Result (convertNotes notes) mayType >>= \_typ -> do
let infos = Foldable.toList $ Typechecker.infos notes
(topLevelComponents :: [[(v, Term v, Type v)]]) <-
let

1
parser-typechecker/src/Unison/TermParser.hs
View File

@ -8,7 +8,6 @@
module Unison.TermParser where
-- import Debug.Trace
import qualified Data.Strings as Strings
import qualified Data.Text as Text
import Control.Applicative
import Control.Monad (guard, join, when)

1
parser-typechecker/src/Unison/UnisonFile.hs
View File

@ -14,7 +14,6 @@ import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Text as Text
import Unison.DataDeclaration (DataDeclaration')
import Unison.DataDeclaration (EffectDeclaration' (..))
import Unison.DataDeclaration (hashDecls, toDataDecl, withEffectDecl)

18
parser-typechecker/tests/Unison/Test/Typechecker.hs
View File

@ -13,7 +13,6 @@ import EasyTest
import System.FilePath (joinPath, splitPath)
import System.FilePath.Find (always, extension, find, (==?))
import qualified Unison.Builtin as Builtin
import Unison.FileParsers (Type, Term)
import Unison.Parser as Parser
import qualified Unison.PrettyPrintEnv as PPE
import qualified Unison.PrintError as PrintError
@ -23,18 +22,20 @@ import Unison.Symbol (Symbol)
import Unison.Test.Common (parseAndSynthesizeAsFile)
import qualified Unison.UnisonFile as UF
import Unison.Util.Monoid (intercalateMap)
import Control.Arrow ((&&&))
type Note = Result.Note Symbol Parser.Ann
type TFile = UF.TypecheckedUnisonFile Symbol Ann
type SynthResult =
Result (Seq Note) (PrintError.Env, Maybe (Term Symbol, Type Symbol))
type EitherResult = Either String (Term Symbol, Type Symbol)
Result (Seq Note)
(PrintError.Env, Maybe TFile)
type EitherResult = Either String TFile
ppEnv :: PPE.PrettyPrintEnv
ppEnv = PPE.fromNames Builtin.names
expectRight' :: EitherResult -> Test (Term Symbol, Type Symbol)
expectRight' :: Either String a -> Test a
expectRight' (Left e) = crash e
expectRight' (Right a) = ok >> pure a
@ -80,13 +81,13 @@ showNotes source env notes =
intercalateMap "\n\n" (PrintError.renderNoteAsANSI env source) notes
decodeResult
:: String -> SynthResult -> Either String (Term Symbol, Type Symbol)
:: String -> SynthResult -> EitherResult-- String (UF.TypecheckedUnisonFile Symbol Ann)
decodeResult source (Result notes Nothing) =
Left $ showNotes source ppEnv notes
decodeResult source (Result notes (Just (env, Nothing))) =
Left $ showNotes source env notes
decodeResult _source (Result _notes (Just (_env, Just (t, typ)))) =
Right (t, typ)
decodeResult _source (Result _notes (Just (_env, Just uf))) =
Right uf
makePassingTest :: (EitherResult -> Test ()) -> FilePath -> Test ()
makePassingTest how filepath = join $ do
@ -97,6 +98,5 @@ makePassingTest how filepath = join $ do
$ scope shortName
. how
. decodeResult source
. fmap (fmap (fmap (UF.topLevelTerm &&& UF.typ)))
. parseAndSynthesizeAsFile shortName
$ source