Fixed all warnings

parser-typechecker/src/Unison/Builtin.hs

@@ -1,12 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Unison.Builtin where
 
-import Unison.Parser (PEnv, penv0)
+import Unison.Parser (penv0)
 import Unison.Parsers (unsafeParseType, unsafeParseTerm)
 import Unison.Symbol (Symbol)
 import Unison.Type (Type)
 import Unison.Term (Term)
-import Unison.Var (Var)
 import Data.Set (Set)
 import qualified Data.Map as Map
 import qualified Data.Set as Set

parser-typechecker/src/Unison/Hashable.hs

@@ -2,7 +2,8 @@
 
 module Unison.Hashable where
 
-import Data.Word (Word8)
+import Data.Int (Int64)
+import Data.Word (Word8, Word64)
 import Data.ByteString (ByteString)
 import Data.Text (Text)
 
@@ -13,6 +14,7 @@ data Token h
   | Text !Text
   | Double !Double
   | Hashed !h
+  | Word !Word64
 
 class Accumulate h where
   accumulate :: [Token h] -> h
@@ -54,3 +56,12 @@ instance Hashable Text where
 instance Hashable ByteString where
   tokens bs = [Bytes bs]
 
+instance Hashable Word64 where
+  tokens w = [Word w]
+
+instance Hashable Int64 where
+  tokens w = [Word $ fromIntegral w]
+
+instance Hashable Bool where
+  tokens b = [Tag . fromIntegral $ fromEnum b]
+

parser-typechecker/src/Unison/Parser.hs

@@ -8,7 +8,6 @@ module Unison.Parser where
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Reader
 import Data.Char (isSpace)
 import Data.List hiding (takeWhile)
 import Data.Map
@@ -147,6 +146,9 @@ symbolyId keywords = label "operator" . token $ do
 token :: Parser s a -> Parser s a
 token p = attempt (L.spaced p)
 
+token_ :: Parser s a -> Parser s ()
+token_ = void . token
+
 parenthesized :: Parser s a -> Parser s a
 parenthesized p = lp *> body <* rp
   where

parser-typechecker/src/Unison/Parsers.hs

@@ -2,21 +2,15 @@
 
 module Unison.Parsers where
 
-import Control.Arrow ((***))
-import Data.Text (Text)
-import Unison.Term (Term)
-import Unison.Type (Type)
-import Unison.Parser (run, PEnv)
-import Unison.Var (Var)
-import qualified Unison.Parser as Parser
-import qualified Data.Text as Text
 import qualified Unison.ABT as ABT
+import           Unison.Parser (run, PEnv)
+import qualified Unison.Parser as Parser
+import           Unison.Term (Term)
 import qualified Unison.Term as Term
 import qualified Unison.TermParser as TermParser
+import           Unison.Type (Type)
 import qualified Unison.TypeParser as TypeParser
-import qualified Unison.Type as Type
-import qualified Unison.Reference as R
-import qualified Unison.Var as Var
+import           Unison.Var (Var)
 
 type S v = TypeParser.S v
 

parser-typechecker/src/Unison/Pattern.hs

@@ -30,5 +30,5 @@ instance H.Hashable Pattern where
   tokens (Constructor r n args) =
     [H.Tag 6, H.accumulateToken r, H.VarInt n, H.accumulateToken args]
   tokens (EffectPure p) = H.Tag 7 : H.tokens p
-  tokens (EffectBind r ctor ps k) =
+  tokens (EffectBind _r _ctor _ps _k) =
     H.Tag 8 : error "need fo figure out hashable"

parser-typechecker/src/Unison/Term.hs

@@ -346,6 +346,11 @@ instance Var v => Hashable1 (F v) where
       -- Note: start each layer with leading `1` byte, to avoid collisions with
       -- types, which start each layer with leading `0`. See `Hashable1 Type.F`
       _ -> Hashable.accumulate $ tag 1 : case e of
