curry-base 1.1.0 → 1.1.1

raw patch · 11 files changed

+127/−93 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• curry-base.cabal +1/−1
• src/Curry/AbstractCurry/Type.hs +1/−0
• src/Curry/Files/Unlit.hs +68/−15
• src/Curry/Syntax/Extension.hs +0/−1
• src/Curry/Syntax/InterfaceEquivalence.hs +10/−10
• src/Curry/Syntax/Parser.hs +12/−23
• src/Curry/Syntax/Pretty.hs +6/−12
• src/Curry/Syntax/ShowModule.hs +3/−9
• src/Curry/Syntax/Type.hs +14/−14
• src/Curry/Syntax/Utils.hs +6/−7

@@ -1,8 +1,13 @@ Change log for curry-base ========================= +Version (1.2.0) (WIP)+=====================++  * Added support for latex-style in literate curry+ Version (1.1.0)-===================================+===============    * Added SpanInfos to AST 

@@ -1,5 +1,5 @@ Name:          curry-base-Version:       1.1.0+Version:       1.1.1 Cabal-Version: >= 1.10 Synopsis:      Functions for manipulating Curry programs Description:   This package serves as a foundation for Curry compilers.

@@ -147,6 +147,7 @@ -- the name written in the source program). type CTVarIName = (Int, String) +-- TODO: Remove context and existential quantified type variables. -- |A constructor declaration consists of a list of existentially -- quantified type variables, a context, the name of the constructor -- and a list of the argument types of the constructor.

