diff --git a/egison.cabal b/egison.cabal --- a/egison.cabal +++ b/egison.cabal @@ -1,5 +1,5 @@ Name: egison -Version: 2.4.5 +Version: 2.4.6 Synopsis: An Interpreter and Compiler for the Programming Language Egison Description: An interpreter and compiler for the programming language Egison. A feature of Egison is the strong pattern match facility. diff --git a/hs-src/Language/Egison/Parser.hs b/hs-src/Language/Egison/Parser.hs --- a/hs-src/Language/Egison/Parser.hs +++ b/hs-src/Language/Egison/Parser.hs @@ -46,11 +46,11 @@ lexeme = P.lexeme lexer symbol :: Parser Char ---symbol = oneOf "!$%&|*+-/:<=>?@^_~." +--symbol = oneOf "!$%&|*+-/<=>?@^_~." symbol = oneOf "&*+-/:=" symbol2 :: Parser Char ---symbol = oneOf "!$%&|*+-/:<=>?@^_~." +--symbol = oneOf "!$%&|*+-/<=>?@^_~." symbol2 = oneOf "!?" parseBool :: Parser EgisonExpr @@ -80,104 +80,22 @@ case chrExpr of CharExpr chr -> return chr -parseOctalNumber :: Parser EgisonExpr -parseOctalNumber = do - _ <- try (string "#o") - sign <- many (oneOf "-") - num <- many1 (oneOf "01234567") - case (length sign) of - 0 -> return $ NumberExpr $ fst $ Numeric.readOct num !! 0 - 1 -> return $ NumberExpr $ fromInteger $ (*) (-1) $ fst $ Numeric.readOct num !! 0 - _ -> pzero - -parseBinaryNumber :: Parser EgisonExpr -parseBinaryNumber = do - _ <- try (string "#b") - sign <- many (oneOf "-") - num <- many1 (oneOf "01") - case (length sign) of - 0 -> return $ NumberExpr $ fst $ Numeric.readInt 2 (`elem` "01") Char.digitToInt num !! 0 - 1 -> return $ NumberExpr $ fromInteger $ (*) (-1) $ fst $ Numeric.readInt 2 (`elem` "01") Char.digitToInt num !! 0 - _ -> pzero - -parseHexNumber :: Parser EgisonExpr -parseHexNumber = do - _ <- try (string "#x") - sign <- many (oneOf "-") - num <- many1 (digit <|> oneOf "abcdefABCDEF") - case (length sign) of - 0 -> return $ NumberExpr $ fst $ Numeric.readHex num !! 0 - 1 -> return $ NumberExpr $ fromInteger $ (*) (-1) $ fst $ Numeric.readHex num !! 0 - _ -> pzero - parseDecimalNumber :: Parser EgisonExpr parseDecimalNumber = do - _ <- try (many (string "#d")) sign <- many (oneOf "-") num <- many1 (digit) if (length sign) > 1 then pzero else return $ (NumberExpr . read) $ sign ++ num -parseDecimalNumberMaybeExponent :: Parser EgisonExpr -parseDecimalNumberMaybeExponent = do - num <- parseDecimalNumber - result <- parseNumberExponent num - return result - parseNumber :: Parser EgisonExpr -parseNumber = parseDecimalNumberMaybeExponent <|> - parseHexNumber <|> - parseBinaryNumber <|> - parseOctalNumber - "Unable to parse number" +parseNumber = parseDecimalNumber parseNumber2 :: Parser Integer parseNumber2 = do numExpr <- parseNumber case numExpr of NumberExpr n -> return n --- |Parse a floating point number -parseRealNumber :: Parser EgisonExpr -parseRealNumber = do - sign <- many (oneOf "-+") - num <- many1 (digit) - _ <- char '.' - frac <- many1 (digit) - let dec = num ++ "." ++ frac - f <- case (length sign) of - 0 -> return $ FloatExpr $ fst $ Numeric.readFloat dec !! 0 - -- Bit of a hack, but need to support the + sign as well as the minus. - 1 -> if sign == "-" - then return $ FloatExpr $ (*) (-1.0) $ fst $ Numeric.readFloat dec !! 0 - else return $ FloatExpr $ fst $ Numeric.readFloat dec !! 0 - _ -> pzero - result <- parseNumberExponent f - return result - -parseRealNumber2 :: Parser Double -parseRealNumber2 = do floatExpr <- parseRealNumber - case floatExpr of - FloatExpr d -> return d - --- | Parse the exponent section of a floating point number --- in scientific notation. Eg "e10" from "1.0e10" -parseNumberExponent :: EgisonExpr -> Parser EgisonExpr -parseNumberExponent n = do - exp <- many $ oneOf "Ee" - case (length exp) of - 0 -> return n - 1 -> do - num <- try (parseDecimalNumber) - case num of - NumberExpr exp -> buildResult n exp - _ -> pzero - _ -> pzero - where - buildResult (NumberExpr num) exp = return $ FloatExpr $ (fromIntegral num) * (10 ** (fromIntegral exp)) - buildResult (FloatExpr num) exp = return $ FloatExpr $ num * (10 ** (fromIntegral exp)) - buildResult num _ = pzero - parseEscapedChar :: GenParser Char st Char parseEscapedChar = do _ <- char '\\' @@ -370,8 +288,8 @@ return (PPatBool b) <|> do c <- try parseChar2 return (PPatChar c) - <|> do d <- try parseRealNumber2 - return (PPatFloat d) +-- <|> do d <- try parseRealNumber2 +-- return (PPatFloat d) <|> do n <- try parseNumber2 return (PPatNumber n) @@ -392,8 +310,8 @@ -- |Parse an expression parseExpr :: Parser EgisonExpr parseExpr = - try (lexeme parseRealNumber) - <|> try (lexeme parseNumber) +-- try (lexeme parseRealNumber) + try (lexeme parseNumber) <|> lexeme parseChar <|> lexeme parseString <|> try (lexeme parseBool) diff --git a/sample/icfpc2012/mine.egi b/sample/icfpc2012/mine.egi --- a/sample/icfpc2012/mine.egi +++ b/sample/icfpc2012/mine.egi @@ -399,41 +399,41 @@ [mx my])))))) (define $main - (lambda [$: $argv] + (lambda [$world $argv] (match argv (List String) {[> - (do {[[$: $port] (open-input-file : file)] + (do {[[$world $port] (open-input-file world file)] } - (letrec {[$readMapLoop (lambda [$: $lines] - (do {[[$: $line] (read-line-from-port : port)]} + (letrec {[$readMapLoop (lambda [$world $lines] + (do {[[$world $line] (read-line-from-port world port)]} (if (or (eof? line) (eq-s? line "")) - [: lines] - (readMapLoop : {@lines line}))))] + [world lines] + (readMapLoop world {@lines line}))))] } - (do {[[$: $lines] (readMapLoop : {})] + (do {[[$world $lines] (readMapLoop world {})] [$init-mine (generate-mine lines)] [$init-state ]} (letrec {[$interactive - (lambda [$: $game-state] + (lambda [$world $game-state] (match game-state GameState {[ (do { - [$: (write-string : (show-mine mine))] - [$: (write-char : '\n')] - [$: (write-string : "robot-state: ")] - [$: (write : (get-robot-state mine))] - [$: (write-char : '\n')] - [$: (write-string : "lambda-count: ")] - [$: (write : lambda-count)] - [$: (write-char : '\n')] - [$: (write-string : "score: ")] - [$: (write : score)] - [$: (write-char : '\n')] - [$: (write-string : "command: ")] - [$: (flush :)] - [[$: $cmd] (read-char :)] - [$: (write-char : '\n')] - [$: (flush :)] + [$world (write-string world (show-mine mine))] + [$world (write-char world '\n')] + [$world (write-string world "robot-state: ")] + [$world (write world (get-robot-state mine))] + [$world (write-char world '\n')] + [$world (write-string world "lambda-count: ")] + [$world (write world lambda-count)] + [$world (write-char world '\n')] + [$world (write-string world "score: ")] + [$world (write world score)] + [$world (write-char world '\n')] + [$world (write-string world "command: ")] + [$world (flush world)] + [[$world $cmd] (read-char world)] + [$world (write-char world '\n')] + [$world (flush world)] [$move (char-to-move cmd)] [$mine2 (ending-update (update-map (move-robot mine move)))] [$game-state2 > - (do {[[$: $port] (open-input-file : file1)]} - (letrec {[$copyLoop (lambda [$:] - (do {[[$: $line] (read-line-from-port : port)]} + (do {[[$world $port] (open-input-file world file1)]} + (letrec {[$copyLoop (lambda [$world] + (do {[[$world $line] (read-line-from-port world port)]} (if (eof? line) - : - (do {[$: (write-string : line)] - [$: (write-char : '\n')]} - (copyLoop :)))))]} - (do {[$: (copyLoop :)] - [$: (close-input-port : port)]} - :)))] + world + (do {[$world (write-string world line)] + [$world (write-char world '\n')]} + (copyLoop world)))))]} + (do {[$world (copyLoop world)] + [$world (close-input-port world port)]} + world)))] [_ ]}))) diff --git a/sample/io/char-test.egi b/sample/io/char-test.egi --- a/sample/io/char-test.egi +++ b/sample/io/char-test.egi @@ -1,10 +1,10 @@ (define $main - (lambda [$: $argv] - (do {[$: (write-string : "input char : ")] - [$: (flush :)] - [[$: $c] (read-char :)] - [$: (write-char : '\n')] - [$: (write-string : "output : ")] - [$: (write-char : c)] - [$: (write-char : '\n')]} - :))) + (lambda [$world $argv] + (do {[$world (write-string world "input char : ")] + [$world (flush world)] + [[$world $c] (read-char world)] + [$world (write-char world '\n')] + [$world (write-string world "output : ")] + [$world (write-char world c)] + [$world (write-char world '\n')]} + world))) diff --git a/sample/io/copy.egi b/sample/io/copy.egi --- a/sample/io/copy.egi +++ b/sample/io/copy.egi @@ -1,19 +1,19 @@ (define $main - (lambda [$: $argv] + (lambda [$world $argv] (match argv (List String) {[>> - (do {[[$: $port1] (open-input-file : file1)] - [[$: $port2] (open-output-file : file2)]} - (letrec {[$copyLoop (lambda [$:] - (do {[[$: $line] (read-line-from-port : port1)]} + (do {[[$world $port1] (open-input-file world file1)] + [[$world $port2] (open-output-file world file2)]} + (letrec {[$copyLoop (lambda [$world] + (do {[[$world $line] (read-line-from-port world port1)]} (if (eof? line) - : - (do {[$: (write-string-to-port : port2 line)] - [$: (write-char-to-port : port2 '\n')]} - (copyLoop :)))))]} - (do {[$: (copyLoop :)] - [$: (close-output-port : port2)] - [$: (close-input-port : port1)]} - :)))] + world + (do {[$world (write-string-to-port world port2 line)] + [$world (write-char-to-port world port2 '\n')]} + (copyLoop world)))))]} + (do {[$world (copyLoop world)] + [$world (close-output-port world port2)] + [$world (close-input-port world port1)]} + world)))] [_ ]}))) diff --git a/sample/io/hello.egi b/sample/io/hello.egi --- a/sample/io/hello.egi +++ b/sample/io/hello.egi @@ -1,4 +1,4 @@ (define $main - (lambda [$: $argv] - (do {[$: (print : "Hello world!")]} - :))) + (lambda [$world $argv] + (do {[$world (print world "Hello world!")]} + world))) diff --git a/sample/io/read-write-test.egi b/sample/io/read-write-test.egi --- a/sample/io/read-write-test.egi +++ b/sample/io/read-write-test.egi @@ -1,9 +1,9 @@ (define $main - (lambda [$: $argv] - (do {[$: (write-string : "input : ")] - [$: (flush :)] - [[$: $val] (read :)] - [$: (write-string : "output : ")] - [$: (write : val)] - [$: (write-char : '\n')]} - :))) + (lambda [$world $argv] + (do {[$world (write-string world "input : ")] + [$world (flush world)] + [[$world $val] (read world)] + [$world (write-string world "output : ")] + [$world (write world val)] + [$world (write-char world '\n')]} + world)))