+        UInt64 i -> [tag 64, accumulateToken i]
+        Int64 i -> [tag 65, accumulateToken i]
+        Float n -> [tag 66, Hashable.Double n]
+        Boolean b -> [tag 67, accumulateToken b]
+        Text t -> [tag 68, accumulateToken t]
         Blank -> [tag 1]
         Ref (Reference.Builtin name) -> [tag 2, accumulateToken name]
         Ref (Reference.Derived _) -> error "handled above, but GHC can't figure this out"
@@ -357,7 +362,13 @@ instance Var v => Hashable1 (F v) where
         LetRec as a -> case hashCycle as of
           (hs, hash) -> tag 7 : hashed (hash a) : map hashed hs
         -- here, order is significant, so don't use hashCycle
-        Let b a -> [tag 8, hashed (hash b), hashed (hash a)]
+        Let b a -> [tag 8, hashed $ hash b, hashed $ hash a]
+        If b t f -> [tag 9, hashed $ hash b, hashed $ hash t, hashed $ hash f]
+        Request r n -> [tag 10, accumulateToken r, varint n]
+        EffectPure r -> [tag 11, hashed $ hash r]
+        EffectBind r i rs k ->
+          [tag 14, accumulateToken r, varint i, varint (length rs)] ++
+          (hashed . hash <$> rs ++ [k])
         Constructor r n -> [tag 12, accumulateToken r, varint n]
         Match e branches -> tag 13 : hashed (hash e) : concatMap h branches
           where
@@ -365,6 +376,9 @@ instance Var v => Hashable1 (F v) where
               concat [[accumulateToken pat],
                       toList (hashed . hash <$> guard),
                       [hashed (hash branch)]]
+        Handle h b -> [tag 15, hashed $ hash h, hashed $ hash b]
+        And x y -> [tag 16, hashed $ hash x, hashed $ hash y]
+        Or x y -> [tag 17, hashed $ hash x, hashed $ hash y]
 
 -- mostly boring serialization code below ...
 
@@ -373,6 +387,7 @@ instance Var v => Show1 (F v) where showsPrec1 = showsPrec
 
 instance (Var v, Show a) => Show (F v a) where
   showsPrec p fa = go p fa where
+    showConstructor r n = showsPrec 0 r <> s"#" <> showsPrec 0 n
     go _ (Int64 n) = (if n >= 0 then s "+" else s "") <> showsPrec 0 n
     go _ (UInt64 n) = showsPrec 0 n
     go _ (Float n) = showsPrec 0 n
@@ -387,9 +402,21 @@ instance (Var v, Show a) => Show (F v a) where
     go _ (Let b body) = showParen True (s"let " <> showsPrec 0 b <> s" in " <> showsPrec 0 body)
     go _ (LetRec bs body) = showParen True (s"let rec" <> showsPrec 0 bs <> s" in " <> showsPrec 0 body)
     go _ (Handle b body) = showParen True (s"handle " <> showsPrec 0 b <> showsPrec 0 body)
-    go _ (Constructor r n) = showsPrec 0 r <> showsPrec 0 n
+    go _ (Constructor r n) = showConstructor r n
     go _ (Match scrutinee cases) =
       showParen True (s"case " <> showsPrec 0 scrutinee <> s" of " <> showsPrec 0 cases)
     go _ (Text s) = showsPrec 0 s
+    go _ (Request r n) = showConstructor r n
+    go _ (EffectPure r) = s"{ " <> showsPrec 0 r <> s" }"
+    go _ (EffectBind ref i args k) =
+      s"{ " <> showConstructor ref i <> showListWith (showsPrec 0) args <>
+      s" -> " <> showsPrec 0 k <> s" }"
+    go p (If c t f) = showParen (p > 0) $
+      s"if " <> showsPrec 0 c <> s" then " <> showsPrec 0 t <>
+      s" else " <> showsPrec 0 f
+    go p (And x y) = showParen (p > 0) $
+      s"and " <> showsPrec 0 x <> s" " <> showsPrec 0 y
+    go p (Or x y) = showParen (p > 0) $
+      s"or " <> showsPrec 0 x <> s" " <> showsPrec 0 y
     (<>) = (.)
     s = showString

parser-typechecker/src/Unison/TermParser.hs