@@ -1,3 +1,4 @@+{-# LANGUAGE ViewPatterns #-} {- |     Module      :  $Header$     Description :  Handling of literate Curry files@@ -16,12 +17,16 @@     literate programs, Curry requires at least one program line to be     present in the file. In addition, every block of program code must be     preceded by a blank line and followed by a blank line.++    It is also possible to use "\begin{code}" and "\end{code}"+    to mark code segments. Both styles can be used in mixed fashion. -}  module Curry.Files.Unlit (isLiterate, unlit) where -import Control.Monad         (when, zipWithM)+import Control.Monad         (when, unless, zipWithM) import Data.Char             (isSpace)+import Data.List             (stripPrefix)  import Curry.Base.Monad      (CYM, failMessageAt) import Curry.Base.Position   (Position (..), first)@@ -33,38 +38,86 @@  -- |Data type representing different kind of lines in a literate source data Line-  = Program !Int String -- ^ program line with a line number and content-  | Blank               -- ^ blank line-  | Comment             -- ^ comment line+  = ProgramStart !Int        -- ^ \begin{code}+  | ProgramEnd   !Int        -- ^ \end{code}+  | Program      !Int String -- ^ program line with a line number and content+  | Comment      !Int String -- ^ comment line+  | Blank        !Int        -- ^ blank line  -- |Process a curry program into error messages (if any) and the -- corresponding non-literate program. unlit :: FilePath -> String -> CYM String unlit fn cy   | isLiterate fn = do-      ls <- progLines fn $ zipWith classify [1 .. ] $ lines cy+      let cyl = lines cy+      ls <- progLines fn =<<+            normalize fn (length cyl) False (zipWith classify [1 .. ] cyl)       when (all null ls) $ failMessageAt (first fn) "No code in literate script"       return (unlines ls)   | otherwise     = return cy  -- |Classification of a single program line classify :: Int -> String -> Line-classify l ('>' : cs) = Program l cs-classify _ cs | all isSpace cs = Blank-              | otherwise      = Comment+classify l s@('>' : _) = Program l s+classify l s@(stripPrefix "\\begin{code}" -> Just cs)+  | all isSpace cs = ProgramStart l+  | otherwise      = Comment l s+classify l s@(stripPrefix "\\end{code}" -> Just cs)+  | all isSpace cs = ProgramEnd l+  | otherwise      = Comment l s+classify l s+  | all isSpace s = Blank l+  | otherwise     = Comment l s --- |Check that each program line is not adjacent to a comment line and there--- is at least one program line.+-- |Check that ProgramStart and ProgramEnd match and desugar them.+normalize :: FilePath -> Int -> Bool -> [Line] -> CYM [Line]+normalize _  _ False [] = return []+normalize fn n True  [] = reportMissingEnd fn n+normalize fn n b (ProgramStart l : rest) = do+  when b $ reportSpurious fn l "\\begin{code}"+  norm <- normalize fn n True rest+  return (Blank l : norm)+normalize fn n b (ProgramEnd   l : rest) = do+  unless b $ reportSpurious fn l "\\end{code}"+  norm <- normalize fn n False rest+  return (Blank l : norm)+normalize fn n b (Comment l s : rest) = do+  let cons = if b then Program l s else Comment l s+  norm <- normalize fn n b rest+  return (cons : norm)+normalize fn n b (Program l s : rest) = do+  let cons = if b then Program l s else Program l (drop 1 s)+  norm <- normalize fn n b rest+  return (cons : norm)+normalize fn n b (Blank   l   : rest) = do+  let cons = if b then Program l "" else Blank l+  norm <- normalize fn n b rest+  return (cons : norm)++-- |Check that each program line is not adjacent to a comment line. progLines :: FilePath -> [Line] -> CYM [String]-progLines fn cs = zipWithM checkAdjacency (Blank : cs) cs where-  checkAdjacency (Program p _) Comment       = report fn p "followed"-  checkAdjacency Comment       (Program p _) = report fn p "preceded"+progLines fn cs = zipWithM checkAdjacency (Blank 0 : cs) cs where+  checkAdjacency (Program p _) (Comment _ _) = reportBlank fn p "followed"+  checkAdjacency (Comment _ _) (Program p _) = reportBlank fn p "preceded"   checkAdjacency _             (Program _ s) = return s   checkAdjacency _             _             = return ""  -- |Compute an appropiate error message-report :: String -> Int -> String -> CYM a-report f l cause = failMessageAt (Position f l 1) msg+reportBlank :: FilePath -> Int -> String -> CYM a+reportBlank f l cause = failMessageAt (Position f l 1) msg   where msg = concat [ "When reading literate source: "                      , "Program line is " ++ cause ++ " by comment line."+                     ]++reportMissingEnd :: FilePath -> Int -> CYM a+reportMissingEnd f l = failMessageAt (Position f (l+1) 1) msg+  where msg = concat [ "When reading literate source: "+                     , "Missing '\\end{code}' at the end of file."+                     ]+++reportSpurious :: FilePath -> Int -> String -> CYM a+reportSpurious f l cause = failMessageAt (Position f l 1) msg+  where msg = concat [ "When reading literate source: "+                     , "Spurious '" ++ cause ++ "'."                      ]

@@ -41,7 +41,6 @@ data KnownExtension   = AnonFreeVars              -- ^ anonymous free variables   | CPP                       -- ^ C preprocessor-  | ExistentialQuantification -- ^ existential quantification   | FunctionalPatterns        -- ^ functional patterns   | NegativeLiterals          -- ^ negative literals   | NoImplicitPrelude         -- ^ no implicit import of the prelude

@@ -99,12 +99,12 @@   _ =~= _ = False  instance Equiv ConstrDecl where-  ConstrDecl _ evs1 cx1 c1 tys1 =~= ConstrDecl _ evs2 cx2 c2 tys2-    = c1 == c2 && evs1 == evs2 && cx1 == cx2 && tys1 == tys2-  ConOpDecl _ evs1 cx1 ty11 op1 ty12 =~= ConOpDecl _ evs2 cx2 ty21 op2 ty22-    = op1 == op2 && evs1 == evs2 && cx1 == cx2 && ty11 == ty21 && ty12 == ty22-  RecordDecl _ evs1 cx1 c1 fs1 =~= RecordDecl _ evs2 cx2 c2 fs2-    = c1 == c2 && evs1 == evs2 && cx1 == cx2 && fs1 `eqvList` fs2+  ConstrDecl _ c1 tys1 =~= ConstrDecl _ c2 tys2+    = c1 == c2 && tys1 == tys2+  ConOpDecl _ ty11 op1 ty12 =~= ConOpDecl _ ty21 op2 ty22+    = op1 == op2 && ty11 == ty21 && ty12 == ty22+  RecordDecl _ c1 fs1 =~= RecordDecl _ c2 fs2+    = c1 == c2 && fs1 `eqvList` fs2   _ =~= _ = False  instance Equiv FieldDecl where@@ -159,10 +159,10 @@   fix _ d = d  instance FixInterface ConstrDecl where-  fix tcs (ConstrDecl p evs cx      c tys) = ConstrDecl p evs cx c (fix tcs tys)-  fix tcs (ConOpDecl  p evs cx ty1 op ty2) = ConOpDecl  p evs cx   (fix tcs ty1)-                                                              op   (fix tcs ty2)-  fix tcs (RecordDecl p evs cx c fs)       = RecordDecl p evs cx c (fix tcs fs)+  fix tcs (ConstrDecl p      c tys) = ConstrDecl p c (fix tcs tys)+  fix tcs (ConOpDecl  p ty1 op ty2) = ConOpDecl  p   (fix tcs ty1)+                                                op   (fix tcs ty2)+  fix tcs (RecordDecl p c fs)       = RecordDecl p c (fix tcs fs)  instance FixInterface FieldDecl where   fix tcs (FieldDecl p ls ty) = FieldDecl p ls (fix tcs ty)

@@ -119,7 +119,7 @@           updateEndPos $ setSrcInfoPoints (sp1 : (ss ++ [sp2])) $           spc (fromSrcSpan (getSrcSpan qtc)) qtc         exportTypeWith' c spi qtc = ExportTypeWith spi qtc c-        exportModule' sp = updateEndPos . ExportModule (SpanInfo sp [])+        exportModule' sp = updateEndPos . ExportModule (SpanInfo sp [sp])  moduleDecls :: Parser a Token ([ImportDecl], [Decl ()]) moduleDecls = impDecl <$> importDecl@@ -331,8 +331,7 @@ typeDeclLhs f kw = f <$> tokenSpan kw <*> tycon <*> many anonOrTyvar  constrDecl :: Parser a Token ConstrDecl-constrDecl = spanPosition <**> (existVars-                          <**> optContext (\cx sp f -> f sp cx) constr)+constrDecl = spanPosition <**> constr   where   constr =  conId     <**> identDecl         <|> tokenSpan LeftParen <**> parenDecl@@ -348,16 +347,16 @@   conType f tys c = f $ foldl mkApply (mkConstructorType $ qualify c) tys   mkApply t1 t2 = updateEndPos $ ApplyType (fromSrcSpan (getSrcSpan t1)) t1 t2   mkConstructorType qid = ConstructorType (fromSrcSpan (getSrcSpan qid)) qid-  conDecl tys c ss1 cx (ss2, tvs) sp = updateEndPos $-    ConstrDecl (SpanInfo sp (ss2 ++ ss1)) tvs cx c tys-  conOpDecl op ty2 ty1 ss1 cx (ss2, tvs) sp = updateEndPos $-    ConOpDecl (SpanInfo sp (ss2 ++ ss1)) tvs cx ty1 op ty2-  conOpDeclParen op ty2 sp1 ty1 sp2 ss1 cx (ss2, tvs) sp5 = updateEndPos $-    ConOpDecl (SpanInfo sp5 (ss2 ++ ss1 ++ [sp2, sp1])) tvs cx ty1 op ty2-  conOpDeclPrefix op sp1 ty1 ty2 sp2 ss1 cx (ss2, tvs) sp3 = updateEndPos $-    ConOpDecl (SpanInfo sp3 (ss2 ++ ss1 ++ [sp2,sp1])) tvs cx ty1 op ty2-  recDecl ((fs, ss), sp1, sp2) c ss1 cx (ss2, tvs) sp3 = updateEndPos $-    RecordDecl (SpanInfo sp3 (ss2 ++ ss1 ++ (sp1: (ss ++ [sp2])))) tvs cx c fs+  conDecl tys c sp = updateEndPos $+    ConstrDecl (SpanInfo sp []) c tys+  conOpDecl op ty2 ty1 sp = updateEndPos $+    ConOpDecl (SpanInfo sp []) ty1 op ty2+  conOpDeclParen op ty2 sp1 ty1 sp2 sp5 = updateEndPos $+    ConOpDecl (SpanInfo sp5 [sp2, sp1]) ty1 op ty2+  conOpDeclPrefix op sp1 ty1 ty2 sp2 sp3 = updateEndPos $+    ConOpDecl (SpanInfo sp3 [sp2, sp1]) ty1 op ty2+  recDecl ((fs, ss), sp1, sp2) c sp3 = updateEndPos $+    RecordDecl (SpanInfo sp3 (sp1 : ss ++ [sp2])) c fs  fieldDecl :: Parser a Token FieldDecl fieldDecl = mkFieldDecl <$> spanPosition <*> labels@@ -386,13 +385,6 @@                       <*> (qtycls `sepBySp` comma)                       <*> tokenSpan RightParen) --- Parsing of existential variables-existVars :: Parser a Token ([Span], [Ident])-existVars = mk <$> tokenSpan Id_forall <*> many1 tyvar <*>-                   tokenSpan SymDot-              `opt` ([],[])-  where mk sp1 a sp2 = ([sp1,sp2], a)- functionDecl :: Parser a Token (Decl ()) functionDecl = spanPosition <**> decl   where decl = fun `sepBy1Sp` comma <**> funListDecl <|?> funRule@@ -1315,9 +1307,6 @@                <$> tokenSpan LeftParen                <*> p                <*> tokenSpan RightParen--backquotes :: Parser a Token b -> Parser a Token b-backquotes p = between backquote p expectBackquote  backquotesSp :: Parser a Token b -> Parser a Token (b, Span, Span) backquotesSp p = (\sp1 b sp2 -> (b, sp1, sp2))

@@ -155,18 +155,12 @@ ppTypeDeclLhs kw tc tvs = text kw <+> ppIdent tc <+> hsep (map ppIdent tvs)  ppConstr :: ConstrDecl -> Doc-ppConstr (ConstrDecl     _ tvs cx c tys) =-  sep [ ppQuantifiedVars tvs <+> ppContext cx-      , ppIdent c <+> fsep (map (ppTypeExpr 2) tys)-      ]-ppConstr (ConOpDecl _ tvs cx ty1 op ty2) =-  sep [ ppQuantifiedVars tvs <+> ppContext cx-      , ppTypeExpr 1 ty1, ppInfixOp op <+> ppTypeExpr 1 ty2-      ]-ppConstr (RecordDecl _ tvs cx c fs) =-  sep [ ppQuantifiedVars tvs <+> ppContext cx-      , ppIdent c <+> record (list (map ppFieldDecl fs))-      ]+ppConstr (ConstrDecl     _ c tys) =+  sep [ ppIdent c <+> fsep (map (ppTypeExpr 2) tys) ]+ppConstr (ConOpDecl _ ty1 op ty2) =+  sep [ ppTypeExpr 1 ty1, ppInfixOp op <+> ppTypeExpr 1 ty2 ]+ppConstr (RecordDecl _ c fs)      =+  sep [ ppIdent c <+> record (list (map ppFieldDecl fs)) ]  ppFieldDecl :: FieldDecl -> Doc ppFieldDecl (FieldDecl _ ls ty) = list (map ppIdent ls)

@@ -235,28 +235,22 @@ showsInstanceType = showsTypeExpr  showsConsDecl :: ConstrDecl -> ShowS-showsConsDecl (ConstrDecl spi idents context ident types)+showsConsDecl (ConstrDecl spi ident types)   = showsString "(ConstrDecl "   . showsSpanInfo spi . space-  . showsList showsIdent idents . space-  . showsContext context . space   . showsIdent ident . space   . showsList showsTypeExpr types   . showsString ")"-showsConsDecl (ConOpDecl spi idents context ty1 ident ty2)+showsConsDecl (ConOpDecl spi ty1 ident ty2)   = showsString "(ConOpDecl "   . showsSpanInfo spi . space-  . showsList showsIdent idents . space-  . showsContext context . space   . showsTypeExpr ty1 . space   . showsIdent ident . space   . showsTypeExpr ty2   . showsString ")"-showsConsDecl (RecordDecl spi idents context ident fs)+showsConsDecl (RecordDecl spi ident fs)   = showsString "(RecordDecl "   . showsSpanInfo spi . space-  . showsList showsIdent idents . space-  . showsContext context . space   . showsIdent ident . space   . showsList showsFieldDecl fs   . showsString ")"

@@ -182,9 +182,9 @@  -- |Constructor declaration for algebraic data types data ConstrDecl-  = ConstrDecl SpanInfo [Ident] Context Ident [TypeExpr]-  | ConOpDecl  SpanInfo [Ident] Context TypeExpr Ident TypeExpr-  | RecordDecl SpanInfo [Ident] Context Ident [FieldDecl]+  = ConstrDecl SpanInfo Ident [TypeExpr]+  | ConOpDecl  SpanInfo TypeExpr Ident TypeExpr+  | RecordDecl SpanInfo Ident [FieldDecl]     deriving (Eq, Read, Show)  -- |Constructor declaration for renaming types (newtypes)@@ -644,23 +644,23 @@   updateEndPos i@(ImportTypeAll _ _) = i  instance HasSpanInfo ConstrDecl where-  getSpanInfo (ConstrDecl sp _ _ _ _)   = sp-  getSpanInfo (ConOpDecl  sp _ _ _ _ _) = sp-  getSpanInfo (RecordDecl sp _ _ _ _)   = sp+  getSpanInfo (ConstrDecl sp _ _)   = sp+  getSpanInfo (ConOpDecl  sp _ _ _) = sp+  getSpanInfo (RecordDecl sp _ _)   = sp -  setSpanInfo sp (ConstrDecl _ tvar ctx idt ty) = ConstrDecl sp tvar ctx idt ty-  setSpanInfo sp (ConOpDecl  _ tvar ctx ty1 idt ty2) = ConOpDecl sp tvar ctx ty1 idt ty2-  setSpanInfo sp (RecordDecl _ tvar ctx idt fd) = RecordDecl sp tvar ctx idt fd+  setSpanInfo sp (ConstrDecl _ idt ty) = ConstrDecl sp idt ty+  setSpanInfo sp (ConOpDecl  _ ty1 idt ty2) = ConOpDecl sp ty1 idt ty2+  setSpanInfo sp (RecordDecl _ idt fd) = RecordDecl sp idt fd -  updateEndPos c@(ConstrDecl _ _ _ _ (t:ts)) =+  updateEndPos c@(ConstrDecl _ _ (t:ts)) =     setEndPosition (getSrcSpanEnd (last (t:ts))) c-  updateEndPos c@(ConstrDecl _ _ _ idt _) =+  updateEndPos c@(ConstrDecl _ idt _) =     setEndPosition (incr (getPosition idt) (identLength idt - 1)) c-  updateEndPos c@(ConOpDecl _ _ _ _ _ ty) =+  updateEndPos c@(ConOpDecl _ _ _ ty) =     setEndPosition (getSrcSpanEnd ty) c-  updateEndPos c@(RecordDecl (SpanInfo _ ss) _ _ _ _) =+  updateEndPos c@(RecordDecl (SpanInfo _ ss) _ _) =     setEndPosition (end (last ss)) c-  updateEndPos c@(RecordDecl _ _ _ _ _) = c+  updateEndPos c@(RecordDecl _ _ _) = c  instance HasSpanInfo NewConstrDecl where   getSpanInfo (NewConstrDecl sp _ _)   = sp

@@ -39,7 +39,6 @@ import Control.Monad.State  import Curry.Base.Ident-import Curry.Base.Position import Curry.Base.SpanInfo import Curry.Files.Filenames (takeBaseName) import Curry.Syntax.Extension@@ -212,9 +211,9 @@  -- | Get the identifier of a constructor declaration constrId :: ConstrDecl -> Ident-constrId (ConstrDecl  _ _ _ c  _) = c-constrId (ConOpDecl _ _ _ _ op _) = op-constrId (RecordDecl  _ _ _ c  _) = c+constrId (ConstrDecl  _ c  _) = c+constrId (ConOpDecl _ _ op _) = op+constrId (RecordDecl  _ c  _) = c  -- | Get the identifier of a newtype constructor declaration nconstrId :: NewConstrDecl -> Ident@@ -228,9 +227,9 @@  -- | Get record label identifiers of a constructor declaration recordLabels :: ConstrDecl -> [Ident]-recordLabels (ConstrDecl   _ _ _ _ _) = []-recordLabels (ConOpDecl _ _ _ _ _  _) = []-recordLabels (RecordDecl  _ _ _ _ fs) = [l | FieldDecl _ ls _ <- fs, l <- ls]+recordLabels (ConstrDecl   _ _ _) = []+recordLabels (ConOpDecl _ _ _  _) = []+recordLabels (RecordDecl  _ _ fs) = [l | FieldDecl _ ls _ <- fs, l <- ls]  -- | Get record label identifier of a newtype constructor declaration nrecordLabels :: NewConstrDecl -> [Ident]