Use Happy grammar for imports extraction instead of hand made shallow crapy grammar

src/GF/Canon/GetGFC.hs

@@ -19,7 +19,6 @@ import GF.Canon.ParGFC
 import GF.Canon.GFC
 import GF.Canon.MkGFC
 import GF.Infra.Modules
-import GF.Compile.GetGrammar (err2err) ---
 import GF.Infra.UseIO
 
 import System.IO

src/GF/Compile/GetGrammar.hs

@@ -14,8 +14,7 @@
 
 module GF.Compile.GetGrammar (
   getSourceModule, getSourceGrammar,
-  getOldGrammar, getCFGrammar, getEBNFGrammar,
+  getOldGrammar, getCFGrammar, getEBNFGrammar
-		   err2err
 		  ) where
 
 import GF.Data.Operations
@@ -63,14 +62,14 @@ getSourceModule opts file0 = do
         Just "utf8" -> decodeUTF8 string0
         _ -> string0
   let tokens = myLexer (BS.pack string)
-  mo1  <- ioeErr $ err2err $ pModDef tokens
+  mo1  <- ioeErr $ pModDef tokens
   ioeErr $ transModDef mo1
 
 getSourceGrammar :: Options -> FilePath -> IOE SourceGrammar
 getSourceGrammar opts file = do
   string    <- readFileIOE file
   let tokens = myLexer (BS.pack string)
-  gr1  <- ioeErr $ err2err $ pGrammar tokens
+  gr1  <- ioeErr $ pGrammar tokens
   ioeErr $ transGrammar gr1
 
 
@@ -102,18 +101,12 @@ parseOldGrammar :: FilePath -> IOE ([FilePath],[A.TopDef])
 parseOldGrammar file = do
   putStrLnE $ "reading old file" +++ file
   s <- ioeIO $ readFileIf file
-  A.OldGr incl topdefs <- ioeErr $ err2err $ pOldGrammar $ oldLexer $ fixNewlines s
+  A.OldGr incl topdefs <- ioeErr $ pOldGrammar $ oldLexer $ fixNewlines s
   includes <- ioeErr $ transInclude incl
   return (includes, topdefs)
 
 ----
 
-err2err :: E.Err a -> Err a
-err2err (E.Ok v) = Ok v
-err2err (E.Bad s) = Bad s
-
-ioeEErr = ioeErr . err2err
-
 -- | To resolve the new reserved words: 
 -- change them by turning the final letter to upper case.
 --- There is a risk of clash. 

src/GF/Compile/PGrammar.hs

@@ -33,7 +33,7 @@ import qualified Data.ByteString.Char8 as BS
 
 pTerm :: String -> Err Term
 pTerm s = do
-  e <- err2err $ pExp $ myLexer (BS.pack s)
+  e <- pExp $ myLexer (BS.pack s)
   transExp e
 
 pTrm :: String -> Term

src/GF/Devel/GetGrammar.hs

@@ -50,10 +50,5 @@ getSourceModule opts file0 = do
     _ -> return file0
   string    <- readFileIOE file
   let tokens = myLexer string
-  mo1  <- ioeErr $ err2err $ pModDef tokens
+  mo1  <- ioeErr $ pModDef tokens
   ioeErr $ transModDef mo1
-
-err2err :: E.Err a -> Err a
-err2err (E.Ok v) = Ok v
-err2err (E.Bad s) = Bad s
-

src/GF/Devel/ReadFiles.hs

@@ -36,6 +36,8 @@ import Control.Monad
 import Data.List
 import System.Directory
 import qualified Data.ByteString.Char8 as BS
+import GF.Source.AbsGF hiding (FileName)
+import GF.Source.ParGF
 
 
 type ModName = String
@@ -204,7 +206,7 @@ getImports ps = get [] where
   get ds file0 = do
     let name = justModuleName file0 ---- fileBody file0
     (p,s) <- tryRead name
-    let ((typ,mname),imps) = importsOfFile (BS.unpack s)
+    ((typ,mname),imps) <- ioeErr (importsOfFile s)
     let namebody = justFileName name
     ioeErr $ testErr  (mname == namebody) $ 
              "module name" +++ mname +++ "differs from file name" +++ namebody
