ucsd-progsys / liquidhaskell

Liquid Types For Haskell

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

Cannot parse `GHC.Types.:`

layus opened this issue · comments

{- UGH CAN'T PARSE `GHC.Types.:`...
foldr' :: forall <p :: [a] -> b -> Prop>.
(xs:[a] -> x:a -> b<p xs> -> b<p (GHC.Types.: x xs)>)
-> b<p GHC.Types.[]>
-> ys:[a]
-> b<p ys>
@-}
foldr' f z [] = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)


There is no way to refer to list contructor : inside specifications, as : is reserved for typing variables and expressions. This makes it impossible to prove semi-advanced programs based on lists.

I think there should be a way to refer to GHC.Types.: in specifications, or a canonical way to define aliases for strange names that cannot be parsed.


I have made numerous attempts at bypassing this issue, to no avail.

  • (xs:[a] -> x:a -> b<p xs> -> b<p (GHC.Types.: x xs)>) has undefined symbol GHC.Types.
  • (xs:[a] -> x:a -> b<p xs> -> b<p (x:xs)>) has cast error, because x (a a) cannot be converted to the type of xs (a [a])
  • (xs:[a] -> x:a -> b<p xs> -> b<p (cons x xs)>) seems to work (with cons = (:) being reflected) until you realize the inference cannot prove anything useful about cons. Something as trivial as this fails verification:
{-@ prop_cons :: x:a -> xs:[a] -> {xxs:[a] | xxs == (cons x xs)} @-}
prop_cons x xs = x:xs -- Fails

More generally, it is possible to prove that insertionSort and quickSort generate ordered permutations of their inputs, but not when using foldr, or a generalized foldr' that supports a ghost variable. The initial quote above cannot be made to work.


If you are curious, here is my attempt:

