first commit

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c)2012, Ömer Sinan Ağacan
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Ömer Sinan Ağacan nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

language-lua.cabal

@@ -0,0 +1,34 @@
+-- language-lua.cabal auto-generated by cabal init. For additional
+-- options, see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                language-lua
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version:             0.1
+Synopsis:            Lua parser and pretty-printer
+Homepage:            http://github.com/osa1/language-lua
+License:             BSD3
+License-file:        LICENSE
+Author:              Ömer Sinan Ağacan
+Maintainer:          omeragacan@gmail.com
+Category:            Language
+Build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+-- Extra-source-files:
+
+-- Constraint on the version of Cabal needed to build this package.
+Cabal-version:       >=1.2
+
+Library
+  -- Modules exported by the library.
+  Hs-source-dirs:      src
+  Exposed-modules:     Language.Lua.Expr, Language.Lua.Parser
+  Ghc-options:         -O2
+  Build-depends:       base >= 4,
+                       mtl,
+                       parsec

src/Language/Lua/Lexer.x

@@ -0,0 +1,137 @@
+-- TODO:
+-- * Multi-line comment and strings
+
+{
+module Language.Lua.Lexer where
+
+import Language.Lua.Token
+}
+
+%wrapper "posn"
+
+$space = [ \ \t ]                        -- horizontal white space
+$eol   = \n                              -- end of line
+
+$letter   = [a-zA-Z]                     -- first letter of variables
+$identletter = [a-zA-Z_0-9]              -- letters for rest of variables
+
+$octdigit = 0-7                          -- octal digits
+$digit    = 0-9                          -- decimal digits
+$hexdigit = [0-9a-fA-F]                  -- hexadecimal digits
+
+$instr    = \0-\255 # [ \\ \" \n ]       -- valid character in a string literal
+$anyButNL = \0-\255 # \n
+
+@sp = $space*
+
+-- escape characters
+@charesc  = \\ ([ntvbrfaeE\\\?\'\"] | $octdigit{1,3} | x$hexdigit+ | X$hexdigit+)
+
+@digits = $digit+
+@intpart = @digits
+@fractpart = @digits
+
+@mantpart = (@intpart? \. @fractpart) | @intpart \.
+@exppart  = [eE][\+\-]?@digits
+
+@hexprefix = 0x | 0X
+@hexdigits = $hexdigit+
+@hexmant   = @hexdigits? \. @hexdigits | @hexdigits\.
+
+
+tokens :-
+
+    $white+ ;
+
+    $letter $identletter* { ident }
+
+    @hexprefix $hexdigit+ { \posn s -> (LTokNum s, posn) } -- FIXME
+    @mantpart  @exppart?  { \posn s -> (LTokNum s, posn) }
+    @digits               { \posn s -> (LTokNum s, posn) }
+
+    \"($instr|@charesc)*\" { \posn s -> (LTokSLit s, posn) }
+
+    "+"   { \posn _ -> (LTokPlus, posn) }
+    "-"   { \posn _ -> (LTokMinus, posn) }
+    "*"   { \posn _ -> (LTokStar, posn) }
+    "/"   { \posn _ -> (LTokSlash, posn) }
+    "%"   { \posn _ -> (LTokPercent, posn) }
+    "^"   { \posn _ -> (LTokExp, posn) }
+    "#"   { \posn _ -> (LTokSh, posn) }
+    "=="  { \posn _ -> (LTokEqual, posn) }
+    "~="  { \posn _ -> (LTokNotequal, posn) }
+    "<="  { \posn _ -> (LTokLEq, posn) }
+    ">="  { \posn _ -> (LTokGEq, posn) }
+    "<"   { \posn _ -> (LTokLT, posn) }
+    ">"   { \posn _ -> (LTokGT, posn) }
+    "="   { \posn _ -> (LTokAssign, posn) }
+    "("   { \posn _ -> (LTokLParen, posn) }
+    ")"   { \posn _ -> (LTokRParen, posn) }
+    "{"   { \posn _ -> (LTokLBrace, posn) }
+    "}"   { \posn _ -> (LTokRBrace, posn) }
+    "["   { \posn _ -> (LTokLBracket, posn) }
+    "]"   { \posn _ -> (LTokRBracket, posn) }
+    "::"  { \posn _ -> (LTokDColon, posn) }
+    ";"   { \posn _ -> (LTokSemic, posn) }
+    ":"   { \posn _ -> (LTokColon, posn) }
+    ","   { \posn _ -> (LTokComma, posn) }
+    "."   { \posn _ -> (LTokDot, posn) }
+    ".."  { \posn _ -> (LTokDDot, posn) }
+    "..." { \posn _ -> (LTokEllipsis, posn) }
+
+
+{
+
+type TokPos = (LToken, AlexPosn)
+type AlexAction = AlexPosn -> String -> TokPos
+
+{-# INLINE ident #-}
+ident :: AlexAction
+ident posn "and"    = (LTokAnd, posn)
+ident posn "break"  = (LTokBreak, posn)
+ident posn "do"     = (LTokDo, posn) 
+ident posn "else"   = (LTokElse, posn)
+ident posn "elseif" = (LTokElseIf, posn)
+ident posn "end"    = (LTokEnd, posn)
+ident posn "false"  = (LTokFalse, posn)
+ident posn "for"    = (LTokFor, posn)
+ident posn "goto"   = (LTokGoto, posn)
+ident posn "if"     = (LTokIf, posn)
+ident posn "in"     = (LTokIn, posn)
+ident posn "local"  = (LTokLocal, posn)
+ident posn "nil"    = (LTokNil, posn)
+ident posn "not"    = (LTokNot, posn)
+ident posn "or"     = (LTokOr, posn)
+ident posn "repeat" = (LTokRepeat, posn)
+ident posn "return" = (LTokReturn, posn)
+ident posn "then"   = (LTokThen, posn)
+ident posn "true"   = (LTokTrue, posn)
+ident posn "until"  = (LTokUntil, posn)
+ident posn "while"  = (LTokWhile, posn)
+ident posn name     = (LTokIdent name, posn)
+
+--data AlexPosn = AlexPn !Int  -- absolute character offset
+--                       !Int  -- line number
+--                       !Int  -- column number
+--
+--type AlexInput = (AlexPosn,     -- current position,
+--                  Char,         -- previous char
+--                  [Byte],       -- rest of the bytes for the current char
+--                  String)       -- current input string
+
+--alexScanTokens :: String -> [token]
+--alexScanTokens str = go (alexStartPos,'\n',[],str)
+--  where go inp@(pos,_,_,str) =
+--          case alexScan inp 0 of
+--                AlexEOF -> []
+--                AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at " ++ (show line) ++ " line, " ++ (show column) ++ " column"
+--                AlexSkip  inp' len     -> go inp'
+--                AlexToken inp' len act -> act pos (take len str) : go inp'
+
+
+main = do
+    s <- getContents
+    print (alexScanTokens s)
+
+}
+

src/Language/Lua/Test.hs

@@ -0,0 +1,28 @@
+module Langauge.Lua.Test where
+
+import Language.Lua.Lexer hiding (main)
+import Data.List (sort)
+import System.Directory (getDirectoryContents)
+import System.FilePath (takeExtension, (</>), splitExtension)
+import Control.Monad (forM)
+import Test.HUnit
+
+main :: IO ()
+main = do
+    runLexerTests
+
+runLexerTests :: IO ()
+runLexerTests = do
+    files <- fmap (map ("tests" </>) . sort . filter luaFile) $ getDirectoryContents "tests"
+    tests <- forM files $ \file -> do
+        contents <- readFile file
+        let tokens = alexScanTokens contents
+        r <- readFile (fst $ splitExtension file)
+        return (file, TestCase $ assertEqual "lexer test" r (show tokens ++ "\n"))
+    let testList = TestList $ map (\(fileName, test) -> TestLabel fileName test) tests
+    putStrLn $ show testList
+    runTestTT testList
+    return ()
+
+luaFile :: FilePath -> Bool
+luaFile = (== ".lua") . takeExtension

syntax

@@ -0,0 +1,62 @@
+    chunk ::= block
+
+    block ::= {stat} [retstat]
+
+    stat ::=  ‘;’ |
+         varlist ‘=’ explist |
+         functioncall |
+         label |
+         break |
+         goto Name |
+         do block end |
+         while exp do block end |
+         repeat block until exp |
+         if exp then block {elseif exp then block} [else block] end |
+         for Name ‘=’ exp ‘,’ exp [‘,’ exp] do block end |
+         for namelist in explist do block end |
+         function funcname funcbody |
+         local function Name funcbody |
+         local namelist [‘=’ explist]
+
+    retstat ::= return [explist] [‘;’]
+
+    label ::= ‘::’ Name ‘::’
+
+    funcname ::= Name {‘.’ Name} [‘:’ Name]
+
+    varlist ::= var {‘,’ var}
+
+    var ::=  Name | prefixexp ‘[’ exp ‘]’ | prefixexp ‘.’ Name
+
+    namelist ::= Name {‘,’ Name}
+
+    explist ::= exp {‘,’ exp}
+
+    exp ::=  nil | false | true | Number | String | ‘...’ | functiondef |
+         prefixexp | tableconstructor | exp binop exp | unop exp
+
+    prefixexp ::= var | functioncall | ‘(’ exp ‘)’
+
+    functioncall ::=  prefixexp args | prefixexp ‘:’ Name args
+
+    args ::=  ‘(’ [explist] ‘)’ | tableconstructor | String
+
+    functiondef ::= function funcbody
+
+    funcbody ::= ‘(’ [parlist] ‘)’ block end
+
+    parlist ::= namelist [‘,’ ‘...’] | ‘...’
+
+    tableconstructor ::= ‘{’ [fieldlist] ‘}’
+
+    fieldlist ::= field {fieldsep field} [fieldsep]
+
+    field ::= ‘[’ exp ‘]’ ‘=’ exp | Name ‘=’ exp | exp
+
+    fieldsep ::= ‘,’ | ‘;’
+
+    binop ::= ‘+’ | ‘-’ | ‘*’ | ‘/’ | ‘^’ | ‘%’ | ‘..’ |
+         ‘<’ | ‘<=’ | ‘>’ | ‘>=’ | ‘==’ | ‘~=’ |
+         and | or
+
+    unop ::= ‘-’ | not | ‘#’

tests/numbers

@@ -0,0 +1 @@
+[LTokNum "3",LTokNum "3.0",LTokNum "3.1416",LTokNum "314.16e-2",LTokNum "0.31416E1",LTokNum "0xff",LTokNum "0x0.1E",LTokNum "0xA23p-4",LTokNum "0X1.921FB54442D18P+1"]

tests/numbers.lua

@@ -0,0 +1,9 @@
+3
+3.0
+3.1416
+314.16e-2
+0.31416E1
+0xff
+0x0.1E
+0xA23p-4
+0X1.921FB54442D18P+1

tests/test

@@ -0,0 +1 @@
+[(LTokNum "1",AlexPn 0 1 1),(LTokIdent "bir",AlexPn 2 2 1),(LTokMinus,AlexPn 5 2 4),(LTokIdent "token",AlexPn 6 2 5),(LTokSLit "\"bir string\"",AlexPn 12 3 1)]

tests/test.lua

@@ -0,0 +1,3 @@
+1
+bir-token
+"bir string"

tests/test2

@@ -0,0 +1 @@
+[]