egison 2.3.2 → 2.3.3

raw patch · 12 files changed

+623/−1 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +2/−1
• sample/icfpc2012/maps/contest1.map +6/−0
• sample/icfpc2012/maps/contest10.map +24/−0
• sample/icfpc2012/maps/contest2.map +7/−0
• sample/icfpc2012/maps/contest3.map +9/−0
• sample/icfpc2012/maps/contest4.map +9/−0
• sample/icfpc2012/maps/contest5.map +12/−0
• sample/icfpc2012/maps/contest6.map +15/−0
• sample/icfpc2012/maps/contest7.map +9/−0
• sample/icfpc2012/maps/contest8.map +18/−0
• sample/icfpc2012/maps/contest9.map +17/−0
• sample/icfpc2012/mine.egi +495/−0

@@ -1,5 +1,5 @@ Name:                egison-Version:             2.3.2+Version:             2.3.3 Synopsis:            An Interpreter for the Programming Language Egison Description:         An interpreter for the programming language Egison.                      A feature of Egison is the strong pattern match facility.@@ -20,6 +20,7 @@                      sample/number-test.egi sample/collection-test.egi sample/array-test.egi sample/graph-test.egi                      sample/poker-hands-test.egi sample/compile-test.egi                      sample/io/argv-test.egi sample/io/cat.egi sample/io/copy.egi sample/io/char-test.egi sample/io/hello.egi sample/io/read-write-test.egi+                     sample/icfpc2012/mine.egi sample/icfpc2012/maps/*.map                      elisp/egison-mode.el                      etc/template.hs 

@@ -0,0 +1,6 @@+######+#. *R#+#  \.#+#\ * #+L  .\#+######

@@ -0,0 +1,24 @@+#############################+#..........................\#+#..\\###...#....        ###.#+#..\*\\\.. #.... ..##\\..\#.#+#..\*\.... #.... ..#\#....#.#+#...\###.. #.... ....#....#.#+#... ..... ..... .####......#+#\\. #....           .......#+#... #..#. .....*\ ##.......#+#.#....... ...#..  ....######+#. ...#... ...#.\  ....#..* #+##........ ...#.. #....#.#\\#+#.....*... .....*\#\\.....*.#+#.***.* .......*\****.....#.#+#.\\\.. ................   .#+#.#####    .######    ##### #+#....\\.................... #+#....****...#.##.....\\\\..\#+#....\\\\...#.........*....\#+#....\\\\...#.\\.    #\###.\#+#....     ..#.... ...#\\\\. #+#........ ..#.... ...#..... #+#........         ........#R#+###########################L#

@@ -0,0 +1,7 @@+#######+#..***#+#..\\\#+#...**#+#.*.*\#+LR....#+#######

@@ -0,0 +1,9 @@+########+#..R...#+#..*...#+#..#...#+#.\.\..L+####**.#+#\.....#+#\..* .#+########

@@ -0,0 +1,9 @@+#########+#.*..#\.#+#.\..#\.L+#.R .##.#+#.\  ...#+#..\  ..#+#...\  ##+#....\ \#+#########

@@ -0,0 +1,12 @@+############+#..........#+#.....*....#+#..\\\\\\..#+#.     ....#+#..\\\\\\\.#+#..\..    .#+#..\.. ....#+#..... ..* #+#..### ### #+#...R#\#\\.#+######L#####

@@ -0,0 +1,15 @@+###############+#\\\.......** #+#\\#.#####...##+#\\#.....*##. #+#\#####\...## #+#\......####* #+#\.######* #.\#+#\.#. *...##.##+#\##. ..  *...#+#\...... L#.#.#+###########.#.#+#\..........#.#+##.##########.#+#R.#\.........#+###############

@@ -0,0 +1,9 @@+    #######+    ##    *#+     ##R  *##+      ##\\\\##+       ##....##+      ##..\ . ##+     ## . L .  ##+    ##\\\# #\\\\##+   ######   #######

@@ -0,0 +1,18 @@+##############+#\\... ......#+###.#. ...*..#+  #.#. ... ..#+### #.   \ ..#+#. .#..... **#######+#.#\#..... ..\\\*. #+#*\\#.###. ####\\\ #+#\\.#.     ...## \ #+#\#.#..... ....# \ #  +###.#..... ....#   ##+#\\.#..... ....#\   # +########.. ..###*####+#......... .........#+#......... ....***..#+#..\\\\\ # ####.....#+#........*R..\\\   .#+##########L##########

@@ -0,0 +1,17 @@+        #L#######+        #*** \\ #+        #\\\ .. #+#########.##    ##########+#.......\ ..........*   .#+#*******\......#....#\\ .#+###\.\\\...**..#....... *#+#*****\\  .\\..##     #\.#+######### ....  ##########+        #       #+        ####*####      +        #.......#+#########  \\\\*##########+#*\\  **#     *..*\ \\\\\#+#.\**\*** .....**.# \\##\#+#\R......     .\\.. \\\\\#+##########################

@@ -0,0 +1,495 @@+;;;+;;; ICFPC 2012 Simulator+;;;++(define $RobotState+  (type+    {[,$val []+      {[$tgt (if (eq? tgt val)+                 {[]}+                 {})]}]+     [<normal> []+      {[<normal> {[]}]+       [_ {}]}]+     [<on-lambda> []+      {[<on-lambda> {[]}]+       [_ {}]}]+     [<abort> []+      {[<abort> {[]}]+       [_ {}]}]+     [<broken> []+      {[<broken> {[]}]+       [_ {}]}]+     [<goal> []+      {[<goal> {[]}]+       [_ {}]}]+     [_ [Something]+      {[$tgt {tgt}]}]+     }))++(define $Tile+  (type+    {[<robot ,$pState> []+      {[<robot $state> (if ((= RobotState) pState state)+                           {[]}+                           {})]+       [_ {}]}]+     [<robot _> [RobotState]+      {[<robot $state> {state}]+       [_ {}]}]+     [<rock ,$pFlag> []+      {[<rock $flag> (if (eq? pFlag flag)+                         {[]}+                         {})]+       [_ {}]}]+     [<rock _> [Bool]+      {[<rock $flag> {[flag]}]+       [_ {}]}]+     [<wall> []+      {[<wall> {[]}]+       [_ {}]}]+     [<lambda-stone> []+      {[<lambda-stone> {[]}]+       [_ {}]}]+     [<earth> []+      {[<earth> {[]}]+       [_ {}]}]+     [<empty> []+      {[<empty> {[]}]+       [_ {}]}]+     [<open-lift> []+      {[<open-lift> {[]}]+       [_ {}]}]+     [<closed-lift> []+      {[<closed-lift> {[]}]+           [_ {}]}]+     [_ [Something]+      {[$tgt {tgt}]}]+     }))++(define $show-tile+  (lambda [$tile]+    (match tile Tile+      {[<robot _> "R"]+       [<rock _> "*"]+       [<wall> "#"]+       [<lambda-stone> "\\"]+       [<earth> "."]+       [<empty> " "]+       [<open-lift> "O"]+       [<closed-lift> "L"]})))++(define $char-to-tile+  (lambda [$c]+    (match c Char+      {[,'R' <robot <normal>>]+       [,'*' <rock #f>]+       [,'#' <wall>]+       [,'\\' <lambda-stone>]+       [,'.' <earth>]+       [,' ' <empty>]+       [,'O' <open-lift>]+       [,'L' <closed-lift>]+       })))++(define $Mine (Array Tile))++(define $Move+  (type+    {[<left> []+      {[<left> {[]}]+       [_ {}]}]+     [<right> []+      {[<right> {[]}]+       [_ {}]}]+     [<up> []+      {[<up> {[]}]+       [_ {}]}]+     [<down> []+      {[<down> {[]}]+       [_ {}]}]+     [<wait> []+      {[<wait> {[]}]+       [_ {}]}]+     [<abort> []+      {[<abort> {[]}]+           [_ {}]}]+     [_ [Something]+      {[$tgt {tgt}]}]+     }))++(define $char-to-move+  (lambda [$c]+    (match c Char+      {[,'L' <left>]+       [,'R' <right>]+       [,'U' <up>]+       [,'D' <down>]+       [,'W' <wait>]+       [,'A' <abort>]+       [,'h' <left>]+       [,'l' <right>]+       [,'k' <up>]+       [,'j' <down>]+       })))++(define $Point [Integer Integer])++(define $GameState+  (type+    {[<game-state _ _ _ _> [Mine Integer Integer Integer]+      {[<game-state $mine $step $score $lambda-count>+        {[mine step score lambda-count]}]}]+     [_ [Something]+      {[$tgt {tgt}]}]+     }))++(define $get-mine+  (lambda [$game-state]+    (match game-state GameState+      {[<game-state $mine _ _ _> mine]})))++(define $show-mine+  (lambda [$mine]+    (let {[$kss (keys-for-display (array-range mine))]}+      (foldl string-append ""+             (map (lambda [$ks]+                    (string-append (foldl string-append ""+                                          (map (lambda [$k]+                                                 (show-tile (array-ref k mine))) ks))+                                   "\n"))+                  kss)))))++(define $get-robot-state+  (lambda [$mine]+    (let {[$rp ((find-from-value-with-pattern Tile) <robot _> mine)]}+      (match (array-ref rp mine) Tile+        {[<robot $state> state]}))))++(define $move-robot+  (lambda [$mine $move]+    (generate-array+      (lambda [$x $y]+        (match move Move+          {[<left>+            (match mine Mine+              {+               [<cons ,[x y] <robot _>+                      <cons ,[(- x 1) y] <open-lift>+                            _>>+                <empty>]+               [<cons ,[x y] <open-lift>+                      <cons ,[(+ x 1) y] <robot _>+                            _>>+                <robot <goal>>]+               [<cons ,[x y] <robot _>+                      <cons ,[(- x 1) y] <lambda-stone>+                            _>>+                <empty>]+               [<cons ,[x y] <lambda-stone>+                      <cons ,[(+ x 1) y] <robot _>+                            _>>+                <robot <on-lambda>>]+               [<cons ,[x y] <robot _>+                      (| ^<cons ,[(- x 1) y] (| <wall> <rock _>) _>+                         <cons ,[(- x 1) y] <rock _>+                               <cons ,[(- x 2) y] <empty> _>>)>+                <empty>]+               [<cons ,[(+ x 1) y] <robot _>+                      (| ^<cons ,[x y] (| <wall> <rock _>) _>+                         <cons ,[x y] <rock _>+                               <cons ,[(- x 1) y] <empty> _>>)>+                <robot <normal>>]+               [<cons ,[x y] <empty>+                      <cons ,[(+ x 1) y] <rock _>+                            <cons ,[(+ x 2) y] <robot _>+                                  _>>>+                <rock #f>]+               [<cons ,[x y] <robot _>+                      _>+                <robot <normal>>]+               [<cons ,[x y] $tile _> tile]})]+           [<right>+            (match mine Mine+              {+               [<cons ,[x y] <robot _>+                      <cons ,[(+ x 1) y] <open-lift>+                            _>>+                <empty>]+               [<cons ,[x y] <open-lift>+                      <cons ,[(- x 1) y] <robot _>+                            _>>+                <robot <goal>>]+               [<cons ,[x y] <robot _>+                      <cons ,[(+ x 1) y] <lambda-stone>+                            _>>+                <empty>]+               [<cons ,[x y] <lambda-stone>+                      <cons ,[(- x 1) y] <robot _>+                            _>>+                <robot <on-lambda>>]+               [<cons ,[x y] <robot _>+                      (| ^<cons ,[(+ x 1) y] (| <wall> <rock _>) _>+                         <cons ,[(+ x 1) y] <rock _>+                               <cons ,[(+ x 2) y] <empty> _>>)>+                <empty>]+               [<cons ,[(- x 1) y] <robot _>+                      (| ^<cons ,[x y] (| <wall> <rock _>) _>+                         <cons ,[x y] <rock _>+                               <cons ,[(+ x 1) y] <empty> _>>)>+                <robot <normal>>]+               [<cons ,[x y] <empty>+                      <cons ,[(- x 1) y] <rock _>+                            <cons ,[(- x 2) y] <robot _>+                                  _>>>+                <rock #f>]+               [<cons ,[x y] <robot _>+                      _>+                <robot <normal>>]+               [<cons ,[x y] $tile _> tile]})]+           [<up>+            (match mine Mine+              {+               [<cons ,[x y] <robot _>+                      <cons ,[x (+ y 1)] <open-lift>+                            _>>+                <empty>]+               [<cons ,[x y] <open-lift>+                      <cons ,[x (- y 1)] <robot _>+                            _>>+                <robot <goal>>]+               [<cons ,[x y] <robot _>+                      <cons ,[x (+ y 1)] <lambda-stone>+                            _>>+                <empty>]+               [<cons ,[x y] <lambda-stone>+                      <cons ,[x (- y 1)] <robot _>+                            _>>+                <robot <on-lambda>>]+               [<cons ,[x y] <robot _>+                      ^<cons ,[x (+ y 1)] (| <wall> <rock _>) _>>+                <empty>]+               [<cons ,[x (- y 1)] <robot _>+                      ^<cons ,[x y] (| <wall> <rock _>) _>>+                <robot <normal>>]+               [<cons ,[x y] <robot _>+                      _>+                <robot <normal>>]+               [<cons ,[x y] $tile _> tile]})]+           [<down>+            (match mine Mine+              {+               [<cons ,[x y] <robot _>+                      <cons ,[x (- y 1)] <open-lift>+                            _>>+                <empty>]+               [<cons ,[x y] <open-lift>+                      <cons ,[x (+ y 1)] <robot _>+                            _>>+                <robot <goal>>]+               [<cons ,[x y] <robot _>+                      <cons ,[x (- y 1)] <lambda-stone>+                            _>>+                <empty>]+               [<cons ,[x y] <lambda-stone>+                      <cons ,[x (+ y 1)] <robot _>+                            _>>+                <robot <on-lambda>>]+               [<cons ,[x y] <robot _>+                      ^<cons ,[x (- y 1)] (| <wall> <rock _>) _>>+                <empty>]+               [<cons ,[x (+ y 1)] <robot _>+                      ^<cons ,[x y] (| <wall> <rock _>) _>>+                <robot <normal>>]+               [<cons ,[x y] <robot _>+                      _>+                <robot <normal>>]+               [<cons ,[x y] $tile _> tile]})]+           [<abort>+            (match mine Mine+              {[<cons ,[x y] <robot _> _>+                <robot <abort>>]+               [<cons ,[x y] $tile _> tile]})]+           [<wait>+            (match mine Mine+              {[<cons ,[x y] <robot _> _>+                <robot <normal>>]+               [<cons ,[x y] $tile _> tile]})]+           }))+      (array-range mine))))+                           +(define $update-map+  (lambda [$mine]+    (generate-array+      (lambda [$x $y]+        (match mine Mine+          {[<cons ,[x y] <empty>+                  <cons ,[x (+ y 1)] <rock _>+                        _>>+            <rock #t>]+           [<cons ,[x (- y 1)] <empty>+                  <cons ,[x y] <rock _>+                        _>>+            <empty>]+           [<cons ,[x y] <empty>+                  <cons ,[(- x 1) y] (| <rock _> <lambda-stone>)+                        <cons ,[(- x 1) (+ y 1)] <rock _>+                              <cons ,[x (+ y 1)] <empty>+                                    _>>>>+            <rock #t>]+           [<cons ,[x y] <rock _>+                  <cons ,[x (- y 1)] (| <rock _> <lambda-stone>)+                        <cons ,[(+ x 1) (- y 1)] <empty>+                              <cons ,[(+ x 1) y] <empty>+                                    _>>>>+            <empty>]+           [<cons ,[x y] <rock _>+                  <cons ,[x (- y 1)] <rock _>+                        (& (| <cons ,[(+ x 1) y] ^<empty> _>+                              <cons ,[(+ x 1) (- y 1)] ^<empty> _>)+                           <cons ,[(- x 1) (- y 1)] <empty>+                                 <cons ,[(- x 1) y] <empty>+                                       _>>)>>+            <empty>]+           [<cons ,[(+ x 1) (+ y 1)] <rock _>+                  <cons ,[(+ x 1) y] <rock _>+                        (& (| <cons ,[(+ x 2) y] ^<empty> _>+                              <cons ,[(+ x 2) (+ y 1)] ^<empty> _>)+                           <cons ,[x (+ y 1)] <empty>+                                 <cons ,[x y] <empty>+                                       _>>)>>+            <rock #t>]+           [<cons ,[x y] <closed-lift> _>+            (if (eq? 0 (size (lambda-stones mine)))+                <open-lift>+                <closed-lift>)]+           [<cons ,[x y] <rock _> _>+                <rock #f>]+           [<cons ,[x y] $tile _> tile]+           }))+      (array-range mine))))++(define $lambda-stones+  (lambda [$mine]+    (concat (map (lambda [$x $y]+                   (match mine Mine+                     {[<cons ,[x y] <lambda-stone> _> {[x y]}]+                      [_ {}]}))+                 (array-keys mine)))))++(define $ending-update+  (lambda [$mine]+    (generate-array+      (lambda [$x $y]+        (match mine Mine+          {[<cons ,[x y] <robot <normal>>+                  <cons ,[x (+ y 1)] <rock ,#t>+                        _>>+            <robot <broken>>]+           [<cons ,[x y] $tile _> tile]+           }))+      (array-range mine))))++(define $ending?+  (lambda [$mine]+    (match (get-robot-state mine) RobotState+      {[(| <abort> <broken> <goal>) #t]+       [_ #f]})))++(define $calc-score+  (lambda [$game-state]+    (match game-state GameState+      {[<game-state $mine $step $score $lambda-count>+        (match (get-robot-state mine) RobotState+          {[<goal> (+ score (* 25 lambda-count))]+           [<abort> score]+           [<broken> 0]})]})))++(define $generate-mine+  (lambda [$lines]+    (do {[$tss (map (lambda [$line]+                      (map char-to-tile+                           (string-to-chars line)))+                    (reverse lines))]+         [$mx (max (map size tss))]+         [$my (size tss)]+         [$tss2 (map (lambda [$cs]+                       {@cs @(loop $l $i (between 1 (- mx (size cs))) {<wall> @l} {})})+                     tss)]+         }+      (letrec {[$rotate+                (lambda [$tss]+                  (match (car tss) (List Something)+                    {[<nil> {}]+                     [_ {(map car tss) @(rotate (map cdr tss))}]}))]}+        (let {[$tss3 (rotate tss2)]}+          (generate-array+            (lambda [$x $y] (nth y (nth x tss3)))+            [mx my]))))))++(define $main+  (lambda [$: $argv]+    (match argv (List String)+      {[<cons $file <nil>>+        (do {[[$: $port] (open-input-file : file)]+             }+          (letrec {[$readMapLoop (lambda [$: $lines]+                                   (do {[[$: $line] (read-line-from-port : port)]}+                                     (if (or (eof? line) (eq-s? line ""))+                                         [: lines]+                                         (readMapLoop : {@lines line}))))]+                   }+            (do {[[$: $lines] (readMapLoop : {})]+                 [$init-mine (generate-mine lines)]+                 [$init-state <game-state init-mine 0 0 0>]}+              (letrec {[$interactive+                        (lambda [$: $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 :)]+                                   [$move (char-to-move cmd)]+                                   [$mine2 (ending-update (update-map (move-robot mine move)))]+                                   [$game-state2 <game-state mine2 (+ 1 step)+                                                             (if ((= RobotState) <on-lambda> (get-robot-state mine2))+                                                                 (- (+ 50 score) 1)+                                                                 (- score 1))+                                                             (if ((= RobotState) <on-lambda> (get-robot-state mine2))+                                                                 (+ 1 lambda-count)+                                                                 lambda-count)+                                                             >]+                                   }+                                (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')]+                                         }+                                      :)+                                    (interactive : game-state2)))]}))]}+                (interactive : init-state)))))]+       [_ (do {+               [$: (write-string : "usage: mine FILENAME (specify map file)\n")]+               }+            :)]})))+