{-# LANGUAGE NoMonomorphismRestriction #-}

module PuttingThingsInOrder () where

import Prelude hiding (break)
import qualified Language.Haskell.Liquid.Bag as B
import Language.Haskell.Liquid.Prelude (liquidAssert)

{-@ measure elems @-}
elems :: (Ord a) => [a] -> B.Bag a
elems []     = B.empty
elems (x:xs) = B.put x (elems xs)

{-@ predicate Perm X Y = elems X == elems Y @-}
{-@ type IncrList a = [a]<{\xi xj -> xi <= xj}> @-}
{-@ type SortedList a Xs = {ys:IncrList a | Perm ys Xs} @-}

{-@ reflect cons @-}
cons :: a -> [a] -> [a]
cons x xs = x : xs

-- All the properties fail

{-@ prop_cons :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_cons x xs = cons x xs == x:xs

{-@ prop_cons2 :: x:a -> xs:[a] -> {xxs:[a] | xxs == (cons x xs)} @-}
prop_cons2 x xs = x:xs

{-@ prop_elems_cons :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_elems_cons x xs = elems (cons x xs) == B.put x (elems xs)

{-@ prop_elems_cons2 :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_elems_cons2 x xs = elems (cons x xs) == elems (x:xs)

{-@ prop_elems_put :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_elems_put x xs = elems (cons x xs) == B.put x (elems xs)

{-@ insert :: (Ord a) => x:a -> xs:IncrList a -> ys:{ys:IncrList a | elems ys == B.put x (elems xs)} @-}
-- FAILS: {-@ insert :: (Ord a) => x:a -> xs:IncrList a -> SortedList a (cons x xs) @-}
insert y []     = [y]
insert y (x:xs)
  | y <= x      = y : x : xs
  | otherwise   = x : insert y xs

{-@
foldr' :: forall <p :: [a] -> b -> Bool>.
          (xs:[a] -> x:a -> b<p xs> -> b<p (cons x xs)>)
       -> b<p []>
       -> ys:[a]
       -> b<p ys>
@-}
foldr' :: ([a] -> a -> b -> b) -> b -> [a] -> b
foldr' f z []     = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)

{-@ ghostInsert :: (Ord a) => xs:[a] -> y:a -> ys:SortedList a xs -> SortedList a (cons y ys) @-}
ghostInsert :: Ord a => [a] -> a -> [a] -> [a]
ghostInsert xs y ys = insert y ys

{-@ insertSort :: (Ord a) => xs:[a] -> SortedList a xs @-}
insertSort :: Ord a => [a] -> [a]
insertSort xs  = foldr' ghostInsert [] xs

cc @facundominguez follow-up from previous discussion

Perhaps the workaround needs {-@ LIQUID "--ple" @-} in addition (?).

Is the workaround the best "fix" or can we aim for something better? Maybe we could escape : somehow so it is not interpreted as a type annotation.

Please disregard a former message that I sent and then deleted.

{-@ LIQUID "--ple" @-} and {-@ LIQUID "--reflect" @-} do both help verifying the properties in the example above. Together all the properties are checked.
These flags should be documented next to the "reflect" annotation if they are that important. What do they do ?

It also helps proving ghostInsert, but somehow breaks foldr' (Tested in http://goto.ucsd.edu:8090/index.html).

As for the parser, I looked at the code, but parsing haskell is hard, and adding an extra syntax on top is hard. My impression is that the best way would be to support an escape character, like \, as in GHC.Types.\:

Just for reference, I got it working by specializing the type of foldr':

{-@
foldr' :: (xs:[a] -> x:a -> SortedList a xs -> SortedList a (cons x xs))
       -> SortedList a []
       -> ys:[a]
       -> SortedList a ys
@-}
foldr' :: ([a] -> a -> [a] -> [a]) -> [a] -> [a] -> [a]
foldr' f z []     = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)

instead of the more generic

{-@
foldr' :: forall <p :: [a] -> b -> Bool>.
          (xs:[a] -> x:a -> b<p xs> -> b<p (cons x xs)>)
       -> b<p []>
       -> ys:[a]
       -> b<p ys>
@-}
foldr' :: ([a] -> a -> b -> b) -> b -> [a] -> b
foldr' f z []     = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)

Which is a bit unsatisfying, but good enough given that the issue here was getting cons to work. So at least there exists a working workaround.

I think liquidhaskell fails to instantiate type b to IncrList a, and predicate p to Perm, possibly because both are bundled under SortedList a xs. But that is a whole different story.

{-# LANGUAGE NoMonomorphismRestriction #-}
{-@ LIQUID "--ple" @-}
{-@ LIQUID "--reflect" @-}

module PuttingThingsInOrder () where

import Prelude hiding (break)
import qualified Language.Haskell.Liquid.Bag as B
import Language.Haskell.Liquid.Prelude (liquidAssert)

{-@ measure elems @-}
elems :: (Ord a) => [a] -> B.Bag a
elems []     = B.empty
elems (x:xs) = B.put x (elems xs)

{-@ predicate Perm X Y = elems X == elems Y @-}
{-@ type IncrList a = [a]<{\xi xj -> xi <= xj}> @-}
{-@ type SortedList a Xs = {ys:IncrList a | Perm ys Xs} @-}

{-@ reflect cons @-}
cons :: a -> [a] -> [a]
cons x xs = x : xs

-- All the properties fail

{-@ prop_cons :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_cons x xs = cons x xs == x:xs

{-@ prop_cons2 :: x:a -> xs:[a] -> {xxs:[a] | xxs == (cons x xs)} @-}
prop_cons2 x xs = x:xs

{-@ prop_elems_cons :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_elems_cons x xs = elems (cons x xs) == B.put x (elems xs)

{-@ prop_elems_cons2 :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_elems_cons2 x xs = elems (cons x xs) == elems (x:xs)

{-@ prop_elems_put :: x:a -> xs:[a] -> {b:Bool | b} @-}
prop_elems_put x xs = elems (cons x xs) == B.put x (elems xs)

{-@ insert :: (Ord a) => x:a -> xs:IncrList a -> SortedList a (cons x xs) @-}
insert y []     = [y]
insert y (x:xs)
  | y <= x      = y : x : xs
  | otherwise   = x : insert y xs

{- @
foldr' :: forall <p :: [a] -> b -> Bool>.
          (xs:[a] -> x:a -> b<p xs> -> b<p (cons x xs)>)
       -> b<p []>
       -> ys:[a]
       -> b<p ys>
@-}
{-@
foldr' :: (xs:[a] -> x:a -> SortedList a xs -> SortedList a (cons x xs))
       -> SortedList a []
       -> ys:[a]
       -> SortedList a ys
@-}
foldr' :: ([a] -> a -> [a] -> [a]) -> [a] -> [a] -> [a]
foldr' f z []     = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)

{-@ ghostInsert :: (Ord a) => xs:[a] -> y:a -> ys:SortedList a xs -> SortedList a (cons y ys) @-}
ghostInsert :: Ord a => [a] -> a -> [a] -> [a]
ghostInsert xs y ys = insert y ys

{-@ insertSort :: (Ord a) => xs:[a] -> SortedList a xs @-}
insertSort :: Ord a => [a] -> [a]
insertSort xs  = foldr' ghostInsert [] xs

These flags should be documented next to the "reflect" annotation if they are that important. What do they do ?

Their substance is explained in the "Refinement Reflection" paper listed here.

I managed to parse both SortedList a (GHC.Types.: x xs) and SortedList a ((:) x xs) by hardcoding GHC.Types.: and (:) in liquidhaskell-fixpoint parsers. That is enough to get the proof to proceed (still need --ple, but not --reflect)

{-@
foldr' :: (xs:[a] -> x:a -> SortedList a xs -> SortedList a (GHC.Types.: x xs))
        -> SortedList a []
        -> ys:[a]
        -> SortedList a ys
@-}
foldr' :: ([a] -> a -> [a] -> [a]) -> [a] -> [a] -> [a]
foldr' f z []     = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)

{-@ ghostInsert :: (Ord a) => xs:[a] -> y:a -> ys:SortedList a xs -> SortedList a ((:) y ys) @-}
ghostInsert :: Ord a => [a] -> a -> [a] -> [a]
ghostInsert xs y ys = insert y ys
diff --git a/liquid-fixpoint/src/Language/Fixpoint/Parse.hs b/liquid-fixpoint/src/Language/Fixpoint/Parse.hs
index 05961797..15df20a9 100644
--- a/liquid-fixpoint/src/Language/Fixpoint/Parse.hs
+++ b/liquid-fixpoint/src/Language/Fixpoint/Parse.hs
@@ -657,6 +657,8 @@ condIdR initial okChars condition msg = do
 --
 upperIdR :: Parser Symbol
 upperIdR =
+  -- This one works for 'GHC.Types.:' but not for '(:)', oddly
+  -- ((string "(:)" <|> string "GHC.Types.:") >> return "GHC.Types.:") <|> 
   condIdR upperChar (`S.member` symChars) (const True) "unexpected"
 
 -- | Raw parser for an identifier starting with a lowercase letter.
@@ -665,6 +667,8 @@ upperIdR =
 --
 lowerIdR :: Parser Symbol
 lowerIdR =
+  -- This one works for both 'GHC.Types.:' and '(:)'
+  ((string "(:)" <|> string "GHC.Types.:") >> return "GHC.Types.:") <|>
   condIdR (lowerChar <|> char '_') (`S.member` symChars) isNotReserved "unexpected reserved word"
 
 -- | Raw parser for an identifier starting with any letter.
@@ -673,6 +677,7 @@ lowerIdR =
 --
 symbolR :: Parser Symbol
 symbolR =
+  -- This one never gets a chance to parse 'GHC.Types.:'
   condIdR (letterChar <|> char '_') (`S.member` symChars) isNotReserved "unexpected reserved word"
 
 isNotReserved :: String -> Bool
diff --git a/liquidhaskell-boot/src/Language/Haskell/Liquid/Parse.hs b/liquidhaskell-boot/src/Language/Haskell/Liquid/Parse.hs
index 544cd4298..067173dfc 100644
--- a/liquidhaskell-boot/src/Language/Haskell/Liquid/Parse.hs
+++ b/liquidhaskell-boot/src/Language/Haskell/Liquid/Parse.hs
@@ -1705,6 +1705,7 @@ infixBinderIdP =
 
 upperIdR' :: Parser Symbol
 upperIdR' =
+  -- This one never gets a chance to parse 'GHC.Types.:'
   condIdR upperChar (\ c -> isAlphaNum c || c == '\'') (const True) "unexpected"
 
 locUpperIdP' :: Parser (Located Symbol)

Another option is to use backslashes. Due to current implementation decisions, backslashes are not allowed for the first character. So this POC enables GHC.Types.\: but not bare \:. It's a bit messy in liquid-prelude/src/Language/Haskell/Liquid/RTick.hs because of the operators containing backslashes, but that is the only nasty impact in the test suite:

{-@
foldr' :: (xs:[a] -> x:a -> SortedList a xs -> SortedList a (GHC.Types.\: x xs))
        -> SortedList a []
        -> ys:[a]
        -> SortedList a ys
@-}
foldr' :: ([a] -> a -> [a] -> [a]) -> [a] -> [a] -> [a]
foldr' f z []     = z
foldr' f z (x:xs) = f xs x (foldr' f z xs)

{-@ ghostInsert :: (Ord a) => xs:[a] -> y:a -> ys:SortedList a xs -> SortedList a (GHC.Types.\: y ys) @-}
ghostInsert :: Ord a => [a] -> a -> [a] -> [a]
ghostInsert xs y ys = insert y ys

The implementation is more generic, but laborious:

diff --git a/liquid-fixpoint/src/Language/Fixpoint/Parse.hs b/liquid-fixpoint/src/Language/Fixpoint/Parse.hs
index 05961797..950e91e2 100644
--- a/liquid-fixpoint/src/Language/Fixpoint/Parse.hs
+++ b/liquid-fixpoint/src/Language/Fixpoint/Parse.hs
@@ -643,11 +643,19 @@ naturalR =
 -- * an error message to display if the final check fails.
 --
 condIdR :: Parser Char -> (Char -> Bool) -> (String -> Bool) -> String -> Parser Symbol
-condIdR initial okChars condition msg = do
-  s <- (:) <$> initial <*> takeWhileP Nothing okChars
+condIdR initial okChar condition msg = do
+  s <- (:) <$> initial <*> following
   if condition s
     then pure (symbol s)
     else fail (msg <> " " <> show s)
+ where
+  okChars :: Parser String
+  okChars = takeWhileP Nothing (\c -> c /= '\\' && okChar c)
+  escapedChars :: Parser String
+  escapedChars = some (char '\\' >> anySingle)
+  nonempty = (++) <$> escapedChars <*> okChars
+  following = concat <$> ((:) <$> okChars <*> many nonempty)
+

and a sample of the impact in RTick.hs:

--- a/liquid-prelude/src/Language/Haskell/Liquid/RTick.hs
+++ b/liquid-prelude/src/Language/Haskell/Liquid/RTick.hs
@@ -303,10 +303,10 @@ infixl 4 <//>
 --
 -- \"gapp\": @(f <\>) := step (-1) . (f <*>)@.
 --
-{-@ reflect <\> @-}
-{-@ (<\>) :: t1:(Tick (a -> b)) -> t2:Tick a
+{-@ reflect <\\> @-}
+{-@ (<\\>) :: t1:(Tick (a -> b)) -> t2:Tick a
      -> { t:Tick b | (tval t1) (tval t2) == tval  t &&
                tcost t1 + tcost t2 - 1 == tcost t }
@-}

Are you willing to merge a PR for any of these ideas ? Do you want the code of both options to make your own mind ? I understand that it's kind of a long-lasting decision.

One option that was not explored yet is to quote identifiers, but ' is used for lifting, " for strings, and for infix. Haskell has little room for new syntax. everything is already claimed. It's just amazing that you got to make:` work for typing without breaking everything.

Documenting the above reflect workaround and keeping things as-is is also fine by me.

I find the prefix (:) and (GHC.Types.:) the least surprising. The escape with \ works, but is a new thing to learn for Haskellers. I find GHC.Types.: x xs (without the parentheses) less consistent with Haskell.

One thing to consider is to aim for a more generic change where we allow any infix symbol to be placed in prefix form by surrounding it with parenthesis. Then specs can allow (++), (<>), etc.

Another change to consider is using :: for type signatures in specs. This would make liquid-fixpoint favor the Haskell syntax as well, but it is starting to look to me like using the same parser in liquid-fixpoint and Liquid Haskell isn't necessary. The parser could be generalized to get a parameter that indicates how to parse sort annotations, so :: is only allowed in Liquid Haskell specs.

The treatment of (:) had been already discussed in #1374 and also #1373.