@@ -13,41 +13,42 @@ import           Data.Char (isDigit, isUpper)
 import           Data.Foldable (asum,toList)
 import           Data.Functor
 import           Data.Int (Int64)
-import           Data.Map (Map)
 import qualified Data.Map as Map
-import           Data.Word (Word64)
 import qualified Data.Text as Text
+import           Data.Word (Word64)
 import           Prelude hiding (takeWhile)
 import qualified Text.Parsec.Layout as L
+import           Text.Parsec.Prim (ParsecT)
 import qualified Unison.ABT as ABT
 import           Unison.Parser
 import           Unison.Pattern (Pattern)
 import qualified Unison.Pattern as Pattern
-import           Unison.Reference (Reference)
 import           Unison.Term (Term)
 import qualified Unison.Term as Term
 import           Unison.Type (Type)
 import qualified Unison.Type as Type
 import qualified Unison.TypeParser as TypeParser
-import qualified Unison.Typechecker.Components as Components
 import           Unison.Var (Var)
 import qualified Unison.Var as Var
 
 import Debug.Trace
 import Text.Parsec (anyChar)
 
+pTrace :: [Char] -> Text.Parsec.Prim.ParsecT Text.Text (Env s) ((->) PEnv) ()
 pTrace s = pt <|> return ()
     where pt = attempt $
                do
                  x <- attempt $ many anyChar
-                 trace (s++": " ++x) $ attempt $ char 'z'
+                 void $ trace (s++": " ++x) $ attempt $ char 'z'
                  fail x
 
--- traced s p = p
+traced :: [Char]
+       -> Text.Parsec.Prim.ParsecT Text.Text (Env s) ((->) PEnv) b
+       -> Text.Parsec.Prim.ParsecT Text.Text (Env s) ((->) PEnv) b
 traced s p = do
   pTrace s
   a <- p <|> trace (s ++ " backtracked") (fail s)