@@ -243,62 +245,47 @@ data ModTyp =
 
 type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)])
 
-importsOfFile :: String -> ModuleHeader
+importsOfFile :: BS.ByteString -> Err ModuleHeader
-importsOfFile = 
+importsOfFile bs = do
-  getModuleHeader .          -- analyse into mod header
+  (MModule compl typ body) <- (pModHeader . myLexer) bs
-  filter (not . spec) .      -- ignore keywords and special symbols
+  return $
-  unqual .                   -- take away qualifiers
+      case (compl,modType typ (modBody body [])) of
-  unrestr .                  -- take away union restrictions
+            (CMIncompl, ((MTyResource,m),xs)) -> ((MTyIncResource,m),xs)
-  takeWhile (not . term) .   -- read until curly or semic
+            (CMIncompl, ((t,m),xs)) -> ((MTyIncomplete,m),xs)
-  lexs .                     -- analyse into lexical tokens
+            (CMCompl,   v) -> v
-  unComm                     -- ignore comments before the headed line
+  where
- where
+    modType (MTAbstract  m)      xs = ((MTyOther,modName m),xs)
-    term = flip elem ["{",";"]
+    modType (MTResource m)       xs = ((MTyResource,modName m),xs)
-    spec = flip elem ["of", "open","in",":", "->","=", "-","(", ")",",","**","union"]
+    modType (MTInterface m)      xs = ((MTyIncResource,modName m),xs)
-    unqual ws = case ws of
+    modType (MTConcrete m m2)    xs = ((MTyOther,modName m),(modName m2,MUOther):xs)
-      "(":q:ws' -> unqual ws'
+    modType (MTInstance m m2)    xs = ((MTyResource,modName m),(modName m2,MUInstance):xs)
-      w:ws' -> w:unqual ws'
+    modType (MTTransfer m o1 o2) xs = ((MTyOther,modName m),open o1 (open o2 xs))
-      _ -> ws
-    unrestr ws = case ws of
-      "[":ws' -> unrestr $ tail $ dropWhile (/="]") ws'
-      w:ws' -> w:unrestr ws'
-      _ -> ws
 
-getModuleHeader :: [String] -> ModuleHeader -- with, reuse
+    modBody (MBody e o _)            xs = extend e (opens o xs)
-getModuleHeader ws = case ws of
+    modBody (MNoBody is)             xs = foldr include xs is
-  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
+    modBody (MWith i os)             xs = include i (foldr open xs os)
-    case ty of
+    modBody (MWithBody i os o _)     xs = include i (foldr open (opens o xs) os)
-      MTyResource -> ((MTyIncResource,name),us)
+    modBody (MWithE is i os)         xs = foldr include (include i (foldr open xs os)) is
-      _ -> ((MTyIncomplete,name),us)
+    modBody (MWithEBody is i os o _) xs = foldr include (include i (foldr open (opens o xs) os)) is
-  "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
+    modBody (MReuse m)               xs = (modName m,MUReuse):xs
-    ((MTyIncResource,name),us)
+    modBody (MUnion is)              xs = foldr include xs is
 
-  "resource":name:ws2 -> case ws2 of
+    include (IAll   m)   xs = (modName m,MUOther):xs
-    "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
+    include (ISome  m _) xs = (modName m,MUOther):xs
-    m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    include (IMinus m _) xs = (modName m,MUOther):xs
-    ms -> ((MTyResource,name),[(n,MUOther) | n <- ms])
 
-  "instance":name:m:ws2 -> case ws2 of
+    open (OName n)     xs = (modName n,MUComplete):xs
-    "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)])
+    open (OQualQO _ n) xs = (modName n,MUComplete):xs
-    n:"with":ms -> 
+    open (OQual _ _ n) xs = (modName n,MUComplete):xs
-      ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
-    ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
 
-  "concrete":name:a:ws2 -> case span (/= "with") ws2 of
+    extend NoExt    xs = xs
+    extend (Ext is) xs = foldr include xs is
 
