Add parsing of qualified names

and also remove build artifacts.. i've been using Git for 10 years. how
does that happen

.gitignore

@@ -11,4 +11,8 @@
 /*.hs
 
 # except for this one
-!/Setup.hs
+!/Setup.hs
+
+# alex/happy artefacts
+src/*.o
+src/*.hi

src/Frontend/Autogen/Lexer.x

@@ -25,7 +25,7 @@ tokens :-
   { just $ pushStartCode newline }
   
 <0,module_header,import_>
-  $alpha [$alpha $digit \_ \']*   { variableOrKeyword }
+  $alpha [$alpha $digit \_ \' \.]* { variableOrKeyword }
 
 <0> \=                            { always TokEqual }
 <0> \: \:                         { always TokDoubleColon }
@@ -169,16 +169,16 @@ data LayoutState
   deriving (Show)
 
 data AlexUserState =
-  AlexUserState { layoutColumns     :: [LayoutState]
-                , startCodes        :: [Int]
-                , leastColumn       :: Int
+  AlexUserState { layoutColumns     :: ![LayoutState]
+                , startCodes        :: ![Int]
+                , leastColumn       :: !Int
 
                 , pendingLayoutKw   :: Maybe (Int -> LayoutState)
-                , pendingTokens     :: [Token]
-                , pendingLambdaCase :: Bool
-                , haveModuleHeader  :: Bool
+                , pendingTokens     :: ![Token]
+                , pendingLambdaCase :: !Bool
+                , haveModuleHeader  :: !Bool
 
-                , stringBuffer      :: T.Text
+                , stringBuffer      :: !T.Text
                 }
 
 alexInitUserState = AlexUserState [] [] 0 Nothing [] False False T.empty
@@ -293,26 +293,41 @@ closeBrace (AlexPn _ line col, _, _, _) _ = do
   pure (Token TokCBrace line col)
 
 variableOrKeyword :: AlexAction Token
-variableOrKeyword (AlexPn _ l c, _, s, _) size = do
+variableOrKeyword (AlexPn _ l c, _, s, _) size = finishVarKw l c $ T.decodeUtf8 (Lbs.toStrict (Lbs.take size s))
+
+finishVarKw :: Int -> Int -> T.Text -> Alex Token
+finishVarKw l c text
+  | T.null text = undefined
+  | Data.Char.isUpper (T.head text), T.singleton '.' `T.isInfixOf` text = pure $
+    let
+      txet = T.reverse text
+      (suffix', prefix') = T.span (/= '.') txet
+
+      prefix = T.reverse (T.tail prefix')
+      suffix = T.reverse suffix'
+    in if Data.Char.isUpper (T.head suffix)
+        then Token (TokQual ConId prefix suffix) l c
+        else Token (TokQual VarId prefix suffix) l c
+  | Data.Char.isUpper (T.head text) = pure $ Token (TokUnqual ConId text) l c
+
+finishVarKw l c text = do
   sc    <- alexGetStartCode
   state <- getUserState
   
   clearPendingLC
 
-  let
-    text = T.decodeUtf8 (Lbs.toStrict (Lbs.take size s))
-    col  = layoutCol (head (layoutColumns state))
+  let col  = layoutCol (head (layoutColumns state))
 
   case T.unpack text of
     "as"
       | sc == import_, c > col -> pure (Token TokAs l c)
-      | sc == import_          -> offsideKeyword (TokVar text) l c
-      | otherwise              -> pure (Token (TokVar text) l c)
+      | sc == import_          -> offsideKeyword (TokUnqual VarId text) l c
+      | otherwise              -> pure (Token (TokUnqual VarId text) l c)
 
     "qualified"
       | sc == import_, c > col -> pure (Token TokQualified l c)
-      | sc == import_          -> offsideKeyword (TokVar text) l c
-      | otherwise              -> pure (Token (TokVar text) l c)
+      | sc == import_          -> offsideKeyword (TokUnqual VarId text) l c
+      | otherwise              -> pure (Token (TokUnqual VarId text) l c)
 
     "let"  -> laidOut' (Just LetLayout) TokLet l c
     "in"   -> do
@@ -348,9 +363,7 @@ variableOrKeyword (AlexPn _ l c, _, s, _) size = do
         pushStartCode module_header
       pure (Token TokModule l c)
 
-    (x:_)
-      | Data.Char.isUpper x -> pure (Token (TokCon text) l c)
-      | otherwise           -> pure (Token (TokVar text) l c)
+    (x:_) -> pure (Token (TokUnqual VarId text) l c)
 
     [] -> error "empty keyword/identifier"
 

src/Frontend/Autogen/Parser.y

@@ -3,7 +3,6 @@
 module Frontend.Autogen.Parser where
 
 import qualified Data.Text as T
-import Data.Text (Text)
 
 import Frontend.Lexer.Tokens
 import Frontend.Parser.Posn
@@ -29,8 +28,11 @@ import Debug.Trace
 %error { parseError }
 
 %token
-  VAR         { Token (TokVar _) _ _ }
-  CON         { Token (TokCon _) _ _ }
+  VAR         { Token (TokUnqual VarId _) _ _ }
+  CON         { Token (TokUnqual ConId _) _ _ }
+
+  QVAR        { Token (TokQual VarId _ _) _ _ }
+  QCON        { Token (TokQual ConId _ _) _ _ }
   STRING      { Token (TokString _) _ _ }
   'eof'       { Token TokEof _ _ }
 
@@ -89,8 +91,8 @@ FuncExp :: { Exp }
   | Aexp         { $1 }
 
 Aexp :: { Exp }
-  : qvar                   { span $1 $1 $ Ref (getVar $1) }
-  | qcon                   { span $1 $1 $ Con (getVar $1) }
+  : qvar                   { span $1 $1 $ Ref $1 }
+  | qcon                   { span $1 $1 $ Con $1 }
   | '(' CommaList(Exp) ')' { span $1 $3 $ makeTuple $2 }
   | STRING                 { span $1 $1 $ Literal (LitString (getString $1)) }
 
@@ -103,10 +105,9 @@ Btype :: { Type }
   | Atype       { $1 }
       
 Atype :: { Type }
-  : qvar                    { span $1 $1 $ Tyvar (getVar $1) }
-  | qcon                    { span $1 $1 $ Tycon (getVar $1) }
+  : qvar                    { span $1 $1 $ Tyvar $1 }
+  | qcon                    { span $1 $1 $ Tycon $1 }
   | '(' CommaList(Type) ')' { span $1 $3 $ makeTupleType $2 }
-  
 
 Pat :: { Pat }
   : Lpat { $1 }
@@ -120,9 +121,9 @@ Apat :: { Pat }
   | '(' CommaList(Pat) ')' { span $1 $3 $ makeTuplePattern $2 }
 
 Decl :: { Decl }
-  : VAR '::' Type           { TySig   (getVar $1) $3 }
-  | VAR Apat List(Apat) Rhs { FunDecl (getVar $1) ($2:$3) $4 }
-  | Pat Rhs                 { PatDecl $1 $2 }
+  : CommaList1(VAR) '::' Type  { TySig   (getVar `fmap` $1) $3 }
+  | VAR Apat List(Apat) Rhs    { FunDecl (getVar $1) ($2:$3) $4 }
+  | Pat Rhs                    { PatDecl $1 $2 }
 
 Rhs :: { Rhs }
   : '=' Exp                           { BareRhs $2 [] }
@@ -139,16 +140,16 @@ LOLContents(p, End)
 
 Module :: { Module }
   : 'module' CON ImportExportList 'where' LaidOutList(ModItem)
-    { Module { moduleName    = getVar $2
+    { Module { moduleName    = toModId (getVar $2)
              , moduleExports = $3
              , moduleItems   = thd $5 }
     }
 
-ImportExportList :: { Maybe [NamespacedItem Text] }
+ImportExportList :: { Maybe [NamespacedItem ParsedVar] }
   : {-empty-}                 { Nothing }
   | '(' CommaList(NSItem) ')' { Just $2 }
 
-NSItem :: { NamespacedItem Text }
+NSItem :: { NamespacedItem ParsedVar }
   : VAR          { IEVar (getVar $1) }
   | CON          { IECon (getVar $1) }
   | 'module' CON { IEModule (getVar $2) }
@@ -157,18 +158,18 @@ ModItem :: { Item }
   : Decl            { ModDecl $1 }
   | Import          { ModImport $1 } 
 
-Import
-  : 'import' qcon ImportExportList
-    { Import (getVar $2) $3 False Nothing }
+Import :: { ModuleImport ParsedVar }
+  : 'import' modid ImportExportList
+    { Import $2 $3 False Nothing }
 
-  | 'import' qcon ImportExportList 'as' CON
-    { Import (getVar $2) $3 False (Just (getVar $5)) }
+  | 'import' modid ImportExportList 'as' CON
+    { Import $2 $3 False (Just (getVar $5)) }
     
-  | 'import' 'qualified' qcon ImportExportList
-    { Import (getVar $3) $4 True Nothing }
+  | 'import' 'qualified' modid ImportExportList
+    { Import $3 $4 True Nothing }
     
-  | 'import' 'qualified' qcon ImportExportList 'as' CON
-    { Import (getVar $3) $4 True (Just (getVar $6)) }
+  | 'import' 'qualified' modid ImportExportList 'as' CON
+    { Import $3 $4 True (Just (getVar $6)) }
 
 Opt(p)
   :           { () }
@@ -179,8 +180,14 @@ Semis
   | ';'       { () }
 
 -- TODO: qualified names
-qvar : VAR { $1 }
-qcon : CON { $1 }
+qvar :: { ParsedVar }
+qvar : VAR  { getVar $1 }
+     | QVAR { getVar $1 }
+
+qcon : CON  { getVar $1 }
+     | QCON { getVar $1 }
+
+modid : qcon { toModId $1 }
 
 List(p)
   : {-empty-} { [] }
@@ -191,19 +198,23 @@ CommaList(p)
   | p                  { [$1] }
   | p ',' CommaList(p) { $1:$3 }
 
+CommaList1(p)
+  : p                  { [$1] }
+  | p ',' CommaList(p) { $1:$3 }
+
 Block(p)
   : START p END { (startPosn $1, endPosn $3, $2) }
   | '{' p '}'   { (startPosn $1, endPosn $3, $2) }
 
 {
 
-type Exp    = FeExpr     Text
-type Pat    = FePat      Text
-type Decl   = FeDecl     Text
-type Type   = FeType     Text
-type Rhs    = FeRhs      Text
-type Module = FeModule   Text
-type Item   = ModuleItem Text
+type Exp    = FeExpr     ParsedVar
+type Pat    = FePat      ParsedVar
+type Decl   = FeDecl     ParsedVar
+type Type   = FeType     ParsedVar
+type Rhs    = FeRhs      ParsedVar
+type Module = FeModule   ParsedVar
+type Item   = ModuleItem ParsedVar
 
 lexer cont = alexMonadScan >>= cont
 
@@ -211,8 +222,9 @@ parseError x = alexError (show x)
 
 makeLams xs b = foldr Lam b xs
 
-getVar (Token (TokVar s) _ _) = s
-getVar (Token (TokCon s) _ _) = s
+getVar :: Token -> ParsedVar
+getVar tok@(Token (TokQual _ p s) _ _) = QualVar { varId = s, varPrefix = p, varBegin = startPosn tok, varEnd = endPosn tok }
+getVar tok@(Token (TokUnqual _ s) _ _) = UnqualVar { varId = s, varBegin = startPosn tok, varEnd = endPosn tok }
 getVar _ = error "getVar non-var"
 
 getString (Token (TokString s) _ _) = s

src/Frontend/Lexer/Tokens.hs

@@ -3,9 +3,12 @@ module Frontend.Lexer.Tokens where
 import qualified Data.Text as T
 import Data.Text (Text)
 
+data IdClass = ConId | VarId
+  deriving (Eq, Show, Ord)
+
 data TokenClass
-  = TokVar    Text
-  | TokCon    Text
+  = TokUnqual IdClass Text
+  | TokQual   IdClass Text Text
   | TokString Text
   | TokEof
 
@@ -48,8 +51,8 @@ data TokenClass
   deriving (Eq, Show, Ord)
 
 tokSize :: TokenClass -> Int
-tokSize (TokVar x)     = T.length x
-tokSize (TokCon x)     = T.length x
+tokSize (TokUnqual _ x) = T.length x
+tokSize (TokQual _ x y) = T.length x + T.length y + 1
 tokSize TokEof         = 0
 tokSize TokLambda      = 1
 tokSize TokOParen      = 1

src/Frontend/Syntax.hs

@@ -2,6 +2,7 @@ module Frontend.Syntax where
 
 import Frontend.Parser.Posn
 import qualified Data.Text as T
+import Data.Text (Text)
 
 data FeExpr var
   = Ref var
@@ -71,9 +72,9 @@ instance HasPosn (FeType var) where
   span sp ep x              = SPType x (startPosn sp) (endPosn ep)
 
 data FeDecl var
-  = PatDecl (FePat var)     (FeRhs var)
+  = PatDecl (FePat var) (FeRhs var)
   | FunDecl var [FePat var] (FeRhs var)
-  | TySig   var (FeType var)
+  | TySig   [var] (FeType var)
   deriving (Eq, Show, Ord)
 
 data FeRhs var
@@ -109,4 +110,34 @@ data NamespacedItem var
 data ModuleItem var
   = ModDecl (FeDecl var)
   | ModImport (ModuleImport var)
-  deriving (Eq, Show, Ord)
+  deriving (Eq, Show, Ord)
+
+data ParsedVar
+  = UnqualVar
+    { varId :: Text
+    , varBegin :: Posn
+    , varEnd :: Posn
+    }
+  | QualVar
+    { varId     :: Text
+    , varPrefix :: Text
+    , varBegin  :: Posn
+    , varEnd    :: Posn
+    }
+  | ModId
+    { varId    :: Text
+    , varBegin :: Posn
+    , varEnd   :: Posn
+    }
+  deriving (Eq, Show, Ord)
+
+toModId :: ParsedVar -> ParsedVar
+toModId x@ModId{} = x
+toModId (UnqualVar x y z) = ModId x y z
+toModId (QualVar id pref b e) = ModId (pref <> T.singleton '.' <> id) b e
+
+instance HasPosn ParsedVar where
+  startPosn = varBegin
+  endPosn = varEnd
+
+  span sp ep s = s { varBegin = startPosn sp, varEnd = endPosn ep }

src/Main.hs

@@ -27,7 +27,7 @@ testParse s = Main.lex print parseMod (Lbs.fromStrict (T.encodeUtf8 (T.pack s)))
 
 testLex :: String -> IO ()
 testLex s = Main.lex (const (pure ())) (scan []) (Lbs.fromStrict (T.encodeUtf8 (T.pack s)))
-
+ 
 lex :: (a -> IO ()) -> Alex a -> Lbs.ByteString -> IO ()
 lex show cont arg = do
   let x = runAlex arg cont