-
Notifications
You must be signed in to change notification settings - Fork 0
/
pp-amidakuji-0.satyh
121 lines (102 loc) · 3.3 KB
/
pp-amidakuji-0.satyh
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
@stage: 0
@import: external/satysfi-lib/parser
type amida-drawn =
| HorizontalLine of int * int
| CrossingLines of int * int
| PositiveLine of int * int
| NegativeLine of int * int
| DoubleLine of int * int
let lift-amida-drawn drawn =
match drawn with
| HorizontalLine(i, j) -> &(HorizontalLine(~(lift-int i), ~(lift-int j)))
| CrossingLines(i, j) -> &(CrossingLines(~(lift-int i), ~(lift-int j)))
| PositiveLine(i, j) -> &(PositiveLine(~(lift-int i), ~(lift-int j)))
| NegativeLine(i, j) -> &(NegativeLine(~(lift-int i), ~(lift-int j)))
| DoubleLine(i, j) -> &(DoubleLine(~(lift-int i), ~(lift-int j)))
let lift-list liftf xs =
let codeacc =
xs |> List.fold-left (fun codeacc x ->
&(~(liftf x) :: ~codeacc)
) &[]
in
&(List.reverse ~(codeacc))
let display-drawn drawn =
let f s i j =
display-message (s ^ `(` ^ (arabic i) ^ `, `# ^ (arabic j) ^ `)`)
in
match drawn with
| HorizontalLine(i, j) -> f `H` i j
| CrossingLines(i, j) -> f `C` i j
| _ -> f `O` 0 0
module Amidakuji : sig
val parse : string -> amida-drawn list * int * int
end = struct
type amida-element =
| Horizon
| Empty
| Crossing
| Positive
| Negative
| Double
let charLF = Char.of-codepoint 0x0A
let charCR = Char.of-codepoint 0x0D
let break-parser =
open Parser in
(char charCR >> char charLF >> return ())
<|> (char charLF >> return ())
let space-parser =
Parser.string #` `#
let element-parser =
open Parser in
debug `element` (
(string `-|` >> return Horizon)
<|> (string #` |` >> return Empty)
<|> (string `X|` >> return Crossing)
<|> (string `/|` >> return Positive)
<|> (string `\|` >> return Negative)
<|> (string `=|` >> return Double)
)
let line-parser =
open Parser in
debug `line` (
between (string `|`) (break-parser >> many space-parser)
(many element-parser) >>= (fun line -> return [line])
)
let blank-parser =
open Parser in
debug `blank` (
(many space-parser) >> break-parser >> many space-parser >> return []
)
let main-parser =
open Parser in
many1 (line-parser <|> blank-parser) >>= (fun liness -> (
return (List.concat liness)
))
let int-max m n =
if m >= n then m else n
let parse s =
match main-parser |> Parser.run (s ^ Char.to-string charLF) with
| None ->
error `syntax error (1)`
| Some((lines, rest)) ->
if not (String.is-empty rest) then
error (`syntax error (2): "` ^ rest ^ `"`)
else
let (accfinal, inum) =
lines |> List.fold-lefti (fun j (acc, inum) line -> (
let accnew =
line |> List.fold-lefti (fun i acc elem -> (
match elem with
| Empty -> acc
| Horizon -> (HorizontalLine(i, j)) :: acc
| Crossing -> (CrossingLines(i, j)) :: acc
| Positive -> (PositiveLine(i, j)) :: acc
| Negative -> (NegativeLine(i, j)) :: acc
| Double -> (DoubleLine(i, j)) :: acc
)) acc
in
(accnew, int-max inum (List.length line))
)) ([], 0)
in
(List.reverse accfinal, inum, List.length lines)
end