-    (es,_:ms) -> ((MTyOther,name),
+    opens NoOpens     xs = xs
-                  [(m,MUOther)    | m <- es] ++
+    opens (OpenIn os) xs = foldr open xs os
-                  [(n,MUComplete) | n <- ms])
+
-    --- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    modName (PIdent (_,s)) = s
-    (ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
 
-  _:name:ws2 -> case ws2 of
-    "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
-    ---- m:n:"with":ms -> 
-    ----  ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
-    m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
-  _ -> error "the file is empty"
 
 unComm s = case s of
       '-':'-':cs -> unComm $ dropWhile (/='\n') cs
@@ -311,16 +298,12 @@ dpComm s = case s of
       c:cs -> dpComm cs
       _ -> s
 
-lexs s = x:xs where 
-      (x,y) = head $ lex s
-      xs = if null y then [] else lexs y
-
 -- | options can be passed to the compiler by comments in @--#@, in the main file
 getOptionsFromFile ::  FilePath -> IO Options
 getOptionsFromFile file = do
   s <- readFileIfStrict file
-  let ls = filter (isPrefixOf "--#") $ lines (BS.unpack s)
+  let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
-  return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
+  return $ fst $ getOptions "-" $ map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
 
 -- | check if old GF file
 isOldFile :: FilePath -> IO Bool

src/GF/Source/GF.cf

@@ -32,6 +32,20 @@ separator Transfer "" ;--%
 TransferIn.  Transfer ::= "(" "transfer" "in" Open ")" ;  --%
 TransferOut. Transfer ::= "(" "transfer" "out" Open ")" ;  --%
 
+-- the module header
+
+MModule2. ModHeader ::= ComplMod ModType "=" ModHeaderBody ;
+
+MBody2.      ModHeaderBody ::= Extend Opens ;
+MNoBody2.    ModHeaderBody ::= [Included] ;
+MWith2.      ModHeaderBody ::=                 Included "with" [Open] ;
+MWithBody2.  ModHeaderBody ::=                 Included "with" [Open] "**" Opens ; 
+MWithE2.     ModHeaderBody ::= [Included] "**" Included "with" [Open] ;
+MWithEBody2. ModHeaderBody ::= [Included] "**" Included "with" [Open] "**" Opens ; 
+
+MReuse2. ModHeaderBody ::= "reuse" PIdent ; --%
+MUnion2. ModHeaderBody ::= "union" [Included] ;--%
+
 -- the individual modules
 
 MModule. ModDef ::= ComplMod ModType "=" ModBody ;

src/GF/Source/ParGF.y

@@ -1,7 +1,7 @@
 -- This Happy file was machine-generated by the BNF converter
 {
 {-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
- module GF.Source.ParGF (pGrammar, pModDef, pOldGrammar, pExp, myLexer) where --H
+ module GF.Source.ParGF (pGrammar, pModDef, pOldGrammar, pExp, pModHeader, myLexer) where --H
 import GF.Source.AbsGF       --H
 import GF.Source.LexGF       --H
 import GF.Infra.Ident        --H
@@ -12,6 +12,7 @@ import GF.Data.ErrM          --H
 %name pModDef ModDef
 %name pOldGrammar OldGrammar
 %name pExp Exp
+%partial pModHeader ModHeader
 
 -- no lexer declaration
 %monad { Err } { thenM } { returnM }
@@ -38,6 +39,7 @@ import GF.Data.ErrM          --H
  '<' { PT _ (TS "<") }
  '>' { PT _ (TS ">") }
  '@' { PT _ (TS "@") }
+ '#' { PT _ (TS "#") }
  '!' { PT _ (TS "!") }
  '*' { PT _ (TS "*") }
  '+' { PT _ (TS "+") }
@@ -94,21 +96,21 @@ import GF.Data.ErrM          --H
  'where' { PT _ (TS "where") }
  'with' { PT _ (TS "with") }
 
-L_ident  { PT _ (TV $$) }
 L_integ  { PT _ (TI $$) }
 L_quoted { PT _ (TL $$) }
 L_doubl  { PT _ (TD $$) }
 L_LString { PT _ (T_LString $$) }
+L_PIdent { PT _ (T_PIdent _) }
 L_err    { _ }
 
 
 %%
 
-Ident   :: { Ident }   : L_ident  { identC $1 } --H
 Integer :: { Integer } : L_integ  { (read $1) :: Integer }
 String  :: { String }  : L_quoted { $1 }
 Double  :: { Double }  : L_doubl  { (read $1) :: Double }
 LString    :: { LString} : L_LString { LString ($1)}
+PIdent    :: { PIdent} : L_PIdent { PIdent (mkPosToken $1)}
 
 Grammar :: { Grammar }
 Grammar : ListModDef { Gr (reverse $1) } 
@@ -121,12 +123,12 @@ ListModDef : {- empty -} { [] }
 
 ModDef :: { ModDef }
 ModDef : ModDef ';' { $1 } 
-  | 'grammar' Ident '=' '{' 'abstract' '=' Ident ';' ListConcSpec '}' { MMain $2 $7 $9 }
+  | 'grammar' PIdent '=' '{' 'abstract' '=' PIdent ';' ListConcSpec '}' { MMain $2 $7 $9 }
   | ComplMod ModType '=' ModBody { MModule $1 $2 $4 }
 
 
 ConcSpec :: { ConcSpec }
-ConcSpec : Ident '=' ConcExp { ConcSpec $1 $3 } 
+ConcSpec : PIdent '=' ConcExp { ConcSpec $1 $3 } 
 
 
 ListConcSpec :: { [ConcSpec] }
@@ -136,7 +138,7 @@ ListConcSpec : {- empty -} { [] }
 
 
 ConcExp :: { ConcExp }
-ConcExp : Ident ListTransfer { ConcExp $1 (reverse $2) } 
+ConcExp : PIdent ListTransfer { ConcExp $1 (reverse $2) } 
 
 
 ListTransfer :: { [Transfer] }
@@ -149,13 +151,28 @@ Transfer : '(' 'transfer' 'in' Open ')' { TransferIn $4 }
   | '(' 'transfer' 'out' Open ')' { TransferOut $4 }
 
 
+ModHeader :: { ModDef }
+ModHeader : ComplMod ModType '=' ModHeaderBody { MModule $1 $2 $4 } 
+
+
+ModHeaderBody :: { ModBody }
+ModHeaderBody : Extend Opens { MBody $1 $2 [] } 
+  | ListIncluded { MNoBody $1 }
+  | Included 'with' ListOpen { MWith $1 $3 }
+  | Included 'with' ListOpen '**' Opens { MWithBody $1 $3 $5 [] }
+  | ListIncluded '**' Included 'with' ListOpen { MWithE $1 $3 $5 }
+  | ListIncluded '**' Included 'with' ListOpen '**' Opens { MWithEBody $1 $3 $5 $7 [] }
+  | 'reuse' PIdent { MReuse $2 }
+  | 'union' ListIncluded { MUnion $2 }
+
+
 ModType :: { ModType }
-ModType : 'abstract' Ident { MTAbstract $2 } 
+ModType : 'abstract' PIdent { MTAbstract $2 } 
-  | 'resource' Ident { MTResource $2 }
+  | 'resource' PIdent { MTResource $2 }
-  | 'interface' Ident { MTInterface $2 }
+  | 'interface' PIdent { MTInterface $2 }
-  | 'concrete' Ident 'of' Ident { MTConcrete $2 $4 }
+  | 'concrete' PIdent 'of' PIdent { MTConcrete $2 $4 }
-  | 'instance' Ident 'of' Ident { MTInstance $2 $4 }
+  | 'instance' PIdent 'of' PIdent { MTInstance $2 $4 }
-  | 'transfer' Ident ':' Open '->' Open { MTTransfer $2 $4 $6 }
+  | 'transfer' PIdent ':' Open '->' Open { MTTransfer $2 $4 $6 }
 
 
 ModBody :: { ModBody }
@@ -165,7 +182,7 @@ ModBody : Extend Opens '{' ListTopDef '}' { MBody $1 $2 (reverse $4) }
   | Included 'with' ListOpen '**' Opens '{' ListTopDef '}' { MWithBody $1 $3 $5 (reverse $7) }
   | ListIncluded '**' Included 'with' ListOpen { MWithE $1 $3 $5 }
   | ListIncluded '**' Included 'with' ListOpen '**' Opens '{' ListTopDef '}' { MWithEBody $1 $3 $5 $7 (reverse $9) }
-  | 'reuse' Ident { MReuse $2 }
+  | 'reuse' PIdent { MReuse $2 }
   | 'union' ListIncluded { MUnion $2 }
 
 
@@ -191,9 +208,9 @@ Opens : {- empty -} { NoOpens }
 
 
 Open :: { Open }
-Open : Ident { OName $1 } 
+Open : PIdent { OName $1 } 
-  | '(' QualOpen Ident ')' { OQualQO $2 $3 }
+  | '(' QualOpen PIdent ')' { OQualQO $2 $3 }
-  | '(' QualOpen Ident '=' Ident ')' { OQual $2 $3 $5 }
+  | '(' QualOpen PIdent '=' PIdent ')' { OQual $2 $3 $5 }
 
 
 ComplMod :: { ComplMod }
@@ -214,9 +231,9 @@ ListIncluded : {- empty -} { [] }
 
 
 Included :: { Included }
-Included : Ident { IAll $1 } 
+Included : PIdent { IAll $1 } 
-  | Ident '[' ListIdent ']' { ISome $1 $3 }
+  | PIdent '[' ListPIdent ']' { ISome $1 $3 }
-  | Ident '-' '[' ListIdent ']' { IMinus $1 $4 }
+  | PIdent '-' '[' ListPIdent ']' { IMinus $1 $4 }
 
 
 Def :: { Def }
@@ -244,28 +261,28 @@ TopDef : 'cat' ListCatDef { DefCat $2 }
   | 'printname' ListPrintDef { DefPrintOld $2 }
   | 'lintype' ListDef { DefLintype $2 }
   | 'pattern' ListDef { DefPattern $2 }
-  | 'package' Ident '=' '{' ListTopDef '}' ';' { DefPackage $2 (reverse $5) }
+  | 'package' PIdent '=' '{' ListTopDef '}' ';' { DefPackage $2 (reverse $5) }
   | 'var' ListDef { DefVars $2 }
-  | 'tokenizer' Ident ';' { DefTokenizer $2 }
+  | 'tokenizer' PIdent ';' { DefTokenizer $2 }
 
 
 CatDef :: { CatDef }
-CatDef : Ident ListDDecl { SimpleCatDef $1 (reverse $2) } 
+CatDef : PIdent ListDDecl { SimpleCatDef $1 (reverse $2) } 
-  | '[' Ident ListDDecl ']' { ListCatDef $2 (reverse $3) }
+  | '[' PIdent ListDDecl ']' { ListCatDef $2 (reverse $3) }
-  | '[' Ident ListDDecl ']' '{' Integer '}' { ListSizeCatDef $2 (reverse $3) $6 }
+  | '[' PIdent ListDDecl ']' '{' Integer '}' { ListSizeCatDef $2 (reverse $3) $6 }
 
 
 FunDef :: { FunDef }
-FunDef : ListIdent ':' Exp { FunDef $1 $3 } 
+FunDef : ListPIdent ':' Exp { FunDef $1 $3 } 
 
 
 DataDef :: { DataDef }
-DataDef : Ident '=' ListDataConstr { DataDef $1 $3 } 
+DataDef : PIdent '=' ListDataConstr { DataDef $1 $3 } 
 
 
 DataConstr :: { DataConstr }
-DataConstr : Ident { DataId $1 } 
+DataConstr : PIdent { DataId $1 } 
-  | Ident '.' Ident { DataQId $1 $3 }
+  | PIdent '.' PIdent { DataQId $1 $3 }
 
 
 ListDataConstr :: { [DataConstr] }
@@ -275,13 +292,13 @@ ListDataConstr : {- empty -} { [] }
 
 
 ParDef :: { ParDef }
-ParDef : Ident '=' ListParConstr { ParDefDir $1 $3 } 
+ParDef : PIdent '=' ListParConstr { ParDefDir $1 $3 } 
-  | Ident '=' '(' 'in' Ident ')' { ParDefIndir $1 $5 }
+  | PIdent '=' '(' 'in' PIdent ')' { ParDefIndir $1 $5 }
-  | Ident { ParDefAbs $1 }
+  | PIdent { ParDefAbs $1 }
 
 
 ParConstr :: { ParConstr }
-ParConstr : Ident ListDDecl { ParConstr $1 (reverse $2) } 
+ParConstr : PIdent ListDDecl { ParConstr $1 (reverse $2) } 
 
 
 PrintDef :: { PrintDef }
@@ -289,7 +306,7 @@ PrintDef : ListName '=' Exp { PrintDef $1 $3 }
 
 
 FlagDef :: { FlagDef }
-FlagDef : Ident '=' Ident { FlagDef $1 $3 } 
+FlagDef : PIdent '=' PIdent { FlagDef $1 $3 } 
 
 
 ListDef :: { [Def] }
@@ -333,14 +350,14 @@ ListParConstr : {- empty -} { [] }
   | ParConstr '|' ListParConstr { (:) $1 $3 }
 
 
-ListIdent :: { [Ident] }
+ListPIdent :: { [PIdent] }
-ListIdent : Ident { (:[]) $1 } 
+ListPIdent : PIdent { (:[]) $1 } 
-  | Ident ',' ListIdent { (:) $1 $3 }
+  | PIdent ',' ListPIdent { (:) $1 $3 }
 
 
 Name :: { Name }
-Name : Ident { IdentName $1 } 
+Name : PIdent { IdentName $1 } 
-  | '[' Ident ']' { ListName $2 }
+  | '[' PIdent ']' { ListName $2 }
 
 
 ListName :: { [Name] }
@@ -349,9 +366,9 @@ ListName : Name { (:[]) $1 }
 
 
 LocDef :: { LocDef }
-LocDef : ListIdent ':' Exp { LDDecl $1 $3 } 
+LocDef : ListPIdent ':' Exp { LDDecl $1 $3 } 
-  | ListIdent '=' Exp { LDDef $1 $3 }
+  | ListPIdent '=' Exp { LDDef $1 $3 }
-  | ListIdent ':' Exp '=' Exp { LDFull $1 $3 $5 }
+  | ListPIdent ':' Exp '=' Exp { LDFull $1 $3 $5 }
 
 
 ListLocDef :: { [LocDef] }
@@ -361,9 +378,9 @@ ListLocDef : {- empty -} { [] }
 
 
 Exp6 :: { Exp }
-Exp6 : Ident { EIdent $1 } 
+Exp6 : PIdent { EIdent $1 } 
-  | '{' Ident '}' { EConstr $2 }
+  | '{' PIdent '}' { EConstr $2 }
-  | '%' Ident '%' { ECons $2 }
+  | '%' PIdent '%' { ECons $2 }
   | Sort { ESort $1 }
   | String { EString $1 }
   | Integer { EInt $1 }
@@ -371,11 +388,11 @@ Exp6 : Ident { EIdent $1 }
   | '?' { EMeta }
   | '[' ']' { EEmpty }
   | 'data' { EData }
-  | '[' Ident Exps ']' { EList $2 $3 }
+  | '[' PIdent Exps ']' { EList $2 $3 }
   | '[' String ']' { EStrings $2 }
   | '{' ListLocDef '}' { ERecord $2 }
   | '<' ListTupleComp '>' { ETuple $2 }
-  | '(' 'in' Ident ')' { EIndir $3 }
+  | '(' 'in' PIdent ')' { EIndir $3 }
   | '<' Exp ':' Exp '>' { ETyped $2 $4 }
   | '(' Exp ')' { $2 }
   | LString { ELString $1 }
@@ -383,8 +400,8 @@ Exp6 : Ident { EIdent $1 }
 
 Exp5 :: { Exp }
 Exp5 : Exp5 '.' Label { EProj $1 $3 } 
-  | '{' Ident '.' Ident '}' { EQConstr $2 $4 }
+  | '{' PIdent '.' PIdent '}' { EQConstr $2 $4 }
-  | '%' Ident '.' Ident { EQCons $2 $4 }
+  | '%' PIdent '.' PIdent { EQCons $2 $4 }
   | Exp6 { $1 }
 
 
@@ -397,9 +414,11 @@ Exp4 : Exp4 Exp5 { EApp $1 $2 }
   | 'variants' '{' ListExp '}' { EVariants $3 }
   | 'pre' '{' Exp ';' ListAltern '}' { EPre $3 $5 }
   | 'strs' '{' ListExp '}' { EStrs $3 }
-  | Ident '@' Exp6 { EConAt $1 $3 }
+  | PIdent '@' Exp6 { EConAt $1 $3 }
+  | '#' Patt2 { EPatt $2 }
+  | 'pattern' Exp5 { EPattType $2 }
   | Exp5 { $1 }
-  | 'Lin' Ident { ELin $2 }
+  | 'Lin' PIdent { ELin $2 }
 
 
 Exp3 :: { Exp }
@@ -444,10 +463,14 @@ Exps : {- empty -} { NilExp }
 
 
 Patt2 :: { Patt }
-Patt2 : '_' { PW } 
+Patt2 : '?' { PChar } 
-  | Ident { PV $1 }
+  | '[' String ']' { PChars $2 }
-  | '{' Ident '}' { PCon $2 }
+  | '#' PIdent { PMacro $2 }
-  | Ident '.' Ident { PQ $1 $3 }
+  | '#' PIdent '.' PIdent { PM $2 $4 }
+  | '_' { PW }
+  | PIdent { PV $1 }
+  | '{' PIdent '}' { PCon $2 }
+  | PIdent '.' PIdent { PQ $1 $3 }
   | Integer { PInt $1 }
   | Double { PFloat $1 }
   | String { PStr $1 }
@@ -457,10 +480,10 @@ Patt2 : '_' { PW }
 
 
 Patt1 :: { Patt }
-Patt1 : Ident ListPatt { PC $1 $2 } 
+Patt1 : PIdent ListPatt { PC $1 $2 } 
-  | Ident '.' Ident ListPatt { PQC $1 $3 $4 }
+  | PIdent '.' PIdent ListPatt { PQC $1 $3 $4 }
   | Patt2 '*' { PRep $1 }
-  | Ident '@' Patt2 { PAs $1 $3 }
+  | PIdent '@' Patt2 { PAs $1 $3 }
   | '-' Patt2 { PNeg $2 }
   | Patt2 { $1 }
 
@@ -472,11 +495,11 @@ Patt : Patt '|' Patt1 { PDisj $1 $3 }
 
 
 PattAss :: { PattAss }
-PattAss : ListIdent '=' Patt { PA $1 $3 } 
+PattAss : ListPIdent '=' Patt { PA $1 $3 } 
 
 
 Label :: { Label }
-Label : Ident { LIdent $1 } 
+Label : PIdent { LIdent $1 } 
   | '$' Integer { LVar $2 }
 
 
@@ -500,7 +523,7 @@ ListPatt : Patt2 { (:[]) $1 }
 
 
 Bind :: { Bind }
-Bind : Ident { BIdent $1 } 
+Bind : PIdent { BIdent $1 } 
   | '_' { BWild }
 
 
@@ -585,11 +608,11 @@ Include : {- empty -} { NoIncl }
 
 FileName :: { FileName }
 FileName : String { FString $1 } 
-  | Ident { FIdent $1 }
+  | PIdent { FIdent $1 }
   | '/' FileName { FSlash $2 }
   | '.' FileName { FDot $2 }
   | '-' FileName { FMinus $2 }
-  | Ident FileName { FAddId $1 $2 }
+  | PIdent FileName { FAddId $1 $2 }
 
 
 ListFileName :: { [FileName] }