unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-24 08:47:19 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'wip/rt1' of github.com:unisonweb/unison into wip/rt1

Browse Source
This commit is contained in:
Paul Chiusano 2019-02-21 17:05:37 -05:00
commit aee8de62d6
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
parser-typechecker/src/Unison/Builtin.hs
View File

@ -7,12 +7,15 @@
module Unison.Builtin where
import Control.Arrow ( first )
import Control.Applicative ( liftA2 )
import Control.Applicative ( liftA2
, (<|>)
)
import qualified Data.Map as Map
import Data.Set ( Set )
import qualified Data.Set as Set
import qualified Text.Megaparsec.Error as MPE
import qualified Unison.ABT as ABT
import Unison.Codebase.CodeLookup ( CodeLookup(..) )
import qualified Unison.ConstructorType as CT
import Unison.DataDeclaration ( DataDeclaration'
, EffectDeclaration'
@ -140,6 +143,14 @@ builtinDataDecls = l
builtinEffectDecls :: Var v => [(v, (R.Reference, EffectDeclaration v))]
builtinEffectDecls = []
codeLookup :: (Applicative m, Var v) => CodeLookup m v Ann
codeLookup = CodeLookup (const $ pure Nothing) $ \r ->
pure
$ lookup r [ (r, Right x) | (R.DerivedId r, x) <- snd <$> builtinDataDecls ]
<|> lookup
r
[ (r, Left x) | (R.DerivedId r, x) <- snd <$> builtinEffectDecls ]
toSymbol :: Var v => R.Reference -> v
toSymbol (R.Builtin txt) = Var.named txt
toSymbol _ = error "unpossible"

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

@ -109,9 +109,11 @@ makePassingTest rt how filepath = scope shortName $ do
(True, Right file) -> do
values <- io $ unpack <$> Data.Text.IO.readFile valueFile
let untypedFile = UF.discardTypes file
let term = Parsers.parseTerm values $ UF.toNames untypedFile
watches <- io
$ evaluateWatches mempty (const $ pure Nothing) rt untypedFile
let term = Parsers.parseTerm values $ UF.toNames untypedFile
watches <- io $ evaluateWatches Builtin.codeLookup
(const $ pure Nothing)
rt
untypedFile
case term of
Right tm ->
expect $ (view _4 <$> Map.elems watches) == [amap (const ()) tm]