-  let !x = trace (s ++ " succeeded") ()
+  let !_ = trace (s ++ " succeeded") ()
   pure a
 
 {-
@@ -86,19 +87,17 @@ blockTerm = letBlock <|> handle <|> ifthen <|> match <|> lam term <|> infixApp
 
 match :: Var v => TermP v
 match = do
-  token (string "case")
+  token_ $ string "case"
   scrutinee <- term
-  token (string "of")
+  token_ $ string "of"
   cases <- L.vblock (sepBy L.vsemi matchCase)
   pure $ Term.match scrutinee cases
 
 matchCase :: Var v => Parser (S v) (Term.MatchCase (Term v))
 matchCase = do
   (p, boundVars) <- pattern
-  guard <- optional $ do
-    token (string "|")
-    block
-  token (string "->")
+  guard <- optional $ token (string "|") *> block
+  token_ $ string "->"
   t <- block
   pure . Term.MatchCase p guard $ ABT.absChain boundVars t
 
@@ -188,6 +187,7 @@ number' i u f = token $ do
       Nothing -> u (read ds)
       Just '+' -> i (read ds)
       Just '-' -> i (read ('-':ds))
+      _ -> error "impossible!"
     Just fraction ->
       let signl = toList sign
       in f (read (signl ++ ds ++ fraction))
@@ -287,9 +287,9 @@ block = traced "block" $ go =<< L.vblock (sepBy L.vsemi statement)
 
 handle :: Var v => TermP v
 handle = do
-  token $ string "handle"
+  token_ $ string "handle"
   handler <- term
-  token $ string "in"
+  token_ $ string "in"
   b <- block
   pure $ Term.handle handler b
 

parser-typechecker/src/Unison/Type.hs

@@ -14,14 +14,13 @@ import Data.Set (Set)
 import Data.Text (Text)
 import GHC.Generics
 import Prelude.Extras (Eq1(..),Show1(..))
-import Unison.Hashable (Hashable, Hashable1)
+import Unison.Hashable (Hashable1)
 import Unison.Note (Noted)
 import Unison.Reference (Reference)
 import Unison.TypeVar (TypeVar)
 import Unison.Var (Var)
 import qualified Data.Set as Set
 import qualified Unison.ABT as ABT
-import qualified Unison.Hash as Hash
 import qualified Unison.Hashable as Hashable
 import qualified Unison.Kind as K
 import qualified Unison.Reference as Reference

parser-typechecker/src/Unison/Typechecker/Context.hs

@@ -16,7 +16,6 @@ module Unison.Typechecker.Context where
 import Control.Monad
 import Data.List
 import Data.Map (Map)
-import Data.Maybe
 import Data.Set (Set)
 import Unison.DataDeclaration (DataDeclaration)
 import Unison.Note (Note,Noted(..))
@@ -423,10 +422,10 @@ check :: Var v => Term v -> Type v -> M v ()
 check e t = getContext >>= \ctx -> scope ("check: " ++ show e ++ ":   " ++ show t) $
   if wellformedType ctx t then
     let
-      go (Term.Int64' n) _ = subtype Type.int64 t -- 1I
-      go (Term.UInt64' n) _ = subtype Type.uint64 t -- 1I
-      go (Term.Float' n) _ = subtype Type.float t -- 1I
-      go (Term.Boolean' n) _ = subtype Type.boolean t -- 1I
+      go (Term.Int64' _) _ = subtype Type.int64 t -- 1I
+      go (Term.UInt64' _) _ = subtype Type.uint64 t -- 1I
+      go (Term.Float' _) _ = subtype Type.float t -- 1I
+      go (Term.Boolean' _) _ = subtype Type.boolean t -- 1I
       go Term.Blank' _ = pure () -- somewhat hacky short circuit; blank checks successfully against all types
       go _ (Type.Forall' body) = do -- ForallI
         x <- extendUniversal =<< ABT.freshen body freshenTypeVar
@@ -451,7 +450,7 @@ check e t = getContext >>= \ctx -> scope ("check: " ++ show e ++ ":   " ++ show
       go (Term.Match' scrutinee branches) t = do
         scrutineeType <- synthesize scrutinee
         dataDecls <- getDataDeclarations
-        forM_ branches $ \(Term.MatchCase lhs guard rhs) -> do
+        forM_ branches $ \(Term.MatchCase lhs _guard rhs) -> do
           checkPattern lhs dataDecls scrutineeType
           check rhs t
           -- NOTE: Typecheck the guard

parser-typechecker/tests/Unison/Test/TermParser.hs

@@ -66,6 +66,9 @@ test = scope "termparser" . tests . map parses $
     "  0 ->\n" ++
     "    z = 0\n" ++
     "    z"
+
+  , "case x of\n" ++
+    " 0 | 1 == 2 -> 123"
   ]
 
 builtins = Map.fromList

yaks/parsec-layout/src/Text/Parsec/Layout.hs

@@ -40,6 +40,7 @@ import qualified Text.Parsec.Char as Parsec.Char
 import Debug.Trace
 import Text.Parsec (anyChar)
 
+pTrace :: Stream s m Char => [Char] -> ParsecT s u m ()
 pTrace s = pt <|> return ()
     where pt = try $
                do
@@ -47,10 +48,12 @@ pTrace s = pt <|> return ()
                  trace (s++": " ++x) $ try $ char 'z'
                  fail x
 
+traced :: (Stream s m Char, HasLayoutEnv u) =>
+          [Char] -> ParsecT s u m b -> ParsecT s u m b
 traced s p = do
   pTrace s
   ctx <- getEnv
-  let !y = trace ("ctx: " ++ show ctx) ()
+  let !_ = trace ("ctx: " ++ show ctx) ()
   a <- p --  <|> trace (s ++ " backtracked") (fail s)
   -- let !x = trace (s ++ " succeeded") ()
   pure a
@@ -98,12 +101,6 @@ getIndentation = depth . envLayout <$> getEnv where
     depth (Layout n:_) = n
     depth _ = 0
 
-pushCurrentContext :: (HasLayoutEnv u, Stream s m c) => ParsecT s u m ()
-pushCurrentContext = do
-    indent <- getIndentation
-    col <- sourceColumn <$> getPosition
-    pushContext . Layout $ max (indent+1) col
-
 -- Pushes a column onto the layout stack determined by the column where
 -- the next token begins. Ex:
 --   let