diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +yi-lexers +========= + +Collection of lexers used by the Yi text editor. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Yi/Buffer/Basic.hs b/src/Yi/Buffer/Basic.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Buffer/Basic.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE + StandaloneDeriving, + DeriveDataTypeable, + ScopedTypeVariables, + ExistentialQuantification, + GeneralizedNewtypeDeriving, + MultiParamTypeClasses, + TemplateHaskell, + DeriveGeneric, + CPP #-} +-- Copyright 2008 JP Bernardy +-- | Basic types useful everywhere we play with buffers. +module Yi.Buffer.Basic where +import Data.Binary +import Data.Typeable +#if __GLASGOW_HASKELL__ < 708 +import Data.DeriveTH +#else +import GHC.Generics (Generic) +#endif +import Data.Ix +import Data.Default +import Yi.Utils + +-- | Direction of movement inside a buffer +data Direction = Backward + | Forward + deriving (Eq,Ord,Typeable,Show,Bounded,Enum) + +#if __GLASGOW_HASKELL__ < 708 +$(derive makeBinary ''Direction) +#else +deriving instance Generic Direction +instance Binary Direction +#endif + +reverseDir :: Direction -> Direction +reverseDir Forward = Backward +reverseDir Backward = Forward + + +-- | reverse if Backward +mayReverse :: Direction -> [a] -> [a] +mayReverse Forward = id +mayReverse Backward = reverse + +-- | 'direction' is in the same style of 'maybe' or 'either' functions, +-- It takes one argument per direction (backward, then forward) and a +-- direction to select the output. +directionElim :: Direction -> a -> a -> a +directionElim Backward b _ = b +directionElim Forward _ f = f + +-- | A mark in a buffer +newtype Mark = Mark {markId::Int} deriving (Eq, Ord, Show, Typeable, Binary) + +-- | Reference to a buffer. +newtype BufferRef = BufferRef Int + deriving (Eq, Ord, Typeable, Binary, + Num) + +instance Show BufferRef where + show (BufferRef r) = "B#" ++ show r + +-- | A point in a buffer +newtype Point = Point {fromPoint :: Int} -- offset in the buffer (#codepoints, NOT bytes) + deriving (Eq, Ord, Enum, Bounded, Typeable, Binary, Ix, + Num, Real, Integral) + +instance Show Point where + show (Point p) = show p + +-- | Size of a buffer region +newtype Size = Size {fromSize :: Int} -- size in bytes (#bytes, NOT codepoints) + deriving (Show, Eq, Ord, Num, Enum, Real, Integral, Binary) + +instance SemiNum Point Size where + Point p +~ Size s = Point (p + s) + Point p -~ Size s = Point (p - s) + Point p ~- Point q = Size (abs (p - q)) + +-- | Window references +newtype WindowRef = WindowRef { unWindowRef :: Int } + deriving(Eq, Ord, Enum, Show, Typeable, Binary) + +instance Default WindowRef where def = WindowRef (-1) + diff --git a/src/Yi/Lexer/Abella.x b/src/Yi/Lexer/Abella.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Abella.x @@ -0,0 +1,121 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for Abella +-- +-- (c) Nicolas Pouillard 2009 +-- + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Abella ( lexer, tokenToText, TT, isComment, Token(..), HlState + , Reserved(..), ReservedOp(..) ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style +} + +$whitechar = [\ \t\n\r\f\v] + +$digit = 0-9 + +$small = [a-z] +$large = [A-Z] +$alpha = [$small $large] +$idchar = [$alpha $digit \_ \'] + +$nl = [\n\r] + +@reservedid = + Theorem|Define +@reservedop = [\=\:\,\(\)\{\}] + +@varid = $large $idchar* +@conid = [\' \_ $small] $idchar* +@anyid = (@varid | @conid) + +@decimal = $digit+ + +abella :- + +<0> $white+ ; + +<0> { + "%"[^$nl]* { c CommentLine } + + "exists" { c $ Reserved Exists } + "forall" { c $ Reserved Forall } + + @reservedid { c $ Reserved Other } + + \\ { c $ ReservedOp BackSlash } + \\\/ { c $ ReservedOp Or } + \/\\ { c $ ReservedOp And } + "->" { c $ ReservedOp RightArrow } + "=>" { c $ ReservedOp DoubleRightArrow } + "." { c $ ReservedOp Dot } + @reservedop { c $ ReservedOp OtherOp } + + @decimal { c Number } + + "skip" { c Skip } + + @varid { c VarIdent } + @conid { c ConsIdent } + + . { c Unrecognized } +} + +{ + +type HlState = Int + +data Reserved = Forall | Exists | Other + deriving (Eq, Show) + +data ReservedOp = Or | And | BackSlash | RightArrow | DoubleRightArrow | Dot | OtherOp + deriving (Eq, Show) + +data Token = Number | VarIdent | ConsIdent + | Reserved !Reserved | ReservedOp !ReservedOp + | CommentLine | Skip + | Unrecognized + deriving (Eq, Show) + +tokenToStyle :: Token -> StyleName +tokenToStyle tok = case tok of + Number -> numberStyle + VarIdent -> variableStyle + ConsIdent -> typeStyle + ReservedOp _ -> operatorStyle + Reserved _ -> keywordStyle + CommentLine -> commentStyle + Skip -> errorStyle + Unrecognized -> errorStyle + +tokenToText :: Token -> Maybe String +tokenToText (ReservedOp RightArrow) = Just "→ " +tokenToText (ReservedOp DoubleRightArrow) = Just "⇒ " +tokenToText (ReservedOp And) = Just "∧ " +tokenToText (ReservedOp Or) = Just "∨ " +tokenToText (Reserved Exists) = Just "∃" +tokenToText (Reserved Forall) = Just "∀" +tokenToText _ = Nothing + +isComment CommentLine = True +isComment _ = False + +stateToInit = const 0 + +initState :: HlState +initState = 0 + +type TT = Tok Token + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = tokenToStyle + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Alex.hs b/src/Yi/Lexer/Alex.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Alex.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Yi.Lexer.Alex +-- License : GPL-2 +-- Maintainer : yi-devel@googlegroups.com +-- Stability : experimental +-- Portability : portable +-- +-- Utilities to turn a lexer generated by Alex into a 'Scanner' that +-- can be used by Yi. Most lexers will use the types defined here. +-- Some things are exported for use by lexers themselves through the +-- use of @Yi/Lexers/common.hsinc@. + +module Yi.Lexer.Alex ( module Yi.Lexer.Alex + , (+~), (~-), Size(..), Stroke ) where + +import Control.Lens (_1, view) +import Control.Lens.TH (makeLenses) +import qualified Data.Bits +import Data.Char (ord) +import Data.Function (on) +import Data.Ix +import Data.List (foldl') +import Data.Ord (comparing) +import Data.Word (Word8) +import Yi.Style (StyleName) +import Yi.Syntax hiding (mkHighlighter) +import Yi.Utils + +-- | Encode a Haskell String to a list of Word8 values, in UTF8 format. +utf8Encode :: Char -> [Word8] +utf8Encode = map fromIntegral . go . ord + where + go oc + | oc <= 0x7f = [oc] + + | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) + , 0x80 + oc Data.Bits..&. 0x3f + ] + + | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) + , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) + , 0x80 + oc Data.Bits..&. 0x3f + ] + | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) + , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) + , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) + , 0x80 + oc Data.Bits..&. 0x3f + ] +type Byte = Word8 + +type IndexedStr = [(Point, Char)] +type AlexInput = (Char, [Byte],IndexedStr) +type Action hlState token = IndexedStr -> hlState -> (hlState, token) + +-- | Lexer state +data AlexState lexerState = AlexState { + stLexer :: lexerState, -- (user defined) lexer state + lookedOffset :: !Point, -- Last offset looked at + stPosn :: !Posn + } deriving Show + +data Tok t = Tok { tokT :: t + , tokLen :: Size + , tokPosn :: Posn + } deriving Functor + +instance Eq (Tok a) where + (==) = (==) `on` tokPosn + +tokToSpan :: Tok t -> Span t +tokToSpan (Tok t len posn) = Span (posnOfs posn) t (posnOfs posn +~ len) + +tokFromT :: t -> Tok t +tokFromT t = Tok t 0 startPosn + +tokBegin :: Tok t -> Point +tokBegin = posnOfs . tokPosn + +tokEnd :: Tok t -> Point +tokEnd t = tokBegin t +~ tokLen t + +instance Show t => Show (Tok t) where + show tok = show (tokPosn tok) ++ ": " ++ show (tokT tok) + +data Posn = Posn { + posnOfs :: !Point + , posnLine :: !Int + , posnCol :: !Int + } deriving (Eq, Ix) + +-- TODO: Verify that this is right. /Deniz +instance Ord Posn where + compare = comparing posnOfs + +instance Show Posn where + show (Posn o l c) = "L" ++ show l ++ " " ++ "C" ++ show c ++ "@" ++ show o + +startPosn :: Posn +startPosn = Posn 0 1 0 + +moveStr :: Posn -> IndexedStr -> Posn +moveStr posn str = foldl' moveCh posn (fmap snd str) + +moveCh :: Posn -> Char -> Posn +moveCh (Posn o l c) '\t' = Posn (o+1) l (((c+8) `div` 8)*8) +moveCh (Posn o l _) '\n' = Posn (o+1) (l+1) 0 +moveCh (Posn o l c) _ = Posn (o+1) l (c+1) + +alexGetChar :: AlexInput -> Maybe (Char, AlexInput) +alexGetChar (_,_,[]) = Nothing +alexGetChar (_,b,(_,c):rest) = Just (c, (c,b,rest)) + +alexGetByte :: AlexInput -> Maybe (Word8,AlexInput) +alexGetByte (c, b:bs, s) = Just (b,(c,bs,s)) +alexGetByte (_, [], []) = Nothing +alexGetByte (_, [], c:s) = case utf8Encode (snd c) of + (b:bs) -> Just (b, ((snd c), bs, s)) + [] -> Nothing + +{-# ANN alexCollectChar "HLint: ignore Use String" #-} +alexCollectChar :: AlexInput -> [Char] +alexCollectChar (_, _, []) = [] +alexCollectChar (_, b, (_, c):rest) = c : alexCollectChar (c, b, rest) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar = view _1 + +-- | Return a constant token +actionConst :: token -> Action lexState token +actionConst token = \_str state -> (state, token) + +-- | Return a constant token, and modify the lexer state +actionAndModify :: (lexState -> lexState) -> token -> Action lexState token +actionAndModify modifierFct token = \_str state -> (modifierFct state, token) + +-- | Convert the parsed string into a token, +-- and also modify the lexer state +actionStringAndModify :: (s -> s) -> (String -> token) -> Action s token +actionStringAndModify modF f = \istr s -> (modF s, f $ fmap snd istr) + +-- | Convert the parsed string into a token +actionStringConst :: (String -> token) -> Action lexState token +actionStringConst f = \indexedStr state -> (state, f $ fmap snd indexedStr) + +type ASI s = (AlexState s, AlexInput) + +-- | Function to (possibly) lex a single token and give us the +-- remaining input. +type TokenLexer l s t i = (l s, i) -> Maybe (t, (l s, i)) + +-- | Handy alias +type CharScanner = Scanner Point Char + +-- | Generalises lexers. This allows us to easily use lexers which +-- don't want to be cornered into the types we have predefined here +-- and use in @common.hsinc@. +data Lexer l s t i = Lexer + { _step :: TokenLexer l s t i + , _starting :: s -> Point -> Posn -> l s + , _withChars :: Char -> [(Point, Char)] -> i + , _looked :: l s -> Point + , _statePosn :: l s -> Posn + , _lexEmpty :: t + , _startingState :: s + } + +-- | Just like 'Lexer' but also knows how to turn its tokens into +-- 'StyleName's. +data StyleLexer l s t i = StyleLexer + { _tokenToStyle :: t -> StyleName + , _styleLexer :: Lexer l s (Tok t) i + } + +-- | 'StyleLexer' over 'ASI'. +type StyleLexerASI s t = StyleLexer AlexState s t AlexInput + +-- | Defines a 'Lexer' for 'ASI'. This exists to make using the new +-- 'lexScanner' easier if you're using 'ASI' as all our lexers do +-- today, 23-08-2014. +commonLexer :: (ASI s -> Maybe (Tok t, ASI s)) + -> s + -> Lexer AlexState s (Tok t) AlexInput +commonLexer l st0 = Lexer + { _step = l + , _starting = AlexState + , _withChars = \c p -> (c, [], p) + , _looked = lookedOffset + , _statePosn = stPosn + , _lexEmpty = error "Yi.Lexer.Alex.commonLexer: lexEmpty" + , _startingState = st0 + } + +-- | Combine a character scanner with a lexer to produce a token +-- scanner. May be used together with 'mkHighlighter' to produce a +-- 'Highlighter', or with 'linearSyntaxMode' to produce a 'Mode'. +lexScanner :: Lexer l s t i -> CharScanner -> Scanner (l s) t +lexScanner Lexer {..} src = Scanner + { scanLooked = _looked + , scanInit = _starting _startingState 0 startPosn + , scanRun = \st -> case posnOfs $ _statePosn st of + 0 -> unfoldLexer _step (st, _withChars '\n' $ scanRun src 0) + ofs -> case scanRun src (ofs -1) of + [] -> [] + (_, ch) : rest -> unfoldLexer _step (st, _withChars ch rest) + , scanEmpty = _lexEmpty + } + +-- | unfold lexer into a function that returns a stream of (state, token) +unfoldLexer :: ((state, input) -> Maybe (token, (state, input))) + -> (state, input) -> [(state, token)] +unfoldLexer f b = case f b of + Nothing -> [] + Just (t, b') -> (fst b, t) : unfoldLexer f b' + +-- * Lenses +makeLensesWithSuffix "A" ''Posn +makeLensesWithSuffix "A" ''Tok +makeLenses ''Lexer +makeLenses ''StyleLexer diff --git a/src/Yi/Lexer/C.x b/src/Yi/Lexer/C.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/C.x @@ -0,0 +1,176 @@ +-- -*- haskell -*- +-- Simple lexer for c + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} -- Alex generate warnings-ridden code. +module Yi.Lexer.C ( lexer ) where + +{- Standard Library Modules Imported -} +import Yi.Lexer.Alex hiding (tokenToStyle) + +{- External Library Modules Imported -} + +{- Local Modules Imported -} +import qualified Yi.Syntax +import Yi.Style + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@reservedid = + auto + | break + | case + | char + | const + | continue + | default + | do + | double + | else + | enum + | extern + | float + | for + | goto + | if + | int + | long + | register + | return + | short + | signed + | static + | struct + | switch + | typedef + | union + | unsigned + | void + | volatile + | while + +@cppid = + "#define" + | "#defined" + | "#if" + | "#ifdef" + | "#ifndef" + | "#elif" + | "#else" + | "#endif" + | "#include" + +-- From this list, but only the C ones: http://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B +@reservedop = + "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | + "<" | "<=" | ">" | ">=" | "!=" | "==" | + "!" | "&&" | "||" | + "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | + "=" | "->" | "." | "," | "?" | ":" | "sizeof" + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +c :- + +<0> $white+ { c defaultStyle } -- whitespace + + { + -- We could do nested comments like this + -- "/*" { m (subtract 1) blockCommentStyle } + "*/" { m (+1) blockCommentStyle } + $white+ ; -- Whitespace + . { c blockCommentStyle } +} + +<0> { + "//"[^\n]* { c commentStyle } + "/*".*"*/" { c blockCommentStyle } + + "/*" @reservedop* { m (subtract 1) blockCommentStyle } + + $special { c defaultStyle } + + @reservedid { c keywordStyle } + @cppid { c preprocessorStyle } + @varid { c defaultStyle } + @conid { c typeStyle } + + @reservedop { c operatorStyle } + @varsym { c operatorStyle } + @consym { c typeStyle } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c defaultStyle } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c defaultStyle } + + \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } + \" @string* \" { c stringStyle } + . { c operatorStyle } +} + + +{ + +type HlState = Int +type Token = StyleName + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +stateToInit :: HlState -> Int +stateToInit x | x < 0 = nestcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Cabal.x b/src/Yi/Lexer/Cabal.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Cabal.x @@ -0,0 +1,195 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for Cabal files +-- +-- History: +-- Adapted from the Haskell lexical syntax by Allan Clark +-- Adapted to follow more closely the Cabal tool by Nicolas Pouillard +-- + +{ +{-# OPTIONS -w #-} +module Yi.Lexer.Cabal ( lexer ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style + ( Style ( .. ) + , StyleName + , defaultStyle + , commentStyle + , blockCommentStyle + , keywordStyle + , operatorStyle + , typeStyle + , stringStyle + , numberStyle + ) +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@reservedid = + GPL + |LGPL + |BSD3 + |BSD4 + |PublicDomain + |AllRightsReserved + |OtherLicense + |if + |[Ff]lag + |else + |[Oo][Ss] + |[Aa]rch + |[Tt]rue + |[Ff]alse + |[Ii]mpl + +@fieldid = + [Aa]uthor + |[Bb]ug\-[Rr]eports + |[Bb]uild\-[Dd]epends + |[Bb]uild\-[Tt]ype + |[Bb]uild\-[Tt]ools + |[Bb]uildable + |[Cc]\-[Ss]ources + |[Cc][Cc]\-[Oo]ptions + |[Cc]abal\-[Vv]ersion + |[Cc]ategory + |[Cc]opyright + |[Dd]ata\-[Dd]ir + |[Dd]ata\-[Ff]iles + |[Dd]efault + |[Dd]escription + |[Ee]xecutable + |[Ee]xposed + |[Ee]xposed\-[Mm]odules + |[Ee]xtensions + |[Ee]xtra\-[Ll]ibraries + |[Ee]xtra\-[Ll]ib\-[Dd]irs + |[Ee]xtra\-[Ss]ource\-[Ff]iles + |[Ee]xtra\-[Tt]mp\-[Ff]iles + |[Ff]rameworks + |[Gg][Hh][Cc]\-[Oo]ptions + |[Gg][Hh][Cc]\-[Pp]rof\-[Oo]ptions + |[Gg][Hh][Cc]\-[Ss]hared\-[Oo]ptions + |[Hh][Uu][Gg][Ss]\-[Oo]ptions + |[Nn][Hh][Cc]98\-[Oo]ptions + |[Hh]omepage + |[Hh][Ss]\-[Ss]ource\-[Dd]irs + |[Ii]nclude\-[Dd]irs + |[Ii]ncludes + |[Ii]nstall\-[Ii]ncludes + |[Ll]icense + |[Ll]icense\-[Ff]ile + |[Ll][Dd]\-[Oo]ptions + |[Mm]ain\-[Ii]s + |[Mm]aintainer + |[Nn]ame + |[Oo]ther\-[Mm]odules + |[Pp]ackage\-[Uu][Rr][Ll] + |[Pp]kgconfig\-[Dd]epends + |[Ss]tability + |[Ss]ynopsis + |[Tt]ested\-[Ww]ith + |[Vv]ersion + +@sourcerepofieldid = + [Tt]ype + |[Ll]ocation + |[Mm]odule + |[Bb]ranch + |[Tt]ag + |[Ss]ubdir + +@reservedop = + ">" | ">=" | "<" | "<=" + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +main :- + +<0> { + [\ \t]+ { c defaultStyle } + $nl+ { c defaultStyle } + + ^ [\ \t]* "--" [^$nl]* $ { c commentStyle } + + $special { c defaultStyle } + + @reservedid { c keywordStyle } + @varid { c defaultStyle } + @conid { c defaultStyle } + + @fieldid ":" { c typeStyle } + @sourcerepofieldid ":" { c typeStyle } + + @reservedop { c operatorStyle } + @varsym { c operatorStyle } + @consym { c defaultStyle } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c defaultStyle } + + @decimal \. @decimal { c defaultStyle } + + \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } + \" @string* \" { c stringStyle } + . { c operatorStyle } +} + +{ +type HlState = () +type Token = StyleName + +stateToInit () = 0 + +initState :: HlState +initState = () + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Compilation.x b/src/Yi/Lexer/Compilation.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Compilation.x @@ -0,0 +1,55 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for compilation messages +-- + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Compilation (lexer, Token(..)) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Regex +import Yi.Style (commentStyle) +} + +$digit = 0-9 +$white = [\ \n] +$filechar = ~[\: $white] + +@file = $filechar+ +@number = $digit+ + +tokens :- + @file":" @number ":" @number ":" .*\n { \str st -> + let Just (_before, arr, _after) = matchOnceText re $ map snd str + re :: Regex + re = makeRegex "^(.+):([0-9]+):([0-9]+):(.*)$" + in (st, Report (fst $ arr!1) (read $ fst $ arr!2) (read $ fst $ arr!3) (fst $ arr!4)) } + -- without a column number + @file":" @number ":" .*\n { \str st -> + let Just (_before, arr, _after) = matchOnceText re $ map snd str + re :: Regex + re = makeRegex "^(.+):([0-9]+):(.*)$" + in (st, Report (fst $ arr!1) (read $ fst $ arr!2) 0 (fst $ arr!3)) } + + $white+ ; -- unparseable stuff + [^$white]+ ; +{ + +type HlState = () +data Token + = Report String Int Int String + | Text String + deriving Show + +stateToInit () = 0 +initState = () + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = const commentStyle + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Cplusplus.x b/src/Yi/Lexer/Cplusplus.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Cplusplus.x @@ -0,0 +1,220 @@ +-- -*- haskell -*- +-- Simple lexer for c/c++ files + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Cplusplus ( lexer ) where +{- Standard Library Modules Imported -} +import Yi.Lexer.Alex hiding (tokenToStyle) +{- External Library Modules Imported -} +{- Local Modules Imported -} +import qualified Yi.Syntax +import Yi.Style + +{- End of Module Imports -} + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@reservedid = + asm + |break + |case + |continue + |default + |do + |else + |enum + |for + |fortran + |goto + |if + |return + |sizeof + |struct + |switch + |typedef + |union + |while + |_Bool + |_Complex + |_Imaginary + |bool + |char + |double + |float + |int + |long + |short + |signed + |size_t + |unsigned + |void + |auto + |const + |extern + |inline + |register + |restrict + |static + |volatile + |NULL + |MAX + |MIN + |TRUE + |FALSE + |__LINE__ + |__DATA__ + |__FILE__ + |__func__ + |__TIME__ + |__STDC__ + |and + |and_eq + |bitand + |bitor + |catch + |compl + |const_cast + |delete + |dynamic_cast + |false + |for + |friend + |new + |not + |not_eq + |operator + |or + |or_eq + |private + |protected + |public + |reinterpret_cast + |static_cast + |this + |throw + |true + |try + |typeid + |using + |xor + |xor_eq + |class + |namespace + |typename + |template + |virtual + |bool + |explicit + |export + |inline + |mutable + |wchar_t + + +@reservedop = + "->" | "*" | "+" | "-" | "%" | \\ | "||" | "&&" | "?" | ":" + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +haskell :- + +<0> $white+ { c defaultStyle } -- whitespace + + { + -- We could do nested comments like this + -- "/*" { m (subtract 1) blockCommentStyle } + "*/" { m (+1) blockCommentStyle } + $white+ { c defaultStyle } -- whitespace + . { c blockCommentStyle } +} + +<0> { + "//"[^\n]* { c commentStyle } + + "/*" { m (subtract 1) blockCommentStyle } + + $special { c defaultStyle } + + @reservedid { c keywordStyle } + @varid { c defaultStyle } + @conid { c typeStyle } + + @reservedop { c operatorStyle } + @varsym { c operatorStyle } + @consym { c typeStyle } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c defaultStyle } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c defaultStyle } + + \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } + \" @string* \" { c stringStyle } + . { c operatorStyle } +} + + +{ + +type HlState = Int +type Token = StyleName + +stateToInit x | x < 0 = nestcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/GNUMake.x b/src/Yi/Lexer/GNUMake.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/GNUMake.x @@ -0,0 +1,212 @@ +-- -*- haskell -*- +-- Lexer for Makefiles with consideration of GNU extensions +-- This is based off the syntax as described in the GNU Make manual: +-- http://www.gnu.org/software/make/manual/make.html +-- Maintainer: Corey O'Connor +{ +{-# OPTIONS -w #-} +module Yi.Lexer.GNUMake ( lexer ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style + ( Style ( .. ) + , StyleName + ) +import qualified Yi.Style as Style +} + +@varAssignOp = + "=" + | "?=" + | "+=" + | ":=" + +-- The documentation implies that {,},(, and ) can be used as single character variable names. +-- "A variable name may be any sequence of characters not containing `:', `#', `=', or leading or +-- trailing whitespace." +-- http://www.gnu.org/software/make/manual/make.html#Using-Variables +-- However when I try to feed GNU makefile containing such weird variable names GNU make fails. +-- Though the specification does leave limiting the scope of valid variable names that as an open +-- option for "the future" +$varChar = $printable # [\: \# \= \ \{ \} \( \)] + +@directives = + include + | if + | export + | unexport + | define + +@specialVars = + MAKEFILE_LIST + | ".DEFAULT_GOAL" + | MAKE_RESTARTS + | ".VARIABLES" + | ".FEATURES" + | ".INCLUDE_DIRS" + | MAKE + +$space = [\ ] + +make :- + +<0> +{ + -- All lines that start with a \t are passed to the shell post variable expansion and '\' + -- handling. + -- TODO: I'm almost convinced I'd like to see the tab character visually distinct from a space. + -- One possibility would be to treat the tab character as an operator. + ^\t + { m (const RuleCommand) Style.defaultStyle } + + -- There can be any number of spaces (but not tabs!) preceeded a directive. + ^$space+ + { c Style.defaultStyle } + + -- The "include" directive can occur in two forms: + -- One preceeded by a "-" + -- Another not preceeded by a "-" + \-?"include" + { m (const IncludeDirective) Style.importStyle } + + -- A variable expansion outside of a prerequisite can occur in three different forms. + -- Inside a prerequisite they can occur in four different forms. + -- TODO: Highlight the automatic variables differently. + -- 1. Single character variable names unless the character is a $. + "$$" + { c Style.defaultStyle } + \$$varChar + { c Style.variableStyle } + + -- 2 & 3: Parentheses or brackets could indicate a variable expansion or function call. + "${" + { m (const $ ComplexExpansion '}' TopLevel) Style.operatorStyle } + "$(" + { m (const $ ComplexExpansion ')' TopLevel) Style.operatorStyle } + + \# + { m (const $ InComment) Style.commentStyle } + \n + { c Style.defaultStyle } + . + { c Style.defaultStyle } +} + +-- The include directive is a space separated list. Optionally followed by a comment. + +{ + $space+ + { c Style.defaultStyle } + \# + { m (const $ InComment) Style.commentStyle } + \n + { m (const $ TopLevel) Style.defaultStyle } + + -- For now anything else is considered a string. + -- This is incorrect. The items of the space separated list can be: + -- 0. File globs + -- 1. Variable expansions + -- 2. String literals + . + { c Style.stringStyle } +} + +-- A variable expansion that starts with a parentheses or bracket could be a function call. For now +-- everything up to the close character is considered part of the variable name. + +{ + $white+ { c Style.defaultStyle } + + -- Variable expansion is supported in a variable expansion. Unlike in a rule commmand the + -- sequence $$ means the variable named $$. + "$$" + { c Style.variableStyle } + \$$varChar + { c Style.variableStyle } + "${" + { m (\this -> ComplexExpansion '}' this) Style.operatorStyle } + "$(" + { m (\this -> ComplexExpansion ')' this) Style.operatorStyle } + + ./ + { + \state preInput _ _ -> + case state of + ComplexExpansion endChar _ -> + let currentChar = head $ alexCollectChar preInput + in if (currentChar == endChar) then True else False + _ -> False + } + { + m (\(ComplexExpansion _ prevState) -> prevState) Style.operatorStyle + } + . + { c Style.variableStyle } +} + +-- After all the lines joined by a '\' character are appended together the text only undergoes +-- variable expansion before being passed to the shell. +-- This means that a '#' character only indicates a comment *only* if the shell interpretting the +-- expanded text would consider it a comment. Wack huh? +-- See 3.1 + +{ + -- If the \n is preceeded by a \ then the next line is part of this command even if there is no + -- \t at the start. + \\[.\n] + { c Style.makeFileAction } + \n + { m (const $ TopLevel) Style.defaultStyle } + + -- Variable expansion is supported in a rule command. + "$$" + { c Style.makeFileAction } + \$$varChar + { c Style.variableStyle } + "${" + { m (const $ ComplexExpansion '}' RuleCommand) Style.operatorStyle } + "$(" + { m (const $ ComplexExpansion ')' RuleCommand) Style.operatorStyle } + + . + { c Style.makeFileAction } +} + + +{ + -- Comments can be continued to the next line with a trailing slash. + -- See 3.1 + \\[.\n] + { c Style.commentStyle } + \n + { m (const TopLevel) Style.defaultStyle } + . + { c Style.commentStyle } +} + +{ +data HlState = + TopLevel + | InComment + | IncludeDirective + | ComplexExpansion Char HlState + | RuleCommand + deriving Show +stateToInit TopLevel = 0 +stateToInit InComment = comment +stateToInit IncludeDirective = includeDirective +stateToInit (ComplexExpansion _ _) = complexExpansion +stateToInit RuleCommand = ruleCommand + +initState :: HlState +initState = TopLevel + +type Token = StyleName + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/GitCommit.x b/src/Yi/Lexer/GitCommit.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/GitCommit.x @@ -0,0 +1,104 @@ +-- -*- haskell -*- +-- Maintainer: Andrew Myers +{ +{-# OPTIONS -w #-} +module Yi.Lexer.GitCommit ( lexer, Token(..) ) where +import Data.Monoid (mappend) +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style ( StyleName ) +import qualified Yi.Style as Style +} + +$commitChars = [$printable\t] # [\#] +@diffStart = diff\ \-\-git\ $commitChars* +$nl = [\n\r] +$notColon = $printable # [:] + +gitCommit :- + +-- The first line of a git commit message is the digest that is +-- displayed as a summary of the commit in virtually all git tools. +<0> { +.+ { c Style.regexStyle } +$nl { m (const SecondLine) Style.defaultStyle } +} + +-- There should never be anything on the second line of a git commit message +-- so it is styled in a deliberately hideous color scheme. + { +.+ { c (const $ Style.withFg Style.red `mappend` Style.withBg Style.brown) } +$nl { m (const MessageLine) Style.defaultStyle } +} + +-- The body of a commit message is broken up as follows +-- * User's message +-- * git generated information in comments +-- * optional diff if commit was run with the -v option. + { +^@diffStart$ { m (const $ DiffDeclaration) Style.regexStyle } +\# { m (const $ LineComment) Style.commentStyle } +$commitChars*$ { c Style.defaultStyle } +$white { c Style.defaultStyle } +. { c Style.defaultStyle } +} + +-- Inside git generated comments specific information about what this +-- commit will do is displayed. Highlight keywords and filenames. +-- The notColon rule highlights filenames not preceded by keywords. +-- The specific keywords rules switch to context to highlight +-- everything to the end of the line (which should only ever be a filename.) + { +$nl { m (const MessageLine) Style.defaultStyle } +\t$notColon+$ { c Style.preprocessorStyle } +"modified:" { m (const Keyword) Style.keywordStyle } +"new file:" { m (const Keyword) Style.keywordStyle } +"deleted:" { m (const Keyword) Style.keywordStyle } +. { c Style.commentStyle } +} + + { +$nl { m (const MessageLine) Style.defaultStyle } +. { c Style.preprocessorStyle } +} + +-- Highlight diff lines + { +^@diffStart$ { c Style.regexStyle } +^\@\@.* { c Style.keywordStyle } +^\- .*$ { c Style.commentStyle } +^\+ .*$ { c Style.operatorStyle } +^.*$ { c Style.defaultStyle } +$white { c Style.defaultStyle } +. { c Style.defaultStyle } +} + +{ + +data HlState = Digest + | SecondLine + | Keyword + | MessageLine + | LineComment + | DiffDeclaration + deriving (Show, Eq) + +stateToInit Digest = 0 +stateToInit SecondLine = secondLine +stateToInit Keyword = keyword +stateToInit MessageLine = body +stateToInit DiffDeclaration = diff +stateToInit LineComment = lineComment + +initState :: HlState +initState = Digest + +type Token = StyleName + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Haskell.x b/src/Yi/Lexer/Haskell.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Haskell.x @@ -0,0 +1,264 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for illiterate Haskell 98. +-- +-- (c) Simon Marlow 2003, with the caveat that much of this is +-- translated directly from the syntax in the Haskell 98 report. +-- + +{ +{-# OPTIONS -w #-} +module Yi.Lexer.Haskell ( initState, alexScanToken, tokenToStyle, + tokenToText, + TT, isErrorTok, isSpecial, + startsLayout, isComment, Token(..), HlState, CommentType(..), ReservedType(..), OpType(..) ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@reservedid = + case|default|else|if| + infix|infixl|infixr| + then|family|foreign|export|dynamic| + safe|threadsafe|unsafe|stdcall|ccall|dotnet + +@varid = $small $idchar* [\#]? +@conid = $large $idchar* [\#]? +@anyid = (@varid | @conid) +@anyTHid = [$small $large] [$alpha $digit]* +@qual = (@conid ".")* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +haskell :- + +<0> $white+ ; + + { + "{-" { m (subtract 1) (Comment Open) } + "-}" { m (+1) (Comment Close) } + $white+ ; -- whitespace + [^\-\{]+ { c $ Comment Text } -- rule to generate comments larger than 1 char + . { c $ Comment Text } +} + +<0> { +-- The first rule matches operators that begin with --, eg --++-- is a valid +-- operator and *not* a comment. +-- Note that we have to dissallow '-' as a symbol char for the first one +-- of these because we may have -------- which would stilljust be the +-- start of a comment. + "--"\-* [$symbol # \-] $symchar* { cs Operator } +-- The next rule allows for the start of a comment basically +-- it is -- followed by anything which isn't a symbol character +-- (OR more '-'s). So for example "-----:" is still the start of a comment. + "--"~[$symbol # \-][^$nl]* { c $ Comment Line } +-- Finally because the above rule had to add in a non symbol character +-- it's also possible that we have just finishing a line, +-- people sometimes do this for example when breaking up paragraphs +-- in a long comment. + "--"$nl { c $ Comment Line } + + "{-" { m (subtract 1) $ Comment Open } + + ^"#".* { c $ CppDirective } + $special { cs $ \(c:_) -> Special c } + "deriving" { c (Reserved Deriving) } + "forall" { c (Reserved Forall) } + @reservedid { c (Reserved Other) } + "hiding" { c (Reserved Hiding) } + "module" { c (Reserved Module) } + "type" { c (Reserved Type) } + "newtype" { c (Reserved NewType) } + "as" { c (Reserved As) } + "import" { c (Reserved Import) } + "data" { c (Reserved Data) } + "where" { c (Reserved Where) } + "qualified" { c (Reserved Qualified) } + "let" { c (Reserved Let) } + "in" { c (Reserved In) } + "of" { c (Reserved Of) } + "do" | "mdo" { c (Reserved Do) } + "class" { c (Reserved Class) } + "instance" { c (Reserved Instance) } + `@qual @varid` { cs $ Operator . init . tail } + `@qual @conid` { cs $ ConsOperator . init . tail } + @qual @varid { c VarIdent } + @qual @conid { c ConsIdent } + + "|" { c (ReservedOp Pipe) } + "=" { c (ReservedOp Equal) } + \\ { c (ReservedOp BackSlash) } + "<-" { c (ReservedOp LeftArrow) } + "->" { c (ReservedOp RightArrow) } + ".." { c (ReservedOp DoubleDot) } + "@" { c (ReservedOp Arobase) } + "~" { c (ReservedOp Tilda) } + "=>" { c (ReservedOp DoubleRightArrow) } + "::" { c (ReservedOp DoubleColon) } + @qual @varsym { cs Operator } + @qual @consym { cs ConsOperator } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c Number } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c Number } + + \'\' @anyid { c THQuote } -- type + \' @anyTHid { c THQuote } -- expression + \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok } + \" @string* \" { c StringTok } + . { c Unrecognized } +} + +{ + +type HlState = Int + +data CommentType = Open | Close | Text | Line + deriving (Eq, Show) + +data ReservedType = Hiding | Qualified | As | Import | Data | NewType | Type | Where + | Let | In | Do | Of | OtherLayout | Deriving | Module | Forall | Other | Class | Instance + deriving (Eq, Show) + +data OpType = Pipe | Equal | BackSlash | LeftArrow | RightArrow | DoubleRightArrow | DoubleColon | DoubleDot | Arobase | Tilda + deriving (Eq, Show) + +data Token = Number | CharTok | StringTok | VarIdent | ConsIdent + | Reserved !ReservedType | ReservedOp !OpType | Special Char + | ConsOperator String | Operator String + | Comment !CommentType + | THQuote + | CppDirective | Unrecognized + deriving (Eq, Show) + +tokenToStyle :: Token -> StyleName +tokenToStyle tok = case tok of + CppDirective -> preprocessorStyle + Number -> numberStyle + CharTok -> stringStyle + StringTok -> stringStyle + VarIdent -> variableStyle + ConsIdent -> typeStyle + ReservedOp _ -> operatorStyle + Reserved Import -> importStyle + Reserved Qualified -> importStyle + Reserved As -> importStyle + Reserved Hiding -> importStyle + Reserved _ -> keywordStyle + Special _ -> defaultStyle + ConsOperator _ -> operatorStyle + Operator _ -> operatorStyle + Comment _ -> commentStyle + THQuote -> quoteStyle + Unrecognized -> errorStyle + +tokenToText :: Token -> Maybe String +tokenToText (ReservedOp BackSlash) = Just "λ" +tokenToText (ReservedOp RightArrow) = Just "→ " +tokenToText (ReservedOp DoubleRightArrow) = Just "⇒ " +tokenToText (ReservedOp LeftArrow) = Just "← " +tokenToText (ReservedOp DoubleColon) = Just "∷ " +-- missing: ++ >>= +tokenToText (Operator "*") = Just "×" +tokenToText (Operator "-") = Just "−" +-- tokenToText (Operator "-->") = Just " ⟶ " +tokenToText (Operator ".") = Just "·" +tokenToText (Operator "/=") = Just "≠ " +-- tokenToText (Operator "<--") = Just " ⟵ " +tokenToText (Operator "<-|") = Just " ↤ " +-- tokenToText (Operator "<<") = Just "⟪ " +tokenToText (Operator "<|") = Just "◃ " +tokenToText (Operator "<~") = Just "↜ " +tokenToText (Operator "==") = Just "≡ " +-- tokenToText (Operator "==>") = Just " ⟹ " +tokenToText (Operator "=?") = Just "≟ " +-- tokenToText (Operator ">>") = Just "⟫ " +tokenToText (Operator "|-->") = Just " ⟼ " +tokenToText (Operator "|->") = Just " ↦ " +tokenToText (Operator "|>") = Just "▹ " +tokenToText (Operator "~=") = Just "≃ " +tokenToText (Operator "~>") = Just "↝ " +tokenToText (Operator ">=") = Just "≥ " +tokenToText (Operator "<=") = Just "≤ " +tokenToText (Operator "-<") = Just "↢ " +tokenToText (Operator "&&") = Just "∧ " +tokenToText (Operator "||") = Just "∨ " +{- these are not operators +tokenToText (Operator "_|_") = Just " ⊥ " +tokenToText (Operator "exists") = Just " ∃ " +tokenToText (Operator "not") = Just " ¬ " +tokenToText (Operator "neg") = Just " ¬ " +-} +tokenToText (Reserved Forall) = Just " ∀ " +tokenToText _ = Nothing + +startsLayout (Reserved Do) = True +startsLayout (Reserved Of) = True +startsLayout (Reserved Where) = True +startsLayout (Reserved Let) = True +startsLayout (Reserved OtherLayout) = True +startsLayout _ = False + +isComment (Comment _) = True +isComment _ = False + +stateToInit x | x < 0 = nestcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +type TT = Tok Token + +isSpecial :: String -> Token -> Bool +isSpecial cs (Special c) = c `elem` cs +isSpecial _ _ = False + +isErrorTok :: Token -> Bool +isErrorTok = isSpecial "!" + + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/JSON.x b/src/Yi/Lexer/JSON.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/JSON.x @@ -0,0 +1,83 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for JSON +-- + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.JSON ( lexer, Token(..)) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}\:] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_] + +$graphic = [$small $large $symbol $digit $special \"\'] + +$nonzerodigit = 1-9 +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit] +$symchar = [$symbol] + +@digits = $nonzerodigit $digit* +@octits = "0" $octit +@hexits = "0x" $hexit + +@integer = @digits | @octits | @hexits +@longinteger = @integer +@number = @integer | @longinteger + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL + +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @number) +@string = $graphic # [\"\\] | " " | @escape + +json :- +<0> { + $white+ { c defaultStyle } + null { c keywordStyle } + \" @string* \" { c stringStyle } + @number + | @number \. @number? { c numberStyle } + . { c defaultStyle } +} + +{ + +type HlState = Int +type Token = StyleName + +stateToInit :: HlState -> Int +stateToInit x = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Java.x b/src/Yi/Lexer/Java.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Java.x @@ -0,0 +1,195 @@ +-- -*- haskell -*- +-- Simple lexer for c + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} -- Alex generate warnings-ridden code. +module Yi.Lexer.Java ( lexer ) where + +{- Standard Library Modules Imported -} +import Yi.Lexer.Alex hiding (tokenToStyle) + +{- External Library Modules Imported -} + +{- Local Modules Imported -} +import qualified Yi.Syntax +import Yi.Style + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@keywordid = + abstract + | assert + | break + | catch + | class + | case + | const + | continue + | default + | except + | extends + | else + | false + | finally + | goto + | final + | for + | if + | implements + | import + | instanceof + | interface + | long + | native + | new + | null + | package + | private + | protected + | public + | return + | static + | switch + | unsigned + | volatile + | while + | super + | switch + | synchronized + | this + | throw + | throws + | true + | transient + | try + | void + | volatile + | while + +@builtinTypes = + char + | byte + | boolean + | double + | enum + | float + | int + | long + | short + | void + | String + | Integer + | Float + | Double + | Long + +@reservedop = + "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | + "<" | "<=" | ">" | ">=" | "!=" | "==" | + "!" | "&&" | "||" | + "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | + "=" | "->" | "." | "," | "?" | ":" + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +java :- + +<0> $white+ { c defaultStyle } -- whitespace + + { + "*/" { m (+1) blockCommentStyle } + $white+ ; -- Whitespace + . { c blockCommentStyle } +} + +<0> { + "//"[^\n]* { c commentStyle } + + "/*" @reservedop* { m (subtract 1) blockCommentStyle } + + $special { c defaultStyle } + + @keywordid { c keywordStyle } + @builtinTypes { c typeStyle } + @varid { c defaultStyle } + @conid { c typeStyle } + + @reservedop { c operatorStyle } + @varsym { c operatorStyle } + @consym { c typeStyle } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c defaultStyle } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c defaultStyle } + + \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } + \" @string* \" { c stringStyle } + . { c operatorStyle } +} + + +{ + +type HlState = Int +type Token = StyleName + +stateToInit :: HlState -> Int +stateToInit x | x < 0 = nestcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/JavaScript.x b/src/Yi/Lexer/JavaScript.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/JavaScript.x @@ -0,0 +1,281 @@ +-- -*- haskell -*- +-- +-- Simple lexer for JavaScript 1.7 +-- (C) Copyright 2009 Deniz Dogan +-- +-- Note that this mode is for JavaScript 1.7, i.e. Mozilla, not ECMAScript, nor +-- JScript, but it does take much of its information from the ECMAScript +-- specification. +-- +-- Things about JavaScript deserve to be mentioned: +-- * JavaScript explicitly forbids nested comments, so we don't have to care +-- about the "level" of nesting in multiline comments +-- * JavaScript supports making variables for which the name clashes with +-- constructors, e.g. Array, but you cannot use "new Array()" to create an +-- array if you do that. +-- +-- Sources for reserved words: +-- https://developer.mozilla.org/En/Core_JavaScript_1.5_Reference/Reserved_Words +-- https://developer.mozilla.org/en/New_in_JavaScript_1.6 +-- https://developer.mozilla.org/en/New_in_JavaScript_1.7 +-- +-- Sources for the general syntax: +-- http://en.wikipedia.org/wiki/JavaScript_syntax +-- http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-262.pdf + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} + +module Yi.Lexer.JavaScript ( initState, alexScanToken, tokenToStyle, + TT, Token(..), Reserved(..), Operator(..), + HlState, prefixOperators, infixOperators, + postfixOperators ) where + +import Data.Monoid (Endo(..)) +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style + +} + +$whitechar = [\ \t\n\r\f\v] + +@builtin = true | false | null | undefined +@reservedid = break | case | catch | continue | default | delete | do | else + | finally | for | function | if | in | instanceof | new | return + | switch | this | throw | try | typeof | var | void | while | with + | @builtin + +@ops = "+" | "-" | "*" | "/" | "%" | "++" | "--" | "=" | "+=" + | "-=" | "*=" | "/=" | "%=" | "==" | "!=" | ">" | ">=" | "<" + | "<=" | "===" | "!==" | "&&" |"||" | "!" | "&" | "|" | "^" + | "<<" | ">>" | ">>>" | "~" | "." + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff] +$special = [\(\)\,\;\[\]\{\}\:\?] + +$digit = 0-9 +$hexit = [0-9 A-F a-f] +@decimal = $digit+ +@hexal = "0x" $hexit+ + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\@\\\^\|\-\~\_] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \:\"\'] +$graphic = [$small $large $symbol $digit $special \:\"\'] +$name = [a-zA-Z0-9\_\$] -- Valid characters for a "name" + +-- Octals are sort of "implicit" in JavaScript. "0307" is a valid octal, but +-- "0309" is the exact same thing as "309." Since we don't make any distinction +-- between different types of numbers, we completely disregard octals here, they +-- Just Work (tm). +@number = @decimal | @hexal +@gap = \\ $whitechar +@string1 = $graphic # [\"\\] | " " | @gap +@string2 = $graphic # [\'\\] | " " | @gap + +-- @varid represents valid names for variables and functions. +@varid = [$name # [0-9A-Z]] $name* +@const = [$name # [0-9a-z]] $name* -- Constants and constructors + +haskell :- + +<0> { + +$whitechar+ ; +$special { cs $ (Special . head) } -- All of the special symbols are characters + +@number { cs $ Number } +@ops { cs $ (Op . opToOp) } +@reservedid { cs $ (Res . resToRes) } +@varid { cs $ ValidName } +@const { cs $ Const } + +\" @string1* \" { cs $ Str } +\' @string2* \' { cs $ Str } +\/ [^\/]+ \/ { cs $ Rex } +"//".* { c $ Comment Line } +"/*" { m (subtract 1) $ Comment Start } +"" { m (subtract 1) $ Comment End } +$whitechar+ ; +[^\-] { c $ Comment Text } +. { c $ Comment Text } +} + + +{ + +type TT = Tok Token + +-- | The @Line@ constructor represents a single-line comment. @Start@ and @End@ +-- represent the start and end of a multi-line comment, respectively. @Text@ +-- represents the text in a multi-line comment. +data CommentType = Line | Start | End | Text + deriving (Show, Eq) + +-- | The constructors for @Reserved@ have an apostrophe as a suffix because +-- @Default@ is already used. Also note that @Undefined'@ is not intended as +-- some sort of "backup" reserved word for things we don't care about -- it +-- really means the "undefined" built-in in JavaScript. +data Reserved = Break' | Case' | Catch' | Continue' | Default' | Delete' | Do' + | Else' | Finally' | For' | Function' | If' | In' | InstanceOf' + | New' | Return' | Switch' | This' | Throw' | Try' | TypeOf' + | Var' | Void' | While' | With' | True' | False' | Null' + | Undefined' + deriving (Show, Eq) + +-- | The constructors for @Operator@ have an apostrophe as a suffix because +-- e.g. @LT@ is already used by @Prelude@. +data Operator = Add' | Subtract' | Multiply' | Divide' | Modulo' | Increment' + | Decrement' | Assign' | AddAssign' | SubtractAssign' + | MultiplyAssign' | DivideAssign' | ModuloAssign' | Equals' + | NotEquals' | GT' | GTE' | LT' | LTE' | EqualsType' + | NotEqualsType' | And' | Or' | Not' | BitAnd' | BitOr' | BitXor' + | LeftShift' | RightShift' | RightShiftZ' | BitNot' | Qualify' + deriving (Show, Eq) + +-- | Prefix operators. NOTE: Add' is also a valid prefix operator, but since +-- it's completely useless in the real world, we don't care about it here. +-- Doing this makes parsing much, much easier. +prefixOperators = [ Subtract', Increment', Decrement', BitNot', Not' ] + +-- | Postfix operators. +postfixOperators = [ Increment', Decrement' ] + +-- | Infix operators. +infixOperators = [ Add', Subtract', Multiply', Divide', Modulo', Assign', + AddAssign', SubtractAssign', MultiplyAssign', DivideAssign', + ModuloAssign', Equals', NotEquals', GT', GTE', LT', LTE', + EqualsType', NotEqualsType', And', Or', BitAnd', BitOr', + BitXor', LeftShift', RightShift', RightShiftZ', Qualify' ] + +-- | @HlState@ is 0 when outside of a multi-line comment and -1 when inside one. +type HlState = Int + +-- | The different tokens. +data Token = Unknown + | Res !Reserved + | Str !String + | Rex !String + | Op !Operator + | Special !Char + | Number !String + | ValidName !String + | Comment !CommentType + | Const !String + deriving (Show, Eq) + +stateToInit x | x < 0 = multicomm + | x > 0 = htmlcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +-- | Takes a 'Token' and returns a style to be used for that type of token. +-- +-- TODO: The `elem` check is potentially unnecessarily slow. We could split +-- the Const constructor into two different ones, one for builtins and one for +-- others. +tokenToStyle (Comment Line) = commentStyle +tokenToStyle (Comment _) = blockCommentStyle +tokenToStyle (Const x) | x `elem` builtinConstructors = builtinStyle + | otherwise = typeStyle +tokenToStyle (Number _) = numberStyle +tokenToStyle (Res _) = keywordStyle +tokenToStyle (Str _) = stringStyle +tokenToStyle (Rex _) = regexStyle +tokenToStyle Unknown = errorStyle +tokenToStyle _ = defaultStyle + +builtinConstructors :: [String] +builtinConstructors = [ "Array", "String", "RegExp", "Function", "Date" + , "Boolean", "Object" ] + +-- | Given a @String@ representing an operator, returns an 'Operator' with the +-- appropriate constructor. +opToOp :: String -> Operator +opToOp "+" = Add' +opToOp "-" = Subtract' +opToOp "*" = Multiply' +opToOp "/" = Divide' +opToOp "%" = Modulo' +opToOp "++" = Increment' +opToOp "--" = Decrement' +opToOp "=" = Assign' +opToOp "+=" = AddAssign' +opToOp "-=" = SubtractAssign' +opToOp "*=" = MultiplyAssign' +opToOp "/=" = DivideAssign' +opToOp "%=" = ModuloAssign' +opToOp "==" = Equals' +opToOp "!=" = NotEquals' +opToOp ">" = GT' +opToOp ">=" = GTE' +opToOp "<" = LT' +opToOp "<=" = LTE' +opToOp "===" = EqualsType' +opToOp "!==" = NotEqualsType' +opToOp "&&" = And' +opToOp "||" = Or' +opToOp "!" = Not' +opToOp "&" = BitAnd' +opToOp "|" = BitOr' +opToOp "^" = BitXor' +opToOp "<<" = LeftShift' +opToOp ">>" = RightShift' +opToOp ">>>" = RightShiftZ' +opToOp "~" = BitNot' +opToOp "." = Qualify' + +-- | Given a @String@ representing a reserved word, returns a 'Reserved' with +-- the appropriate constructor. +resToRes :: String -> Reserved +resToRes "break" = Break' +resToRes "case" = Case' +resToRes "catch" = Catch' +resToRes "continue" = Continue' +resToRes "default" = Default' +resToRes "delete" = Delete' +resToRes "do" = Do' +resToRes "else" = Else' +resToRes "finally" = Finally' +resToRes "for" = For' +resToRes "function" = Function' +resToRes "if" = If' +resToRes "in" = In' +resToRes "instanceof" = InstanceOf' +resToRes "new" = New' +resToRes "return" = Return' +resToRes "switch" = Switch' +resToRes "this" = This' +resToRes "throw" = Throw' +resToRes "try" = Try' +resToRes "typeof" = TypeOf' +resToRes "var" = Var' +resToRes "void" = Void' +resToRes "while" = While' +resToRes "with" = With' +resToRes "true" = True' +resToRes "false" = False' +resToRes "null" = Null' +resToRes "undefined" = Undefined' + +#include "common.hsinc" + +} diff --git a/src/Yi/Lexer/Latex.x b/src/Yi/Lexer/Latex.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Latex.x @@ -0,0 +1,388 @@ +-- -*- haskell -*- +-- +-- Simple syntax highlighting for Latex source files +-- +-- This is not intended to be a lexical analyser for +-- latex, merely good enough to provide some syntax +-- highlighting for latex source files. +-- + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Latex ( initState, alexScanToken, Token(..), HlState, tokenToText ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style +} + +$special = [\[\]\{\}\$\\\%\(\)\ ] +$textChar = [~$special $white] +$idchar = [a-zA-Z 0-9_\-] + +@reservedid = begin|end|newcommand +@ident = $idchar+ +@text = $textChar+ + +haskell :- + + "%"\-*[^\n]* { c $ Comment } + $special { cs $ \(c:_) -> Special c } + \\"begin{"@ident"}" { cs $ \s -> Begin (drop 6 s) } + \\"end{"@ident"}" { cs $ \s -> End (drop 4 s) } + \\$special { cs $ \(_:cs) -> Command cs } + \\newcommand { c $ NewCommand } + \\@ident { cs $ \(_:cs) -> Command cs } + @text { c $ Text } + + +{ + +data Token = Comment | Text | Special !Char | Command !String | Begin !String | End !String | NewCommand + deriving (Eq, Show, Ord) + +type HlState = Int + +{- See Haskell.x which uses this to say whether we are in a + comment (perhaps a nested comment) or not. +-} +stateToInit x = 0 + +initState :: HlState +initState = 0 + +tokenToText (Command "alpha") = Just "α" +tokenToText (Command "beta") = Just "β" +tokenToText (Command "gamma") = Just "γ" +tokenToText (Command "delta") = Just "δ" +tokenToText (Command "epsilon") = Just "∊" +tokenToText (Command "varepsilon") = Just "ε" +tokenToText (Command "zeta") = Just "ζ" +tokenToText (Command "eta") = Just "η" +tokenToText (Command "theta") = Just "θ" +tokenToText (Command "vartheta") = Just "ϑ" +tokenToText (Command "iota") = Just "ι" +tokenToText (Command "kappa") = Just "κ" +tokenToText (Command "lambda") = Just "λ" +tokenToText (Command "mu") = Just "μ" +tokenToText (Command "nu") = Just "ν" +tokenToText (Command "xi") = Just "ξ" +tokenToText (Command "pi") = Just "π" +tokenToText (Command "varpi") = Just "ϖ" +tokenToText (Command "rho") = Just "ρ" +tokenToText (Command "varrho") = Just "ϱ" +tokenToText (Command "sigma") = Just "σ" +tokenToText (Command "varsigma") = Just "ς" +tokenToText (Command "tau") = Just "τ" +tokenToText (Command "upsilon") = Just "υ" +tokenToText (Command "phi") = Just "φ" +tokenToText (Command "varphi") = Just "ϕ" +tokenToText (Command "chi") = Just "χ" +tokenToText (Command "psi") = Just "ψ" +tokenToText (Command "omega") = Just "ω" +tokenToText (Command "Gamma") = Just "Γ" +tokenToText (Command "Delta") = Just "Δ" +tokenToText (Command "Theta") = Just "Θ" +tokenToText (Command "Lambda") = Just "Λ" +tokenToText (Command "Xi") = Just "Ξ" +tokenToText (Command "Pi") = Just "Π" +tokenToText (Command "Upsilon") = Just "Υ" +tokenToText (Command "Phi") = Just "Φ" +tokenToText (Command "Psi") = Just "Ψ" +tokenToText (Command "Omega") = Just "Ω" +tokenToText (Command "leq") = Just "≤" +tokenToText (Command "ll") = Just "≪" +tokenToText (Command "prec") = Just "≺" +tokenToText (Command "preceq") = Just "≼" +tokenToText (Command "subset") = Just "⊂" +tokenToText (Command "subseteq") = Just "⊆" +tokenToText (Command "sqsubset") = Just "⊏" +tokenToText (Command "sqsubseteq") = Just "⊑" +tokenToText (Command "in") = Just "∈" +tokenToText (Command "vdash") = Just "⊢" +tokenToText (Command "mid") = Just "∣" +tokenToText (Command "smile") = Just "⌣" +tokenToText (Command "geq") = Just "≥" +tokenToText (Command "gg") = Just "≫" +tokenToText (Command "succ") = Just "≻" +tokenToText (Command "succeq") = Just "≽" +tokenToText (Command "supset") = Just "⊃" +tokenToText (Command "supseteq") = Just "⊇" +tokenToText (Command "sqsupset") = Just "⊐" +tokenToText (Command "sqsupseteq") = Just "⊒" +tokenToText (Command "ni") = Just "∋" +tokenToText (Command "dashv") = Just "⊣" +tokenToText (Command "parallel") = Just "∥" +tokenToText (Command "frown") = Just "⌢" +tokenToText (Command "notin") = Just "∉" +tokenToText (Command "equiv") = Just "≡" +tokenToText (Command "doteq") = Just "≐" +tokenToText (Command "sim") = Just "∼" +tokenToText (Command "simeq") = Just "≃" +tokenToText (Command "approx") = Just "≈" +tokenToText (Command "cong") = Just "≅" +tokenToText (Command "Join") = Just "⋈" +tokenToText (Command "bowtie") = Just "⋈" +tokenToText (Command "propto") = Just "∝" +tokenToText (Command "models") = Just "⊨" +tokenToText (Command "perp") = Just "⊥" +tokenToText (Command "asymp") = Just "≍" +tokenToText (Command "neq") = Just "≠" +tokenToText (Command "pm") = Just "±" +tokenToText (Command "cdot") = Just "⋅" +tokenToText (Command "times") = Just "×" +tokenToText (Command "cup") = Just "∪" +tokenToText (Command "sqcup") = Just "⊔" +tokenToText (Command "vee") = Just "∨" +tokenToText (Command "oplus") = Just "⊕" +tokenToText (Command "odot") = Just "⊙" +tokenToText (Command "otimes") = Just "⊗" +tokenToText (Command "bigtriangleup") = Just "△" +tokenToText (Command "lhd") = Just "⊲" +tokenToText (Command "unlhd") = Just "⊴" +tokenToText (Command "mp") = Just "∓" +tokenToText (Command "div") = Just "÷" +tokenToText (Command "setminus") = Just "∖" +tokenToText (Command "cap") = Just "∩" +tokenToText (Command "sqcap") = Just "⊓" +tokenToText (Command "wedge") = Just "∧" +tokenToText (Command "ominus") = Just "⊖" +tokenToText (Command "oslash") = Just "⊘" +tokenToText (Command "bigcirc") = Just "○" +tokenToText (Command "bigtriangledown") = Just "▽" +tokenToText (Command "rhd") = Just "⊳" +tokenToText (Command "unrhd") = Just "⊵" +tokenToText (Command "triangleleft") = Just "◁" +tokenToText (Command "triangleright") = Just "▷" +tokenToText (Command "star") = Just "⋆" +tokenToText (Command "ast") = Just "∗" +tokenToText (Command "circ") = Just "∘" +tokenToText (Command "bullet") = Just "∙" +tokenToText (Command "diamond") = Just "⋄" +tokenToText (Command "uplus") = Just "⊎" +tokenToText (Command "dagger") = Just "†" +tokenToText (Command "ddagger") = Just "‡" +tokenToText (Command "wr") = Just "≀" +tokenToText (Command "sum") = Just "∑" +tokenToText (Command "prod") = Just "∏" +tokenToText (Command "coprod") = Just "∐" +tokenToText (Command "int") = Just "∫" +tokenToText (Command "bigcup") = Just "⋃" +tokenToText (Command "bigcap") = Just "⋂" +tokenToText (Command "bigsqcup") = Just "⊔" +tokenToText (Command "oint") = Just "∮" +tokenToText (Command "bigvee") = Just "⋁" +tokenToText (Command "bigwedge") = Just "⋀" +tokenToText (Command "bigoplus") = Just "⊕" +tokenToText (Command "bigotimes") = Just "⊗" +tokenToText (Command "bigodot") = Just "⊙" +tokenToText (Command "biguplus") = Just "⊎" +tokenToText (Command "leftarrow") = Just "←" +tokenToText (Command "rightarrow") = Just "→" +tokenToText (Command "leftrightarrow") = Just "↔" +tokenToText (Command "Leftarrow") = Just "⇐" +tokenToText (Command "Rightarrow") = Just "⇒" +tokenToText (Command "Leftrightarrow") = Just "⇔" +tokenToText (Command "mapsto") = Just "↦" +tokenToText (Command "hookleftarrow") = Just "↩" +tokenToText (Command "leftharpoonup") = Just "↼" +tokenToText (Command "leftharpoondown") = Just "↽" +tokenToText (Command "hookrightarrow") = Just "↪" +tokenToText (Command "rightharpoonup") = Just "⇀" +tokenToText (Command "rightharpoondown") = Just "⇁" +tokenToText (Command "longleftarrow") = Just "←" +tokenToText (Command "longrightarrow") = Just "→" +tokenToText (Command "longleftrightarrow") = Just "↔" +tokenToText (Command "Longleftarrow") = Just "⇐" +tokenToText (Command "Longrightarrow") = Just "⇒" +tokenToText (Command "Longleftrightarrow") = Just "⇔" +tokenToText (Command "longmapsto") = Just "⇖" +tokenToText (Command "uparrow") = Just "↑" +tokenToText (Command "downarrow") = Just "↓" +tokenToText (Command "updownarrow") = Just "↕" +tokenToText (Command "Uparrow") = Just "⇑" +tokenToText (Command "Downarrow") = Just "⇓" +tokenToText (Command "Updownarrow") = Just "⇕" +tokenToText (Command "nearrow") = Just "↗" +tokenToText (Command "searrow") = Just "↘" +tokenToText (Command "swarrow") = Just "↙" +tokenToText (Command "nwarrow") = Just "↖" +tokenToText (Command "leadsto") = Just "↝" +tokenToText (Command "dots") = Just "…" +tokenToText (Command "cdots") = Just "⋯" +tokenToText (Command "vdots") = Just "⋮" +tokenToText (Command "ddots") = Just "⋱" +tokenToText (Command "hbar") = Just "ℏ" +tokenToText (Command "ell") = Just "ℓ" +tokenToText (Command "Re") = Just "ℜ" +tokenToText (Command "Im") = Just "ℑ" +tokenToText (Command "aleph") = Just "א" +tokenToText (Command "wp") = Just "℘" +tokenToText (Command "forall") = Just "∀" +tokenToText (Command "exists") = Just "∃" +tokenToText (Command "mho") = Just "℧" +tokenToText (Command "partial") = Just "∂" +tokenToText (Command "prime") = Just "′" +tokenToText (Command "emptyset") = Just "∅" +tokenToText (Command "infty") = Just "∞" +tokenToText (Command "nabla") = Just "∇" +tokenToText (Command "triangle") = Just "△" +tokenToText (Command "Box") = Just "□" +tokenToText (Command "Diamond") = Just "◇" +tokenToText (Command "bot") = Just "⊥" +tokenToText (Command "top") = Just "⊤" +tokenToText (Command "angle") = Just "∠" +tokenToText (Command "surd") = Just "√" +tokenToText (Command "diamondsuit") = Just "♢" +tokenToText (Command "heartsuit") = Just "♡" +tokenToText (Command "clubsuit") = Just "♣" +tokenToText (Command "spadesuit") = Just "♠" +tokenToText (Command "neg") = Just "¬" +tokenToText (Command "flat") = Just "♭" +tokenToText (Command "natural") = Just "♮" +tokenToText (Command "sharp") = Just "♯" +tokenToText (Command "digamma") = Just "Ϝ" +tokenToText (Command "varkappa") = Just "ϰ" +tokenToText (Command "beth") = Just "ב" +tokenToText (Command "daleth") = Just "ד" +tokenToText (Command "gimel") = Just "ג" +tokenToText (Command "lessdot") = Just "⋖" +tokenToText (Command "leqslant") = Just "≤" +tokenToText (Command "leqq") = Just "≦" +tokenToText (Command "lll") = Just "⋘" +tokenToText (Command "lesssim") = Just "≲" +tokenToText (Command "lessgtr") = Just "≶" +tokenToText (Command "lesseqgtr") = Just "⋚" +tokenToText (Command "preccurlyeq") = Just "≼" +tokenToText (Command "curlyeqprec") = Just "⋞" +tokenToText (Command "precsim") = Just "≾" +tokenToText (Command "Subset") = Just "⋐" +tokenToText (Command "sqsubset") = Just "⊏" +tokenToText (Command "therefore") = Just "∴" +tokenToText (Command "smallsmile") = Just "⌣" +tokenToText (Command "vartriangleleft") = Just "⊲" +tokenToText (Command "trianglelefteq") = Just "⊴" +tokenToText (Command "gtrdot") = Just "⋗" +tokenToText (Command "geqq") = Just "≧" +tokenToText (Command "ggg") = Just "⋙" +tokenToText (Command "gtrsim") = Just "≳" +tokenToText (Command "gtrless") = Just "≷" +tokenToText (Command "gtreqless") = Just "⋛" +tokenToText (Command "succcurlyeq") = Just "≽" +tokenToText (Command "curlyeqsucc") = Just "⋟" +tokenToText (Command "succsim") = Just "≿" +tokenToText (Command "Supset") = Just "⋑" +tokenToText (Command "sqsupset") = Just "⊐" +tokenToText (Command "because") = Just "∵" +tokenToText (Command "shortparallel") = Just "∥" +tokenToText (Command "smallfrown") = Just "⌢" +tokenToText (Command "vartriangleright") = Just "⊳" +tokenToText (Command "trianglerighteq") = Just "⊵" +tokenToText (Command "doteqdot") = Just "≑" +tokenToText (Command "risingdotseq") = Just "≓" +tokenToText (Command "fallingdotseq") = Just "≒" +tokenToText (Command "eqcirc") = Just "≖" +tokenToText (Command "circeq") = Just "≗" +tokenToText (Command "triangleq") = Just "≜" +tokenToText (Command "bumpeq") = Just "≏" +tokenToText (Command "Bumpeq") = Just "≎" +tokenToText (Command "thicksim") = Just "∼" +tokenToText (Command "thickapprox") = Just "≈" +tokenToText (Command "approxeq") = Just "≊" +tokenToText (Command "backsim") = Just "∽" +tokenToText (Command "vDash") = Just "⊨" +tokenToText (Command "Vdash") = Just "⊩" +tokenToText (Command "Vvdash") = Just "⊪" +tokenToText (Command "backepsilon") = Just "∍" +tokenToText (Command "varpropto") = Just "∝" +tokenToText (Command "between") = Just "≬" +tokenToText (Command "pitchfork") = Just "⋔" +tokenToText (Command "blacktriangleleft") = Just "◀" +tokenToText (Command "blacktriangleright") = Just "▷" +tokenToText (Command "dashleftarrow") = Just "⇠" +tokenToText (Command "leftleftarrows") = Just "⇇" +tokenToText (Command "leftrightarrows") = Just "⇆" +tokenToText (Command "Lleftarrow") = Just "⇚" +tokenToText (Command "twoheadleftarrow") = Just "↞" +tokenToText (Command "leftarrowtail") = Just "↢" +tokenToText (Command "leftrightharpoons") = Just "⇋" +tokenToText (Command "Lsh") = Just "↰" +tokenToText (Command "looparrowleft") = Just "↫" +tokenToText (Command "curvearrowleft") = Just "↶" +tokenToText (Command "circlearrowleft") = Just "↺" +tokenToText (Command "dashrightarrow") = Just "⇢" +tokenToText (Command "rightrightarrows") = Just "⇉" +tokenToText (Command "rightleftarrows") = Just "⇄" +tokenToText (Command "Rrightarrow") = Just "⇛" +tokenToText (Command "twoheadrightarrow") = Just "↠" +tokenToText (Command "rightarrowtail") = Just "↣" +tokenToText (Command "rightleftharpoons") = Just "⇌" +tokenToText (Command "Rsh") = Just "↱" +tokenToText (Command "looparrowright") = Just "↬" +tokenToText (Command "curvearrowright") = Just "↷" +tokenToText (Command "circlearrowright") = Just "↻" +tokenToText (Command "multimap") = Just "⊸" +tokenToText (Command "upuparrows") = Just "⇈" +tokenToText (Command "downdownarrows") = Just "⇊" +tokenToText (Command "upharpoonleft") = Just "↿" +tokenToText (Command "upharpoonright") = Just "↾" +tokenToText (Command "downharpoonleft") = Just "⇃" +tokenToText (Command "downharpoonright") = Just "⇂" +tokenToText (Command "rightsquigarrow") = Just "⇝" +tokenToText (Command "leftrightsquigarrow") = Just "↭" +tokenToText (Command "dotplus") = Just "∔" +tokenToText (Command "ltimes") = Just "⋉" +tokenToText (Command "Cup") = Just "⋓" +tokenToText (Command "veebar") = Just "⊻" +tokenToText (Command "boxplus") = Just "⊞" +tokenToText (Command "boxtimes") = Just "⊠" +tokenToText (Command "leftthreetimes") = Just "⋋" +tokenToText (Command "curlyvee") = Just "⋎" +tokenToText (Command "centerdot") = Just "⋅" +tokenToText (Command "rtimes") = Just "⋈" +tokenToText (Command "Cap") = Just "⋒" +tokenToText (Command "barwedge") = Just "⊼" +tokenToText (Command "boxminus") = Just "⊟" +tokenToText (Command "boxdot") = Just "⊡" +tokenToText (Command "rightthreetimes") = Just "⋌" +tokenToText (Command "curlywedge") = Just "⋏" +tokenToText (Command "intercal") = Just "⊺" +tokenToText (Command "divideontimes") = Just "⋇" +tokenToText (Command "smallsetminus") = Just "∖" +tokenToText (Command "circleddash") = Just "⊝" +tokenToText (Command "circledcirc") = Just "⊚" +tokenToText (Command "circledast") = Just "⊛" +tokenToText (Command "hbar") = Just "ℏ" +tokenToText (Command "hslash") = Just "ℏ" +tokenToText (Command "square") = Just "□" +tokenToText (Command "blacksquare") = Just "■" +tokenToText (Command "circledS") = Just "Ⓢ" +tokenToText (Command "vartriangle") = Just "△" +tokenToText (Command "blacktriangle") = Just "▲" +tokenToText (Command "complement") = Just "∁" +tokenToText (Command "triangledown") = Just "▽" +tokenToText (Command "blacktriangledown") = Just "▼" +tokenToText (Command "lozenge") = Just "◊" +tokenToText (Command "blacklozenge") = Just "◆" +tokenToText (Command "bigstar") = Just "★" +tokenToText (Command "angle") = Just "∠" +tokenToText (Command "measuredangle") = Just "∡" +tokenToText (Command "sphericalangle") = Just "∢" +tokenToText (Command "backprime") = Just "‵" +tokenToText (Command "nexists") = Just "∄" +tokenToText (Command "Finv") = Just "Ⅎ" +tokenToText (Command "varnothing") = Just "∅" +tokenToText (Command "eth") = Just "ð" +tokenToText (Command "mho") = Just "℧" +tokenToText (Command "AA") = Just "Å" +tokenToText (Command "euro") = Just "€" +tokenToText (Command "degree") = Just "°" +tokenToText (Command "lnot") = Just "¬" +tokenToText (Command "textdegree") = Just "°" +tokenToText (Command "textlnot") = Just "¬" +tokenToText (Command "textsurd") = Just "√" +tokenToText (Command "textdiv") = Just "÷" +tokenToText (Command "textpm") = Just "±" +tokenToText _ = Nothing + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/LiterateHaskell.x b/src/Yi/Lexer/LiterateHaskell.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/LiterateHaskell.x @@ -0,0 +1,224 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for literate Haskell 98. +-- +-- (c) Simon Marlow 2003, with the caveat that much of this is +-- translated directly from the syntax in the Haskell 98 report. +-- +-- Adapted to literate Haskell 98 by Nicolas Pouillard +-- + +{ +{-# OPTIONS -w #-} +module Yi.Lexer.LiterateHaskell ( initState, alexScanToken, HlState ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Lexer.Haskell hiding (initState, alexScanToken, HlState) +import Yi.Style +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@reservedid = + as|case|class|data|default|else|hiding|if| + import|in|infix|infixl|infixr|instance|newtype| + qualified|then|type|family|foreign|export|dynamic| + safe|threadsafe|unsafe|stdcall|ccall|dotnet + +@layoutReservedId = + of|let|do|mdo + + +@reservedop = + ".." | ":" | "::" | "=" | \\ | "|" | "<-" | "->" | "@" | "~" | "=>" + +@varid = $small $idchar* +@conid = $large $idchar* +@qual = (@conid ".")* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +haskell :- + +<0> $white+ ; + + { + "{-" { m CommentBlock (Comment Open) } + "-}" { m unComment (Comment Close) } + $white+ ; -- whitespace + [^\-\{]+ { c $ Comment Text } -- rule to generate comments larger than 1 char + . { c $ Comment Text } +} + +<0> { + ^ "\begin{code}" { m (const CodeBlock) $ Reserved Other } + ^ ">" { ms (const CodeLine) Operator } + $white+ ; -- whitespace + . { c $ Comment Text {-LaTeX-} } +} + + { + "\end{code}" { m (const LaTeXBlock) $ Reserved Other } + + $white+ ; -- whitespace + +-- The first rule matches operators that begin with --, eg --++-- is a valid +-- operator and *not* a comment. +-- Note that we have to dissallow '-' as a symbol char for the first one +-- of these because we may have -------- which would stilljust be the +-- start of a comment. + "--"\-* [$symbol # \-] $symchar* { cs Operator } +-- The next rule allows for the start of a comment basically +-- it is -- followed by anything which isn't a symbol character +-- (OR more '-'s). So for example "-----:" is still the start of a comment. + "--"~[$symbol # \-][^$nl]* { c $ Comment Line } +-- Finally because the above rule had to add in a non symbol character +-- it's also possible that we have just finishing a line, +-- people sometimes do this for example when breaking up paragraphs +-- in a long comment. + "--"$nl { c $ Comment Line } + + "{-" { m CommentBlock $ Comment Open } + + ^"#".* { c $ CppDirective } + $special { cs $ \(c:_) -> Special c } + "deriving" { c (Reserved Deriving) } + "forall" { c (Reserved Forall) } + @reservedid { c (Reserved Other) } + "module" { c (Reserved Module) } + "where" { c (Reserved Where) } + @layoutReservedId { c (Reserved OtherLayout) } + `@qual @varid` { cs $ Operator . init . tail } + `@qual @conid` { cs $ ConsOperator . init . tail } + @qual @varid { c VarIdent } + @qual @conid { c ConsIdent } + + "|" { c (ReservedOp Pipe) } + "=" { c (ReservedOp Equal) } + \\ { c (ReservedOp BackSlash) } + "<-" { c (ReservedOp LeftArrow) } + "->" { c (ReservedOp RightArrow) } + "=>" { c (ReservedOp DoubleRightArrow) } + ".." { c (ReservedOp DoubleDot) } + "@" { c (ReservedOp Arobase) } + "~" { c (ReservedOp Tilda) } + "=>" { c (ReservedOp DoubleRightArrow) } + "::" { c (ReservedOp DoubleColon) } + @qual @varsym { cs Operator } + @qual @consym { cs ConsOperator } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c Number } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c Number } + + \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok } + \" @string* \" { c StringTok } + . { c Unrecognized } +} + + { + [\t\n\r\f\v]+ { m (const LaTeXBlock) $ Reserved Other } + + [\ \t]+ ; -- whitespace + +-- Same three rules for line comments as above (see above for explanation). + "--"\-* [$symbol # \-] $symchar* { cs Operator } + "--"~[$symbol # \-][^$nl]* { c $ Comment Line } + "--"$nl { c $ Comment Line } + + "{-" { m CommentBlock $ Comment Open } + + ^"#".* { c $ CppDirective } + $special { cs $ \(c:_) -> Special c } + "deriving" { c (Reserved Deriving) } + "forall" { c (Reserved Forall) } + @reservedid { c (Reserved Other) } + "module" { c (Reserved Module) } + "where" { c (Reserved Where) } + @layoutReservedId { c (Reserved OtherLayout) } + `@qual @varid` { cs $ Operator . init . tail } + `@qual @conid` { cs $ ConsOperator . init . tail } + @qual @varid { c VarIdent } + @qual @conid { c ConsIdent } + + "|" { c (ReservedOp Pipe) } + "=" { c (ReservedOp Equal) } + \\ { c (ReservedOp BackSlash) } + "<-" { c (ReservedOp LeftArrow) } + "->" { c (ReservedOp RightArrow) } + "=>" { c (ReservedOp DoubleRightArrow) } + ".." { c (ReservedOp DoubleDot) } + "@" { c (ReservedOp Arobase) } + "~" { c (ReservedOp Tilda) } + "=>" { c (ReservedOp DoubleRightArrow) } + "::" { c (ReservedOp DoubleColon) } + @qual @varsym { cs Operator } + @qual @consym { cs ConsOperator } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c Number } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c Number } + + \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok } + \" @string* \" { c StringTok } + . { c Unrecognized } +} + +{ + +data HlState = CodeBlock + | CodeLine + | CommentBlock { unComment :: HlState } + | LaTeXBlock + deriving (Eq, Show) + +stateToInit (CommentBlock _) = nestcomm +stateToInit CodeBlock = codeBlock +stateToInit CodeLine = codeLine +stateToInit LaTeXBlock = 0 + +initState = LaTeXBlock + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/OCaml.x b/src/Yi/Lexer/OCaml.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/OCaml.x @@ -0,0 +1,152 @@ +-- -*- haskell -*- +-- +-- Lexical syntax for OCaml +-- +-- (c) Nicolas Pouillard 2008 +-- + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.OCaml ( lexer, Token(..) ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] -- OCAML CHECK + +$digit = 0-9 + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] -- OCAML CHECK +$symbol = $ascsymbol # [$special \_\:\"\'] -- OCAML CHECK + +$large = [A-Z \xc0-\xd6 \xd8-\xde] -- OCAML CHECK +$small = [a-z \xdf-\xf6 \xf8-\xff \_] -- OCAML CHECK +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] -- OCAML CHECK + +$bit = 0-1 +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] -- OCAML CHECK +$nl = [\n\r] + +@revisedReservedId = + value|declare + +@reservedid = + and|as|asr|assert|begin|class|constraint|do|done|downto|else|end| + exception|external|as|assert|false|for|fun|function|if|in|include| + inherit|initializer|land|lor|lxor|lsl|lsr|lazy|let|match|method|mod| + module|mutable|new|object|of|open|or|parser|private|raise|rec|sig| + struct|then|to|true|try|type|val|virtual|when|while|with| + @revisedReservedId + +@reservedop = + "=" | ":=" | "?" | \\ | "|" | "<-" | "->" | "~" -- OCAML CHECK + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \:\: $symchar* + +@binary = $bit+ +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +@number = @decimal + | 0[bB] @binary + | 0[oO] @octal + | 0[xX] @hexadecimal + | @decimal \. @decimal @exponent? + | @decimal @exponent +@numberPostfix = [lLn]? + +-- OCAML CHECK +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +ocaml :- + +<0> $white+ ; + + { + "(*" { m (subtract 1) Comment } + "*)" { m (+1) Comment } + $white+ ; -- whitespace + . { c Comment } +} + +<0> { + + "(*" { m (subtract 1) Comment } + + $special { \str st -> (st, Special (snd $ head str)) } + + @reservedid { c Reserved } + @varid { c VarIdent } + @conid { c ConsIdent } + + @reservedop { c Operator } + @varsym { c Operator } + @consym { c ConsOperator } + + @number @numberPostfix { c Number } + + \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok } + \" @string* \" { c StringTok } + . { c Operator } +} + +{ + +type HlState = Int + +data Token = Number | CharTok | StringTok | VarIdent | ConsIdent + | IndentReserved | Reserved | ReservedOp | Special Char + | ConsOperator | Operator + | Comment + deriving (Eq, Show) + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = tokenToStyle + , _styleLexer = commonLexer alexScanToken initState + } + +tokenToStyle :: Token -> StyleName +tokenToStyle tok = case tok of + Number -> defaultStyle + CharTok -> stringStyle + StringTok -> stringStyle + VarIdent -> defaultStyle + ConsIdent -> typeStyle + ReservedOp -> operatorStyle + Reserved -> keywordStyle + IndentReserved -> keywordStyle + Special _ -> defaultStyle + ConsOperator -> typeStyle + Operator -> operatorStyle + Comment -> commentStyle + + +stateToInit x | x < 0 = nestcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/ObjectiveC.x b/src/Yi/Lexer/ObjectiveC.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/ObjectiveC.x @@ -0,0 +1,197 @@ +-- -*- haskell -*- +-- Simple lexer for objective-c + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} -- Alex generate warnings-ridden code. +module Yi.Lexer.ObjectiveC ( lexer ) where + +{- Standard Library Modules Imported -} +import Yi.Lexer.Alex hiding (tokenToStyle) + +{- External Library Modules Imported -} + +{- Local Modules Imported -} +import qualified Yi.Syntax +import Yi.Style + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol \:] +$nl = [\n\r] + +@reservedid = + auto + | break + | case + | char + | const + | continue + | default + | do + | double + | else + | enum + | extern + | float + | for + | goto + | if + | int + | long + | register + | return + | short + | signed + | static + | struct + | switch + | typedef + | union + | unsigned + | void + | volatile + | while + | "@class" + | "@interface" + | "@implementation" + | "@public" + | "@private" + | "@protected" + | "@try" + | "@catch" + | "@throw" + | "@finally" + | "@end" + | "@protocol" + | "@optional" + | "@required" + | "@selector" + | "@synchronized" + | "@defs" + | "@encode" + | "@property" + | "@synthesize" + | "@dynamic" + | nil + | Nil + | id + | SEL + | BOOL + | in + | out + | inout + | bycopy + | byref + | oneway + | YES + | NO + +-- From this list, but only the C ones: http://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B +@reservedop = + "+" | "++" | "+=" | "-" | "--" | "-=" | "*" | "*=" | "/" | "/=" | "%" | "%=" | + "<" | "<=" | ">" | ">=" | "!=" | "==" | + "!" | "&&" | "||" | + "<<" | "<<=" | ">>" | ">>=" | "~" | "&" | "&=" | "|" | "|=" | "^" | "^=" | + "=" | "->" | "." | "," | "?" | ":" | "sizeof" + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +haskell :- + +<0> $white+ { c defaultStyle } -- whitespace + + { + -- We could do nested comments like this + -- "/*" { m (subtract 1) blockCommentStyle } + "*/" { m (+1) blockCommentStyle } + $white+ { c defaultStyle } -- whitespace + . { c blockCommentStyle } +} + +<0> { + "//"[^\n]* { c commentStyle } + + "/*" { m (subtract 1) blockCommentStyle } + + $special { c defaultStyle } + + @reservedid { c keywordStyle } + @varid { c defaultStyle } + @conid { c typeStyle } + + @reservedop { c operatorStyle } + @varsym { c operatorStyle } + @consym { c typeStyle } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c defaultStyle } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c defaultStyle } + + \' ($graphic # [\'\\] | " " | @escape) \' { c stringStyle } + \" @string* \" { c stringStyle } + . { c operatorStyle } +} + + +{ + +type HlState = Int +type Token = StyleName + +stateToInit x | x < 0 = nestcomm + | otherwise = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Ott.x b/src/Yi/Lexer/Ott.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Ott.x @@ -0,0 +1,123 @@ +-- -*- haskell -*- + +{ +#define NO_ALEX_CONTEXTS +{- The Ott website: http://www.cl.cam.ac.uk/~pes20/ott -} + +{-# OPTIONS -w #-} +module Yi.Lexer.Ott ( lexer ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style + ( Style ( .. ) + , StyleName + ) +import Yi.Style +} + +@reservedid = metavar + | indexvar + | grammar + | embed + | subrules + | contextrules + | substitutions + | single + | multiple + | freevars + | defns + | defn + | by + | homs + | funs + | fun + | parsing + | left + | right + +@reservedop = "::" + | "::=" + | "_::" + | "<::" + | "<=" + | "/>" + | "//" + | " $white+ ; + +<0> +{ + $white+ ; -- whitespace + "%"[^\n]* { c commentStyle } + ">>" { m (subtract 1) commentStyle } + @reservedid { c keywordStyle } + @reservedop { c operatorStyle } + "|" $white+ { c operatorStyle } + "(+" { m (const bindspec) numberStyle } + "{{" { m (const beginHom) stringStyle } + . { c defaultStyle } +} + + { + ">>" { m (subtract 1) commentStyle } + "<<" { m (+1) commentStyle } + $white+ ; -- whitespace + . { c commentStyle } +} + + { + "bind" | "in" | "union" | "{" | "}" { c numberStyle } + $white+ ; -- whitespace + "+)" { m (const 0) numberStyle } + . { c defaultStyle } +} + + { + $white+ ; -- whitespace + @homid { m (const hom) typeStyle } + "}}" { m (const 0) stringStyle } + . { m (const hom) defaultStyle } +} + + { + "[[" { m (const splice) stringStyle } + $white+ ; -- whitespace + "}}" { m (const 0) stringStyle } + . { c defaultStyle } +} + + { + "]]" { m (const hom) stringStyle } + $white+ ; -- whitespace + . { c defaultStyle } +} + +{ +type HlState = Int + +stateToInit x | x < 0 = nestcomm + | otherwise = x + +initState :: HlState +initState = 0 + +type Token = StyleName + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Perl.x b/src/Yi/Lexer/Perl.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Perl.x @@ -0,0 +1,516 @@ +-- -*- haskell -*- +-- Simple lexer for Perl source files. +-- This started as a copy of the C++ lexer so some bits and pieces don't make sense for Perl. +-- Maintainer: Corey O'Connor +{ +{-# OPTIONS -w #-} +module Yi.Lexer.Perl ( lexer ) where +{- Standard Library Modules Imported -} +import Yi.Lexer.Alex hiding (tokenToStyle) +{- External Library Modules Imported -} +{- Local Modules Imported -} +import qualified Yi.Syntax +import Yi.Style +{- End of Module Imports -} + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\'] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $ascdigit] +$nl = [\n\r] + +@importId = + use + | require + +@reservedId = + if + | while + | do + | then + | last + | next + | redo + | continue + | goto + | redo + | for + | foreach + | unless + | until + | elsif + | else + | sub + | package + | our + | my + | defined + | undef + | exists + | die + | shift + +@seperator = $whitechar+ | $special +@interpVarSeperator = [^$idchar] | $nl + +@reservedop = + "->" | "*" | "+" | "-" | "%" | \\ | "||" | "&&" | "?" | ":" | "=>" + | "or" | "xor" | "and" | "ne" | "eq" + | "=~" | "!~" + +@preMatchRegexOp = @reservedop | "(" | "{" | "," + +-- Standard variables +-- TODO: Handle casts of the form @varTypeOp{@varid} +@varTypeOp = + "@" + | "$" + | "%" + +@varPackageSpec = $idchar+ "::" +@varIdentifier = @varPackageSpec* $idchar+ + +-- TODO: A lot! There is a whole list of special global variables. +@specialVarIdentifier = + "_" | ARG + | "." | INPUT_LINE_NUMBER | NR + | "?" | CHILD_ERROR + | ENV + +-- TODO: The specialVarToken should have an entry like the following: +-- | "/" | INPUT_RECORD_SEPARATOR | RS +-- but that messes up the hacked together regex support. + +-- Standard classes +@decimal = $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +-- string components +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL + +-- The charesc set contains more than it really should. +-- It currently tries to be the superset of all characters that are possible +-- to escape in the various quoting modes. Problem is, the actual set of +-- Characters that should be escapable in any quoting mode depends on the +-- delimiter of the quoting mode and I haven't implemented such fanciness +-- yet. +$charesc = [abfnrtv\\\"\'\&\`\/] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ + +@nonInterpolatingString = $graphic # [\'] | " " + +@quoteLikeDelimiter = $special | $ascsymbol | \" | \' + +-- Heredoc +@heredocId = $idchar+ + +-- Perldoc +-- perldoc starts at a "line that begins with an equal sign and a word" +-- (man perlsyn) +@perlDocStartWord = "=" [^$whitechar]+ + +perlHighlighterRules :- + +<0> +{ + -- Conditionalize on not being prefixed with a character that could + -- indicate a regex-style quote. + [^smqrty]^"#"[^\n]* { c commentStyle } + ^"#"[^\n]* { c commentStyle } + + @seperator @reservedId / @seperator { c importStyle } + @seperator @importId / @seperator { c keywordStyle } + ^ @reservedId / @seperator { c importStyle } + ^ @importId / @seperator { c keywordStyle } + + @varTypeOp + { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } + + @reservedop { c operatorStyle } + + @decimal + | 0[oO] @octal + | 0[xX] @hexadecimal { c numberStyle } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c numberStyle } + + -- Chunks that are handled as interpolating strings. + \" + { + m (const $ HlInInterpString False "\"" ) operatorStyle + } + "`" + { + m (const $ HlInInterpString False "`" ) operatorStyle + } + + -- Matching regex quote-like operators are also kinda like interpolating strings. + -- In order to prevent a / delimited regex quote from being confused with + -- division this only matches in the case the / is preeceded with the usual + -- context I use it. + ^($white*)"/" + { m (const $ HlInInterpString True "/" ) operatorStyle } + (@preMatchRegexOp $whitechar* "/") + { + m (const $ HlInInterpString True "/" ) operatorStyle + } + -- "?" + -- { + -- m (const $ HlInInterpString True "?" ) operatorStyle + -- } + + "m/" + { + \str _ -> (HlInInterpString True "/", operatorStyle) + } + + "s/" + { + \str _ -> (HlInSubstRegex "/", operatorStyle) + } + + "m#" + { + \str _ -> (HlInInterpString True "#", operatorStyle) + } + + "s#" + { + \str _ -> (HlInSubstRegex "#", operatorStyle) + } + + -- In order to handle the various interpolation forms of a heredoc the lexer transitions to a + -- state devoted to just collecting the heredoc identifier. + "<<" + { \str _ -> (HlStartCollectHeredocIdent, operatorStyle) } + + -- Chunks that are handles as non-interpolating strings. + \' + { + m (const $ HlInString '\'') operatorStyle + } + + "qw" @quoteLikeDelimiter + { + \str _ -> + let startChar = head $ drop 2 $ fmap snd str + closeChar '(' = ')' + closeChar '{' = '}' + closeChar '<' = '>' + closeChar '[' = ']' + closeChar c = c + in (HlInString (closeChar startChar), operatorStyle) + } + + -- perldoc starts at a "line that begins with an equal sign and a word" + -- (man perlsyn) + ^ @perlDocStartWord + { + m (const $ HlInPerldoc) commentStyle + } + + + -- Everything else is unstyled. + $white { c defaultStyle } + . { c defaultStyle } +} + + +{ + @escape { c defaultStyle } + $white+ { c defaultStyle } + + -- Prevent $ at the end of a regex quote from being recognized as a + -- variable. + "$"/ + { + \state _ _ postInput -> + case state of + HlInInterpString True end_tag -> + let postText = take (length end_tag) $ alexCollectChar postInput + in if (postText == end_tag) then True else False + HlInSubstRegex end_tag -> + let postText = take (length end_tag) $ alexCollectChar postInput + in if (postText == end_tag) then True else False + _ -> False + } + { + c stringStyle + } + + @varTypeOp + { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } + + ./ + { + \state preInput _ _ -> + case state of + HlInInterpString _ end_tag -> + let inputText = take (length end_tag) $ alexCollectChar preInput + in if (inputText == end_tag) then True else False + HlInSubstRegex end_tag -> + let inputText = take (length end_tag) $ alexCollectChar preInput + in if (inputText == end_tag) then True else False + _ -> False + } + { + m fromQuoteState operatorStyle + } + . { c stringStyle } +} + +-- The << operator can be followed by +-- Any number of spaces up to a ' or ". In which case the identifier is the sequence of characters +-- collected until the matching quote. The heredoc is then processed in an interpolating context if +-- the delimiter was " and a non-interpolating context if the delimiter was ' +-- Any number of spaces followed by a non-quote and non-identifier character indicates the start of +-- a heredoc with an empty line as the identifier. +-- An identifier character following the << operator is the start of a heredoc identifier to be +-- processed in an interpolating context. + +{ + $white + { c defaultStyle } + \' + { m (const $ HlCollectHeredocIdent "" (Just '\'')) operatorStyle } + \" + { m (const $ HlCollectHeredocIdent "" (Just '\"')) operatorStyle } + @heredocId + { + \indexedStr _ + -> ( HlCollectHeredocIdent (fmap snd indexedStr) Nothing + , variableStyle + ) + } + . + { + m (const $ HlInInterpHeredocNoIdent) stringStyle + } + -- Although any HEREDOC identifier followed immediately by a newline is likely a syntax error we should still recognize them as + -- HEREDOCs. + \n + { + m (const $ HlInInterpHeredocNoIdent) stringStyle + } +} + +-- A heredoc identifier is collected until: +-- If there is no defined deliminating quote then the next non-identifier character +-- If there is a defined deliminating quote then the next character matching the specified +-- character. +-- TODO: Nested heredoc declarations + +{ + @heredocId + { + \indexedStr (HlCollectHeredocIdent ident delim) + -> ( HlCollectHeredocIdent (ident ++ fmap snd indexedStr) delim + , variableStyle + ) + } + . + { + \indexedStr state + -> let c = head $ fmap snd indexedStr + in case state of + HlCollectHeredocIdent ident Nothing -> (HlInInterpHeredoc ident, stringStyle) + HlCollectHeredocIdent ident (Just '\'') | c == '\'' -> (HlInHeredoc ident, operatorStyle) + | otherwise -> (HlCollectHeredocIdent ident (Just '\''), variableStyle) + HlCollectHeredocIdent ident (Just '"') | c == '"' -> (HlInInterpHeredoc ident, operatorStyle) + | otherwise -> (HlCollectHeredocIdent ident (Just '"'), variableStyle) + } + -- Although any HEREDOC identifier followed immediately by a newline is likely a syntax error we should still recognize them as + -- HEREDOCs. + \n + { + \indexedStr state + -> let c = head $ fmap snd indexedStr + in case state of + HlCollectHeredocIdent ident Nothing -> (HlInInterpHeredoc ident, stringStyle) + HlCollectHeredocIdent ident (Just '\'') | c == '\'' -> (HlInHeredoc ident, operatorStyle) + | otherwise -> (HlCollectHeredocIdent ident (Just '\''), variableStyle) + HlCollectHeredocIdent ident (Just '"') | c == '"' -> (HlInInterpHeredoc ident, operatorStyle) + | otherwise -> (HlCollectHeredocIdent ident (Just '"'), variableStyle) + } +} + + +{ + \n\n + { + m fromQuoteState defaultStyle + } + $white { c defaultStyle } + @varTypeOp + { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } + . { c stringStyle } +} + + +{ + ^(@heredocId\n)/ + { + \state preInput _ _ -> + case state of + HlInInterpHeredoc tag -> + let inputText = take (length tag) $ alexCollectChar preInput + in if (inputText == tag) then True else False + _ -> False + } + { + m fromQuoteState operatorStyle + } + $white+ { c defaultStyle } + @varTypeOp + { m (\s -> HlInVariable 0 s) (const $ withFg darkcyan) } + . { c stringStyle } +} + + +{ + ^(@heredocId\n)/ + { + \state preInput _ _ -> + case state of + HlInHeredoc tag -> + let inputText = take (length tag) $ alexCollectChar preInput + in if (inputText == tag) then True else False + _ -> False + } + { + m fromQuoteState operatorStyle + } + $white+ { c defaultStyle } + . { c stringStyle } +} + + +{ + -- Support highlighting uses of the # to determine subscript of the last element. + -- This isn't entirely correct as it'll accept $########foo. + (@varTypeOp | "#") + { c $ const (withFg darkcyan) } + "{" + { m increaseVarCastDepth $ const (withFg darkcyan) } + "}" + { m decreaseVarCastDepth $ const (withFg darkcyan) } + @specialVarIdentifier + { m exitVarIfZeroDepth $ const (withFg cyan) } + @varIdentifier + { m exitVarIfZeroDepth $ const (withFg darkcyan) } + $white + { m (\(HlInVariable _ s) -> s) defaultStyle } + . + { m (\(HlInVariable _ s) -> s) defaultStyle } +} + + +{ + ^ "=cut" + { + m fromQuoteState commentStyle + } + $white+ { c defaultStyle } + . { c commentStyle } +} + + +{ + $white+ { c defaultStyle } + ./ + { + \state preInput _ _ -> + case state of + HlInString endDelimiter -> + let currentChar = head $ alexCollectChar preInput + in if (currentChar == endDelimiter) then True else False + _ -> False + } + { + m fromQuoteState operatorStyle + } + . { c stringStyle } +} + +{ + +data HlState = + HlInCode + -- Boolean indicating if the interpolated quote is a regex and deliminator of quote. + | HlInInterpString !Bool !String + | HlInString !Char + | HlStartCollectHeredocIdent + | HlCollectHeredocIdent !String !(Maybe Char) + | HlInInterpHeredoc !String + | HlInInterpHeredocNoIdent + | HlInHeredoc !String + | HlInPerldoc + | HlInSubstRegex !String + -- Count of nested {} and the state to transition to once variable is done. + | HlInVariable !Int !HlState + deriving Show + +fromQuoteState (HlInSubstRegex s) = HlInInterpString True s +fromQuoteState _ = HlInCode + +increaseVarCastDepth (HlInVariable n s) = HlInVariable (n + 1) s +increaseVarCastDepth state = error "increaseVarCastDepth applied to non HlInVariable state" + +decreaseVarCastDepth (HlInVariable n s) | n <= 1 = s + | otherwise = HlInVariable (n - 1) s +decreaseVarCastDepth state = error "decreaseVarCastDepth applied to non HlInVariable state" + +exitVarIfZeroDepth (HlInVariable 0 s) = s +exitVarIfZeroDepth s = s + +type Token = StyleName + +stateToInit HlInCode = 0 +stateToInit (HlInInterpString _ _) = interpString +stateToInit (HlInString _) = string +stateToInit HlStartCollectHeredocIdent = startCollectHeredocIdent +stateToInit (HlCollectHeredocIdent _ _) = collectHeredocIdent +stateToInit (HlInInterpHeredoc _) = interpHeredoc +stateToInit HlInInterpHeredocNoIdent = interpHeredocNoIdent +stateToInit (HlInHeredoc _) = heredoc +stateToInit HlInPerldoc = perldoc +stateToInit (HlInSubstRegex _) = interpString +stateToInit (HlInVariable _ _) = variable + +initState :: HlState +initState = HlInCode + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Python.x b/src/Yi/Lexer/Python.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Python.x @@ -0,0 +1,168 @@ +-- -*- haskell -*- +-- +-- A poorly-written Python lexer +-- +-- This is one of the first lexers I've ever written, so this could probably be +-- rewritten much, much better. + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Python ( lexer ) where + +import Yi.Lexer.Alex hiding (tokenToStyle) +import qualified Yi.Syntax +import Yi.Style + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}\:] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \"\'] + +$nonzerodigit = 1-9 +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit] +$symchar = [$symbol] +$nl = [\n\r] + +$strprefix = [urUR] +$longintegersuffix = [lL] + +@builtins = + False + | None + | True + +@importst = import + +@reservedid = + @builtins + | and + | as + | assert + | break + | class + | continue + | def + | del + | elif + | else + | except + | exec + | finally + | for + | from + | global + | if + | in + | is + | lambda + | not + | or + | pass + | print + | raise + | return + | try + | while + | with + | yield + +@compop = + "<=" | ">=" | "==" | "<" | ">" | "<>" + +@infarithop = + "+" | "-" | "*" | "/" | "//" | "%" | "&" | "|" | "^" | ">>" | "<<" | "**" + +-- This is separated so the infix operators above can be used with the augmented assignment form" +@prefarithop = "~" + +@assignop = @infarithop? "=" + +@reservedop = + @compop | @prefarithop | @assignop + +@varid = $alpha $idchar* +@varsym = $symbol+ + +@digits = $nonzerodigit $digit* +@octits = "0" $octit +@hexits = "0x" $hexit + +@integer = @digits | @octits | @hexits +@longinteger = @integer $longintegersuffix +@exponent = [eE] [\-\+] @integer +@number = @integer | @longinteger + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @number) +@gap = \\ $whitechar+ \\ + +@shortstring = $graphic # [\"\'\\] | " " | @escape | @gap +@longstring = @shortstring | $nl + +main :- + +<0> { + $white+ { c defaultStyle } + + "#"[^\n]* { c commentStyle } + + $special { c defaultStyle } + + @importst { c importStyle } + + @reservedid { c keywordStyle } + @varid { c defaultStyle } + + @reservedop { c operatorStyle } +-- @varsym { c operatorStyle } + + @number @exponent? + | @number \. @number? @exponent? { c numberStyle } + + $strprefix* \" @shortstring* \" + | $strprefix* \' @shortstring* \' + | $strprefix* \" \" \" @longstring* \" \" \" + | $strprefix* \' \' \' @longstring* \' \' \' { c stringStyle } + . { c operatorStyle } +} + +{ + +type HlState = Int +type Token = StyleName + +stateToInit x = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Ruby.x b/src/Yi/Lexer/Ruby.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Ruby.x @@ -0,0 +1,216 @@ +-- -*- haskell -*- +-- +-- A Ruby lexer +-- +-- This is based on the Python lexer. + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Ruby ( lexer ) where + +import Yi.Lexer.Alex hiding (tokenToStyle) +import qualified Yi.Syntax +import Yi.Style + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}\:] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$symbol = [$ascsymbol $unisymbol] # [$special \_] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \"\'] + +$nonzerodigit = 1-9 +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit] +$symchar = [$symbol] +$nl = [\n\r] + +$longintegersuffix = [lL] + +@builtinValues = + true + | false + | nil + | self + +@builtinVars = + deferr + | defout + | stderr + | stdin + | stdout + | DEBUG + | FILENAME + | KCODE + | LOADED_FEATURES + | LOAD_PATH + | PROGRAM_NAME + | SAFE + | VERBOSE + +-- @builtinConstants = + +@importst = + import + | include + | require + | require_relative + +@reservedid = + @builtinVars + | abort + | and + | alias + | assert + | begin + | break + | case + | class + | continue + | def + | do + | elsif + | else + | end + | ensure + | except + | exec + | exit + | for + | fork + | from + | gets + | global + | if + | in + | lambda + | loop + | next + | not + | or + | pass + | print + | puts + | raise + | redo + | rescue + | retry + | return + | super + | trap + | try + | undef + | unless + | until + | when + | while + | with + | yield + +@compop = + "<=" | ">=" | "==" | "<" | ">" | "<>" + +@infarithop = + "+" | "-" | "*" | "/" | "//" | "%" | "&" | "|" | "^" | ">>" | "<<" | "**" + +-- This is separated so the infix operators above can be used with the augmented assignment form" +@prefarithop = "~" + +@assignop = @infarithop? "=" + +@reservedop = + @compop | @prefarithop | @assignop + +@varid = $alpha $idchar* +@varsym = $symbol+ + +@digits = $nonzerodigit $digit* +@octits = "0" $octit +@hexits = "0x" $hexit + +@integer = @digits | @octits | @hexits +@longinteger = @integer $longintegersuffix +@exponent = [eE] [\-\+] @integer +@number = @integer | @longinteger +@predicates = $small* \? + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @number) +@gap = \\ $whitechar+ \\ + +@shortstring = $graphic # [\"\'\\] | " " | @escape | @gap +@longstring = @shortstring | $nl + +main :- + +<0> { + $white+ { c defaultStyle } + + "#"[^\n]* { c commentStyle } + $special { c defaultStyle } + @importst { c importStyle } + + @reservedid { c keywordStyle } + @builtinValues { c typeStyle } + @predicates { c operatorStyle } + + -- classes and modules + [A-Z] $alpha* { c builtinStyle } + @varid { c variableStyle } + @reservedop { c operatorStyle } + + @number @exponent? + | @number \. @number? @exponent? { c numberStyle } + + -- symbols and raw strings + :[$small]+ { c stringStyle } + \%q\{ @longstring* \} + | \' @shortstring* \' { c stringStyle } + + -- interpolated strings + \%\{ @longstring* \} + | \%\/ @longstring* \/ + | \%Q\{ @longstring* \} + | \" @shortstring* \" { c stringStyle } + + . { c operatorStyle } +} + + +{ + +type HlState = Int +type Token = StyleName + +stateToInit x = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/SVNCommit.x b/src/Yi/Lexer/SVNCommit.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/SVNCommit.x @@ -0,0 +1,60 @@ +-- -*- haskell -*- +-- Maintainer: Corey O'Connor +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.SVNCommit ( lexer ) where +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style + ( Style ( .. ) + , StyleName + ) +import qualified Yi.Style as Style +} + +@changeType = [^$white]+$white* + +svnCommitMessage :- + +<0> +{ + ^"--".*"--"$ + { m (const $ HlCommitSummary) Style.commentStyle } + $white + { c Style.defaultStyle } + . + { c Style.defaultStyle } +} + + +{ + ^@changeType + { c Style.keywordStyle } + $white + { c Style.commentStyle } + . + { c Style.commentStyle } +} + +{ +data HlState = + HlCommitMessage + | HlCommitSummary + deriving (Show) + +stateToInit HlCommitMessage = 0 +stateToInit HlCommitSummary = commitSummary + +initState :: HlState +initState = HlCommitMessage + +type Token = StyleName + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Srmc.x b/src/Yi/Lexer/Srmc.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Srmc.x @@ -0,0 +1,133 @@ +-- -*- haskell -*- +-- +-- Simple syntax highlighting for srmc source. +-- Also to be used for pepa source files since pepa +-- is a subset of srmc. +-- I also believe that this makes a reasonable example +-- for new syntax files +-- + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} +module Yi.Lexer.Srmc ( lexer ) where +{- Local Modules Imported -} +import Yi.Lexer.Alex hiding (tokenToStyle) +import qualified Yi.Syntax +import Yi.Style + ( Style ( .. ) + , defaultStyle + , commentStyle + , blockCommentStyle + , keywordStyle + , operatorStyle + , typeStyle + , stringStyle + , numberStyle + , StyleName + ) +{- End of Module Imports -} + +} + +$whitechar = [\ \t\n\r\f\v] +$special = [\(\)\,\;\[\]\`\{\}] + +$ascdigit = 0-9 +$unidigit = [] -- TODO +$digit = [$ascdigit $unidigit] + +$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~] +$unisymbol = [] -- TODO +$pepasymbol = [\;\.\,\+=\<\>] +$symbol = [$pepasymbol] + +$large = [A-Z \xc0-\xd6 \xd8-\xde] +$small = [a-z \xdf-\xf6 \xf8-\xff \_] +$alpha = [$small $large] + +$graphic = [$small $large $symbol $digit $special \:\"\'] + +$octit = 0-7 +$hexit = [0-9 A-F a-f] +$idchar = [$alpha $digit \'] +$symchar = [$symbol] +$nl = [\n\r] + +@reservedid = Stop|infty + +@reservedop = "&&" | "||" + +@varid = $small $idchar* +@conid = $large $idchar* +@varsym = $symbol $symchar* +@consym = \: $symchar* + +@decimal = $digit+ +@double = $digit+ \. $digit+ +@octal = $octit+ +@hexadecimal = $hexit+ +@exponent = [eE] [\-\+] @decimal + +$cntrl = [$large \@\[\\\]\^\_] +@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK + | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE + | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM + | SUB | ESC | FS | GS | RS | US | SP | DEL +$charesc = [abfnrtv\\\"\'\&] +@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal) +@gap = \\ $whitechar+ \\ +@string = $graphic # [\"\\] | " " | @escape | @gap + +haskell :- + +<0> $white+ { c defaultStyle } -- whitespace + + +<0> { + "%"\-*[^\n]* { c commentStyle } + "//"\-*[^\n]* { c commentStyle } + + -- $special { c defaultStyle } + + @reservedid { c keywordStyle } + + @varid { c stringStyle } + @conid { c typeStyle } + + @reservedop { c operatorStyle } + @varsym { c operatorStyle } + + @decimal + | @double + | 0[oO] @octal + | 0[xX] @hexadecimal { c numberStyle } + + @decimal \. @decimal @exponent? + | @decimal @exponent { c defaultStyle } + + . { c defaultStyle } + \" @string* \" { c keywordStyle } +} + +{ + +type HlState = Int +type Token = StyleName + +{- + See Haskell.x which uses this to say whether we are in a + comment (perhaps a nested comment) or not. +-} +stateToInit x = 0 +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" +} diff --git a/src/Yi/Lexer/Whitespace.x b/src/Yi/Lexer/Whitespace.x new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/Whitespace.x @@ -0,0 +1,54 @@ +-- -*- haskell -*- + +-- Lexer for Whitespace +-- (C) Copyright 2009 Deniz Dogan (mad credz) + +{ +#define NO_ALEX_CONTEXTS +{-# OPTIONS -w #-} + +module Yi.Lexer.Whitespace ( lexer ) where + +import Yi.Lexer.Alex hiding (tokenToStyle) +import Yi.Style (StyleName, withBg, red, green, commentStyle) + +} + +@space = " " +@tab = \t +@nl = [\r\n] + +:- + +<0> { +@space+ { c spaceStyle } +@tab+ { c tabStyle } +@nl ; +. { c commentStyle } +} + +{ + +spaceStyle :: StyleName +spaceStyle = const $ withBg red + +tabStyle :: StyleName +tabStyle = const $ withBg green + +type Token = StyleName +type HlState = Int + +stateToInit x = 0 + +initState :: HlState +initState = 0 + +lexer :: StyleLexerASI HlState Token +lexer = StyleLexer + { _tokenToStyle = id + , _styleLexer = commonLexer alexScanToken initState + } + +#include "common.hsinc" + +} diff --git a/src/Yi/Lexer/common.hsinc b/src/Yi/Lexer/common.hsinc new file mode 100644 --- /dev/null +++ b/src/Yi/Lexer/common.hsinc @@ -0,0 +1,92 @@ +-- -*- Haskell -*- + +-- The include file for alex-generated syntax highlighters. Because alex +-- declares its own types, any wrapper must have the highlighter in scope... +-- so it must be included. Doubleplusyuck. + +#define IBOX(n) (I# (n)) + +#if __GLASGOW_HASKELL__ > 706 +#define GEQ_(x, y) (tagToEnum# (x >=# y)) +#define EQ_(x, y) (tagToEnum# (x ==# y)) +#else +#define GEQ_(x, y) (x >=# y) +#define EQ_(x, y) (x ==# y) +#endif + +-- | Scan one token. Return (maybe) a token and a new state. +alexScanToken :: (AlexState HlState, AlexInput) -> Maybe (Tok Token, (AlexState HlState, AlexInput)) +alexScanToken (AlexState state lookedOfs pos, inp@(_prevCh,_bs,str)) = + let (scn,lookahead) = alexScanUser' state inp (stateToInit state) + lookedOfs' = max lookedOfs (posnOfs pos +~ Size lookahead) in + case scn of + AlexEOF -> Nothing + AlexError inp' -> Nothing + AlexSkip inp' len -> + let chunk = take (fromIntegral len) str + in alexScanToken (AlexState state lookedOfs' (moveStr pos chunk), inp') + AlexToken inp' len act -> + let (state', tokValue) = act chunk state + chunk = take (fromIntegral len) str + newPos = moveStr pos chunk + in Just (Tok tokValue (posnOfs newPos ~- posnOfs pos) pos, (AlexState state' lookedOfs' newPos, inp')) + +alexScan' input (I# (sc)) + = alexScanUser' undefined input (I# (sc)) + +alexScanUser' user input (I# (sc)) + = case alex_scan_tkn' user input 0# input sc AlexNone of + (AlexNone, input', lookahead) -> + case alexGetByte input of + Nothing -> (AlexEOF, lookahead) + Just _ -> (AlexError input', lookahead) + (AlexLastSkip input'' len, _, lookahead) -> (AlexSkip input'' len, lookahead) + (AlexLastAcc k input'' len, _, lookahead) -> (AlexToken input'' len k, lookahead) + + +-- Same as alex_scan_tkn, but also return the length of lookahead. +alex_scan_tkn' user orig_input len input s last_acc = + input `seq` -- strict in the input + let new_acc = check_accs (alex_accept `quickIndex` IBOX(s)) in + new_acc `seq` + case alexGetByte input of + Nothing -> (new_acc, input, IBOX(len)) + Just (c, new_input) -> + let base = alexIndexInt32OffAddr alex_base s + ord_c = case fromIntegral c of (I# x) -> x + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if GEQ_(offset, 0#) && EQ_(check, ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + new_len = if c < 0x80 || c >= 0xC0 then len +# 1# else len + in case new_s of + -1# -> (new_acc, input, IBOX(new_len)) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + -- (but still, we looked after) + _ -> alex_scan_tkn' user orig_input new_len new_input new_s new_acc + + where + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input IBOX(len) + check_accs (AlexAccSkip) = AlexLastSkip input IBOX(len) +#ifndef NO_ALEX_CONTEXTS + check_accs (AlexAccPred a predx rest) + | predx user orig_input IBOX(len) input + = AlexLastAcc a input IBOX(len) + | otherwise + = check_accs rest + check_accs (AlexAccSkipPred predx rest) + | predx user orig_input IBOX(len) input + = AlexLastSkip input IBOX(len) + | otherwise + = check_accs rest +#endif + + +c = actionConst +m = actionAndModify +ms = actionStringAndModify +cs = actionStringConst diff --git a/src/Yi/Regex.hs b/src/Yi/Regex.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Regex.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE FlexibleContexts, TemplateHaskell, RecordWildCards, + CPP, StandaloneDeriving, DeriveGeneric #-} +-- Copyright (c) Jean-Philippe Bernardy 2008 +module Yi.Regex + ( + SearchOption(..), makeSearchOptsM, + SearchExp(..), searchString, searchRegex, emptySearch, + emptyRegex, + regexEscapeString, + module Text.Regex.TDFA, + ) +where + +import Data.Binary +#if __GLASGOW_HASKELL__ < 708 +import Data.DeriveTH +#else +import GHC.Generics (Generic) +#endif +import Text.Regex.TDFA +import Text.Regex.TDFA.Pattern +import Control.Applicative +import Control.Lens hiding (re) +import Text.Regex.TDFA.ReadRegex(parseRegex) +import Text.Regex.TDFA.TDFA(patternToRegex) +import Yi.Buffer.Basic (Direction(..)) + +-- input string, regexexp, backward regex. +data SearchExp = SearchExp { seInput :: String + , seCompiled :: Regex + , seBackCompiled :: Regex + , seOptions :: [SearchOption] + } + +searchString :: SearchExp -> String +searchString = seInput + +searchRegex :: Direction -> SearchExp -> Regex +searchRegex Forward = seCompiled +searchRegex Backward = seBackCompiled + +-- +-- What would be interesting would be to implement our own general +-- mechanism to allow users to supply a regex function of any kind, and +-- search with that. This removes the restriction on strings be valid +-- under regex(3). +-- + +data SearchOption + = IgnoreCase -- ^ Compile for matching that ignores char case + | NoNewLine -- ^ Compile for newline-insensitive matching + | QuoteRegex -- ^ Treat the input not as a regex but as a literal string to search for. + deriving Eq + +#if __GLASGOW_HASKELL__ < 708 +$(derive makeBinary ''SearchOption) +#else +deriving instance Generic SearchOption +instance Binary SearchOption +#endif + +searchOpt :: SearchOption -> CompOption -> CompOption +searchOpt IgnoreCase = \o->o{caseSensitive = False} +searchOpt NoNewLine = \o->o{multiline = False} +searchOpt QuoteRegex = id + +makeSearchOptsM :: [SearchOption] -> String -> Either String SearchExp +makeSearchOptsM opts re = (\p->SearchExp { seInput = re + , seCompiled = compile p + , seBackCompiled = compile $ reversePattern p + , seOptions = opts + }) <$> pattern + where searchOpts = foldr ((.) . searchOpt) id + compile source = patternToRegex source (searchOpts opts defaultCompOpt) defaultExecOpt + pattern = if QuoteRegex `elem` opts + then Right (literalPattern re) + else mapLeft show (parseRegex re) + +instance Binary SearchExp where + get = do re <- get + opts <- get + return $ case makeSearchOptsM opts re of + Left err -> error err + Right se -> se + put (SearchExp { seInput = re, + seOptions = opts, .. }) = do put re + put opts + +mapLeft :: (t1 -> a) -> Either t1 t -> Either a t +mapLeft _ (Right a) = Right a +mapLeft f (Left a) = Left (f a) + +-- | Return an escaped (for parseRegex use) version of the string. +regexEscapeString :: String -> String +regexEscapeString source = showPattern . literalPattern' $ source + +-- | Return a pattern that matches its argument. +literalPattern :: (Num t) => String -> (Pattern, (t, DoPa)) +literalPattern source = (literalPattern' source, (0,DoPa 0)) + +literalPattern' :: String -> Pattern +literalPattern' = PConcat . map (PChar (DoPa 0)) + +-- | Reverse a pattern. Note that the submatches will be reversed as well. +reversePattern :: (Pattern, (t, DoPa)) -> (Pattern, (t, DoPa)) +reversePattern (pattern,(gi,DoPa maxDoPa)) = (transform rev pattern, (gi,DoPa maxDoPa)) + where rev (PConcat l) = PConcat (reverse l) + rev (PCarat x) = PDollar x + rev (PDollar x) = PCarat x + rev (PEscape {getDoPa = dp, getPatternChar = '<'}) = PEscape {getDoPa = dp, getPatternChar = '>'} + rev (PEscape {getDoPa = dp, getPatternChar = '>'}) = PEscape {getDoPa = dp, getPatternChar = '<'} + rev x = x + +{- +Chris K Commentary: + +I have one DIRE WARNING and one suggestion. + +The DIRE WARNING is against using the reversed Pattern to find captured subexpressions. +It will work perfectly to find the longest match but give nonsense for captures. In +particular matching text "abc" with "(.)*" forward returns the 1st capture as "c". +Searching "cba" with the reverse of "(.)*", which is identical, returns the 1st capture as "a". + +Enough changes to the matching engine could allow for the reversed search on the +reversed text to return the same captures as the the forward search on the forward +text. Rather than that tricky complexity, if you need the substring captures you +can use the reversed pattern to find a whole match and then run the forward pattern +on that substring. + +The one suggestion is that the DoPa are irrelevant to the matching — they are there to +allow a person to understand how the output of each stage of the regex-tdfa code relates +to the input pattern. + +-} + +instance Plated Pattern where + plate f (PGroup x p) = PGroup <$> pure x <*> f p + plate f (POr ps) = POr <$> traverse f ps + plate f (PConcat ps) = PConcat <$> traverse f ps + plate f (PQuest p) = PQuest <$> f p + plate f (PPlus p) = PPlus <$> f p + plate f (PStar x p) = PStar <$> pure x <*> f p + plate f (PBound w x p) = PBound <$> pure w <*> pure x <*> f p + plate f (PNonCapture p) = PNonCapture <$> f p + plate f (PNonEmpty p) = PNonEmpty <$> f p + plate _ p = pure p + +emptySearch :: SearchExp +emptySearch = SearchExp "" emptyRegex emptyRegex [] + + +-- | The regular expression that matches nothing. +emptyRegex :: Regex +Just emptyRegex = makeRegexOptsM defaultCompOpt defaultExecOpt "[[:empty:]]" + diff --git a/src/Yi/Region.hs b/src/Yi/Region.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Region.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- Copyright (C) 2008 JP Bernardy + +-- | This module defines the Region ADT + +module Yi.Region + ( + Region + , emptyRegion + , regionIsEmpty + , mkRegion, mkRegion', mkSizeRegion + , regionStart + , regionEnd + , regionSize + , regionDirection + , inRegion, nearRegion + , includedRegion + , fmapRegion + , intersectRegion + , unionRegion + , regionFirst, regionLast, regionsOverlap + ) +where +import Yi.Buffer.Basic +import Yi.Utils +import Data.Typeable +import Data.Binary +#if __GLASGOW_HASKELL__ < 708 +import Data.DeriveTH +#else +import GHC.Generics (Generic) +#endif + +#ifdef TESTING +import Test.QuickCheck +#endif + +-- | The region data type. +--The region is semi open: it includes the start but not the end bound. This allows simpler region-manipulation algorithms. +-- Invariant : regionStart r <= regionEnd r +data Region = Region {regionDirection :: !Direction, + regionStart, regionEnd :: !Point} + deriving (Typeable) + +#if __GLASGOW_HASKELL__ < 708 +$(derive makeBinary ''Region) +#else +deriving instance Generic Region +instance Binary Region +#endif + +#ifdef TESTING +instance Arbitrary Region where + arbitrary = sized $ \size -> do + x0 :: Int <- arbitrary + return $ mkRegion (fromIntegral x0) (fromIntegral (x0 + size)) +#endif + + +instance Show Region where + show r = show (regionStart r) ++ + (case regionDirection r of + Forward -> " -> " + Backward -> " <- " + ) ++ + show (regionEnd r) + +regionFirst :: Region -> Point +regionFirst (Region Forward p _) = p +regionFirst (Region Backward _ p) = p + +regionLast :: Region -> Point +regionLast (Region Forward _ p) = p +regionLast (Region Backward p _) = p + + +fmapRegion :: (Point -> Point) -> Region -> Region +fmapRegion f (Region d x y) = Region d (f x) (f y) + +regionSize :: Region -> Size +regionSize r = regionEnd r ~- regionStart r + +-- | Take the intersection of two regions +intersectRegion :: Region -> Region -> Region +intersectRegion (Region _ x1 y1) (Region _ x2 y2) = ordRegion (max x1 x2) (min y1 y2) + +-- | Take the union of two regions (including what is between them) +unionRegion :: Region -> Region -> Region +unionRegion (Region _ x1 y1) (Region _ x2 y2) = mkRegion (min x1 x2) (max y1 y2) + + +-- | Create a region from ordered bounds. If 2nd argument is greater than +-- 1st, then the region will be empty. +ordRegion :: Point -> Point -> Region +ordRegion x y = if x < y then Region Forward x y else emptyRegion + +-- | Construct a region from its bounds, emacs style: +-- the right bound is excluded +mkRegion :: Point -> Point -> Region +mkRegion x y = if x <= y then Region Forward x y else Region Backward y x + +mkRegion' :: Direction -> Point -> Point -> Region +mkRegion' d x y = if x <= y then Region d x y else Region d y x + +mkSizeRegion :: Point -> Size -> Region +mkSizeRegion x s = mkRegion x (x +~ s) + +-- | The empty region +emptyRegion :: Region +emptyRegion = Region Forward 0 0 + +-- | True if the given point is inside the given region. +inRegion :: Point -> Region -> Bool +p `inRegion` (Region _ start stop) = start <= p && p < stop + +-- | True if the given point is inside the given region or at the end of it. +nearRegion :: Point -> Region -> Bool +p `nearRegion` (Region _ start stop) = start <= p && p <= stop + +-- | Returns if a region (1st arg) is included in another (2nd arg) +includedRegion :: Region -> Region -> Bool +r0 `includedRegion` r = regionStart r <= regionStart r0 && regionEnd r0 <= regionEnd r + +regionIsEmpty :: Region -> Bool +regionIsEmpty (Region _ start stop) = start >= stop + +regionsOverlap :: Bool -> Region -> Region -> Bool +regionsOverlap border (Region _ x1 y1) (Region _ x2 y2) = + cmp x2 y1 y2 || cmp x2 x1 y2 || + cmp x1 y2 y1 || cmp x1 x2 y1 + where + cmp a b c = a <= b && if border then b <=c else b < c diff --git a/src/Yi/Style.hs b/src/Yi/Style.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Style.hs @@ -0,0 +1,134 @@ +-- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons + +-- | Colors and friends. +module Yi.Style where + +import Data.Word (Word8) +import Data.Char (chr, ord) +import Data.Monoid + +-- | Visual text attributes to be applied during layout. +data Attributes = Attributes + { foreground :: !Color + , background :: !Color + , reverseAttr :: !Bool + -- ^ The text should be show as "active" or "selected". + -- This can be implemented by reverse video on the terminal. + , bold :: !Bool + , italic :: !Bool + , underline :: !Bool + } deriving (Eq, Ord, Show) + +emptyAttributes :: Attributes +emptyAttributes = Attributes { foreground = Default, background = Default, reverseAttr = False, bold = False, italic = False, underline = False } + +-- | The style is used to transform attributes by modifying +-- one or more of the visual text attributes. +type Style = Endo Attributes + +-- | The UI type +data UIStyle = UIStyle + { modelineAttributes :: Attributes -- ^ ground attributes for the modeline + , modelineFocusStyle :: Style -- ^ transformation of modeline in focus + + , tabBarAttributes :: Attributes -- ^ ground attributes for the tabbar + , tabInFocusStyle :: Style -- ^ a tab that currently holds the focus + , tabNotFocusedStyle :: Style -- ^ a tab that does not have the current focus + + , baseAttributes :: Attributes -- ^ ground attributes for the main text views + + -- General styles applied to the ground attributes above + , selectedStyle :: Style -- ^ the selected portion + , eofStyle :: Style -- ^ empty file marker colours + + , errorStyle :: Style -- ^ indicates errors in text + , hintStyle :: Style -- ^ search matches/paren matches/other hints + , strongHintStyle :: Style -- ^ current search match + + -- Syntax highlighting styles + , commentStyle :: Style -- ^ all comments + , blockCommentStyle :: Style -- ^ additional only for block comments + , keywordStyle :: Style -- ^ applied to language keywords + , numberStyle :: Style -- ^ numbers + , preprocessorStyle :: Style -- ^ preprocessor directive (often in Haskell or C) + , stringStyle :: Style -- ^ constant strings + , longStringStyle :: Style -- ^ additional style for long strings + , typeStyle :: Style -- ^ type name (such as class in an OO language) + , dataConstructorStyle + :: Style -- ^ data constructor + , importStyle :: Style -- ^ style of import names + , builtinStyle :: Style -- ^ builtin things, e.g. Array in JavaScript + , regexStyle :: Style -- ^ regular expressions + , variableStyle :: Style -- ^ any standard variable (identifier) + , operatorStyle :: Style -- ^ infix operators + + , quoteStyle :: Style -- ^ Style of a quotation (e.g. in template haskell) + + , makeFileAction :: Style -- ^ stuff that's passed to the shell in a Makefile + , makeFileRuleHead :: Style -- ^ makefile rule headers + } + +-- | A StyleName determines what style to use, taking into account the +-- set of rendering preferences given by a 'UIStyle'. Typically, style +-- names will be 'Style'-valued field names of 'UIStyle'. +type StyleName = UIStyle -> Style + +withFg, withBg :: Color -> Style +-- | A style that sets the foreground. +withFg c = Endo $ \s -> s { foreground = c } +-- | A style that sets the background. +withBg c = Endo $ \s -> s { background = c } + +withBd, withItlc, withUnderline, withReverse :: Bool -> Style +-- | A style that sets the font to bold +withBd c = Endo $ \s -> s { bold = c } +-- | A style that sets the style to italics +withItlc c = Endo $ \s -> s { italic = c } +-- | A style that sets the style to underlined +withUnderline c = Endo $ \s -> s { underline = c } +-- | A style that sets the style to underlined +withReverse c = Endo $ \s -> s { reverseAttr = c } + +-- | The identity transform. +defaultStyle :: StyleName +defaultStyle = mempty + +data Color + = RGB {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 + | Default + -- ^ The system-default color of the engine used. + -- e.g. in Gtk this should pick whatever the user has chosen as default color + -- (background or forground depending on usage) for the text. + deriving (Eq,Ord,Show) + +-- | Convert a color to its text specification, as to be accepted by XParseColor +colorToText :: Color -> String +colorToText Default = "default" +colorToText (RGB r g b) = ('#':) . showsHex r . showsHex g . showsHex b $ [] + where showsHex x s = showHex1 (x `div` 16) : showHex1 (x `mod` 16) : s + showHex1 x | x < 10 = chr (ord '0' + fromIntegral x) + | otherwise = chr (ord 'A' + fromIntegral x - 10) + +------------------------------------------------------------------------ + +-- Some simple colours + +black, grey, lightGrey, darkred, red, darkgreen, green, brown, yellow :: Color +darkblue, blue, purple, magenta, darkcyan, cyan, white, brightwhite :: Color +black = RGB 0 0 0 +grey = RGB 128 128 128 +lightGrey = RGB 100 100 100 +darkred = RGB 139 0 0 +red = RGB 255 0 0 +darkgreen = RGB 0 100 0 +green = RGB 0 128 0 +brown = RGB 165 42 42 +yellow = RGB 255 255 0 +darkblue = RGB 0 0 139 +blue = RGB 0 0 255 +purple = RGB 128 0 128 +magenta = RGB 255 0 255 +darkcyan = RGB 0 139 139 +cyan = RGB 0 255 255 +white = RGB 165 165 165 +brightwhite = RGB 255 255 255 diff --git a/src/Yi/Style/Library.hs b/src/Yi/Style/Library.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Style/Library.hs @@ -0,0 +1,70 @@ +-- A collection of Themes. +module Yi.Style.Library where + +import Yi.Style +import Data.Prototype +import Data.Monoid + +type Theme = Proto UIStyle + +-- | Abstract theme that provides useful defaults. +defaultTheme :: Theme +defaultTheme = Proto $ const UIStyle + { modelineAttributes = emptyAttributes { foreground = white, background = grey } + , modelineFocusStyle = withFg brightwhite + + , tabBarAttributes = emptyAttributes + , tabInFocusStyle = withFg black `mappend` withBg white + , tabNotFocusedStyle = mempty + + , baseAttributes = emptyAttributes + + , selectedStyle = withFg white `mappend` withBg purple + , eofStyle = withFg blue + , errorStyle = withBg red + , hintStyle = withFg black `mappend` withBg cyan + , strongHintStyle = withFg black `mappend` withBg magenta + + , commentStyle = withFg purple + , blockCommentStyle = withFg purple + , keywordStyle = withFg darkblue + , numberStyle = withFg darkred + , preprocessorStyle = withFg red + , stringStyle = withFg darkcyan + , longStringStyle = mempty + , typeStyle = withFg darkgreen + , dataConstructorStyle + = withBd True `mappend` withFg darkgreen + , importStyle = withFg blue + , builtinStyle = withFg blue + , regexStyle = withFg red + , variableStyle = mempty + , operatorStyle = withFg brown + , makeFileRuleHead = withFg blue + , makeFileAction = withFg grey + , quoteStyle = withFg grey + } + +-- | A Theme inspired by the darkblue colorscheme of Vim. +darkBlueTheme :: Theme +darkBlueTheme = defaultTheme `override` \super _ -> super + { modelineAttributes = emptyAttributes { foreground = darkblue, background = white } + , modelineFocusStyle = withBg brightwhite + + , tabBarAttributes = emptyAttributes { foreground = darkblue, background = brightwhite } + , tabInFocusStyle = withFg grey `mappend` withBg white + , tabNotFocusedStyle = withFg lightGrey `mappend` withBg white + + , baseAttributes = emptyAttributes { foreground = white, background = black } + + , selectedStyle = withFg white `mappend` withBg blue + , eofStyle = withFg red + , hintStyle = withBg darkblue + , strongHintStyle = withBg blue + + , commentStyle = withFg darkred + , keywordStyle = withFg brown + , stringStyle = withFg purple + , variableStyle = withFg cyan + , operatorStyle = withFg brown + } diff --git a/src/Yi/Syntax.hs b/src/Yi/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Syntax.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Yi.Syntax +-- Copyright : (c) Don Stewart 2007 +-- License : GPL-2 +-- Maintainer : yi-devel@googlegroups.com +-- Stability : experimental +-- Portability : portable +-- +-- This module defines a common interface for syntax-awareness. +-- +-- There have been many tens of wasted hours in this and lexer +-- modules. This note is to commemorate those who have fallen in +-- battle. + +module Yi.Syntax + ( Highlighter ( .. ) + , Cache + , Scanner (..) + , ExtHL ( .. ) + , noHighlighter, mkHighlighter, skipScanner, emptyFileScan + , Point(..), Size(..), Length, Stroke + , Span(..) + ) +where + +import qualified Data.Map as M +import Control.Arrow +import Yi.Style +import Data.Foldable +import Data.Traversable +import Yi.Buffer.Basic +import Yi.Region + +type Length = Int -- size in #codepoints + +type Stroke = Span StyleName +data Span a = Span {spanBegin :: !Point, spanContents :: !a, spanEnd :: !Point} + deriving (Show, Functor, Foldable, Traversable) + +-- | The main type of syntax highlighters. This record type combines all +-- the required functions, and is parametrized on the type of the internal +-- state. + +-- FIXME: this is actually completetly abstrcted from sytnax HL, so +-- the names are silly. + +data Highlighter cache syntax = + SynHL { hlStartState :: cache -- ^ The start state for the highlighter. + , hlRun :: Scanner Point Char -> Point -> cache -> cache + , hlGetTree :: cache -> WindowRef -> syntax + , hlFocus :: M.Map WindowRef Region -> cache -> cache + -- ^ focus at a given point, and return the coresponding node. + -- (hint -- the root can always be returned, at the cost of + -- performance.) + } + +data ExtHL syntax = forall cache. ExtHL (Highlighter cache syntax) + +data Scanner st a = Scanner + { scanInit :: st -- ^ Initial state + , scanLooked :: st -> Point + -- ^ How far did the scanner look to produce this intermediate state? + -- The state can be reused as long as nothing changes before that point. + , scanEmpty :: a -- hack :/ + , scanRun :: st -> [(st ,a)] + -- ^ Running function returns a list of results and intermediate + -- states. Note: the state is the state /before/ producing the + -- result in the second component. + } + +skipScanner :: Int -> Scanner st a -> Scanner st a +skipScanner n (Scanner i l e r) = Scanner i l e (other 0 . r) + where + other _ [] = [] + other _ [x] = [x] -- we must return the final result (because if + -- the list is empty mkHighlighter thinks it + -- can reuse the previous result) + other 0 (x:xs) = x : other n xs + other m (_:xs) = other (m-1) xs + +instance Functor (Scanner st) where + fmap f (Scanner i l e r) = Scanner i l (f e) (fmap (second f) . r) + +data Cache state result = Cache [state] result + +emptyFileScan :: Scanner Point Char +emptyFileScan = Scanner + { scanInit = 0 + , scanRun = const [] + , scanLooked = id + , scanEmpty = error "emptyFileScan: no scanEmpty" + } + +-- | This takes as input a scanner that returns the "full" result at +-- each element in the list; perhaps in a different form for the +-- purpose of incremental-lazy eval. +mkHighlighter :: forall state result. Show state => + (Scanner Point Char -> Scanner state result) -> + Highlighter (Cache state result) result +mkHighlighter scanner = + Yi.Syntax.SynHL + { hlStartState = Cache [] emptyResult + , hlRun = updateCache + , hlGetTree = \(Cache _ result) _windowRef -> result + , hlFocus = \_ c -> c + } + where startState :: state + startState = scanInit (scanner emptyFileScan) + emptyResult = scanEmpty (scanner emptyFileScan) + updateCache :: Scanner Point Char -> Point -> Cache state result -> Cache state result + updateCache newFileScan dirtyOffset (Cache cachedStates oldResult) = Cache newCachedStates newResult + where newScan = scanner newFileScan + reused :: [state] + reused = takeWhile ((< dirtyOffset) . scanLooked (scanner newFileScan)) cachedStates + resumeState :: state + resumeState = if null reused then startState else last reused + + newCachedStates = reused ++ fmap fst recomputed + recomputed = scanRun newScan resumeState + newResult :: result + newResult = if null recomputed then oldResult else snd $ head recomputed + +noHighlighter :: Highlighter () syntax +noHighlighter = SynHL + { hlStartState = () + , hlRun = \_ _ a -> a + , hlFocus = \_ c -> c + , hlGetTree = \ _ -> error "noHighlighter: tried to use syntax" + } diff --git a/src/Yi/Utils.hs b/src/Yi/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Utils.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Yi.Utils +-- License : GPL-2 +-- Maintainer : yi-devel@googlegroups.com +-- Stability : experimental +-- Portability : portable +-- +-- Various utility functions and instances used throughout Yi. Some of +-- the functions from the now-removed Yi.Prelude found a new home +-- here. + +module Yi.Utils where + +import Control.Applicative +import Control.Lens hiding (cons) +import Control.Monad.Base +import Data.Binary +import Data.Char (toLower) +import Data.Foldable hiding (all,any) +import qualified Data.HashMap.Strict as HashMap +import Data.Hashable(Hashable) +import qualified Data.List.PointedList as PL +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Language.Haskell.TH.Syntax as THS + +io :: MonadBase IO m => IO a -> m a +io = liftBase + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x + +snd3 :: (a,b,c) -> b +snd3 (_,x,_) = x + +trd3 :: (a,b,c) -> c +trd3 (_,_,x) = x + +class SemiNum absolute relative | absolute -> relative where + (+~) :: absolute -> relative -> absolute + (-~) :: absolute -> relative -> absolute + (~-) :: absolute -> absolute -> relative + +{-# ANN nubSet "HLint: ignore Eta reduce" #-} +-- TODO: move somewhere else. +-- | As 'Prelude.nub', but with O(n*log(n)) behaviour. +nubSet :: (Ord a) => [a] -> [a] +nubSet xss = f Set.empty xss + where + f _ [] = [] + f s (x:xs) = if x `Set.member` s then f s xs else x : f (Set.insert x s) xs + +-- | As Map.adjust, but the combining function is applied strictly. +mapAdjust' :: (Ord k) => (a -> a) -> k -> Map.Map k a -> Map.Map k a +mapAdjust' f = Map.alter f' where + f' Nothing = Nothing + f' (Just x) = let x' = f x in x' `seq` Just x' + -- This works because Map is structure-strict, and alter needs to force f' to compute + -- the structure. + +-- | Generalisation of 'Map.fromList' to arbitrary foldables. +mapFromFoldable :: (Foldable t, Ord k) => t (k, a) -> Map.Map k a +mapFromFoldable = foldMap (uncurry Map.singleton) + +-- | Alternative to groupBy. +-- +-- > groupBy' (\a b -> abs (a - b) <= 1) [1,2,3] = [[1,2,3]] +-- +-- whereas +-- +-- > groupBy (\a b -> abs (a - b) <= 1) [1,2,3] = [[1,2],[3]] +-- +-- TODO: Check in ghc 6.12 release if groupBy == groupBy'. +groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] +groupBy' _ [] = [] +groupBy' p l = s1 : groupBy' p s2 where + (s1, s2) = chain p l + +chain :: (a -> a -> Bool) -> [a] -> ([a],[a]) +chain _ [] = ([], []) +chain _ [e] = ([e], []) +chain q (e1 : es@(e2 : _)) + | q e1 e2 = let (s1, s2) = chain q es in (e1 : s1, s2) + | otherwise = ([e1], es) + +-- | Return the longest common prefix of a set of lists. +-- +-- > P(xs) === all (isPrefixOf (commonPrefix xs)) xs +-- > length s > length (commonPrefix xs) --> not (all (isPrefixOf s) xs) +commonPrefix :: Eq a => [[a]] -> [a] +commonPrefix [] = [] +commonPrefix strings + | any null strings = [] + | all (== prefix) heads = prefix : commonPrefix tailz + | otherwise = [] + where + (heads, tailz) = unzip [(h,t) | (h:t) <- strings] + prefix = head heads +-- for an alternative implementation see GHC's InteractiveUI module. + +{-# ANN findPL "HLint: ignore Eta reduce" #-} +---------------------- PointedList stuff +-- | Finds the first element satisfying the predicate, and returns a zipper pointing at it. +findPL :: (a -> Bool) -> [a] -> Maybe (PL.PointedList a) +findPL p xs = go [] xs where + go _ [] = Nothing + go ls (f:rs) | p f = Just (PL.PointedList ls f rs) + | otherwise = go (f:ls) rs + +{-# ANN swapFocus "HLint: ignore Redundant bracket" #-} +-- | Given a function which moves the focus from index A to index B, return a function which swaps the elements at indexes A and B and then moves the focus. See Yi.Editor.swapWinWithFirstE for an example. +swapFocus :: (PL.PointedList a -> PL.PointedList a) -> (PL.PointedList a -> PL.PointedList a) +swapFocus moveFocus xs = + let xs' = moveFocus xs + f1 = view PL.focus xs + f2 = view PL.focus xs' + in set PL.focus f1 . moveFocus . set PL.focus f2 $ xs + +----------------- Orphan 'Binary' instances +instance (Eq k, Hashable k, Binary k, Binary v) => Binary (HashMap.HashMap k v) where + put x = put (HashMap.toList x) + get = HashMap.fromList <$> get + +makeClassyWithSuffix :: String -> THS.Name -> THS.Q [THS.Dec] +makeClassyWithSuffix s = makeLensesWith (classyRules + & lensField .~ (\_ n -> addSuffix n s) + & lensClass .~ classy) + where + classy :: THS.Name -> Maybe (THS.Name, THS.Name) + classy n = case THS.nameBase n of + x:xs -> Just (THS.mkName ("Has" ++ x:xs), + THS.mkName (toLower x : xs ++ s)) + [] -> Nothing + +addSuffix :: THS.Name -> String -> [DefName] +addSuffix n s = [TopName $ THS.mkName $ THS.nameBase n ++ s] + +makeLensesWithSuffix :: String -> THS.Name -> THS.Q [THS.Dec] +makeLensesWithSuffix s = + makeLensesWith (defaultFieldRules & lensField .~ (\_ n -> addSuffix n s)) diff --git a/yi-language.cabal b/yi-language.cabal new file mode 100644 --- /dev/null +++ b/yi-language.cabal @@ -0,0 +1,64 @@ +name: yi-language +version: 0.1.0.0 +synopsis: Collection of language-related Yi libraries. +description: Collection of language-related Yi libraries: lexers, scanners… +homepage: https://github.com/yi-editor/yi-lexers +license: GPL-2 +license-file: LICENSE +author: Mateusz Kowalczyk +maintainer: yi-devel@googlegroups.com +category: Yi +build-type: Simple +extra-source-files: README.md, src/Yi/Lexer/common.hsinc +cabal-version: >=1.10 + +library + exposed-modules: + Yi.Buffer.Basic + , Yi.Style + , Yi.Style.Library + , Yi.Lexer.JSON + , Yi.Lexer.Abella + , Yi.Lexer.Alex + , Yi.Lexer.GNUMake + , Yi.Lexer.LiterateHaskell + , Yi.Lexer.Perl + , Yi.Lexer.Ruby + , Yi.Lexer.SVNCommit + , Yi.Lexer.Cplusplus + , Yi.Lexer.OCaml + , Yi.Lexer.ObjectiveC + , Yi.Lexer.GitCommit + , Yi.Lexer.Compilation + , Yi.Lexer.Whitespace + , Yi.Lexer.Latex + , Yi.Lexer.Java + , Yi.Lexer.Srmc + , Yi.Lexer.Python + , Yi.Lexer.JavaScript + , Yi.Lexer.Ott + , Yi.Lexer.Haskell + , Yi.Lexer.C + , Yi.Lexer.Cabal + , Yi.Regex + , Yi.Region + , Yi.Syntax + , Yi.Utils + + build-depends: base >=4.5 && <5 + , array + , binary, data-default, template-haskell >= 2.4 + , containers + , hashable >=1.1.2.5 + , lens >= 4.4.0.1 + , oo-prototypes + , pointedlist >= 0.5 + , regex-base ==0.93.* + , regex-tdfa >= 1.1 && <1.3 + , transformers-base + , unordered-containers >= 0.1.3 && < 0.3 + + hs-source-dirs: src + build-tools: alex >= 3.0.3 + default-language: Haskell2010 + include-dirs: src/Yi/Lexer