Browse Source

Add parsing of qualified names

and also remove build artifacts.. i've been using Git for 10 years. how
does that happen
master
Amélia Liao 3 years ago
parent
commit
ba505791b1
14 changed files with 125 additions and 62 deletions
  1. +5
    -1
      .gitignore
  2. +32
    -19
      src/Frontend/Autogen/Lexer.x
  3. +46
    -34
      src/Frontend/Autogen/Parser.y
  4. BIN
      src/Frontend/Lexer/Tokens.hi
  5. +7
    -4
      src/Frontend/Lexer/Tokens.hs
  6. BIN
      src/Frontend/Lexer/Tokens.o
  7. BIN
      src/Frontend/Parser/Posn.hi
  8. BIN
      src/Frontend/Parser/Posn.o
  9. BIN
      src/Frontend/Syntax.hi
  10. +34
    -3
      src/Frontend/Syntax.hs
  11. BIN
      src/Frontend/Syntax.o
  12. BIN
      src/Main.hi
  13. +1
    -1
      src/Main.hs
  14. BIN
      src/Main.o

+ 5
- 1
.gitignore View File

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

+ 32
- 19
src/Frontend/Autogen/Lexer.x View File

@ -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"


+ 46
- 34
src/Frontend/Autogen/Parser.y View File

@ -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


BIN
src/Frontend/Lexer/Tokens.hi View File


+ 7
- 4
src/Frontend/Lexer/Tokens.hs View File

@ -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


BIN
src/Frontend/Lexer/Tokens.o View File


BIN
src/Frontend/Parser/Posn.hi View File


BIN
src/Frontend/Parser/Posn.o View File


BIN
src/Frontend/Syntax.hi View File


+ 34
- 3
src/Frontend/Syntax.hs View File

@ -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 }

BIN
src/Frontend/Syntax.o View File


BIN
src/Main.hi View File


+ 1
- 1
src/Main.hs View File

@ -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


BIN
src/Main.o View File


Loading…
Cancel
Save