egison 2.4.5 → 2.4.6

raw patch · 9 files changed

+94/−176 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Language/Egison/Parser.hs +7/−89
• sample/icfpc2012/mine.egi +37/−37
• sample/io/argv-test.egi +5/−5
• sample/io/cat.egi +11/−11
• sample/io/char-test.egi +9/−9
• sample/io/copy.egi +13/−13
• sample/io/hello.egi +3/−3
• sample/io/read-write-test.egi +8/−8

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

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

@@ -399,41 +399,41 @@             [mx my]))))))  (define $main-  (lambda [$: $argv]+  (lambda [$world $argv]     (match argv (List String)       {[<cons $file <nil>>-        (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 <game-state init-mine 0 0 0>]}               (letrec {[$interactive-                        (lambda [$: $game-state]+                        (lambda [$world $game-state]                           (match game-state GameState                             {[<game-state $mine $step $score $lambda-count>                               (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 <game-state mine2 (+ 1 step)@@ -447,20 +447,20 @@                                    }                                 (if (ending? mine2)                                     (do {-                                         [$: (write-string : (show-mine mine2))]-                                         [$: (write-char : '\n')]-                                         [$: (write-string : "robot-state: ")]-                                         [$: (write : (get-robot-state mine2))]-                                         [$: (write-char : '\n')]-                                         [$: (write-string : "score: ")]-                                         [$: (write : (calc-score game-state2))]-                                         [$: (write-char : '\n')]+                                         [$world (write-string world (show-mine mine2))]+                                         [$world (write-char world '\n')]+                                         [$world (write-string world "robot-state: ")]+                                         [$world (write world (get-robot-state mine2))]+                                         [$world (write-char world '\n')]+                                         [$world (write-string world "score: ")]+                                         [$world (write world (calc-score game-state2))]+                                         [$world (write-char world '\n')]                                          }-                                      :)-                                    (interactive : game-state2)))]}))]}-                (interactive : init-state)))))]+                                      world)+                                    (interactive world game-state2)))]}))]}+                (interactive world init-state)))))]        [_ (do {-               [$: (write-string : "usage: mine FILENAME (specify map file)\n")]+               [$world (write-string world "usage: mine FILENAME (specify map file)\n")]                }-            :)]})))+            world)]}))) 

@@ -1,6 +1,6 @@ (define $main-  (lambda [$: $argv]-    (do {[$: (write-string : "output : ")]-         [$: (write : argv)]-         [$: (write-char : '\n')]}-        :)))+  (lambda [$world $argv]+    (do {[$world (write-string world "output : ")]+         [$world (write world argv)]+         [$world (write-char world '\n')]}+        world)))

@@ -1,17 +1,17 @@ (define $main-  (lambda [$: $argv]+  (lambda [$world $argv]     (match argv (List String)       {[<cons $file1 <nil>>-        (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)))]        [_ <argv-error>]}))) 

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

@@ -1,19 +1,19 @@ (define $main-  (lambda [$: $argv]+  (lambda [$world $argv]     (match argv (List String)       {[<cons $file1 <cons $file2 <nil>>>-        (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)))]        [_ <argv-error>]}))) 

@@ -1,4 +1,4 @@ (define $main-  (lambda [$: $argv]-    (do {[$: (print : "Hello world!")]}-        :)))+  (lambda [$world $argv]+    (do {[$world (print world "Hello world!")]}+        world)))

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