├── LICENSE ├── PLAYGROUND ├── README.md └── mysession-bucs520-2018-01 │ ├── DATS │ └── basics.dats │ ├── SATS │ └── basics.sats │ └── TEST │ ├── test01 │ ├── Makefile │ ├── mybasis.dats │ ├── myclient.dats │ ├── myserver.dats │ └── package.json │ └── test02 │ ├── Makefile │ ├── mybasis.dats │ ├── myclient.dats │ ├── mygrader.dats │ ├── myserver.dats │ └── package.json ├── README.md └── RECIPE ├── BinarySearch ├── BinarySearch.dats ├── Makefile └── README.md ├── CSV-parsing ├── DATA │ └── NDX100.csv ├── Makefile ├── NDX100.dats ├── README.md ├── myread.dats └── package.json ├── CountingByHash └── CountingByHash.dats ├── GuessNumber ├── GuessNumber.dats ├── Makefile └── README.md ├── HX-intinf ├── HX-intinf.dats ├── Makefile ├── README.md └── package.json ├── Hangman ├── Hangman.dats ├── Makefile └── README.md ├── Hangman2 ├── Hangman2.dats ├── Hangman2_input.dats ├── Makefile ├── README.md └── package.json ├── Hangman3 ├── Hangman3_channel.dats ├── Hangman3_player0.dats ├── Hangman3_player1.dats ├── Makefile ├── README.md └── package.json ├── Hello ├── Hello.dats ├── Makefile └── README.md ├── Makefile_test ├── README.md ├── ReadFromSTDIN ├── Makefile ├── README.md └── ReadFromSTDIN.dats ├── ReadFromSTDIN2 ├── Makefile ├── README.md └── ReadFromSTDIN2.dats ├── ReadFromSTDIN3 ├── Makefile ├── README.md ├── ReadFromSTDIN3.dats └── package.json ├── Tokenizer ├── Makefile ├── README.md └── Tokenizer.dats └── WordFrqncyCount ├── Makefile ├── README.md ├── WordFrqncyCount.dats └── package.json /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 The ATS PL System 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /PLAYGROUND/README.md: -------------------------------------------------------------------------------- 1 | # ATS-CodeBook/PLAYGROUND # 2 | 3 | The examples in this directory are mostly of experimental nature: 4 | They are primarily for playing with programming ideas of interest. 5 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/DATS/basics.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For implementing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | // 20 | #staload 21 | UN = "prelude/SATS/unsafe.sats" 22 | // 23 | (* ****** ****** *) 24 | 25 | #staload "./../SATS/basics.sats" 26 | 27 | (* ****** ****** *) 28 | // 29 | typedef role = int 30 | // 31 | (* ****** ****** *) 32 | // 33 | implement 34 | print_ssdt(dt) = 35 | fprint_ssdt(stdout_ref, dt) 36 | implement 37 | prerr_ssdt(ssdt) = 38 | fprint_ssdt(stderr_ref, ssdt) 39 | // 40 | implement 41 | fprint_ssdt 42 | (out, ssdt0) = 43 | ( 44 | case+ ssdt0 of 45 | // 46 | | SSDTint() => 47 | fprint(out, "SSDTint()") 48 | // 49 | | SSDTbool() => 50 | fprint(out, "SSDTbool()") 51 | // 52 | | SSDTdouble() => 53 | fprint(out, "SSDTdouble()") 54 | | SSDTstring() => 55 | fprint(out, "SSDTstring()") 56 | // 57 | | SSDTlist(ssdt1) => 58 | fprint!(out, "SSDTlist(", ssdt1, ")") 59 | // 60 | ) (* end of [fprint_ssdt] *) 61 | // 62 | (* ****** ****** *) 63 | 64 | implement 65 | print_prtcl(prot) = 66 | fprint_prtcl(stdout_ref, prot) 67 | implement 68 | prerr_prtcl(prot) = 69 | fprint_prtcl(stderr_ref, prot) 70 | 71 | (* ****** ****** *) 72 | 73 | implement 74 | fprint_val = fprint_prtcl 75 | 76 | (* ****** ****** *) 77 | 78 | implement 79 | fprint_prtcl 80 | (out, prot0) = 81 | ( 82 | case+ prot0 of 83 | // 84 | | PRTCLnil() => 85 | fprint(out, "PRTCLnil()") 86 | // 87 | | PRTCLbmsg(r, ssdt) => 88 | fprint!(out, "PRTCLbmsg(", r, ", ", ssdt, ")") 89 | // 90 | | PRTCLlazy(lprot) => 91 | fprint!(out, "PRTCLlazy(", "...", ")") 92 | // 93 | | PRTCLjoin(prots) => 94 | fprint!(out, "PRTCLjoin(", prots, ")") 95 | // 96 | | PRTCLaconj(r, prots) => 97 | fprint!(out, "PRTCLaconj(", r, ", ", "...", ")") 98 | | PRTCLmconj(r, prots) => 99 | fprint!(out, "PRTCLmconj(", r, ", ", "...", ")") 100 | ) 101 | // 102 | // end of [ssprot] 103 | 104 | (* ****** ****** *) 105 | 106 | implement 107 | prtcl_join 108 | (ps) = 109 | ( 110 | case+ ps of 111 | | list0_nil() => 112 | PRTCLnil() 113 | | list0_cons 114 | (p1, ps2) => 115 | ( 116 | case+ ps2 of 117 | | list0_nil() => p1 118 | | list0_cons _ => PRTCLjoin(ps) 119 | ) 120 | ) 121 | 122 | implement 123 | prtcl_join_cons 124 | (p0, ps) = 125 | ( 126 | case+ p0 of 127 | | PRTCLnil() => prtcl_join(ps) 128 | | _(*non-PRTCLnil*) => 129 | ( 130 | PRTCLjoin(list0_cons(p0, ps)) 131 | ) 132 | ) (* prtcl_join_cons *) 133 | 134 | (* ****** ****** *) 135 | 136 | implement 137 | prtcl_option 138 | (r0, p0) = 139 | ( 140 | PRTCLaconj 141 | ( r0 142 | , list0_tuple(PRTCLnil, p0)) 143 | ) (* prtcl_option *) 144 | 145 | implement 146 | prtcl_optrep 147 | (r0, p0) = 148 | ( 149 | prtcl_option 150 | ( r0 151 | , PRTCLjoin 152 | (list0_tuple 153 | ( p0 154 | , PRTCLlazy 155 | ($delay(prtcl_optrep(r0, p0)))))) 156 | ) 157 | 158 | (* ****** ****** *) 159 | 160 | implement 161 | prtcl_repeat(p0) = 162 | PRTCLjoin( 163 | list0_tuple 164 | (p0, PRTCLlazy($delay(prtcl_repeat(p0)))) 165 | ) (* prtcl_repeat *) 166 | 167 | (* ****** ****** *) 168 | // 169 | extern 170 | fun{} 171 | chanrole_bmsg_recv_int 172 | (CH: channel(), r: role): int 173 | extern 174 | fun{} 175 | chanrole_bmsg_send_int 176 | (CH: channel(), r: role, x: int): void 177 | // 178 | (* ****** ****** *) 179 | 180 | local 181 | 182 | reassume protocol_vtype 183 | 184 | in (* in-of-local *) 185 | 186 | implement 187 | prtcl_join_uncons 188 | (p0) = 189 | ( 190 | case+ p0 of 191 | | PRTCLjoin(ps) => 192 | Some_vt(p1) where 193 | { 194 | val- 195 | list0_cons(p1, ps) = ps 196 | val ((*void*)) = 197 | (p0 := prtcl_join(ps)) 198 | // end of [val] 199 | } 200 | | _(*non-PRTCLjoin*) => None_vt((*void*)) 201 | ) 202 | 203 | end // end of [local] 204 | 205 | (* ****** ****** *) 206 | 207 | local 208 | 209 | reassume protocol_vtype 210 | 211 | in (* in-of-local *) 212 | 213 | implement 214 | {}(*tmp*) 215 | chanprot_elim_nil 216 | ( 217 | CH, prot 218 | ) = let 219 | val P0 = prot 220 | in 221 | ( 222 | case+ P0 of 223 | | PRTCLnil() => () 224 | | ((*rest-of-PRTCL*)) => 225 | let 226 | val () = 227 | prerrln! 228 | ("chanprot_elim_nil: prot = ", P0) 229 | in 230 | let val () = 231 | assertloc(false) in ((*void*)) end 232 | // end of [if] 233 | end (* end of [let] *) 234 | ) 235 | end // end of [chanprot_elim_nil] 236 | 237 | end // end of [local] 238 | 239 | (* ****** ****** *) 240 | 241 | local 242 | 243 | reassume protocol_vtype 244 | 245 | in (* in-of-local *) 246 | 247 | implement 248 | chanprot_bmsg_recv_int<> 249 | ( 250 | CH, prot 251 | ) = let 252 | val P0 = prot 253 | in 254 | ( 255 | case+ P0 of 256 | | PRTCLbmsg 257 | (r, dt) => let 258 | val-SSDTint() = dt 259 | val ((*void*)) = 260 | (prot := PRTCLnil()) 261 | in 262 | chanrole_bmsg_recv_int<>(CH, r) 263 | end // end of [PRTCLbmsg] 264 | | PRTCLjoin(PS) => 265 | (x0) where 266 | { 267 | val- 268 | list0_cons 269 | (P1, PS) = PS 270 | // end of [val] 271 | val () = 272 | prot := P1 273 | val x0 = 274 | chanprot_bmsg_recv_int<>(CH, prot) 275 | val () = 276 | (prot := prtcl_join_cons(prot, PS)) 277 | } (* end of [PRTCLjoin] *) 278 | | PRTCLlazy(LP) => 279 | let 280 | val () = (prot := !LP) 281 | in 282 | chanprot_bmsg_recv_int<>(CH, prot) 283 | end // end of [PRTCLlazy] 284 | | ((*rest-of-PRTCL*)) => 285 | let 286 | val () = 287 | prerrln! 288 | ("chanprot_bmsg_recv_int: prot = ", P0) 289 | in 290 | let val () = 291 | assertloc(false) in $UN.cast{int}(0) end 292 | // end of [if] 293 | end (* end of [let] *) 294 | ) 295 | end // end of [chanprot_bmsg_recv_int] 296 | 297 | (* ****** ****** *) 298 | 299 | implement 300 | chanprot_bmsg_send_int<> 301 | ( 302 | CH, prot, x 303 | ) = let 304 | val P0 = prot 305 | in 306 | ( 307 | case+ P0 of 308 | | PRTCLbmsg 309 | (r, dt) => let 310 | val-SSDTint() = dt 311 | val ((*void*)) = 312 | (prot := PRTCLnil()) 313 | // end of [val] 314 | in 315 | chanrole_bmsg_send_int<>(CH, r, x) 316 | end // end of [PRTCLbmsg] 317 | | PRTCLjoin(PS) => 318 | { 319 | val- 320 | list0_cons 321 | (P1, PS) = PS 322 | // end of [val] 323 | val () = 324 | prot := P1 325 | val () = 326 | chanprot_bmsg_send_int<>(CH, prot, x) 327 | val () = 328 | (prot := prtcl_join_cons(prot, PS)) 329 | // end of [val] 330 | } (* end of [PRTCLjoin] *) 331 | | PRTCLlazy(LP) => 332 | let 333 | val () = (prot := !LP) 334 | in 335 | chanprot_bmsg_send_int<>(CH, prot, x) 336 | end // end of [PRTCLlazy] 337 | | ((*rest-of-PRTCL*)) => 338 | let 339 | val () = 340 | prerrln! 341 | ("chanprot_bmsg_send_int: prot = ", P0) 342 | in 343 | let val () = assertloc(false) in ((*void*)) end 344 | end (* end of [let] *) 345 | ) 346 | end // end of [chanprot_bmsg_send_int] 347 | 348 | end // end of [local] 349 | 350 | (* ****** ****** *) 351 | // 352 | implement 353 | chanprot_bmsg_recv = chanprot_bmsg_recv_int<> 354 | implement 355 | chanprot_bmsg_send = chanprot_bmsg_send_int<> 356 | // 357 | (* ****** ****** *) 358 | 359 | local 360 | 361 | reassume protocol_vtype 362 | 363 | in (* in-of-local *) 364 | 365 | implement 366 | {}(*tmp*) 367 | chanprot_conj_aneg 368 | (CH, prot) = let 369 | // 370 | val P0 = prot 371 | // 372 | in 373 | // 374 | case+ P0 of 375 | | PRTCLjoin(PS) => 376 | opt where 377 | { 378 | val- 379 | list0_cons 380 | (P1, PS) = PS 381 | // end of [val] 382 | val () = 383 | prot := P1 384 | val opt = 385 | chanprot_conj_aneg<>(CH, prot) 386 | val () = 387 | (prot := prtcl_join_cons(prot, PS)) 388 | // end of [val] 389 | } (* end of [PRTCLjoin] *) 390 | | PRTCLlazy(LP) => 391 | let 392 | val () = (prot := !LP) 393 | in 394 | chanprot_conj_aneg<>(CH, prot) 395 | end // end of [PRTCLlazy] 396 | | PRTCLaconj(r, PS) => 397 | opt where 398 | { 399 | val opt = 400 | chanrole_bmsg_recv_int<>(CH, r) 401 | val ((*void*)) = 402 | prot := list0_get_at_exn(PS, opt) 403 | } // end of [PRTCLaconj] 404 | | ((*rest-of-PRTCL*)) => 405 | let 406 | val () = 407 | prerrln! 408 | ("chanprot_conj_aneg: prot = ", P0) 409 | in 410 | let val () = assertloc(false) in $UN.cast{int}(0) end 411 | end (* end of [let] *) 412 | // 413 | end // end of [chanprot_conj_aneg] 414 | 415 | implement 416 | {}(*tmp*) 417 | chanprot_conj_apos 418 | (CH, prot, opt) = let 419 | // 420 | val P0 = prot 421 | // 422 | in 423 | // 424 | case+ P0 of 425 | | PRTCLjoin(PS) => 426 | { 427 | val- 428 | list0_cons 429 | (P1, PS) = PS 430 | // end of [val] 431 | val () = 432 | prot := P1 433 | val () = 434 | chanprot_conj_apos<>(CH, prot, opt) 435 | val () = 436 | (prot := prtcl_join_cons(prot, PS)) 437 | // end of [val] 438 | } (* end of [PRTCLjoin] *) 439 | | PRTCLlazy(LP) => 440 | let 441 | val () = (prot := !LP) 442 | in 443 | chanprot_conj_apos<>(CH, prot, opt) 444 | end // end of [PRTCLlazy] 445 | | PRTCLaconj(r, PS) => let 446 | val () = 447 | prot := 448 | list0_get_at_exn(PS, opt) 449 | in 450 | chanrole_bmsg_send_int<>(CH, r, opt) 451 | end // end of [PRTCLaconj] 452 | | ((*rest-of-PRTCL*)) => 453 | let 454 | val () = 455 | prerrln! 456 | ("chanprot_conj_aneg: prot = ", P0) 457 | in 458 | let val () = assertloc(false) in ((*void*)) end 459 | end (* end of [let] *) 460 | // 461 | end // end of [chanprot_conj_apos] 462 | 463 | end // end of [local] 464 | 465 | (* ****** ****** *) 466 | 467 | (* end of [basics.dats] *) 468 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/SATS/basics.sats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For implementing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #staload 13 | "libats/ML/SATS/basis.sats" 14 | 15 | (* ****** ****** *) 16 | // 17 | datatype 18 | ssdt(a:t@ype) = 19 | // 20 | | SSDTint(int) of () 21 | | SSDTbool(bool) of () 22 | | SSDTdouble(double) of () 23 | | SSDTstring(string) of () 24 | // 25 | | {a:t@ype} 26 | SSDTlist(list0(a)) of ssdt(a) 27 | // 28 | typedef ssdt() = [a:t@ype] ssdt(a) 29 | // 30 | (* ****** ****** *) 31 | 32 | datatype 33 | prtcl = 34 | // 35 | | PRTCLnil of () 36 | // 37 | | PRTCLbmsg of 38 | (int, ssdt()) 39 | // PRTCLbmsg 40 | // 41 | | PRTCLlazy of lazy(prtcl) 42 | // 43 | | PRTCLjoin of ( prtclist ) 44 | // 45 | | PRTCLaconj of (int, prtclist) 46 | | PRTCLmconj of (int, prtclist) 47 | // end of [ssprot] 48 | 49 | where prtclist = list0(prtcl) 50 | 51 | (* ****** ****** *) 52 | // 53 | fun 54 | print_ssdt 55 | {a:t0p}(ssdt(a)): void 56 | fun 57 | prerr_ssdt 58 | {a:t0p}(ssdt(a)): void 59 | fun 60 | fprint_ssdt : 61 | {a:t0p} fprint_type(ssdt(a)) 62 | // 63 | overload print with print_ssdt 64 | overload prerr with prerr_ssdt 65 | overload fprint with fprint_ssdt 66 | // 67 | (* ****** ****** *) 68 | // 69 | fun 70 | print_prtcl(prtcl): void 71 | fun 72 | prerr_prtcl(prtcl): void 73 | fun 74 | fprint_prtcl : fprint_type(prtcl) 75 | // 76 | overload print with print_prtcl 77 | overload prerr with prerr_prtcl 78 | overload fprint with fprint_prtcl 79 | // 80 | (* ****** ****** *) 81 | // 82 | fun 83 | prtcl_join 84 | (ps: prtclist): prtcl 85 | and 86 | prtcl_join_cons 87 | (p0: prtcl, ps: prtclist): prtcl 88 | // 89 | (* ****** ****** *) 90 | // 91 | fun 92 | prtcl_option 93 | (r0: int, prot: prtcl): prtcl 94 | // 95 | fun 96 | prtcl_optrep 97 | (r0: int, prot: prtcl): prtcl 98 | // 99 | fun 100 | prtcl_repeat(prot: prtcl): prtcl 101 | // 102 | (* ****** ****** *) 103 | // 104 | abstype 105 | channel_type(id:int) = ptr 106 | typedef 107 | channel(id:int) = channel_type(id) 108 | // 109 | (* ****** ****** *) 110 | // 111 | typedef 112 | channel() = [id:int] channel_type(id) 113 | // 114 | (* ****** ****** *) 115 | // 116 | absvtype 117 | protocol_vtype(id:int) = ptr 118 | vtypedef 119 | protocol(id:int) = protocol_vtype(id) 120 | // 121 | absvtype 122 | pprotocol_vtype(id:int) = ptr 123 | vtypedef 124 | pprotocol(id:int) = pprotocol_vtype(id) 125 | // 126 | (* ****** ****** *) 127 | 128 | vtypedef 129 | protocol() = [id:int] protocol(id) 130 | vtypedef 131 | pprotocol() = [id:int] pprotocol(id) 132 | 133 | (* ****** ****** *) 134 | 135 | local 136 | 137 | assume 138 | protocol_vtype(id) = prtcl 139 | assume 140 | pprotocol_vtype(id) = prtcl 141 | 142 | in 143 | // nothing 144 | end // end of [local] 145 | 146 | (* ****** ****** *) 147 | // 148 | vtypedef 149 | protocolopt(id:int) = 150 | Option_vt(protocol(id)) 151 | // 152 | (* ****** ****** *) 153 | // 154 | fun 155 | prtcl_join_uncons 156 | {id:int} 157 | (p0: &protocol(id) >> _): protocolopt(id) 158 | // 159 | (* ****** ****** *) 160 | 161 | fun{} 162 | chanprot_elim_nil 163 | {id:int} 164 | (CH: channel(id), prot: protocol(id)): void 165 | 166 | (* ****** ****** *) 167 | 168 | fun 169 | {a:t0p} 170 | chanprot_bmsg_recv 171 | {id:int} 172 | (CH: channel(id), prot: &protocol(id) >> _): (a) 173 | 174 | fun 175 | {a:t0p} 176 | chanprot_bmsg_skip 177 | {id:int} 178 | (CH: channel(id), prot: &protocol(id) >> _): void 179 | 180 | fun 181 | {a:t0p} 182 | chanprot_bmsg_send 183 | {id:int} 184 | ( CH: channel(id), prot: &protocol(id) >> _, x0: a): void 185 | 186 | (* ****** ****** *) 187 | 188 | fun{} 189 | chanprot_bmsg_recv_int: 190 | $d2ctype(chanprot_bmsg_recv) 191 | fun{} 192 | chanprot_bmsg_send_int: 193 | $d2ctype(chanprot_bmsg_send) 194 | 195 | (* ****** ****** *) 196 | 197 | fun{} 198 | chanprot_bmsg_recv_bool: 199 | $d2ctype(chanprot_bmsg_recv) 200 | fun{} 201 | chanprot_bmsg_send_bool: 202 | $d2ctype(chanprot_bmsg_send) 203 | 204 | (* ****** ****** *) 205 | 206 | fun{} 207 | chanprot_conj_aneg 208 | {id:int} 209 | (CH: channel(id), prot: &protocol(id) >> _): int(*opt*) 210 | 211 | fun{} 212 | chanprot_conj_apos 213 | {id:int} 214 | (CH: channel(id), prot: &protocol(id) >> _, opt: int): void 215 | 216 | (* ****** ****** *) 217 | 218 | fun{} 219 | chanprot_conj_mpos 220 | {id:int} 221 | ( CH: channel(id) 222 | , prot: &protocol(id) >> _): list0_vt(protocol(id)) 223 | 224 | fun{} 225 | chanprot_conj_mneg 226 | {id:int} 227 | ( CH: channel(id) 228 | , prot: &protocol(id) >> _): list0_vt(pprotocol(id)) 229 | 230 | (* ****** ****** *) 231 | 232 | (* end of [basics.sats] *) 233 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test01/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-21: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: myserver_dats 23 | all:: myclient_dats 24 | 25 | ###### 26 | 27 | testall:: npm-install 28 | testall:: all cleanall 29 | 30 | ###### 31 | # 32 | myserver_dats: \ 33 | mybasis.dats \ 34 | myserver.dats; \ 35 | $(PATSCC) -I./node_modules \ 36 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $^ -latslib -ljson-c 37 | # 38 | myclient_dats: \ 39 | mybasis.dats \ 40 | myclient.dats; \ 41 | $(PATSCC) -I./node_modules \ 42 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $^ -latslib -ljson-c 43 | # 44 | ###### 45 | 46 | clean:: ; rm -f *~ 47 | clean:: ; rm -f *_?ats.o 48 | clean:: ; rm -f *_?ats.c 49 | 50 | cleanall:: clean 51 | cleanall:: ; rm -f myserver_dats 52 | cleanall:: ; rm -f myclient_dats 53 | cleanall:: ; rm -f node_modules -r 54 | cleanall:: ; rm -f package-lock.json 55 | 56 | ###### 57 | 58 | npm-update:: ; $(NPM) update 59 | npm-install:: ; $(NPM) install 60 | 61 | ###### 62 | 63 | export \ 64 | PATSHOMELOCS=./node_modules:./../node_modules:./../../node_modules 65 | 66 | ###### end of [Makefile] ###### 67 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test01/mybasis.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | local 26 | 27 | (* ****** ****** *) 28 | 29 | #define ssint SSDTint 30 | #define ssbool SSDTbool 31 | #define sslist SSDTlist 32 | 33 | (* ****** ****** *) 34 | 35 | #define ssbmsg PRTCLbmsg 36 | // 37 | #define ssjoin PRTCLjoin 38 | // 39 | #define sslazy PRTCLlazy 40 | // 41 | #define ssaconj PRTCLaconj 42 | #define ssmconj PRTCLmconj 43 | 44 | (* ****** ****** *) 45 | 46 | in 47 | 48 | extern 49 | fun 50 | myprtcl(): prtcl 51 | implement 52 | myprtcl() = ssjoin 53 | ( 54 | list0_tuple 55 | ( ssbmsg(0, ssint), ssbmsg(0, ssint) 56 | , ssbmsg(1, ssint), ssbmsg(0, ssint) 57 | ) 58 | ) 59 | 60 | end // end of [local] 61 | 62 | (* ****** ****** *) 63 | // 64 | #include 65 | "$PATSHOMELOCS\ 66 | /atscntrb-hx-libjson-c/mylibies.hats" 67 | #include 68 | "$PATSHOMELOCS\ 69 | /atscntrb-hx-libjson-c/mylibies_link.hats" 70 | // 71 | #staload $JSON_ML 72 | // 73 | (* ****** ****** *) 74 | // 75 | #include 76 | "$PATSHOMELOCS\ 77 | /atscntrb-hx-teaching-bucs/mylibies.hats" 78 | // 79 | (* ****** ****** *) 80 | // 81 | #define 82 | Channel00Insert 83 | "http://cs320.herokuapp.com/api/channel00/insert" 84 | #define 85 | Channel01Insert 86 | "http://cs320.herokuapp.com/api/channel01/insert" 87 | // 88 | (* ****** ****** *) 89 | 90 | #define 91 | Channel00Readall 92 | "http://cs320.herokuapp.com/api/channel00/readall" 93 | #define 94 | Channel01Readall 95 | "http://cs320.herokuapp.com/api/channel01/readall" 96 | 97 | #define 98 | Channel00Clearall 99 | "http://cs320.herokuapp.com/api/channel00/clearall" 100 | #define 101 | Channel01Clearall 102 | "http://cs320.herokuapp.com/api/channel01/clearall" 103 | 104 | (* ****** ****** *) 105 | // 106 | extern 107 | fun 108 | channel00_insert_msg 109 | (msg: string): void 110 | implement 111 | channel00_insert_msg 112 | (msg) = let 113 | val opt = 114 | $BUCS520.streamopt_url_char<> 115 | (string_append3 116 | (Channel00Insert, "/", msg)) 117 | in 118 | case+ opt of 119 | | ~None_vt() => () 120 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 121 | end // end of [channel00_insert_msg] 122 | // 123 | extern 124 | fun 125 | channel01_insert_msg 126 | (msg: string): void 127 | implement 128 | channel01_insert_msg 129 | (msg) = let 130 | val opt = 131 | $BUCS520.streamopt_url_char<> 132 | (string_append3 133 | (Channel01Insert, "/", msg)) 134 | in 135 | case+ opt of 136 | | ~None_vt() => () 137 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 138 | end // end of [channel01_insert_msg] 139 | // 140 | (* ****** ****** *) 141 | 142 | local 143 | // 144 | assume 145 | channel_type(id) = list0(int) 146 | // 147 | in (* nothing *) end 148 | 149 | (* ****** ****** *) 150 | 151 | local 152 | 153 | reassume channel_type 154 | 155 | fun{} 156 | ismem 157 | ( 158 | CH: 159 | channel(), r0: role 160 | ) : bool = loop(CH) where 161 | { 162 | fun 163 | loop(rs: list0(int)): bool = 164 | ( 165 | case+ rs of 166 | | list0_nil() => false 167 | | list0_cons(r1, rs) => 168 | if r0 = r1 then true else loop(rs) 169 | ) 170 | } 171 | 172 | fun{} 173 | jsonval_int 174 | (x: int) = JSONint(g0i2i(x)) 175 | 176 | in 177 | 178 | implement 179 | {}(*tmp*) 180 | chanrole_bmsg_send_int 181 | (CH, r, x) = let 182 | // 183 | val tf = ismem<>(CH, r) 184 | // 185 | val () = 186 | if (tf) 187 | then () 188 | else let 189 | val () = 190 | prerrln! 191 | ("chanrole_bmsg_send_int: non-send") 192 | in 193 | assertloc(false) 194 | end // end of [if] 195 | // 196 | in 197 | // 198 | ifcase 199 | | (r = 0) => 200 | { 201 | val msg = 202 | jsonval_tostring(jsonval_int(x)) 203 | val ((*send*)) = 204 | channel00_insert_msg($UN.strptr2string(msg)) 205 | val ((*freed*)) = strptr_free(msg) 206 | } 207 | | (r = 1) => 208 | { 209 | val msg = 210 | jsonval_tostring(jsonval_int(x)) 211 | val ((*send*)) = 212 | channel01_insert_msg($UN.strptr2string(msg)) 213 | val ((*freed*)) = strptr_free(msg) 214 | } 215 | | _(* else *) => 216 | let 217 | val () = 218 | prerrln!("chanrole_bmsg_send_int: r = ", r) 219 | in 220 | let val () = assertloc(false) in ((*void*)) end 221 | // end of [if] 222 | end (* end of [let] *) 223 | // 224 | end // chanrole_bmsg_send_int 225 | 226 | end // end of [local] 227 | 228 | (* ****** ****** *) 229 | 230 | #staload 231 | UN = "prelude/SATS/unsafe.sats" 232 | #staload 233 | STDLIB = "libats/libc/SATS/stdlib.sats" 234 | #staload 235 | UNISTD = "libats/libc/SATS/unistd.sats" 236 | 237 | (* ****** ****** *) 238 | 239 | abstype chanraw_type = ptr 240 | typedef chanraw = chanraw_type 241 | 242 | (* ****** ****** *) 243 | // 244 | extern 245 | fun{} 246 | linenum_get(string): int 247 | // 248 | implement 249 | {}(*tmp*) 250 | linenum_get 251 | (line) = $STDLIB.atoi(line) 252 | // 253 | (* ****** ****** *) 254 | // 255 | // HX-2018-01-16: 256 | // [chanraw_readall] 257 | // returns a representation of 258 | // a JSON-array of JSON-strings 259 | // 260 | extern 261 | fun{} 262 | chanraw_readall 263 | (ch: chanraw): Option_vt(string) 264 | // 265 | (* ****** ****** *) 266 | // 267 | extern 268 | fun{} 269 | chanraw_readall_pause(chanraw): void 270 | // 271 | implement 272 | {}(*tmp*) 273 | chanraw_readall_pause 274 | (ch) = 275 | ignoret($UNISTD.usleep(1000000)) 276 | // 277 | (* ****** ****** *) 278 | // 279 | extern 280 | fun{} 281 | streamize_chanraw 282 | (ch: chanraw): stream_vt(string) 283 | extern 284 | fun{} 285 | streamize_chanraw_gte 286 | (ch: chanraw, n0: int): stream_vt(string) 287 | // 288 | (* ****** ****** *) 289 | // 290 | implement 291 | {}(*tmp*) 292 | streamize_chanraw 293 | (ch) = 294 | ( 295 | streamize_chanraw_gte<>(ch, 0(*n0*)) 296 | ) 297 | // 298 | (* ****** ****** *) 299 | 300 | implement 301 | {}(*tmp*) 302 | streamize_chanraw_gte 303 | (ch, n0) = 304 | auxjoin(0) where 305 | { 306 | // 307 | fun 308 | auxone 309 | (n0: int): 310 | List0_vt(string) = let 311 | // 312 | val opt = 313 | chanraw_readall<>(ch) 314 | // 315 | in 316 | // 317 | case+ opt of 318 | | ~None_vt() => 319 | list_vt_nil() 320 | | ~Some_vt(jsn) => let 321 | val jsv = 322 | jsonval_ofstring(jsn) 323 | in 324 | case+ jsv of 325 | | JSONarray(jsvs) => 326 | auxone_arr(n0, jsvs, list_vt_nil) 327 | | _ (*non-JSONarray*) => list_vt_nil() 328 | end // end of [Some_vt] 329 | // 330 | end // end of [auxone] 331 | // 332 | and 333 | auxone_arr 334 | ( 335 | n0: int 336 | , 337 | xs: jsonvalist 338 | , 339 | cs: List0_vt(string) 340 | ) : List0_vt(string) = 341 | ( 342 | case+ xs of 343 | | list_nil() => cs 344 | | list_cons(x0, xs) => let 345 | val-JSONstring(x0) = x0 346 | val i0 = linenum_get<>(x0) 347 | in 348 | if 349 | i0 <= n0 350 | then (cs) 351 | else 352 | auxone_arr(n0, xs, list_vt_cons(x0, cs)) 353 | end // end of [list_cons] 354 | ) (* end of [auxone_arr] *) 355 | // 356 | fun 357 | auxjoin 358 | ( 359 | n0: int 360 | ) : 361 | stream_vt(string) = 362 | $ldelay(auxjoin_con(n0)) 363 | // 364 | and 365 | auxjoin_con 366 | ( 367 | n0: int 368 | ) : 369 | stream_vt_con(string) = 370 | let 371 | val xs = auxone(n0) 372 | in 373 | // 374 | case+ xs of 375 | | ~list_vt_nil 376 | () => 377 | auxjoin_con(n0) where 378 | { 379 | val () = 380 | chanraw_readall_pause<>(ch) 381 | } 382 | | ~list_vt_cons 383 | (x0, xs) => 384 | stream_vt_cons(x0, auxjoin_lst(x0, xs)) 385 | // 386 | end // end of [auxjoin_con] 387 | // 388 | and 389 | auxjoin_lst 390 | ( 391 | x0: string 392 | , 393 | xs: List0_vt(string) 394 | ) : stream_vt(string) = $ldelay 395 | ( 396 | ( 397 | case+ xs of 398 | | ~list_vt_nil 399 | () => ! 400 | (auxjoin($STDLIB.atoi(x0))) 401 | | ~list_vt_cons 402 | (x1, xs) => 403 | stream_vt_cons(x1, auxjoin_lst(x1, xs)) 404 | ), (list_vt_free(xs)) 405 | ) 406 | // 407 | } (* end of [streamize_chanraw_gte] *) 408 | 409 | (* ****** ****** *) 410 | 411 | local 412 | 413 | fun 414 | auxproc 415 | ( 416 | xs: stream_vt(string) 417 | ) : stream_vt(string) = 418 | stream_vt_map 419 | (xs) where 420 | { 421 | // 422 | implement 423 | stream_vt_map$fopr 424 | (x) = 425 | trunc(string2ptr(x)) where 426 | { 427 | // 428 | fun 429 | trunc(p0: ptr): string = let 430 | // 431 | val c0 = $UN.ptr0_get(p0) 432 | // 433 | in 434 | // 435 | if 436 | iseqz(c0) 437 | then "" else 438 | ( 439 | if 440 | (c0 != ':') 441 | then 442 | trunc(ptr_succ(p0)) 443 | else 444 | $UN.cast{string}(ptr_succ(p0)) 445 | ) 446 | // 447 | end // end of [trunc] 448 | } (* end of [stream_vt_map$fopr] *) 449 | } 450 | 451 | in 452 | 453 | fun 454 | streamize_channel00 455 | ( 456 | // argless 457 | ) : stream_vt(string) = let 458 | // 459 | val 460 | CH0 = $UN.cast{chanraw}(0) 461 | // 462 | implement 463 | chanraw_readall<>(ch) = let 464 | val opt = 465 | $BUCS520.streamopt_url_char<> 466 | (Channel00Readall) 467 | in 468 | case+ opt of 469 | | ~None_vt() => 470 | None_vt() 471 | | ~Some_vt(xs) => 472 | Some_vt 473 | (strptr2string 474 | (string_make_stream_vt($UN.castvwtp0(xs))) 475 | ) (* end of [Some_vt] *) 476 | end // end of [chanraw_readall] 477 | // 478 | in 479 | auxproc(streamize_chanraw<>(CH0)) 480 | end // end of [streamize_channel00] 481 | 482 | (* ****** ****** *) 483 | 484 | fun 485 | streamize_channel01 486 | ( 487 | // argless 488 | ) : stream_vt(string) = let 489 | // 490 | val 491 | CH1 = $UN.cast{chanraw}(1) 492 | // 493 | implement 494 | chanraw_readall<>(ch) = let 495 | val opt = 496 | $BUCS520.streamopt_url_char<> 497 | (Channel01Readall) 498 | in 499 | case+ opt of 500 | | ~None_vt() => 501 | None_vt() 502 | | ~Some_vt(xs) => 503 | Some_vt 504 | (strptr2string 505 | (string_make_stream_vt($UN.castvwtp0(xs))) 506 | ) (* end of [Some_vt] *) 507 | end // end of [chanraw_readall] 508 | // 509 | in 510 | auxproc(streamize_chanraw<>(CH1)) 511 | end // end of [streamize_channel01] 512 | 513 | end // end of [local] 514 | 515 | (* ****** ****** *) 516 | 517 | extern 518 | fun 519 | channel00_clearall 520 | ((*void*)): void 521 | implement 522 | channel00_clearall 523 | ((*void*)) = let 524 | val opt = 525 | $BUCS520.streamopt_url_char<> 526 | (Channel00Clearall) 527 | in 528 | case+ opt of 529 | | ~None_vt() => () 530 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 531 | end // end of [channel00_clearall] 532 | 533 | extern 534 | fun 535 | channel01_clearall 536 | ((*void*)): void 537 | implement 538 | channel01_clearall 539 | ((*void*)) = let 540 | val opt = 541 | $BUCS520.streamopt_url_char<> 542 | (Channel01Clearall) 543 | in 544 | case+ opt of 545 | | ~None_vt() => () 546 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 547 | end // end of [channel01_clearall] 548 | 549 | (* ****** ****** *) 550 | 551 | local 552 | 553 | val 554 | theCH00 = 555 | ref(the_null_ptr) 556 | val 557 | theCH01 = 558 | ref(the_null_ptr) 559 | 560 | in 561 | 562 | (* ****** ****** *) 563 | // 564 | extern 565 | fun 566 | channel00_pop_msg 567 | ((*void*)): string 568 | extern 569 | fun 570 | channel01_pop_msg 571 | ((*void*)): string 572 | // 573 | (* ****** ****** *) 574 | 575 | implement 576 | channel00_pop_msg 577 | ((*void*)) = let 578 | // 579 | val p0 = theCH00[] 580 | // 581 | in 582 | if 583 | isneqz(p0) 584 | then let 585 | val xs = 586 | $UN.castvwtp0{stream_vt(string)}(p0) 587 | in 588 | case- !xs of 589 | | ~stream_vt_cons(x0, xs) => x0 where 590 | { 591 | val () = 592 | theCH00[] := $UN.castvwtp0{ptr}(xs) 593 | } 594 | end // end of [then] 595 | else let 596 | val xs = 597 | streamize_channel00() 598 | val () = 599 | theCH00[] := 600 | $UN.castvwtp0{ptr}(xs) in channel00_pop_msg() 601 | end // end of [else] 602 | end // end of [channel00_pop_msg] 603 | 604 | implement 605 | channel01_pop_msg 606 | ((*void*)) = let 607 | // 608 | val p0 = theCH01[] 609 | // 610 | in 611 | if 612 | isneqz(p0) 613 | then let 614 | val xs = 615 | $UN.castvwtp0{stream_vt(string)}(p0) 616 | in 617 | case- !xs of 618 | | ~stream_vt_cons(x0, xs) => x0 where 619 | { 620 | val () = theCH01[] := $UN.castvwtp0{ptr}(xs) 621 | } 622 | end // end of [then] 623 | else let 624 | val xs = 625 | streamize_channel01() 626 | val () = 627 | theCH01[] := $UN.castvwtp0{ptr}(xs) in channel01_pop_msg() 628 | end // end of [else] 629 | end // end of [channel01_pop_msg] 630 | 631 | end // end of [local] 632 | // 633 | (* ****** ****** *) 634 | 635 | local 636 | // 637 | reassume channel_type 638 | // 639 | (* ****** ****** *) 640 | 641 | fun{} 642 | ismem 643 | ( 644 | CH: 645 | channel(), r0: role 646 | ) : bool = loop(CH) where 647 | { 648 | fun 649 | loop(rs: list0(int)): bool = 650 | ( 651 | case+ rs of 652 | | list0_nil() => false 653 | | list0_cons(r1, rs) => 654 | if r0 = r1 then true else loop(rs) 655 | ) 656 | } 657 | 658 | fun{} 659 | jsonval_int 660 | (x: int) = JSONint(g0i2i(x)) 661 | 662 | in 663 | 664 | implement 665 | {}(*tmp*) 666 | chanrole_bmsg_recv_int 667 | (CH, r) = let 668 | // 669 | val tf = ismem<>(CH, r) 670 | // 671 | val () = 672 | if (tf) 673 | then let 674 | val () = 675 | prerrln! 676 | ("chanrole_bmsg_recv_int: non-recv") 677 | in 678 | assertloc(false) 679 | end // end of [if] 680 | // 681 | in 682 | // 683 | ifcase 684 | | (r = 0) => 685 | $UN.cast{int}(x) where 686 | { 687 | val msg = channel00_pop_msg() 688 | val-JSONint(x) = jsonval_ofstring(msg) 689 | } 690 | | (r = 1) => 691 | $UN.cast{int}(x) where 692 | { 693 | val msg = channel01_pop_msg() 694 | val-JSONint(x) = jsonval_ofstring(msg) 695 | } 696 | | _(* else *) => 697 | let 698 | val () = 699 | prerrln!("chanrole_bmsg_recv_int: r = ", r) 700 | in 701 | let val () = assertloc(false) in $UN.cast{int}(0) end 702 | // end of [if] 703 | end (* end of [let] *) 704 | // 705 | end // chanrole_bmsg_recv_int 706 | 707 | end // end of [local] 708 | 709 | (* ****** ****** *) 710 | 711 | (* end of [mybasis.dats] *) 712 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test01/myclient.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | extern 26 | fun 27 | myclient 28 | {id:int} 29 | (CH: channel(id), prot: protocol(id)): void 30 | extern 31 | fun 32 | myclient_optrep 33 | {id:int} 34 | (CH: channel(id), prot: protocol(id)): void 35 | 36 | (* ****** ****** *) 37 | // 38 | #staload UN = $UNSAFE 39 | // 40 | #staload "./mybasis.dats" 41 | // 42 | (* ****** ****** *) 43 | 44 | implement 45 | myclient 46 | (CH, prot) = let 47 | // 48 | var prot = prot 49 | // 50 | val x1 = 51 | chanprot_bmsg_recv 52 | (CH, prot) 53 | val x2 = 54 | chanprot_bmsg_recv 55 | (CH, prot) 56 | // 57 | val () = 58 | println! ("x1 = ", x1) 59 | val () = 60 | println! ("x2 = ", x2) 61 | // 62 | val () = 63 | chanprot_bmsg_send 64 | (CH, prot, x1 * x2) 65 | // 66 | val x4 = 67 | chanprot_bmsg_recv(CH, prot) 68 | // 69 | val () = 70 | println! ("x4 = ", x4) 71 | // 72 | val () = 73 | chanprot_elim_nil(CH, prot) 74 | // 75 | in 76 | // 77 | if (x4 > 0) 78 | then println!("Correct!") else println!("Incorrect!") 79 | // 80 | end // end of [let] // end of [myclient] 81 | 82 | (* ****** ****** *) 83 | 84 | implement 85 | myclient_optrep 86 | (CH, prot) = let 87 | // 88 | var prot = prot 89 | // 90 | (* 91 | val () = 92 | println! 93 | ( "prot = " 94 | , $UN.castvwtp1{prtcl}(prot)) 95 | *) 96 | // 97 | val opt = 98 | chanprot_conj_aneg<>(CH, prot) 99 | (* 100 | val 101 | ((*void*)) = 102 | println! 103 | ("myclient_optrep: opt = ", opt) 104 | *) 105 | // 106 | in 107 | // 108 | if 109 | (opt=0) 110 | then let 111 | val () = 112 | chanprot_elim_nil<> 113 | (CH, prot) 114 | in 115 | println!("It is over!") 116 | end // end of [then] 117 | else let 118 | val- 119 | ~Some_vt(P0) = 120 | prtcl_join_uncons(prot) 121 | val () = myclient(CH, P0) 122 | in 123 | myclient_optrep(CH, prot) 124 | end // end of [else] 125 | // 126 | end // end of [myclient_optrep] 127 | 128 | (* ****** ****** *) 129 | 130 | local 131 | 132 | #dynload"./mybasis.dats" 133 | 134 | #include 135 | "./../../DATS/basics.dats" 136 | 137 | in (*in-of-local*) 138 | 139 | implement 140 | main0() = () where 141 | { 142 | // 143 | val 144 | prot = 145 | prtcl_optrep(0, myprtcl()) 146 | val 147 | [id:int] 148 | prot = 149 | $UN.castvwtp0{protocol()}(prot) 150 | // 151 | val CH = 152 | $UN.cast 153 | {channel(id)}(list0_tuple(1)) 154 | // 155 | val ((*void*)) = myclient_optrep(CH, prot) 156 | // 157 | } (* end of [main0] *) 158 | 159 | end // end of [local] 160 | 161 | (* ****** ****** *) 162 | 163 | (* end of [myclient.dats] *) 164 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test01/myserver.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | extern 26 | fun 27 | myserver 28 | {id:int} 29 | (CH: channel(id), prot: protocol(id)): void 30 | extern 31 | fun 32 | myserver_optrep 33 | {id:int} 34 | ( CH: channel(id) 35 | , prot: protocol(id), lines: stream_vt(string)): void 36 | 37 | (* ****** ****** *) 38 | 39 | #define N 100 40 | 41 | (* ****** ****** *) 42 | // 43 | #staload UN = $UNSAFE 44 | // 45 | #staload "./mybasis.dats" 46 | // 47 | (* ****** ****** *) 48 | 49 | implement 50 | myserver 51 | (CH, prot) = let 52 | // 53 | var prot = prot 54 | // 55 | (* 56 | val () = 57 | println! 58 | ( "myserver: prot = " 59 | , $UN.castvwtp1{prtcl}(prot)) 60 | *) 61 | // 62 | val x1 = randint(N) 63 | val x2 = randint(N) 64 | val () = 65 | chanprot_bmsg_send 66 | (CH, prot, x1) 67 | val () = 68 | chanprot_bmsg_send 69 | (CH, prot, x2) 70 | // 71 | val y3 = 72 | chanprot_bmsg_recv(CH, prot) 73 | // 74 | val () = 75 | println!("x1 = ", x1) 76 | val () = 77 | println!("x2 = ", x2) 78 | val () = 79 | println!("y3 = ", y3) 80 | // 81 | val x4 = 82 | ( 83 | if x1*x2 = y3 then 1 else 0 84 | // end of [if] 85 | ) : int // end of [val] 86 | val () = 87 | chanprot_bmsg_send(CH, prot, x4) 88 | // 89 | val () = 90 | chanprot_elim_nil(CH, prot) 91 | in 92 | // 93 | if (x4 > 0) 94 | then println!("Correct!") else println!("Incorrect!") 95 | // 96 | end // end of [let] // end of [myserver] 97 | 98 | (* ****** ****** *) 99 | 100 | implement 101 | myserver_optrep 102 | (CH, prot, lines) = let 103 | // 104 | var prot = prot 105 | // 106 | val () = 107 | println! (">>test or quit?") 108 | (* 109 | val () = 110 | println! 111 | ( "myserver_optrep: prot = " 112 | , $UN.castvwtp1{prtcl}(prot)) 113 | *) 114 | // 115 | in 116 | // 117 | case+ !lines of 118 | | ~stream_vt_nil() => let 119 | val () = 120 | chanprot_conj_apos<> 121 | (CH, prot, 0(*exit*)) 122 | in 123 | chanprot_elim_nil<>(CH, prot) 124 | end // end of [stream_vt_nil] 125 | | ~stream_vt_cons 126 | (line, lines) => 127 | ( 128 | case+ line of 129 | | "quit" => let 130 | val () = 131 | lazy_vt_free(lines) 132 | val () = 133 | chanprot_conj_apos<> 134 | (CH, prot, 0(*exit*)) 135 | // end of [val] 136 | in 137 | chanprot_elim_nil<>(CH, prot) 138 | end // end of [quit] 139 | | _(*non-quit*) => let 140 | val () = 141 | chanprot_conj_apos<> 142 | (CH, prot, 1(*exit*)) 143 | // end of [val] 144 | val- 145 | ~Some_vt(P0) = 146 | prtcl_join_uncons(prot) 147 | val () = myserver(CH, P0) 148 | in 149 | myserver_optrep(CH, prot, lines) 150 | end // end of [non-quit] 151 | ) 152 | end (* end of [myserver_optrep] *) 153 | 154 | (* ****** ****** *) 155 | 156 | local 157 | 158 | #dynload"./mybasis.dats" 159 | 160 | #include 161 | "./../../DATS/basics.dats" 162 | 163 | in (*in-of-local*) 164 | 165 | implement 166 | main0() = () where 167 | { 168 | // 169 | val 170 | prot = 171 | prtcl_optrep(0, myprtcl()) 172 | val 173 | [id:int] 174 | prot = 175 | $UN.castvwtp0{protocol()}(prot) 176 | // 177 | val () = channel00_clearall() 178 | val () = channel01_clearall() 179 | // 180 | val CH = 181 | $UN.cast 182 | {channel(id)}(list0_tuple(0)) 183 | // 184 | val ((*void*)) = 185 | myserver_optrep 186 | (CH, prot, lines) where 187 | { 188 | val 189 | lines = 190 | streamize_fileref_line(stdin_ref) 191 | } 192 | // 193 | } (* end of [main0] *) 194 | 195 | end // end of [local] 196 | 197 | (* ****** ****** *) 198 | 199 | (* end of [myserver.dats] *) 200 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test01/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-libjson-c": "^1.0.1", 4 | "atscntrb-hx-teaching-bucs": "^1.0.8" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test02/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-21: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: myserver_dats 23 | all:: myclient_dats 24 | all:: mygrader_dats 25 | 26 | ###### 27 | 28 | testall:: npm-install 29 | testall:: all cleanall 30 | 31 | ###### 32 | # 33 | myserver_dats: \ 34 | mybasis.dats \ 35 | myserver.dats; \ 36 | $(PATSCC) -I./node_modules \ 37 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $^ -latslib -ljson-c 38 | # 39 | myclient_dats: \ 40 | mybasis.dats \ 41 | myclient.dats; \ 42 | $(PATSCC) -I./node_modules \ 43 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $^ -latslib -ljson-c 44 | # 45 | mygrader_dats: \ 46 | mybasis.dats \ 47 | mygrader.dats; \ 48 | $(PATSCC) -I./node_modules \ 49 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $^ -latslib -ljson-c 50 | # 51 | ###### 52 | 53 | clean:: ; rm -f *~ 54 | clean:: ; rm -f *_?ats.o 55 | clean:: ; rm -f *_?ats.c 56 | 57 | cleanall:: clean 58 | cleanall:: ; rm -f myserver_dats 59 | cleanall:: ; rm -f myclient_dats 60 | cleanall:: ; rm -f mygrader_dats 61 | cleanall:: ; rm -f node_modules -r 62 | cleanall:: ; rm -f package-lock.json 63 | 64 | ###### 65 | 66 | npm-update:: ; $(NPM) update 67 | npm-install:: ; $(NPM) install 68 | 69 | ###### 70 | 71 | export \ 72 | PATSHOMELOCS=./node_modules:./../node_modules:./../../node_modules 73 | 74 | ###### end of [Makefile] ###### 75 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test02/mybasis.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | local 26 | 27 | (* ****** ****** *) 28 | 29 | #define ssint SSDTint 30 | #define ssbool SSDTbool 31 | #define sslist SSDTlist 32 | 33 | (* ****** ****** *) 34 | 35 | #define ssbmsg PRTCLbmsg 36 | // 37 | #define ssjoin PRTCLjoin 38 | // 39 | #define sslazy PRTCLlazy 40 | // 41 | #define ssaconj PRTCLaconj 42 | #define ssmconj PRTCLmconj 43 | 44 | (* ****** ****** *) 45 | 46 | in 47 | 48 | extern 49 | fun 50 | myprtcl(): prtcl 51 | implement 52 | myprtcl() = ssjoin 53 | ( 54 | list0_tuple 55 | ( ssbmsg(0, ssint), ssbmsg(0, ssint) 56 | , ssbmsg(1, ssint), ssbmsg(2, ssint) 57 | ) 58 | ) 59 | 60 | end // end of [local] 61 | 62 | (* ****** ****** *) 63 | // 64 | #include 65 | "$PATSHOMELOCS\ 66 | /atscntrb-hx-libjson-c/mylibies.hats" 67 | #include 68 | "$PATSHOMELOCS\ 69 | /atscntrb-hx-libjson-c/mylibies_link.hats" 70 | // 71 | #staload $JSON_ML 72 | // 73 | (* ****** ****** *) 74 | // 75 | #include 76 | "$PATSHOMELOCS\ 77 | /atscntrb-hx-teaching-bucs/mylibies.hats" 78 | // 79 | (* ****** ****** *) 80 | // 81 | #define 82 | Channel00Insert 83 | "http://cs320.herokuapp.com/api/channel00/insert" 84 | #define 85 | Channel01Insert 86 | "http://cs320.herokuapp.com/api/channel01/insert" 87 | #define 88 | Channel02Insert 89 | "http://cs320.herokuapp.com/api/channel02/insert" 90 | // 91 | (* ****** ****** *) 92 | 93 | #define 94 | Channel00Readall 95 | "http://cs320.herokuapp.com/api/channel00/readall" 96 | #define 97 | Channel01Readall 98 | "http://cs320.herokuapp.com/api/channel01/readall" 99 | #define 100 | Channel02Readall 101 | "http://cs320.herokuapp.com/api/channel02/readall" 102 | 103 | #define 104 | Channel00Clearall 105 | "http://cs320.herokuapp.com/api/channel00/clearall" 106 | #define 107 | Channel01Clearall 108 | "http://cs320.herokuapp.com/api/channel01/clearall" 109 | #define 110 | Channel02Clearall 111 | "http://cs320.herokuapp.com/api/channel02/clearall" 112 | 113 | (* ****** ****** *) 114 | // 115 | extern 116 | fun 117 | channel00_insert_msg 118 | (msg: string): void 119 | implement 120 | channel00_insert_msg 121 | (msg) = let 122 | val opt = 123 | $BUCS520.streamopt_url_char<> 124 | (string_append3 125 | (Channel00Insert, "/", msg)) 126 | in 127 | case+ opt of 128 | | ~None_vt() => () 129 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 130 | end // end of [channel00_insert_msg] 131 | // 132 | extern 133 | fun 134 | channel01_insert_msg 135 | (msg: string): void 136 | implement 137 | channel01_insert_msg 138 | (msg) = let 139 | val opt = 140 | $BUCS520.streamopt_url_char<> 141 | (string_append3 142 | (Channel01Insert, "/", msg)) 143 | in 144 | case+ opt of 145 | | ~None_vt() => () 146 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 147 | end // end of [channel01_insert_msg] 148 | // 149 | extern 150 | fun 151 | channel02_insert_msg 152 | (msg: string): void 153 | implement 154 | channel02_insert_msg 155 | (msg) = let 156 | val opt = 157 | $BUCS520.streamopt_url_char<> 158 | (string_append3 159 | (Channel02Insert, "/", msg)) 160 | in 161 | case+ opt of 162 | | ~None_vt() => () 163 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 164 | end // end of [channel02_insert_msg] 165 | // 166 | (* ****** ****** *) 167 | 168 | local 169 | // 170 | assume 171 | channel_type(id) = list0(int) 172 | // 173 | in (* nothing *) end 174 | 175 | (* ****** ****** *) 176 | 177 | local 178 | 179 | reassume channel_type 180 | 181 | fun{} 182 | ismem 183 | ( 184 | CH: 185 | channel(), r0: role 186 | ) : bool = loop(CH) where 187 | { 188 | fun 189 | loop(rs: list0(int)): bool = 190 | ( 191 | case+ rs of 192 | | list0_nil() => false 193 | | list0_cons(r1, rs) => 194 | if r0 = r1 then true else loop(rs) 195 | ) 196 | } 197 | 198 | fun{} 199 | jsonval_int 200 | (x: int) = JSONint(g0i2i(x)) 201 | 202 | in 203 | 204 | implement 205 | {}(*tmp*) 206 | chanrole_bmsg_send_int 207 | (CH, r, x) = let 208 | // 209 | val tf = ismem<>(CH, r) 210 | // 211 | val () = 212 | if (tf) 213 | then () 214 | else let 215 | val () = 216 | prerrln! 217 | ("chanrole_bmsg_send_int: non-send") 218 | in 219 | assertloc(false) 220 | end // end of [if] 221 | // 222 | in 223 | // 224 | ifcase 225 | | (r = 0) => 226 | { 227 | val msg = 228 | jsonval_tostring(jsonval_int(x)) 229 | val ((*send*)) = 230 | channel00_insert_msg($UN.strptr2string(msg)) 231 | val ((*freed*)) = strptr_free(msg) 232 | } 233 | | (r = 1) => 234 | { 235 | val msg = 236 | jsonval_tostring(jsonval_int(x)) 237 | val ((*send*)) = 238 | channel01_insert_msg($UN.strptr2string(msg)) 239 | val ((*freed*)) = strptr_free(msg) 240 | } 241 | | (r = 2) => 242 | { 243 | val msg = 244 | jsonval_tostring(jsonval_int(x)) 245 | val ((*send*)) = 246 | channel02_insert_msg($UN.strptr2string(msg)) 247 | val ((*freed*)) = strptr_free(msg) 248 | } 249 | | _(* else *) => 250 | let 251 | val () = 252 | prerrln!("chanrole_bmsg_send_int: r = ", r) 253 | in 254 | let val () = assertloc(false) in ((*void*)) end 255 | // end of [if] 256 | end (* end of [let] *) 257 | // 258 | end // chanrole_bmsg_send_int 259 | 260 | end // end of [local] 261 | 262 | (* ****** ****** *) 263 | 264 | #staload 265 | UN = "prelude/SATS/unsafe.sats" 266 | #staload 267 | STDLIB = "libats/libc/SATS/stdlib.sats" 268 | #staload 269 | UNISTD = "libats/libc/SATS/unistd.sats" 270 | 271 | (* ****** ****** *) 272 | 273 | abstype chanraw_type = ptr 274 | typedef chanraw = chanraw_type 275 | 276 | (* ****** ****** *) 277 | // 278 | extern 279 | fun{} 280 | linenum_get(string): int 281 | // 282 | implement 283 | {}(*tmp*) 284 | linenum_get 285 | (line) = $STDLIB.atoi(line) 286 | // 287 | (* ****** ****** *) 288 | // 289 | // HX-2018-01-16: 290 | // [chanraw_readall] 291 | // returns a representation of 292 | // a JSON-array of JSON-strings 293 | // 294 | extern 295 | fun{} 296 | chanraw_readall 297 | (ch: chanraw): Option_vt(string) 298 | // 299 | (* ****** ****** *) 300 | // 301 | extern 302 | fun{} 303 | chanraw_readall_pause(chanraw): void 304 | // 305 | implement 306 | {}(*tmp*) 307 | chanraw_readall_pause 308 | (ch) = 309 | ignoret($UNISTD.usleep(1000000)) 310 | // 311 | (* ****** ****** *) 312 | // 313 | extern 314 | fun{} 315 | streamize_chanraw 316 | (ch: chanraw): stream_vt(string) 317 | extern 318 | fun{} 319 | streamize_chanraw_gte 320 | (ch: chanraw, n0: int): stream_vt(string) 321 | // 322 | (* ****** ****** *) 323 | // 324 | implement 325 | {}(*tmp*) 326 | streamize_chanraw 327 | (ch) = 328 | ( 329 | streamize_chanraw_gte<>(ch, 0(*n0*)) 330 | ) 331 | // 332 | (* ****** ****** *) 333 | 334 | implement 335 | {}(*tmp*) 336 | streamize_chanraw_gte 337 | (ch, n0) = 338 | auxjoin(0) where 339 | { 340 | // 341 | fun 342 | auxone 343 | (n0: int): 344 | List0_vt(string) = let 345 | // 346 | val opt = 347 | chanraw_readall<>(ch) 348 | // 349 | in 350 | // 351 | case+ opt of 352 | | ~None_vt() => 353 | list_vt_nil() 354 | | ~Some_vt(jsn) => let 355 | val jsv = 356 | jsonval_ofstring(jsn) 357 | in 358 | case+ jsv of 359 | | JSONarray(jsvs) => 360 | auxone_arr(n0, jsvs, list_vt_nil) 361 | | _ (*non-JSONarray*) => list_vt_nil() 362 | end // end of [Some_vt] 363 | // 364 | end // end of [auxone] 365 | // 366 | and 367 | auxone_arr 368 | ( 369 | n0: int 370 | , 371 | xs: jsonvalist 372 | , 373 | cs: List0_vt(string) 374 | ) : List0_vt(string) = 375 | ( 376 | case+ xs of 377 | | list_nil() => cs 378 | | list_cons(x0, xs) => let 379 | val-JSONstring(x0) = x0 380 | val i0 = linenum_get<>(x0) 381 | in 382 | if 383 | i0 <= n0 384 | then (cs) 385 | else 386 | auxone_arr(n0, xs, list_vt_cons(x0, cs)) 387 | end // end of [list_cons] 388 | ) (* end of [auxone_arr] *) 389 | // 390 | fun 391 | auxjoin 392 | ( 393 | n0: int 394 | ) : 395 | stream_vt(string) = 396 | $ldelay(auxjoin_con(n0)) 397 | // 398 | and 399 | auxjoin_con 400 | ( 401 | n0: int 402 | ) : 403 | stream_vt_con(string) = 404 | let 405 | val xs = auxone(n0) 406 | in 407 | // 408 | case+ xs of 409 | | ~list_vt_nil 410 | () => 411 | auxjoin_con(n0) where 412 | { 413 | val () = 414 | chanraw_readall_pause<>(ch) 415 | } 416 | | ~list_vt_cons 417 | (x0, xs) => 418 | stream_vt_cons(x0, auxjoin_lst(x0, xs)) 419 | // 420 | end // end of [auxjoin_con] 421 | // 422 | and 423 | auxjoin_lst 424 | ( 425 | x0: string 426 | , 427 | xs: List0_vt(string) 428 | ) : stream_vt(string) = $ldelay 429 | ( 430 | ( 431 | case+ xs of 432 | | ~list_vt_nil 433 | () => ! 434 | (auxjoin($STDLIB.atoi(x0))) 435 | | ~list_vt_cons 436 | (x1, xs) => 437 | stream_vt_cons(x1, auxjoin_lst(x1, xs)) 438 | ), (list_vt_free(xs)) 439 | ) 440 | // 441 | } (* end of [streamize_chanraw_gte] *) 442 | 443 | (* ****** ****** *) 444 | 445 | local 446 | 447 | fun 448 | auxproc 449 | ( 450 | xs: stream_vt(string) 451 | ) : stream_vt(string) = 452 | stream_vt_map 453 | (xs) where 454 | { 455 | // 456 | implement 457 | stream_vt_map$fopr 458 | (x) = 459 | trunc(string2ptr(x)) where 460 | { 461 | // 462 | fun 463 | trunc(p0: ptr): string = let 464 | // 465 | val c0 = $UN.ptr0_get(p0) 466 | // 467 | in 468 | // 469 | if 470 | iseqz(c0) 471 | then "" else 472 | ( 473 | if 474 | (c0 != ':') 475 | then 476 | trunc(ptr_succ(p0)) 477 | else 478 | $UN.cast{string}(ptr_succ(p0)) 479 | ) 480 | // 481 | end // end of [trunc] 482 | } (* end of [stream_vt_map$fopr] *) 483 | } 484 | 485 | in 486 | 487 | fun 488 | streamize_channel00 489 | ( 490 | // argless 491 | ) : stream_vt(string) = let 492 | // 493 | val 494 | CH0 = $UN.cast{chanraw}(0) 495 | // 496 | implement 497 | chanraw_readall<>(ch) = let 498 | val opt = 499 | $BUCS520.streamopt_url_char<> 500 | (Channel00Readall) 501 | in 502 | case+ opt of 503 | | ~None_vt() => 504 | None_vt() 505 | | ~Some_vt(xs) => 506 | Some_vt 507 | (strptr2string 508 | (string_make_stream_vt($UN.castvwtp0(xs))) 509 | ) (* end of [Some_vt] *) 510 | end // end of [chanraw_readall] 511 | // 512 | in 513 | auxproc(streamize_chanraw<>(CH0)) 514 | end // end of [streamize_channel00] 515 | 516 | (* ****** ****** *) 517 | 518 | fun 519 | streamize_channel01 520 | ( 521 | // argless 522 | ) : stream_vt(string) = let 523 | // 524 | val 525 | CH1 = $UN.cast{chanraw}(1) 526 | // 527 | implement 528 | chanraw_readall<>(ch) = let 529 | val opt = 530 | $BUCS520.streamopt_url_char<> 531 | (Channel01Readall) 532 | in 533 | case+ opt of 534 | | ~None_vt() => 535 | None_vt() 536 | | ~Some_vt(xs) => 537 | Some_vt 538 | (strptr2string 539 | (string_make_stream_vt($UN.castvwtp0(xs))) 540 | ) (* end of [Some_vt] *) 541 | end // end of [chanraw_readall] 542 | // 543 | in 544 | auxproc(streamize_chanraw<>(CH1)) 545 | end // end of [streamize_channel01] 546 | 547 | fun 548 | streamize_channel02 549 | ( 550 | // argless 551 | ) : stream_vt(string) = let 552 | // 553 | val 554 | CH2 = $UN.cast{chanraw}(2) 555 | // 556 | implement 557 | chanraw_readall<>(ch) = let 558 | val opt = 559 | $BUCS520.streamopt_url_char<> 560 | (Channel02Readall) 561 | in 562 | case+ opt of 563 | | ~None_vt() => 564 | None_vt() 565 | | ~Some_vt(xs) => 566 | Some_vt 567 | (strptr2string 568 | (string_make_stream_vt($UN.castvwtp0(xs))) 569 | ) (* end of [Some_vt] *) 570 | end // end of [chanraw_readall] 571 | // 572 | in 573 | auxproc(streamize_chanraw<>(CH2)) 574 | end // end of [streamize_channel02] 575 | 576 | end // end of [local] 577 | 578 | (* ****** ****** *) 579 | 580 | extern 581 | fun 582 | channel00_clearall 583 | ((*void*)): void 584 | implement 585 | channel00_clearall 586 | ((*void*)) = let 587 | val opt = 588 | $BUCS520.streamopt_url_char<> 589 | (Channel00Clearall) 590 | in 591 | case+ opt of 592 | | ~None_vt() => () 593 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 594 | end // end of [channel00_clearall] 595 | 596 | extern 597 | fun 598 | channel01_clearall 599 | ((*void*)): void 600 | implement 601 | channel01_clearall 602 | ((*void*)) = let 603 | val opt = 604 | $BUCS520.streamopt_url_char<> 605 | (Channel01Clearall) 606 | in 607 | case+ opt of 608 | | ~None_vt() => () 609 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 610 | end // end of [channel01_clearall] 611 | 612 | extern 613 | fun 614 | channel02_clearall 615 | ((*void*)): void 616 | implement 617 | channel02_clearall 618 | ((*void*)) = let 619 | val opt = 620 | $BUCS520.streamopt_url_char<> 621 | (Channel02Clearall) 622 | in 623 | case+ opt of 624 | | ~None_vt() => () 625 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 626 | end // end of [channel02_clearall] 627 | 628 | (* ****** ****** *) 629 | 630 | local 631 | 632 | val 633 | theCH00 = 634 | ref(the_null_ptr) 635 | val 636 | theCH01 = 637 | ref(the_null_ptr) 638 | val 639 | theCH02 = 640 | ref(the_null_ptr) 641 | 642 | in 643 | 644 | (* ****** ****** *) 645 | // 646 | extern 647 | fun 648 | channel00_pop_msg 649 | ((*void*)): string 650 | extern 651 | fun 652 | channel01_pop_msg 653 | ((*void*)): string 654 | extern 655 | fun 656 | channel02_pop_msg 657 | ((*void*)): string 658 | // 659 | (* ****** ****** *) 660 | 661 | implement 662 | channel00_pop_msg 663 | ((*void*)) = let 664 | // 665 | val p0 = theCH00[] 666 | // 667 | in 668 | if 669 | isneqz(p0) 670 | then let 671 | val xs = 672 | $UN.castvwtp0{stream_vt(string)}(p0) 673 | in 674 | case- !xs of 675 | | ~stream_vt_cons(x0, xs) => x0 where 676 | { 677 | val () = 678 | theCH00[] := $UN.castvwtp0{ptr}(xs) 679 | } 680 | end // end of [then] 681 | else let 682 | val xs = 683 | streamize_channel00() 684 | val () = 685 | theCH00[] := 686 | $UN.castvwtp0{ptr}(xs) in channel00_pop_msg() 687 | end // end of [else] 688 | end // end of [channel00_pop_msg] 689 | 690 | implement 691 | channel01_pop_msg 692 | ((*void*)) = let 693 | // 694 | val p0 = theCH01[] 695 | // 696 | in 697 | if 698 | isneqz(p0) 699 | then let 700 | val xs = 701 | $UN.castvwtp0{stream_vt(string)}(p0) 702 | in 703 | case- !xs of 704 | | ~stream_vt_cons(x0, xs) => x0 where 705 | { 706 | val () = theCH01[] := $UN.castvwtp0{ptr}(xs) 707 | } 708 | end // end of [then] 709 | else let 710 | val xs = 711 | streamize_channel01() 712 | val () = 713 | theCH01[] := $UN.castvwtp0{ptr}(xs) in channel01_pop_msg() 714 | end // end of [else] 715 | end // end of [channel01_pop_msg] 716 | 717 | implement 718 | channel02_pop_msg 719 | ((*void*)) = let 720 | // 721 | val p0 = theCH02[] 722 | // 723 | in 724 | if 725 | isneqz(p0) 726 | then let 727 | val xs = 728 | $UN.castvwtp0{stream_vt(string)}(p0) 729 | in 730 | case- !xs of 731 | | ~stream_vt_cons(x0, xs) => x0 where 732 | { 733 | val () = theCH02[] := $UN.castvwtp0{ptr}(xs) 734 | } 735 | end // end of [then] 736 | else let 737 | val xs = 738 | streamize_channel02() 739 | val () = 740 | theCH02[] := $UN.castvwtp0{ptr}(xs) in channel02_pop_msg() 741 | end // end of [else] 742 | end // end of [channel02_pop_msg] 743 | 744 | end // end of [local] 745 | // 746 | (* ****** ****** *) 747 | 748 | local 749 | // 750 | reassume channel_type 751 | // 752 | (* ****** ****** *) 753 | 754 | fun{} 755 | ismem 756 | ( 757 | CH: 758 | channel(), r0: role 759 | ) : bool = loop(CH) where 760 | { 761 | fun 762 | loop(rs: list0(int)): bool = 763 | ( 764 | case+ rs of 765 | | list0_nil() => false 766 | | list0_cons(r1, rs) => 767 | if r0 = r1 then true else loop(rs) 768 | ) 769 | } 770 | 771 | fun{} 772 | jsonval_int 773 | (x: int) = JSONint(g0i2i(x)) 774 | 775 | in 776 | 777 | implement 778 | {}(*tmp*) 779 | chanrole_bmsg_recv_int 780 | (CH, r) = let 781 | // 782 | val tf = ismem<>(CH, r) 783 | // 784 | val () = 785 | if (tf) 786 | then let 787 | val () = 788 | prerrln! 789 | ("chanrole_bmsg_recv_int: non-recv") 790 | in 791 | assertloc(false) 792 | end // end of [if] 793 | // 794 | in 795 | // 796 | ifcase 797 | | (r = 0) => 798 | $UN.cast{int}(x) where 799 | { 800 | val msg = channel00_pop_msg() 801 | val-JSONint(x) = jsonval_ofstring(msg) 802 | } 803 | | (r = 1) => 804 | $UN.cast{int}(x) where 805 | { 806 | val msg = channel01_pop_msg() 807 | val-JSONint(x) = jsonval_ofstring(msg) 808 | } 809 | | (r = 2) => 810 | $UN.cast{int}(x) where 811 | { 812 | val msg = channel02_pop_msg() 813 | val-JSONint(x) = jsonval_ofstring(msg) 814 | } 815 | | _(* else *) => 816 | let 817 | val () = 818 | prerrln!("chanrole_bmsg_recv_int: r = ", r) 819 | in 820 | let val () = assertloc(false) in $UN.cast{int}(0) end 821 | // end of [if] 822 | end (* end of [let] *) 823 | // 824 | end // chanrole_bmsg_recv_int 825 | 826 | end // end of [local] 827 | 828 | (* ****** ****** *) 829 | 830 | (* end of [mybasis.dats] *) 831 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test02/myclient.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | extern 26 | fun 27 | myclient 28 | {id:int} 29 | ( CH: channel(id) 30 | , prot: protocol(id) 31 | , lines: stream_vt(string)): stream_vt(string) 32 | extern 33 | fun 34 | myclient_optrep 35 | {id:int} 36 | ( CH: channel(id) 37 | , prot: protocol(id), lines: stream_vt(string)): void 38 | 39 | (* ****** ****** *) 40 | // 41 | #staload UN = $UNSAFE 42 | // 43 | #staload "./mybasis.dats" 44 | // 45 | (* ****** ****** *) 46 | 47 | implement 48 | myclient 49 | (CH, prot, lines) = let 50 | // 51 | var prot = prot 52 | // 53 | val x1 = 54 | chanprot_bmsg_recv 55 | (CH, prot) 56 | val x2 = 57 | chanprot_bmsg_recv 58 | (CH, prot) 59 | // 60 | val () = 61 | println! ("x1 = ", x1) 62 | val () = 63 | println! ("x2 = ", x2) 64 | // 65 | val () = 66 | println! 67 | (">>Input your answer:") 68 | // 69 | val- 70 | ~stream_vt_cons 71 | (line, lines) = !lines 72 | val y3 = 73 | g0string2int(line) 74 | val () = 75 | chanprot_bmsg_send 76 | (CH, prot, y3) 77 | val () = 78 | println! ("y3 = ", y3) 79 | // 80 | val x4 = 81 | chanprot_bmsg_recv(CH, prot) 82 | // 83 | val () = 84 | println! ("x4 = ", x4) 85 | // 86 | val () = 87 | chanprot_elim_nil(CH, prot) 88 | // 89 | in 90 | // 91 | lines where 92 | { 93 | val () = 94 | if (x4 > 0) 95 | then println!("Correct!") else println!("Incorrect!") 96 | } 97 | // 98 | end // end of [let] // end of [myclient] 99 | 100 | (* ****** ****** *) 101 | 102 | implement 103 | myclient_optrep 104 | (CH, prot, lines) = let 105 | // 106 | var prot = prot 107 | // 108 | (* 109 | val () = 110 | println! 111 | ( "prot = " 112 | , $UN.castvwtp1{prtcl}(prot)) 113 | *) 114 | // 115 | val opt = 116 | chanprot_conj_aneg<>(CH, prot) 117 | (* 118 | val 119 | ((*void*)) = 120 | println! 121 | ("myclient_optrep: opt = ", opt) 122 | *) 123 | // 124 | in 125 | // 126 | if 127 | (opt=0) 128 | then let 129 | val () = 130 | chanprot_elim_nil<> 131 | (CH, prot) 132 | in 133 | free(lines); 134 | println!("It is over!") 135 | end // end of [then] 136 | else let 137 | val- 138 | ~Some_vt(P0) = 139 | prtcl_join_uncons(prot) 140 | val lines = 141 | myclient(CH, P0, lines) 142 | in 143 | myclient_optrep(CH, prot, lines) 144 | end // end of [else] 145 | // 146 | end // end of [myclient_optrep] 147 | 148 | (* ****** ****** *) 149 | 150 | local 151 | 152 | #dynload"./mybasis.dats" 153 | 154 | #include 155 | "./../../DATS/basics.dats" 156 | 157 | in (*in-of-local*) 158 | 159 | implement 160 | main0() = () where 161 | { 162 | // 163 | val 164 | prot = 165 | prtcl_optrep(0, myprtcl()) 166 | val 167 | [id:int] 168 | prot = 169 | $UN.castvwtp0{protocol()}(prot) 170 | // 171 | val CH = 172 | $UN.cast 173 | {channel(id)}(list0_tuple(1)) 174 | // 175 | val ((*void*)) = 176 | myclient_optrep 177 | (CH, prot, lines) where 178 | { 179 | val 180 | lines = 181 | streamize_fileref_line(stdin_ref) 182 | } 183 | // 184 | } (* end of [main0] *) 185 | 186 | end // end of [local] 187 | 188 | (* ****** ****** *) 189 | 190 | (* end of [myclient.dats] *) 191 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test02/mygrader.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | extern 26 | fun 27 | mygrader 28 | {id:int} 29 | (CH: channel(id), prot: protocol(id)): void 30 | extern 31 | fun 32 | mygrader_optrep 33 | {id:int} 34 | (CH: channel(id), prot: protocol(id)): void 35 | 36 | (* ****** ****** *) 37 | 38 | #define N 100 39 | 40 | (* ****** ****** *) 41 | // 42 | #staload UN = $UNSAFE 43 | // 44 | #staload "./mybasis.dats" 45 | // 46 | (* ****** ****** *) 47 | 48 | implement 49 | mygrader 50 | (CH, prot) = let 51 | // 52 | var prot = prot 53 | // 54 | (* 55 | val () = 56 | println! 57 | ( "mygrader: prot = " 58 | , $UN.castvwtp1{prtcl}(prot)) 59 | *) 60 | // 61 | val x1 = 62 | chanprot_bmsg_recv 63 | (CH, prot) 64 | val x2 = 65 | chanprot_bmsg_recv 66 | (CH, prot) 67 | val () = println! ("x1 = ", x1) 68 | val () = println! ("x2 = ", x2) 69 | // 70 | val y3 = 71 | chanprot_bmsg_recv 72 | (CH, prot) 73 | val () = println! ("y3 = ", y3) 74 | // 75 | val z4 = 76 | ( 77 | if x1*x2 = y3 then 1 else 0 78 | // end of [if] 79 | ) : int // end of [val] 80 | val () = 81 | chanprot_bmsg_send(CH, prot, z4) 82 | // 83 | val () = 84 | chanprot_elim_nil(CH, prot) 85 | in 86 | // 87 | if (z4 > 0) 88 | then println!("Correct!") else println!("Incorrect!") 89 | // 90 | end // end of [let] // end of [mygrader] 91 | 92 | (* ****** ****** *) 93 | 94 | implement 95 | mygrader_optrep 96 | (CH, prot) = let 97 | // 98 | var prot = prot 99 | // 100 | (* 101 | val () = 102 | println! 103 | ( "prot = " 104 | , $UN.castvwtp1{prtcl}(prot)) 105 | *) 106 | // 107 | val opt = 108 | chanprot_conj_aneg<>(CH, prot) 109 | (* 110 | val 111 | ((*void*)) = 112 | println! 113 | ("mygrader_optrep: opt = ", opt) 114 | *) 115 | // 116 | in 117 | // 118 | if 119 | (opt=0) 120 | then let 121 | val () = 122 | chanprot_elim_nil<> 123 | (CH, prot) 124 | in 125 | println!("It is over!") 126 | end // end of [then] 127 | else let 128 | val- 129 | ~Some_vt(P0) = 130 | prtcl_join_uncons(prot) 131 | val () = mygrader(CH, P0) 132 | in 133 | mygrader_optrep(CH, prot) 134 | end // end of [else] 135 | // 136 | end // end of [mygrader_optrep] 137 | 138 | (* ****** ****** *) 139 | 140 | local 141 | 142 | #dynload"./mybasis.dats" 143 | 144 | #include 145 | "./../../DATS/basics.dats" 146 | 147 | in (*in-of-local*) 148 | 149 | implement 150 | main0() = () where 151 | { 152 | // 153 | val 154 | prot = 155 | prtcl_optrep(0, myprtcl()) 156 | val 157 | [id:int] 158 | prot = 159 | $UN.castvwtp0{protocol()}(prot) 160 | // 161 | val CH = 162 | $UN.cast 163 | {channel(id)}(list0_tuple(2)) 164 | // 165 | val () = mygrader_optrep(CH, prot) 166 | // 167 | } (* end of [main0] *) 168 | 169 | end // end of [local] 170 | 171 | (* ****** ****** *) 172 | 173 | (* end of [mygrader.dats] *) 174 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test02/myserver.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** 4 | ** HX-2018-01: 5 | ** For testing 6 | ** broadcast-based sessions 7 | ** that are dynamically typed 8 | ** 9 | *) 10 | (* ****** ****** *) 11 | 12 | #include 13 | "share/atspre_staload.hats" 14 | #include 15 | "share\ 16 | /atspre_staload_libats_ML.hats" 17 | 18 | (* ****** ****** *) 19 | 20 | #staload"./../../SATS/basics.sats" 21 | #staload"./../../DATS/basics.dats" 22 | 23 | (* ****** ****** *) 24 | 25 | extern 26 | fun 27 | myserver 28 | {id:int} 29 | (CH: channel(id), prot: protocol(id)): void 30 | extern 31 | fun 32 | myserver_optrep 33 | {id:int} 34 | ( CH: channel(id) 35 | , prot: protocol(id), lines: stream_vt(string)): void 36 | 37 | (* ****** ****** *) 38 | 39 | #define N 100 40 | 41 | (* ****** ****** *) 42 | // 43 | #staload UN = $UNSAFE 44 | // 45 | #staload "./mybasis.dats" 46 | // 47 | (* ****** ****** *) 48 | 49 | implement 50 | myserver 51 | (CH, prot) = let 52 | // 53 | var prot = prot 54 | // 55 | (* 56 | val () = 57 | println! 58 | ( "myserver: prot = " 59 | , $UN.castvwtp1{prtcl}(prot)) 60 | *) 61 | // 62 | val x1 = randint(N) 63 | val x2 = randint(N) 64 | val () = 65 | chanprot_bmsg_send 66 | (CH, prot, x1) 67 | val () = 68 | chanprot_bmsg_send 69 | (CH, prot, x2) 70 | // 71 | val y3 = 72 | chanprot_bmsg_recv(CH, prot) 73 | // 74 | val () = 75 | println!("x1 = ", x1) 76 | val () = 77 | println!("x2 = ", x2) 78 | val () = 79 | println!("y3 = ", y3) 80 | // 81 | val z4 = 82 | chanprot_bmsg_recv(CH, prot) 83 | // 84 | val () = 85 | chanprot_elim_nil(CH, prot) 86 | in 87 | // 88 | if (z4 > 0) 89 | then println!("Correct!") else println!("Incorrect!") 90 | // 91 | end // end of [let] // end of [myserver] 92 | 93 | (* ****** ****** *) 94 | 95 | implement 96 | myserver_optrep 97 | (CH, prot, lines) = let 98 | // 99 | var prot = prot 100 | // 101 | val () = 102 | println! (">>test or quit?") 103 | (* 104 | val () = 105 | println! 106 | ( "myserver_optrep: prot = " 107 | , $UN.castvwtp1{prtcl}(prot)) 108 | *) 109 | // 110 | in 111 | // 112 | case+ !lines of 113 | | ~stream_vt_nil() => let 114 | val () = 115 | chanprot_conj_apos<> 116 | (CH, prot, 0(*exit*)) 117 | in 118 | chanprot_elim_nil<>(CH, prot) 119 | end // end of [stream_vt_nil] 120 | | ~stream_vt_cons 121 | (line, lines) => 122 | ( 123 | case+ line of 124 | | "quit" => let 125 | val () = 126 | lazy_vt_free(lines) 127 | val () = 128 | chanprot_conj_apos<> 129 | (CH, prot, 0(*exit*)) 130 | // end of [val] 131 | in 132 | chanprot_elim_nil<>(CH, prot) 133 | end // end of [quit] 134 | | _(*non-quit*) => let 135 | val () = 136 | chanprot_conj_apos<> 137 | (CH, prot, 1(*exit*)) 138 | // end of [val] 139 | val- 140 | ~Some_vt(P0) = 141 | prtcl_join_uncons(prot) 142 | val () = myserver(CH, P0) 143 | in 144 | myserver_optrep(CH, prot, lines) 145 | end // end of [non-quit] 146 | ) 147 | end (* end of [myserver_optrep] *) 148 | 149 | (* ****** ****** *) 150 | 151 | local 152 | 153 | #dynload"./mybasis.dats" 154 | 155 | #include 156 | "./../../DATS/basics.dats" 157 | 158 | in (*in-of-local*) 159 | 160 | implement 161 | main0() = () where 162 | { 163 | // 164 | val 165 | prot = 166 | prtcl_optrep(0, myprtcl()) 167 | val 168 | [id:int] 169 | prot = 170 | $UN.castvwtp0{protocol()}(prot) 171 | // 172 | val () = channel00_clearall() 173 | val () = channel01_clearall() 174 | val () = channel02_clearall() 175 | // 176 | val CH = 177 | $UN.cast 178 | {channel(id)}(list0_tuple(0)) 179 | // 180 | val ((*void*)) = 181 | myserver_optrep 182 | (CH, prot, lines) where 183 | { 184 | val 185 | lines = 186 | streamize_fileref_line(stdin_ref) 187 | } 188 | // 189 | } (* end of [main0] *) 190 | 191 | end // end of [local] 192 | 193 | (* ****** ****** *) 194 | 195 | (* end of [myserver.dats] *) 196 | -------------------------------------------------------------------------------- /PLAYGROUND/mysession-bucs520-2018-01/TEST/test02/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-libjson-c": "^1.0.1", 4 | "atscntrb-hx-teaching-bucs": "^1.0.8" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ATS-CodeBook 2 | 3 | This repository contains coding examples of all sorts 4 | written in ATS and possibly other programming languages. 5 | These examples are primarily meant as recipes for people 6 | interested in learning ATS as well as using it to construct 7 | software for use in the real world. 8 | 9 | HX-2019-06-04: 10 | At this point, I no longer have a plan to continue working on the 11 | CodeBook for ATS-Postiats. Instead, I have decided to concentrate my 12 | effort on writing one for ATS-Temptory. For more information, please 13 | visit [here](https://github.com/githwxi/ATS-Temptory/tree/master/docgen/CodeBook). 14 | 15 | 16 | ## [ATS-CodeBook/RECIPE](./RECIPE) 17 | 18 | Please find various coding examples in this directory. 19 | 20 | ## [ATS-CodeBook/PLAYGROUND](./PLAYGROUND) 21 | 22 | This directory is mostly for playing with some programming ideas of 23 | interest. 24 | -------------------------------------------------------------------------------- /RECIPE/BinarySearch/BinarySearch.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include "share/atspre_staload.hats" 4 | #include "share/atspre_staload_libats_ML.hats" 5 | 6 | (* ****** ****** *) 7 | 8 | typedef 9 | freal = cfun(double, double) 10 | typedef 11 | interval = $tup(double, double) 12 | 13 | (* ****** ****** *) 14 | 15 | fun 16 | interval 17 | ( 18 | a: double, b: double 19 | ) : interval = 20 | ( 21 | if a <= b then $tup(a, b) else $tup(b, a) 22 | ) 23 | 24 | (* ****** ****** *) 25 | // 26 | fun 27 | BinarySearch 28 | ( 29 | f : freal 30 | , 31 | a : double, b : double 32 | ) : stream(interval) = $delay 33 | let 34 | // 35 | val m = (a+b) / 2 36 | // 37 | in 38 | if f(m) >= 0 39 | then stream_cons(interval(a, b), BinarySearch(f, a, m)) 40 | else stream_cons(interval(a, b), BinarySearch(f, m, b)) 41 | // end of [if] 42 | end // end of [BinarySearch] 43 | // 44 | (* ****** ****** *) 45 | 46 | implement 47 | main0() = let 48 | // 49 | val f = 50 | lam 51 | ( 52 | x: double 53 | ): double = 54 | (x * x * x - x - 2.0) 55 | // 56 | #define EPSILON 1E-6 57 | // 58 | val 59 | intervals = 60 | BinarySearch(f, 1.0, 2.0) 61 | val 62 | intervals = 63 | (intervals).filter()(lam($tup(a, b)) => (b-a) < EPSILON) 64 | // 65 | val $tup(a, b) = intervals[0] 66 | // 67 | in 68 | println! ("intervals[0] = ", (a+b)/2) 69 | end // end of [main0] 70 | 71 | (* ****** ****** *) 72 | 73 | (* end of [BinarySearch.dats] *) 74 | -------------------------------------------------------------------------------- /RECIPE/BinarySearch/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | PATSCC=$(PATSHOME)/bin/patscc 13 | PATSOPT=$(PATSHOME)/bin/patsopt 14 | PATSLIB=$(PATSHOME)/ccomp/atslib 15 | 16 | ###### 17 | 18 | all:: BinarySearch_dats 19 | 20 | ###### 21 | 22 | testall:: all 23 | testall:: regress 24 | testall:: cleanall 25 | 26 | ###### 27 | 28 | regress:: BinarySearch_dats; ./$< 29 | 30 | ###### 31 | 32 | %_dats: %.dats; $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< 33 | 34 | ###### 35 | 36 | clean:: ; rm -f *~ 37 | clean:: ; rm -f *_?ats.o 38 | clean:: ; rm -f *_?ats.c 39 | 40 | cleanall:: clean 41 | cleanall:: ; rm -f BinarySearch_dats 42 | 43 | ###### end of [Makefile] ###### 44 | -------------------------------------------------------------------------------- /RECIPE/BinarySearch/README.md: -------------------------------------------------------------------------------- 1 | # Binary Search 2 | 3 | The program in this example demonstrates a stream-based approach to 4 | locating a zero of a given continuous function in a given interval via 5 | the so-called binary search. Unlike Newton-Raphson's method, binary 6 | search does not need the derivative of the given function, though its 7 | convergence rate is (much) slower than that of Newton-Raphson's method. 8 | 9 | Happy programming in ATS!!! 10 | -------------------------------------------------------------------------------- /RECIPE/CSV-parsing/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: NDX100_dats 23 | 24 | ###### 25 | 26 | testall:: npm-install 27 | testall:: all cleanall 28 | 29 | ###### 30 | # 31 | NDX100_dats: \ 32 | NDX100.dats; \ 33 | $(PATSCC) -I./node_modules \ 34 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $< -latslib -ljson-c 35 | # 36 | ###### 37 | 38 | clean:: ; rm -f *~ 39 | clean:: ; rm -f *_?ats.o 40 | clean:: ; rm -f *_?ats.c 41 | 42 | cleanall:: clean 43 | cleanall:: ; rm -f NDX100_dats 44 | cleanall:: ; rm -f node_modules -r 45 | cleanall:: ; rm -f package-lock.json 46 | 47 | ###### 48 | 49 | npm-update:: ; $(NPM) update 50 | npm-install:: ; $(NPM) install 51 | 52 | ###### 53 | 54 | export \ 55 | PATSHOMELOCS = \ 56 | ./node_modules:./../node_modules:./../../node_modules:./../../../node_modules 57 | 58 | ###### end of [Makefile] ###### 59 | -------------------------------------------------------------------------------- /RECIPE/CSV-parsing/NDX100.dats: -------------------------------------------------------------------------------- 1 | //usr/bin/env myatscc "$0"; exit 2 | (* ****** ****** *) 3 | // 4 | (* 5 | ##myatsccdef=\ 6 | patsopt --constraint-ignore --dynamic $1 | \ 7 | tcc - -run -DATS_MEMALLOC_LIBC -I${PATSHOME} -I${PATSHOME}/ccomp/runtime -L${PATSHOME}/ccomp/atslib/lib -latslib 8 | *) 9 | // 10 | (* ****** ****** *) 11 | 12 | #include "./myread.dats" 13 | 14 | (* ****** ****** *) 15 | // 16 | #define 17 | NDX100_csv "./DATA/NDX100.csv" 18 | // 19 | (* ****** ****** *) 20 | 21 | val 22 | NDX100_table = 23 | mytable where 24 | { 25 | // 26 | val- 27 | ~Some_vt(inp) = 28 | fileref_open_opt 29 | (NDX100_csv, file_mode_r) 30 | // 31 | val 32 | mytable = 33 | dframe_read_fileref(inp) 34 | // 35 | val () = fileref_close(inp) 36 | // 37 | } (* end of [val] *) 38 | // 39 | val nday = 40 | length(NDX100_table) 41 | // 42 | val () = 43 | println!("|NDX100_table| = ", nday) 44 | val () = 45 | println!("NDX100_table[0] = ", NDX100_table[0]) 46 | // 47 | (* ****** ****** *) 48 | 49 | val 50 | double_t = TYPE{double} 51 | val 52 | string_t = TYPE{string} 53 | 54 | (* ****** ****** *) 55 | // 56 | val 57 | NDX100_Date = 58 | ( 59 | NDX100_table 60 | ).map(string_t) 61 | (lam(kxs) => 62 | let 63 | (* 64 | val x = 65 | kxs["Date"] 66 | val () = 67 | println! ("x = ", x) 68 | *) 69 | in 70 | GVstring_uncons(kxs["Date"]) 71 | end 72 | ) 73 | // 74 | val () = 75 | println! 76 | ("|NDX100_Date| = ", length(NDX100_Date)) 77 | // 78 | (* ****** ****** *) 79 | 80 | val 81 | NDX100_AdjClose = 82 | ( 83 | NDX100_table 84 | ).map(double_t) 85 | (lam(kxs) => 86 | let 87 | (* 88 | val x = 89 | kxs["Adj Close"] 90 | val () = 91 | println! ("x = ", x) 92 | *) 93 | in 94 | g0string2float_double 95 | (GVstring_uncons(kxs["Adj Close"])) 96 | end 97 | ) 98 | // 99 | val () = 100 | println! 101 | ("|NDX100_AdjClose| = ", length(NDX100_AdjClose)) 102 | // 103 | (* ****** ****** *) 104 | 105 | val 106 | NDX100_PChange = 107 | array0_tabulate 108 | ( 109 | g1ofg0 110 | ( 111 | size(NDX100_AdjClose) 112 | ) 113 | , 114 | lam(i) => 115 | ( 116 | if i = 0 117 | then 118 | (0.0) 119 | else 120 | (NDX100_AdjClose[i]/NDX100_AdjClose[i-1])-1 121 | ) 122 | ) 123 | // 124 | val () = 125 | println! 126 | ("|NDX100_PChange| = ", length(NDX100_PChange)) 127 | val () = 128 | println!("NDX100_PChange[0] = ", NDX100_PChange[0]) 129 | val () = 130 | println!("NDX100_PChange[1] = ", NDX100_PChange[1]) 131 | val () = 132 | println!("NDX100_PChange[2] = ", NDX100_PChange[2]) 133 | val () = 134 | println!("NDX100_PChange[3] = ", NDX100_PChange[3]) 135 | // 136 | (* ****** ****** *) 137 | // 138 | extern 139 | fun 140 | f_NDX100_MPChange 141 | (k0: intGte(1)): array0(double) 142 | // 143 | (* ****** ****** *) 144 | 145 | implement 146 | f_NDX100_MPChange(k0) = let 147 | // 148 | val n0 = length(NDX100_PChange) 149 | // 150 | fun 151 | auxmain 152 | ( i: int 153 | , k: int 154 | , s1: double 155 | ) : stream_vt(double) = $ldelay 156 | ( 157 | if 158 | (i >= n0) 159 | then stream_vt_nil() 160 | else let 161 | val xi = 162 | NDX100_PChange[i] 163 | val s1 = s1 + xi 164 | (* 165 | val () = println! ("s1+ = ", s1) 166 | *) 167 | in 168 | if 169 | (k < k0) 170 | then let 171 | val k = k + 1 172 | val avg = s1/k 173 | in 174 | stream_vt_cons(avg, auxmain(i+1, k, s1)) 175 | end // end of [then] 176 | else let 177 | val xj = 178 | NDX100_PChange[i-k] 179 | val s1 = s1 - xj 180 | (* 181 | val () = println! ("s1- = ", s1) 182 | *) 183 | val avg = s1/k 184 | in 185 | stream_vt_cons(avg, auxmain(i+1, k, s1)) 186 | end // end of [else] 187 | end 188 | ) 189 | in 190 | array0_make_stream_vt(auxmain(0, 0, 0.0)) 191 | end // end of [f_NDX100_MPChange] 192 | 193 | (* ****** ****** *) 194 | // 195 | #define K0 21 196 | // 197 | val 198 | NDX100_MPChange = f_NDX100_MPChange(K0) 199 | val () = 200 | println! 201 | ("|NDX100_MPChange| = ", length(NDX100_MPChange)) 202 | // (* 203 | local 204 | val n0 = length(NDX100_MPChange) 205 | in(*in-of-local*) 206 | val () = 207 | println! 208 | ("NDX100_MPChange[0] = ", NDX100_MPChange[0]) 209 | val () = 210 | println! 211 | ("NDX100_MPChange[1] = ", NDX100_MPChange[1]) 212 | val () = 213 | println! 214 | ("NDX100_MPChange[2] = ", NDX100_MPChange[2]) 215 | val () = 216 | println! 217 | ("NDX100_MPChange[3] = ", NDX100_MPChange[3]) 218 | val () = 219 | println! 220 | ("NDX100_MPChange[-1] = ", NDX100_MPChange[n0-1]) 221 | val () = 222 | println! 223 | ("NDX100_MPChange[-2] = ", NDX100_MPChange[n0-2]) 224 | val () = 225 | println! 226 | ("NDX100_MPChange[-3] = ", NDX100_MPChange[n0-3]) 227 | val () = 228 | println! 229 | ("NDX100_MPChange[-4] = ", NDX100_MPChange[n0-4]) 230 | end // end of [local] 231 | // *) 232 | // 233 | (* ****** ****** *) 234 | // 235 | extern 236 | fun 237 | f_NDX100_table_dateseg 238 | ( start: string 239 | , finish: string): array0(gvhashtbl) 240 | // 241 | implement 242 | f_NDX100_table_dateseg 243 | (start, finish) = let 244 | // 245 | macdef uns = GVstring_uncons 246 | // 247 | val start = 248 | array0_bsearch 249 | ( NDX100_table 250 | , lam(x) => strcmp(start, uns(x["Date"]))) 251 | val finish = 252 | array0_bsearch 253 | ( NDX100_table 254 | , lam(x) => strcmp(finish, uns(x["Date"]))) 255 | // 256 | val start = min(start, finish) 257 | val finish = max(start, finish) 258 | // 259 | in 260 | array0_make_subarray(NDX100_table, start, finish-start) 261 | end // end of [f_NDX100_table_dateseg] 262 | // 263 | (* ****** ****** *) 264 | 265 | val 266 | NDX100_20100101 = 267 | array0_bsearch 268 | ( NDX100_Date 269 | , lam(x) => compare(date, x) 270 | ) where 271 | { 272 | val date = "2010-01-01" 273 | } 274 | val 275 | NDX100_20180101 = 276 | array0_bsearch 277 | ( NDX100_Date 278 | , lam(x) => compare(date, x) 279 | ) where 280 | { 281 | val date = "2018-01-01" 282 | } 283 | // 284 | (* 285 | val () = 286 | println! 287 | ("NDX100_20100101 = ", NDX100_20100101) 288 | val () = 289 | println! 290 | ("NDX100_20180101 = ", NDX100_20180101) 291 | *) 292 | // 293 | (* ****** ****** *) 294 | // 295 | val 296 | NDX100_table_dateseg = 297 | f_NDX100_table_dateseg("2010-01-01", "2018-01-01") 298 | // 299 | val () = 300 | println! 301 | ("|NDX100_table_dateseg| = ", length(NDX100_table_dateseg)) 302 | // 303 | (* ****** ****** *) 304 | 305 | implement main0 ((*void*)) = () 306 | 307 | (* ****** ****** *) 308 | 309 | (* end of [NDX100.dats] *) 310 | -------------------------------------------------------------------------------- /RECIPE/CSV-parsing/README.md: -------------------------------------------------------------------------------- 1 | # Parsing for the CSV format 2 | 3 | This example presents a way to parse a table in the 4 | CSV format. 5 | 6 | The function `csv_parse_line_nerr` in the npm-based package 7 | *atscntrb-hx-csv-parse* parses a given string into a list of 8 | substrings separated by COMMA (or another character chosen by 9 | the user). 10 | 11 | Let us use the name dframe (data-frame) to refer to a table 12 | of the following format: 13 | 14 | ``` 15 | Date,Open,High,Low,Close,Adj Close,Volume 16 | 1985-10-01,110.620003,112.160004,110.565002,112.139999,112.139999,153160000 17 | 1985-10-02,112.139999,112.540001,110.779999,110.824997,110.824997,164640000 18 | ... 19 | ``` 20 | 21 | where the first row contains the name of each column. The function 22 | `dframe_read_fileref` in the file *myread.dats* parses such a table 23 | (contained in the file referred to by a given file handle) into a list 24 | of gvhasbtbl-values, each of which is essentially a hashtable of gvalues 25 | (declared in the file *$PATSHOME/libats/ML/SATS/gvalue.sats*). 26 | 27 | Please find in *NDX100.dats* some code that parses the historic data 28 | for NDX100 (NASDAQ 100). 29 | 30 | If you have [tcc](https://bellard.org/tcc/) installed, you can simply 31 | issue the following command-line: 32 | 33 | ```shell 34 | bash ./NDX100.dats 35 | ``` 36 | 37 | to compile and then execute the code in *NDX100.dats*, effectively using 38 | ATS as a scripting language! 39 | 40 | Happy programming in ATS!!! 41 | -------------------------------------------------------------------------------- /RECIPE/CSV-parsing/myread.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | // For parsing CSV tables 4 | *) 5 | (* ****** ****** *) 6 | // 7 | #include 8 | "share/atspre_staload.hats" 9 | #include 10 | "share/HATS\ 11 | /atspre_staload_libats_ML.hats" 12 | // 13 | (* ****** ****** *) 14 | 15 | extern 16 | fun 17 | print_gvhashtbl: 18 | print_type(gvhashtbl) 19 | overload 20 | print with print_gvhashtbl 21 | implement 22 | print_gvhashtbl(kxs) = 23 | fprint_gvhashtbl(stdout_ref, kxs) 24 | 25 | (* ****** ****** *) 26 | // 27 | #include 28 | "\ 29 | $PATSHOMELOCS\ 30 | /atscntrb-hx-csv-parse/mylibies.hats" 31 | // 32 | (* ****** ****** *) 33 | // 34 | #staload 35 | _(*SBF*) = "libats/DATS/stringbuf.dats" 36 | // 37 | (* ****** ****** *) 38 | 39 | local 40 | #staload 41 | CSVPARSE = $CSV_PARSE_LINE 42 | in(*in-of-local*) 43 | extern 44 | fun{} 45 | csv_parse_line(line: string): List0_vt(string) 46 | implement 47 | {}(*tmp*) 48 | csv_parse_line 49 | (line) = res0 where 50 | { 51 | // 52 | var nerr: int = 0 53 | val res0 = 54 | $CSVPARSE.csv_parse_line_nerr<>(line, nerr) 55 | // 56 | val res0 = $UNSAFE.castvwtp0{List0_vt(string)}(res0) 57 | // 58 | } (* end of [csv_parse_line] *) 59 | end // end of [local] 60 | 61 | (* ****** ****** *) 62 | // 63 | extern 64 | fun 65 | gvhashtbl_make_keys_itms 66 | ( ks: list0(string) 67 | , xs: list0(string)): gvhashtbl 68 | // 69 | implement 70 | gvhashtbl_make_keys_itms 71 | (ks, xs) = let 72 | // 73 | (* 74 | val 75 | () = 76 | println! ("ks = ", ks) 77 | val 78 | () = 79 | println! ("xs = ", xs) 80 | *) 81 | // 82 | val 83 | t0 = gvhashtbl_make_nil(8) 84 | // 85 | fun 86 | auxlst 87 | ( ks: list0(string) 88 | , xs: list0(string)): void = 89 | ( 90 | // 91 | case+ ks of 92 | | list0_nil() => () 93 | | list0_cons(k, ks) => 94 | ( 95 | case+ xs of 96 | | list0_nil() => () 97 | | list0_cons(x, xs) => 98 | auxlst(ks, xs) where 99 | { 100 | (* 101 | val () = println! ("k = ", k) 102 | val () = println! ("x = ", x) 103 | *) 104 | val () = (t0[k] := GVstring(x)) 105 | } (* end of [list0_cons] *) 106 | ) 107 | // 108 | ) 109 | in 110 | let val () = auxlst(ks, xs) in t0 end 111 | end // end of [gvhashtbl_make_keys_itms] 112 | // 113 | (* ****** ****** *) 114 | // 115 | staload UN = $UNSAFE 116 | // 117 | extern 118 | fun 119 | stream_vt_map_line2gvobj 120 | ( 121 | ks: list0(string), lines: stream_vt(string) 122 | ) : stream_vt(gvhashtbl) 123 | // 124 | implement 125 | stream_vt_map_line2gvobj 126 | (ks, lines) = $ldelay 127 | ( 128 | case+ !lines of 129 | | ~stream_vt_nil() => 130 | stream_vt_nil() 131 | | ~stream_vt_cons 132 | (line, lines) => let 133 | val xs = 134 | csv_parse_line(line) 135 | val t0 = 136 | gvhashtbl_make_keys_itms 137 | (ks, g0ofg1($UN.list_vt2t(xs))) 138 | // end of [val] 139 | in 140 | let 141 | val () = list_vt_free(xs) 142 | in 143 | stream_vt_cons 144 | (t0, stream_vt_map_line2gvobj(ks, lines)) 145 | end 146 | end // end of [stream_vt_cons] 147 | , lazy_vt_free(lines) // called if the stream is freed 148 | ) 149 | // 150 | (* ****** ****** *) 151 | // 152 | extern 153 | fun 154 | dframe_read_fileref 155 | (inp: FILEref): array0(gvhashtbl) 156 | // 157 | (* ****** ****** *) 158 | 159 | implement 160 | dframe_read_fileref 161 | (inp) = kxs where 162 | { 163 | // 164 | val 165 | lines = 166 | streamize_fileref_line(inp) 167 | val 168 | lines = 169 | stream_vt_filter_cloptr 170 | (lines, lam(line) => isneqz(line)) 171 | // 172 | val- 173 | ~stream_vt_cons 174 | (line0, lines) = !lines 175 | // 176 | val ks = 177 | csv_parse_line<>(line0) 178 | val kxs = 179 | stream_vt_map_line2gvobj 180 | (g0ofg1($UN.list_vt2t(ks)), lines) 181 | val kxs = 182 | array0_make_stream_vt(kxs) 183 | val ((*freed*)) = list_vt_free(ks) 184 | // 185 | } (* end of [dframe_read_fileref] *) 186 | 187 | (* ****** ****** *) 188 | 189 | (* end of [myread.dats] *) 190 | -------------------------------------------------------------------------------- /RECIPE/CSV-parsing/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-csv-parse": ">=1.0.0" 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /RECIPE/CountingByHash/CountingByHash.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | abstype item 11 | abstype itemopt(bool) 12 | 13 | (* ****** ****** *) 14 | 15 | extern 16 | fun{} 17 | itemopt_is_some 18 | (x0: itemopt(b)): [b==true] void 19 | extern 20 | fun{} 21 | itemopt_is_none 22 | (x0: itemopt(b)): [b==false] void 23 | 24 | (* ****** ****** *) 25 | 26 | extern 27 | fun{} 28 | itemopt_unsome(itemopt(true)): item 29 | extern 30 | fun{} 31 | itemopt_unnone(itemopt(false)): item 32 | 33 | (* ****** ****** *) 34 | 35 | extern 36 | fun{} 37 | counting$get(): item 38 | 39 | (* ****** ****** *) 40 | 41 | (* end of [CountingByHash.dats] *) 42 | -------------------------------------------------------------------------------- /RECIPE/GuessNumber/GuessNumber.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | // 4 | A simple game of guessing 5 | a number in a given range. 6 | // 7 | The computer tries to guess 8 | a number chosen by the player. 9 | // 10 | This implementation is memory-clean 11 | in the sense that every allocated byte 12 | is freed *before* the program exits. 13 | // 14 | *) 15 | (* ****** ****** *) 16 | // 17 | #include 18 | "share/atspre_staload.hats" 19 | // 20 | (* ****** ****** *) 21 | 22 | (* 23 | // 24 | [resp] is like enum: 25 | No memory allocation happens 26 | // 27 | *) 28 | datatype 29 | resp = 30 | Lower | Higher | Okay | Error 31 | 32 | (* ****** ****** *) 33 | 34 | datavtype 35 | state = 36 | State of 37 | (int(*lower*), int(*high*)) 38 | 39 | (* ****** ****** *) 40 | 41 | fun 42 | stateFree(s0: state): void = 43 | let 44 | val+~State(L, H) = s0 in (*nothing*) 45 | end 46 | 47 | fun 48 | stateGuess(s0: !state): int = 49 | let 50 | val+State(L, H) = s0 in (L+H)/2 51 | end 52 | 53 | (* ****** ****** *) 54 | 55 | fun 56 | stateUpdate 57 | ( s0: !state >> _ 58 | , r0: resp): void = 59 | let 60 | val+ 61 | @State(L, H) = s0 62 | in 63 | // 64 | fold@(s0) where 65 | { 66 | val () = 67 | case+ r0 of 68 | | Okay() => () 69 | | Lower() => H := (L+H)/2-1 70 | | Higher() => L := (L+H)/2+1 71 | | Error() => () 72 | } 73 | // 74 | end // end of [stateUpdate] 75 | 76 | (* ****** ****** *) 77 | 78 | fun 79 | doGame 80 | ( s0: !state >> _ 81 | , rs: stream_vt(resp)): void = 82 | ( 83 | println! 84 | ("Guess = ", stateGuess(s0)); 85 | case+ !rs of 86 | | ~stream_vt_nil() => () 87 | | ~stream_vt_cons(r0, rs) => 88 | ( 89 | case+ r0 of 90 | | Okay() => 91 | (println! ("Game Over!"); ~rs) 92 | | Error() => 93 | ( 94 | println! ("Error: ignored!"); doGame(s0, rs) 95 | ) 96 | | _(*more*) => 97 | ( 98 | stateUpdate(s0, r0); doGame(s0, rs) 99 | ) 100 | ) 101 | ) 102 | 103 | (* ****** ****** *) 104 | 105 | implement 106 | main0() = let 107 | // 108 | val rs = 109 | streamize_fileref_line 110 | (stdin_ref) 111 | val rs = map(rs) where 112 | { 113 | // 114 | fun 115 | map 116 | (rs: 117 | stream_vt(Strptr1) 118 | ) : stream_vt(resp) = $ldelay 119 | ( 120 | case+ !rs of 121 | | ~stream_vt_nil() => 122 | stream_vt_nil() 123 | | ~stream_vt_cons(r0, rs) => 124 | stream_vt_cons(fopr(r0), map(rs)) 125 | , stream_vt_free(rs) 126 | ) where 127 | { 128 | fun 129 | fopr(r0: Strptr1): resp = 130 | let 131 | val r1 = 132 | $UNSAFE.strptr2string(r0) 133 | val r1 = 134 | ( 135 | case+ r1 of 136 | | "okay" => Okay 137 | | "lower" => Lower() 138 | | "higher" => Higher() 139 | | _(*unrecognized*) => Error() 140 | ) : resp 141 | in 142 | r1 where { val () = strptr_free(r0) } 143 | end 144 | } 145 | // 146 | } 147 | // 148 | val s0 = State(0, 100) 149 | // 150 | in 151 | doGame(s0, rs); stateFree(s0) 152 | end // end of [main0] 153 | 154 | (* ****** ****** *) 155 | 156 | (* end of [GuessNumber.dats] *) 157 | -------------------------------------------------------------------------------- /RECIPE/GuessNumber/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | PATSCC=$(PATSHOME)/bin/patscc 13 | PATSOPT=$(PATSHOME)/bin/patsopt 14 | PATSLIB=$(PATSHOME)/ccomp/atslib 15 | 16 | ###### 17 | 18 | all:: GuessNumber_dats 19 | 20 | ###### 21 | 22 | testall:: all 23 | testall:: regress 24 | testall:: cleanall 25 | 26 | ###### 27 | 28 | %_dats: %.dats; \ 29 | $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 30 | 31 | ###### 32 | 33 | regress:: GuessNumber_dats; echo 1000000 | ./$< 34 | 35 | ###### 36 | 37 | clean:: ; rm -f *~ 38 | clean:: ; rm -f *_?ats.o 39 | clean:: ; rm -f *_?ats.c 40 | 41 | cleanall:: clean 42 | cleanall:: ; rm -f GuessNumber_dats 43 | 44 | ###### end of [Makefile] ###### 45 | -------------------------------------------------------------------------------- /RECIPE/GuessNumber/README.md: -------------------------------------------------------------------------------- 1 | # Guessing a chosen number 2 | 3 | The code should be self-explanatory. 4 | 5 | The state of the game is modeled as 6 | a pair of integers (representing a range 7 | containing the number chosen by the player). 8 | 9 | The input from the player is first modeled 10 | as a linear stream (of linear strings) and 11 | then converted to a linear stream of responses 12 | (where each response is essentially an integer). 13 | 14 | The following function updates the state of the 15 | game based the current response from the player: 16 | 17 | ```ats 18 | fun 19 | stateUpdate 20 | ( s0: !state >> _ 21 | , r0: resp): void = 22 | let 23 | val+ 24 | @State(L, H) = s0 25 | in 26 | // 27 | fold@(s0) where 28 | { 29 | val () = 30 | case+ r0 of 31 | | Okay() => () 32 | | Lower() => H := (L+H)/2-1 33 | | Higher() => L := (L+H)/2+1 34 | | Error() => () 35 | } 36 | // 37 | end // end of [stateUpdate] 38 | ``` 39 | 40 | Note that this is a memory-clean implementation in the sense 41 | that every allocated byte is freed before the program exits. 42 | The code in this example for handling input does essentially 43 | the same as the code in [ReadFromSTDIN](./../ReadFromSTDIN). 44 | 45 | Happy programming in ATS!!! 46 | -------------------------------------------------------------------------------- /RECIPE/HX-intinf/HX-intinf.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | // 10 | fun 11 | {a:t0p} 12 | gfact1(n: int): a = let 13 | // 14 | overload * with gmul_int_val 15 | // 16 | in 17 | // 18 | (fix 19 | f( i: int 20 | , n: int, r: a): a => 21 | if i < n 22 | then f(i+1, n, (i+1)*r) else r 23 | // end of [if] 24 | )(0, n, gnumber_int(1)) 25 | // 26 | end // end of [let] // end of [gfact1] 27 | // 28 | (* ****** ****** *) 29 | 30 | fun 31 | {a:t0p} 32 | gfact2(n: int): a = let 33 | // 34 | overload * with gmul_int_val 35 | // 36 | fun 37 | loop 38 | (xs: stream_vt(int), r0: a): a = 39 | ( 40 | case+ !xs of 41 | | ~stream_vt_nil 42 | () => r0 43 | | ~stream_vt_cons 44 | (x0, xs) => loop(xs, (x0+1)*r0) 45 | ) 46 | // 47 | val _0_n_ = 48 | streamize_intrange_lr<>(0, n) 49 | // 50 | in 51 | loop(_0_n_, gnumber_int(1)) 52 | end // end of [let] // end of [gfact2] 53 | 54 | (* ****** ****** *) 55 | 56 | fun 57 | {a:t0p} 58 | product 59 | (xs: stream_vt(a)): a = let 60 | // 61 | overload * with gmul_val_val 62 | // 63 | fun 64 | loop 65 | (xs: stream_vt(a), r0: a): a = 66 | ( 67 | case+ !xs of 68 | | ~stream_vt_nil() => r0 69 | | ~stream_vt_cons(x0, xs) => loop(xs, r0*x0) 70 | ) 71 | // 72 | in 73 | loop(xs, gnumber_int(1)) 74 | end // end of [product] 75 | 76 | fun 77 | {a:t0p} 78 | gfact3(n: int): a = 79 | product 80 | (stream_vt_map_cloptr 81 | (streamize_intrange_lr<>(0, n), lam(i) => gnumber_int(i+1)) 82 | ) (* end of [gfact3] *) 83 | 84 | (* ****** ****** *) 85 | 86 | fun 87 | {a:t0p} 88 | derangement 89 | (n: intGte(1)): a = let 90 | // 91 | val gadd = gadd_val_val 92 | val gmul = gmul_int_val 93 | // 94 | fun 95 | loop(i: int, r0: a, r1: a): a = 96 | if i < n 97 | then 98 | loop(i+1, (i)\gmul(gadd(r0,r1)), r0) 99 | else r0 // end of [if] 100 | // 101 | in 102 | loop(1, gnumber_int(0), gnumber_int(1)) 103 | end // end of [derangement] 104 | 105 | (* ****** ****** *) 106 | 107 | #include 108 | "$PATSHOMELOCS\ 109 | /atscntrb-hx-intinf/mylibies.hats" 110 | typedef intinf = $GINTINF_t.intinf 111 | overload print with $GINTINF_t.print_intinf 112 | 113 | (* ****** ****** *) 114 | 115 | #include 116 | "$PATSHOMELOCS\ 117 | /atscntrb-hx-mytesting/mylibies.hats" 118 | 119 | fun 120 | {a:t0p} 121 | my_time_spent 122 | ( 123 | f0: cfun(a) 124 | ) : a = $TIMING.time_spent_cloref(f0) 125 | 126 | (* ****** ****** *) 127 | 128 | implement 129 | main0((*void*)) = 130 | { 131 | // 132 | #define N 25000 133 | typedef a = intinf 134 | // 135 | val r1 = 136 | my_time_spent(lam()=>gfact1(N)) 137 | (* 138 | val () = println! ("gfact1(", N, ") = ", r1) 139 | *) 140 | // 141 | val r2 = 142 | my_time_spent(lam()=>gfact2(N)) 143 | (* 144 | val () = println! ("gfact2(", N, ") = ", r2) 145 | *) 146 | // 147 | val r3 = 148 | my_time_spent(lam()=>gfact3(N)) 149 | (* 150 | val () = println! ("gfact3(", N, ") = ", r3) 151 | *) 152 | // 153 | val r4 = 154 | my_time_spent(lam()=>derangement(N)) 155 | (* 156 | val () = println! ("derangement(", N, ") = ", r4) 157 | *) 158 | // 159 | } (* end of [main0] *) 160 | 161 | (* ****** ****** *) 162 | 163 | (* end of [HX-intinf.dats] *) 164 | -------------------------------------------------------------------------------- /RECIPE/HX-intinf/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: HX-intinf_dats 23 | regress:: HX-intinf_dats; ./$< 24 | cleanall:: ; rm -f HX-intinf_dats 25 | 26 | ###### 27 | 28 | testall:: npm-install 29 | testall:: all regress cleanall 30 | 31 | ###### 32 | 33 | %_dats: \ 34 | %.dats; \ 35 | $(PATSCC) -O2 \ 36 | -I./node_modules \ 37 | -DATS_MEMALLOC_GCBDW -o $@ $< -latslib -lgmp -lgc 38 | 39 | ###### 40 | 41 | clean:: ; rm -f *~ 42 | clean:: ; rm -f *_?ats.o 43 | clean:: ; rm -f *_?ats.c 44 | 45 | cleanall:: clean 46 | cleanall:: ; rm -f node_modules -r 47 | cleanall:: ; rm -f package-lock.json 48 | 49 | ###### 50 | 51 | npm-update:: ; $(NPM) update 52 | npm-install:: ; $(NPM) install 53 | 54 | ###### 55 | 56 | export \ 57 | PATSHOMELOCS = \ 58 | ./node_modules:./../node_modules:./../../node_modules:./../../../node_modules 59 | 60 | ###### end of [Makefile] ###### 61 | -------------------------------------------------------------------------------- /RECIPE/HX-intinf/README.md: -------------------------------------------------------------------------------- 1 | # Using GMP in ATS 2 | 3 | This example presents a simple method for using GMP in ATS. 4 | It also makes use of some timing functions for measuring performance. 5 | 6 | The npm-based package *atscntrb-hx-intinf* contains some basic support 7 | for doing arithmetic operations on integers of multiple precision. For 8 | instance, one can use these operations to compute the 1000th power of 9 | 2 as well as the 1000th factorial. This package depends on another 10 | npm-based package of the name *atscntrb-libgmp*, which is just a thin 11 | API layer for various functions in the GMP library. 12 | 13 | The following code gives a generic implementation of the famous 14 | factorial function: 15 | 16 | ```ats 17 | fun 18 | {a:t0p} 19 | gfact3(n: int): a = 20 | product 21 | (stream_vt_map_cloptr 22 | (streamize_intrange_lr<>(0, n), lam(i) => gnumber_int(i+1)) 23 | ) (* end of [gfact3] *) 24 | ``` 25 | 26 | where the function `product` (for computing the product of the numbers 27 | in a given linear stream) is defined as follows: 28 | 29 | ```ats 30 | fun 31 | {a:t0p} 32 | product 33 | (xs: stream_vt(a)): a = let 34 | // 35 | overload * with gmul_val_val 36 | // 37 | fun 38 | loop 39 | (xs: stream_vt(a), r0: a): a = 40 | ( 41 | case+ !xs of 42 | | ~stream_vt_nil() => r0 43 | | ~stream_vt_cons(x0, xs) => loop(xs, r0*x0) 44 | ) 45 | // 46 | in 47 | loop(xs, gnumber_int(1)) 48 | end // end of [product] 49 | ``` 50 | 51 | We can simply load the package *atscntrb-hx-intinf* 52 | to test `gfact3` for the type `intinf`: 53 | 54 | ```ats 55 | #include 56 | "$PATSHOMELOCS\ 57 | /atscntrb-hx-intinf/mylibies.hats" 58 | typedef intinf = $GINTINF_t.intinf 59 | overload print with $GINTINF_t.print_intinf 60 | // 61 | val N = 1000 62 | val r3 = 63 | my_time_spent 64 | (lam()=>gfact3(N)) 65 | val () = println! ("gfact3(", N, ") = ", r3) 66 | // 67 | ``` 68 | 69 | The function `my_time_spent` is defined as follows 70 | for measuring the time spent on calling its argument 71 | (which is a nullary closure-function): 72 | 73 | ```ats 74 | #include 75 | "$PATSHOMELOCS\ 76 | /atscntrb-hx-mytesting/mylibies.hats" 77 | 78 | fun 79 | {a:t0p} 80 | my_time_spent 81 | ( 82 | f0: cfun(a) 83 | ) : a = $TIMING.time_spent_cloref(f0) 84 | ``` 85 | 86 | The npm-based package *atscntrb-hx-mytesting* contains a few 87 | simple timing functions based on the `clock` system call. 88 | 89 | Happy programming in ATS!!! 90 | -------------------------------------------------------------------------------- /RECIPE/HX-intinf/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-libgmp": "^1.0.1", 4 | "atscntrb-hx-intinf": "^1.0.8", 5 | "atscntrb-hx-mytesting": "^1.0.1" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /RECIPE/Hangman/Hangman.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** HX-2018-01: 4 | ** Hangman: 5 | ** a word-guessing game 6 | *) 7 | (* ****** ****** *) 8 | // 9 | abst@ype state 10 | abst@ype input 11 | // 12 | (* ****** ****** *) 13 | 14 | datatype 15 | status = 16 | | STATUSsolved of () 17 | | STATUStimeup of () 18 | | STATUSasking of () 19 | 20 | (* ****** ****** *) 21 | // 22 | extern 23 | fun 24 | state_check 25 | (&state): status 26 | 27 | extern 28 | fun 29 | state_update 30 | (&state >> _, input): int 31 | 32 | extern 33 | fun 34 | state_initize 35 | ( state: &state? >> _ 36 | , ntime: int, word0: string): int 37 | 38 | (* ****** ****** *) 39 | // 40 | extern 41 | fun 42 | GameLoop 43 | (&state >> _, stream_vt(input)): int 44 | and 45 | GameLoop_solved 46 | (&state >> _, stream_vt(input)): int 47 | and 48 | GameLoop_timeup 49 | (&state >> _, stream_vt(input)): int 50 | and 51 | GameLoop_asking 52 | (&state >> _, stream_vt(input)): int 53 | // 54 | (* ****** ****** *) 55 | 56 | implement 57 | GameLoop 58 | (state, xs) = let 59 | // 60 | val 61 | status = state_check(state) 62 | // 63 | in 64 | case+ status of 65 | | STATUSsolved() => GameLoop_solved(state, xs) 66 | | STATUStimeup() => GameLoop_timeup(state, xs) 67 | | STATUSasking() => GameLoop_asking(state, xs) 68 | end // end of [GameLoop] 69 | 70 | (* ****** ****** *) 71 | 72 | #include 73 | "share/atspre_staload.hats" 74 | #include 75 | "share/atspre_staload_libats_ML.hats" 76 | 77 | (* ****** ****** *) 78 | 79 | local 80 | 81 | assume 82 | state = @{ 83 | ntime= int 84 | , 85 | word0= string 86 | , 87 | guess= list0(char) 88 | } 89 | 90 | assume input = char 91 | 92 | fun 93 | is_guessed 94 | ( c0: char 95 | , guess: list0(char) 96 | ) : bool = 97 | (guess).exists()(lam(c1) => c0=c1) 98 | fun 99 | is_contained 100 | ( c0: char 101 | , word0: string 102 | ) : bool = 103 | (word0).exists()(lam(c1) => c0=c1) 104 | 105 | fun 106 | is_solved 107 | ( w0: string 108 | , guess: list0(char) 109 | ) : bool = 110 | (w0).forall() 111 | (lam(c0) => is_guessed(c0, guess)) 112 | 113 | 114 | fun 115 | word_display 116 | ( word0: string 117 | , guess: list0(char) 118 | ) : void = 119 | ( 120 | (word0).foreach() 121 | (lam(c0) => 122 | print_char 123 | (if is_guessed(c0, guess) then c0 else '_') 124 | ) 125 | ) (* end of [word_display] *) 126 | 127 | in (* in-of-local *) 128 | 129 | implement 130 | state_check 131 | (state) = let 132 | // 133 | val word0 = state.word0 134 | val guess = state.guess 135 | // 136 | in 137 | // 138 | ( 139 | ifcase 140 | | is_solved 141 | (word0, guess) => STATUSsolved() 142 | | state.ntime = 0 => STATUStimeup() 143 | | _ (*otherwise*) => STATUSasking() 144 | ) 145 | // 146 | end // end of [state_check] 147 | 148 | implement 149 | state_update 150 | (state, input) = let 151 | // 152 | val c0 = input 153 | val nt = state.ntime 154 | val w0 = state.word0 155 | val cs = state.guess 156 | // 157 | in 158 | // 159 | ifcase 160 | | is_guessed 161 | (c0, cs) => (0) 162 | | is_contained 163 | (c0, w0) => 164 | (state.guess := list0_cons(c0, cs); 0) 165 | | _ (* otherwise *) => 166 | (state.ntime := nt-1; 167 | state.guess := list0_cons(c0, cs); 1) 168 | // 169 | end // end of [state_update] 170 | 171 | implement 172 | state_initize 173 | ( state 174 | , ntime, word0) = (0) where 175 | { 176 | // 177 | val () = (state.ntime := ntime) 178 | val () = (state.word0 := word0) 179 | val () = (state.guess := list0_nil()) 180 | // 181 | } // end of [state_initize] 182 | 183 | implement 184 | GameLoop_solved 185 | (state, xs) = 186 | state.ntime where 187 | { 188 | val () = free(xs) 189 | val () = println! ("You solved it: ", state.word0) 190 | } 191 | 192 | implement 193 | GameLoop_timeup 194 | (state, xs) = 195 | state.ntime where 196 | { 197 | val () = free(xs) 198 | val () = println! ("Sorry, you have no more chances.") 199 | } 200 | 201 | implement 202 | GameLoop_asking 203 | (state, xs) = let 204 | // 205 | val () = 206 | println! 207 | ("Chances: ", state.ntime) 208 | val () = 209 | println! 210 | ("Guessed: ", state.guess) 211 | val () = 212 | word_display 213 | (state.word0, state.guess) 214 | // 215 | val () = println!((*void*)) 216 | // 217 | in 218 | // 219 | case+ !xs of 220 | | ~stream_vt_nil() => (~1) where 221 | { 222 | val () = 223 | println! 224 | ("ERROR: no input from the player!!!") 225 | } 226 | | ~stream_vt_cons(x0, xs) => 227 | let 228 | val err = 229 | state_update(state, x0) in GameLoop(state, xs) 230 | end 231 | // 232 | end // end of [GameLoop_asking] 233 | 234 | end // end of [local] 235 | 236 | (* ****** ****** *) 237 | 238 | implement 239 | main0() = () where 240 | { 241 | // 242 | val nt = 6 243 | val w0 = "camouflage" 244 | // 245 | val () = println!("Start!") 246 | // 247 | var 248 | state: state 249 | val err = 250 | state_initize(state, nt, w0) 251 | // 252 | val lines = 253 | streamize_fileref_line(stdin_ref) 254 | val chars = auxmain(lines) where 255 | { 256 | // 257 | fun 258 | auxmain 259 | ( 260 | xs: 261 | stream_vt(string) 262 | ) : stream_vt(char) = $ldelay 263 | ( 264 | ( 265 | case+ !xs of 266 | | ~stream_vt_nil() => 267 | stream_vt_nil() 268 | | ~stream_vt_cons(x0, xs) => let 269 | val x0 = g1ofg0(x0) 270 | in 271 | if 272 | iseqz(x0) 273 | then !(auxmain(xs)) 274 | else stream_vt_cons(x0[0], auxmain(xs)) 275 | end // end of [stream_vt_cons] 276 | ) 277 | , (lazy_vt_free(xs)) 278 | ) 279 | } 280 | // 281 | val ntime = 282 | GameLoop(state, chars) where { reassume input } 283 | // 284 | val ((*void*)) = println! ("Game Over: ", ntime) 285 | // 286 | } (* end of [main0] *) 287 | 288 | (* ****** ****** *) 289 | 290 | (* end of [Hangman.dats] *) 291 | -------------------------------------------------------------------------------- /RECIPE/Hangman/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: Hangman_dats 23 | 24 | ###### 25 | 26 | testall:: all cleanall 27 | 28 | ###### 29 | 30 | %_dats: %.dats; \ 31 | $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 32 | 33 | ###### 34 | 35 | clean:: ; rm -f *~ 36 | clean:: ; rm -f *_?ats.o 37 | clean:: ; rm -f *_?ats.c 38 | 39 | cleanall:: clean 40 | cleanall:: ; rm -f Hangman_dats 41 | 42 | ###### end of [Makefile] ###### 43 | -------------------------------------------------------------------------------- /RECIPE/Hangman/README.md: -------------------------------------------------------------------------------- 1 | # Hangman 2 | 3 | Hangman is a simple word-guessing game. 4 | 5 | The program in this example 6 | chooses a word in some random fashion and then gives 7 | the player a fixed number of chances to guess the word. The player 8 | can guess one letter each time; if the letter does not appear in the 9 | word, then the player loses a chance; otherwise, each occurrence of 10 | the letter is displayed and the player does not lose a chance. The 11 | player loses if all of the given chances are used up, or the player 12 | wins after all of the letters in the word are correctly guessed. 13 | 14 | The function `GameLoop` implements a standard loop for playing the game: 15 | 16 | ```ats 17 | (* ****** ****** *) 18 | // 19 | extern 20 | fun 21 | GameLoop 22 | (&state >> _, stream_vt(input)): int 23 | and 24 | GameLoop_solved 25 | (&state >> _, stream_vt(input)): int 26 | and 27 | GameLoop_timeup 28 | (&state >> _, stream_vt(input)): int 29 | and 30 | GameLoop_asking 31 | (&state >> _, stream_vt(input)): int 32 | // 33 | (* ****** ****** *) 34 | 35 | implement 36 | GameLoop 37 | (state, xs) = let 38 | // 39 | val 40 | status = state_check(state) 41 | // 42 | in 43 | case+ status of 44 | | STATUSsolved() => GameLoop_solved(state, xs) 45 | | STATUStimeup() => GameLoop_timeup(state, xs) 46 | | STATUSasking() => GameLoop_asking(state, xs) 47 | end // end of [GameLoop] 48 | ``` 49 | 50 | Note that `GameLoop` takes two arguments: The first argument refers 51 | to the current state of the game being played and the second one is a 52 | linear stream representing inputs from the player. The state is passed 53 | as a call-by-reference argument, and it is updated according to the 54 | current input from the player: 55 | 56 | 57 | ``` 58 | implement 59 | GameLoop_asking 60 | (state, xs) = let 61 | // 62 | val () = 63 | println! 64 | ("Chances: ", state.ntime) 65 | val () = 66 | println! 67 | ("Guessed: ", state.guess) 68 | val () = 69 | word_display 70 | (state.word0, state.guess) 71 | // 72 | val () = println!((*void*)) 73 | // 74 | in 75 | // 76 | case+ !xs of 77 | | ~stream_vt_nil() => (~1) where 78 | { 79 | val () = 80 | println! 81 | ("ERROR: no input from the player!!!") 82 | } 83 | | ~stream_vt_cons(x0, xs) => 84 | let 85 | val err = 86 | state_update(state, x0) in GameLoop(state, xs) 87 | end 88 | // 89 | end // end of [GameLoop_asking] 90 | ``` 91 | 92 | Happy programming in ATS!!! 93 | -------------------------------------------------------------------------------- /RECIPE/Hangman2/Hangman2.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** HX-2018-01: 4 | ** Hangman2: 5 | ** a word-guessing game 6 | *) 7 | (* ****** ****** *) 8 | // 9 | abst@ype state_t0ype 10 | abst@ype input_t0ype 11 | // 12 | typedef state = state_t0ype 13 | typedef input = input_t0ype 14 | // 15 | (* ****** ****** *) 16 | 17 | datatype 18 | status = 19 | | STATUSsolved of () 20 | | STATUStimeup of () 21 | | STATUSasking of () 22 | 23 | (* ****** ****** *) 24 | // 25 | extern 26 | fun 27 | state_check 28 | (&state): status 29 | 30 | extern 31 | fun 32 | state_update 33 | (&state >> _, input): int 34 | 35 | extern 36 | fun 37 | state_initize 38 | ( state: &state? >> _ 39 | , ntime: int, word0: string): int 40 | 41 | (* ****** ****** *) 42 | // 43 | extern 44 | fun 45 | GameLoop 46 | (&state >> _, stream_vt(input)): int 47 | and 48 | GameLoop_solved 49 | (&state >> _, stream_vt(input)): int 50 | and 51 | GameLoop_timeup 52 | (&state >> _, stream_vt(input)): int 53 | and 54 | GameLoop_asking 55 | (&state >> _, stream_vt(input)): int 56 | // 57 | (* ****** ****** *) 58 | 59 | implement 60 | GameLoop 61 | (state, xs) = let 62 | // 63 | val 64 | status = state_check(state) 65 | // 66 | in 67 | case+ status of 68 | | STATUSsolved() => GameLoop_solved(state, xs) 69 | | STATUStimeup() => GameLoop_timeup(state, xs) 70 | | STATUSasking() => GameLoop_asking(state, xs) 71 | end // end of [GameLoop] 72 | 73 | (* ****** ****** *) 74 | 75 | #include 76 | "share/atspre_staload.hats" 77 | #include 78 | "share/atspre_staload_libats_ML.hats" 79 | 80 | (* ****** ****** *) 81 | // 82 | extern 83 | fun 84 | GameMain(): void 85 | // 86 | implement main0() = GameMain((*void*)) 87 | // 88 | (* ****** ****** *) 89 | // 90 | extern 91 | fun 92 | stream_by_url_ 93 | (url: string): streamopt_vt(char) 94 | extern 95 | fun 96 | streamize_channel00 97 | ((*channel00*)): stream_vt(string) 98 | // 99 | (* ****** ****** *) 100 | 101 | local 102 | 103 | #include 104 | "$PATSHOMELOCS\ 105 | /atscntrb-libjson-c/mylibies.hats" 106 | #include 107 | "$PATSHOMELOCS\ 108 | /atscntrb-libjson-c/mylibies_link.hats" 109 | 110 | #include 111 | "$PATSHOMELOCS\ 112 | /atscntrb-hx-teaching-bucs/mylibies.hats" 113 | 114 | #staload $JSON_ML 115 | 116 | #staload 117 | UN = "prelude/SATS/unsafe.sats" 118 | #staload 119 | STDLIB = "libats/libc/SATS/stdlib.sats" 120 | #staload 121 | UNISTD = "libats/libc/SATS/unistd.sats" 122 | 123 | #define 124 | Channel00Readall 125 | "http://cs320.herokuapp.com/api/channel00/readall" 126 | #define 127 | Channel00Clearall 128 | "http://cs320.herokuapp.com/api/channel00/clearall" 129 | 130 | in (* in-of-local *) 131 | 132 | implement 133 | stream_by_url_(url) = 134 | $BUCS520.streamopt_url_char<>(url) 135 | 136 | implement 137 | streamize_channel00 138 | ((*void*)) = let 139 | // 140 | fun 141 | auxone 142 | (n0: int): 143 | List0_vt(string) = let 144 | // 145 | val opt = 146 | stream_by_url_ 147 | (Channel00Readall) 148 | // 149 | val input = 150 | ( 151 | case+ opt of 152 | | ~None_vt() => "" 153 | | ~Some_vt(input) => 154 | strptr2string 155 | ( 156 | string_make_stream_vt 157 | ($UN.castvwtp0(input)) 158 | ) 159 | ) : string // end of [val] 160 | // 161 | val- 162 | JSONarray(jsvs) = 163 | jsonval_ofstring(input) 164 | // 165 | in 166 | // 167 | auxone2(n0, jsvs, list_vt_nil) 168 | // 169 | end // end [auxone] 170 | // 171 | and 172 | auxone2 173 | ( 174 | n0: int 175 | , 176 | xs: jsonvalist 177 | , 178 | cs: List0_vt(string) 179 | ) : List0_vt(string) = 180 | ( 181 | case+ xs of 182 | | list_nil() => cs 183 | | list_cons(x0, xs) => let 184 | val-JSONstring(x0) = x0 185 | val i0 = $STDLIB.atoi(x0) 186 | in 187 | if 188 | i0 <= n0 189 | then (cs) 190 | else 191 | auxone2(n0, xs, list_vt_cons(x0, cs)) 192 | end // end of [list_cons] 193 | ) 194 | // 195 | fun 196 | auxjoin 197 | ( 198 | n0: int 199 | ) : 200 | stream_vt(string) = 201 | $ldelay(auxjoin_con(n0)) 202 | // 203 | and 204 | auxjoin_con 205 | ( 206 | n0: int 207 | ) : 208 | stream_vt_con(string) = 209 | let 210 | val xs = auxone(n0) 211 | in 212 | // 213 | case+ xs of 214 | | ~list_vt_nil 215 | () => 216 | auxjoin_con(n0) where 217 | { 218 | val _ = $UNISTD.sleep(1) 219 | } 220 | | ~list_vt_cons 221 | (x0, xs) => 222 | stream_vt_cons(x0, auxjoin2(x0, xs)) 223 | // 224 | end // end of [auxjoin_con] 225 | // 226 | and 227 | auxjoin2 228 | ( 229 | x0: string 230 | , 231 | xs: List0_vt(string) 232 | ) : stream_vt(string) = $ldelay 233 | ( 234 | ( 235 | case+ xs of 236 | | ~list_vt_nil 237 | () => ! 238 | (auxjoin($STDLIB.atoi(x0))) 239 | | ~list_vt_cons 240 | (x1, xs) => 241 | stream_vt_cons(x1, auxjoin2(x1, xs)) 242 | ), (list_vt_free(xs)) 243 | ) 244 | // 245 | in 246 | // 247 | auxjoin(0) where 248 | { 249 | val 250 | opt = 251 | stream_by_url_(Channel00Clearall) 252 | val 253 | ((*freed*)) = 254 | (case+ opt of 255 | | ~None_vt() => () 256 | | ~Some_vt(cs) => free(stream2list_vt(cs))) 257 | } (* end of [where] *) 258 | // 259 | end // end of [streamize_channel00] 260 | 261 | end // end of [local] 262 | 263 | (* ****** ****** *) 264 | 265 | fun 266 | is_guessed 267 | ( c0: char 268 | , guess: list0(char) 269 | ) : bool = 270 | (guess).exists()(lam(c1) => c0=c1) 271 | 272 | fun 273 | word_display 274 | ( word0: string 275 | , guess: list0(char) 276 | ) : void = 277 | ( 278 | (word0).foreach() 279 | (lam(c0) => 280 | print_char 281 | (if is_guessed(c0, guess) then c0 else '_') 282 | ) 283 | ) (* end of [word_display] *) 284 | 285 | (* ****** ****** *) 286 | 287 | local 288 | 289 | assume 290 | state_t0ype = @{ 291 | ntime= int 292 | , 293 | word0= string 294 | , 295 | guess= list0(char) 296 | } 297 | 298 | assume input_t0ype = char 299 | 300 | fun 301 | is_contained 302 | ( c0: char 303 | , word0: string 304 | ) : bool = 305 | (word0).exists()(lam(c1) => c0=c1) 306 | 307 | fun 308 | is_solved 309 | ( w0: string 310 | , guess: list0(char) 311 | ) : bool = 312 | (w0).forall() 313 | (lam(c0) => is_guessed(c0, guess)) 314 | 315 | in (* in-of-local *) 316 | 317 | implement 318 | state_check 319 | (state) = let 320 | // 321 | val word0 = state.word0 322 | val guess = state.guess 323 | // 324 | in 325 | // 326 | ( 327 | ifcase 328 | | is_solved 329 | (word0, guess) => STATUSsolved() 330 | | state.ntime = 0 => STATUStimeup() 331 | | _ (*otherwise*) => STATUSasking() 332 | ) 333 | // 334 | end // end of [state_check] 335 | 336 | implement 337 | state_update 338 | (state, input) = let 339 | // 340 | val c0 = input 341 | val nt = state.ntime 342 | val w0 = state.word0 343 | val cs = state.guess 344 | // 345 | in 346 | // 347 | ifcase 348 | | is_guessed 349 | (c0, cs) => (0) 350 | | is_contained 351 | (c0, w0) => 352 | (state.guess := list0_cons(c0, cs); 0) 353 | | _ (* otherwise *) => 354 | (state.ntime := nt-1; 355 | state.guess := list0_cons(c0, cs); 1) 356 | // 357 | end // end of [state_update] 358 | 359 | implement 360 | state_initize 361 | ( state 362 | , ntime, word0) = (0) where 363 | { 364 | // 365 | val () = (state.ntime := ntime) 366 | val () = (state.word0 := word0) 367 | val () = (state.guess := list0_nil()) 368 | // 369 | } // end of [state_initize] 370 | 371 | implement 372 | GameLoop_solved 373 | (state, xs) = 374 | state.ntime where 375 | { 376 | val () = free(xs) 377 | val () = println! ("You solved it: ", state.word0) 378 | } 379 | 380 | implement 381 | GameLoop_timeup 382 | (state, xs) = 383 | state.ntime where 384 | { 385 | val () = free(xs) 386 | val () = println! ("Sorry, you have no more chances.") 387 | } 388 | 389 | implement 390 | GameLoop_asking 391 | (state, xs) = let 392 | // 393 | val () = 394 | println! 395 | ("Chances: ", state.ntime) 396 | val () = 397 | println! 398 | ("Guessed: ", state.guess) 399 | val () = 400 | word_display 401 | (state.word0, state.guess) 402 | // 403 | val () = println!((*void*)) 404 | // 405 | in 406 | // 407 | case+ !xs of 408 | | ~stream_vt_nil() => (~1) where 409 | { 410 | val () = 411 | println! 412 | ("ERROR: no input from the player!!!") 413 | } 414 | | ~stream_vt_cons(x0, xs) => 415 | let 416 | val err = 417 | state_update(state, x0) in GameLoop(state, xs) 418 | end 419 | // 420 | end // end of [GameLoop_asking] 421 | 422 | end // end of [local] 423 | 424 | (* ****** ****** *) 425 | 426 | implement 427 | GameMain() = 428 | { 429 | // 430 | val nt = 6 431 | val w0 = "camouflage" 432 | // 433 | val () = println!("Start!") 434 | // 435 | var 436 | state: state 437 | val err = 438 | state_initize(state, nt, w0) 439 | // 440 | val lines = 441 | streamize_channel00() 442 | val lines = 443 | stream_vt_map 444 | (lines) where 445 | { 446 | // 447 | #staload UN = $UNSAFE 448 | // 449 | implement 450 | stream_vt_map$fopr 451 | (line) = 452 | trunc(line) where 453 | { 454 | // 455 | fun 456 | trunc 457 | (line: string): string = let 458 | // 459 | val ofs = 460 | string_find_index<>(line, ':') 461 | // 462 | in 463 | // 464 | if 465 | isgtez(ofs) 466 | then 467 | ( 468 | $UN.cast 469 | {string} 470 | ( 471 | ptr_add 472 | (string2ptr(line), succ(ofs)) 473 | ) 474 | ) else ("") 475 | // 476 | end // end of [trunc] 477 | } (* end of [stream_vt_map$fopr] *) 478 | } 479 | val chars = auxmain(lines) where 480 | { 481 | // 482 | fun 483 | auxmain 484 | ( 485 | xs: 486 | stream_vt(string) 487 | ) : stream_vt(char) = $ldelay 488 | ( 489 | ( 490 | case+ !xs of 491 | | ~stream_vt_nil() => 492 | stream_vt_nil() 493 | | ~stream_vt_cons(x0, xs) => let 494 | val x0 = g1ofg0(x0) 495 | in 496 | if 497 | iseqz(x0) 498 | then !(auxmain(xs)) 499 | else stream_vt_cons(x0[0], auxmain(xs)) 500 | end // end of [stream_vt_cons] 501 | ) 502 | , (lazy_vt_free(xs)) 503 | ) 504 | } 505 | // 506 | val 507 | ntime = 508 | GameLoop(state, chars) 509 | where 510 | { reassume input_t0ype } 511 | // 512 | val ((*void*)) = println! ("Game Over: ", ntime) 513 | // 514 | } (* end of [GameMain] *) 515 | 516 | (* ****** ****** *) 517 | 518 | (* end of [Hangman2.dats] *) 519 | -------------------------------------------------------------------------------- /RECIPE/Hangman2/Hangman2_input.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | local 11 | // 12 | #staload 13 | STDLIB = "libats/libc/SATS/stdlib.sats" 14 | // 15 | #define 16 | Channel00Insert 17 | "http://cs320.herokuapp.com/api/channel00/insert" 18 | // 19 | in (* in-of-local *) 20 | 21 | fun 22 | GameKeyboard 23 | (): void = { 24 | // 25 | fun 26 | auxmain 27 | ( 28 | lines: 29 | stream_vt(string) 30 | ) : void = 31 | ( 32 | // 33 | case+ !lines of 34 | | ~stream_vt_nil 35 | ((*void*)) => () 36 | | ~stream_vt_cons 37 | (line, lines) => 38 | ( 39 | if 40 | isneqz(line) 41 | then let 42 | // 43 | val url = 44 | string_append3 45 | (Channel00Insert, "/", line) 46 | val err = 47 | $STDLIB.system 48 | ("wget -q -O - " + url + " > /dev/null") 49 | // 50 | in 51 | auxmain(lines) 52 | end // end of [then] 53 | else 54 | ( 55 | auxmain(lines) 56 | ) (* end of [else] *) 57 | ) 58 | // 59 | ) (* end of [auxmain] *) 60 | // 61 | val () = 62 | auxmain(lines) where 63 | { 64 | val 65 | inp = stdin_ref 66 | val 67 | lines= 68 | streamize_fileref_line(inp) 69 | } (* end of [val] *) 70 | // 71 | } (* end of [GameKeyboard] *) 72 | 73 | end // end of [local] 74 | 75 | (* ****** ****** *) 76 | 77 | implement 78 | main0 () = GameKeyboard() 79 | 80 | (* ****** ****** *) 81 | 82 | (* end of [Hangman2_input.dats] *) 83 | -------------------------------------------------------------------------------- /RECIPE/Hangman2/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: Hangman2_dats 23 | all:: Hangman2_input_dats 24 | 25 | ###### 26 | 27 | testall:: npm-install 28 | testall:: all cleanall 29 | 30 | ###### 31 | # 32 | Hangman2_dats: \ 33 | Hangman2.dats; \ 34 | $(PATSCC) -I./node_modules \ 35 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $< -latslib -ljson-c 36 | # 37 | ###### 38 | # 39 | Hangman2_input_dats: \ 40 | Hangman2_input.dats; \ 41 | $(PATSCC) -I./node_modules -DATS_MEMALLOC_LIBC -o $@ $< -latslib 42 | # 43 | ###### 44 | 45 | clean:: ; rm -f *~ 46 | clean:: ; rm -f *_?ats.o 47 | clean:: ; rm -f *_?ats.c 48 | 49 | cleanall:: clean 50 | cleanall:: ; rm -f Hangman2_dats 51 | cleanall:: ; rm -f Hangman2_input_dats 52 | cleanall:: ; rm -f node_modules -r 53 | cleanall:: ; rm -f package-lock.json 54 | 55 | ###### 56 | 57 | npm-update:: ; $(NPM) update 58 | npm-install:: ; $(NPM) install 59 | 60 | ###### 61 | 62 | export \ 63 | PATSHOMELOCS = \ 64 | ./node_modules:./../node_modules:./../../node_modules:./../../../node_modules 65 | 66 | ###### end of [Makefile] ###### 67 | -------------------------------------------------------------------------------- /RECIPE/Hangman2/README.md: -------------------------------------------------------------------------------- 1 | # Hangman (2) 2 | 3 | If you have not yet read [Hangman](./Hangman), please 4 | do so first. 5 | 6 | The following code builds a stream of input chars based 7 | a simple web service provided at 8 | [http://cs320.herokuapp.com](http://cs320.herokuapp.com): 9 | 10 | 11 | ```ats 12 | local 13 | 14 | #include 15 | "$PATSHOMELOCS\ 16 | /atscntrb-libjson-c/mylibies.hats" 17 | #include 18 | "$PATSHOMELOCS\ 19 | /atscntrb-libjson-c/mylibies_link.hats" 20 | 21 | #include 22 | "$PATSHOMELOCS\ 23 | /atscntrb-hx-teaching-bucs/mylibies.hats" 24 | 25 | #staload $JSON_ML 26 | 27 | #staload 28 | UN = "prelude/SATS/unsafe.sats" 29 | #staload 30 | STDLIB = "libats/libc/SATS/stdlib.sats" 31 | #staload 32 | UNISTD = "libats/libc/SATS/unistd.sats" 33 | 34 | #define 35 | Channel00Readall 36 | "http://cs320.herokuapp.com/api/channel00/readall" 37 | #define 38 | Channel00Clearall 39 | "http://cs320.herokuapp.com/api/channel00/clearall" 40 | 41 | in (* in-of-local *) 42 | 43 | implement 44 | stream_by_url_(url) = 45 | $BUCS520.streamopt_url_char<>(url) 46 | 47 | implement 48 | streamize_channel00 49 | ((*void*)) = let 50 | // 51 | fun 52 | auxone 53 | (n0: int): 54 | List0_vt(string) = let 55 | // 56 | val opt = 57 | stream_by_url_ 58 | (Channel00Readall) 59 | // 60 | val input = 61 | ( 62 | case+ opt of 63 | | ~None_vt() => "" 64 | | ~Some_vt(input) => 65 | strptr2string 66 | ( 67 | string_make_stream_vt 68 | ($UN.castvwtp0(input)) 69 | ) 70 | ) : string // end of [val] 71 | // 72 | val- 73 | JSONarray(jsvs) = 74 | jsonval_ofstring(input) 75 | // 76 | in 77 | // 78 | auxone2(n0, jsvs, list_vt_nil) 79 | // 80 | end // end [auxone] 81 | // 82 | and 83 | auxone2 84 | ( 85 | n0: int 86 | , 87 | xs: jsonvalist 88 | , 89 | cs: List0_vt(string) 90 | ) : List0_vt(string) = 91 | ( 92 | case+ xs of 93 | | list_nil() => cs 94 | | list_cons(x0, xs) => let 95 | val-JSONstring(x0) = x0 96 | val i0 = $STDLIB.atoi(x0) 97 | in 98 | if 99 | i0 <= n0 100 | then (cs) 101 | else 102 | auxone2(n0, xs, list_vt_cons(x0, cs)) 103 | end // end of [list_cons] 104 | ) 105 | // 106 | fun 107 | auxjoin 108 | ( 109 | n0: int 110 | ) : 111 | stream_vt(string) = 112 | $ldelay(auxjoin_con(n0)) 113 | // 114 | and 115 | auxjoin_con 116 | ( 117 | n0: int 118 | ) : 119 | stream_vt_con(string) = 120 | let 121 | val xs = auxone(n0) 122 | in 123 | // 124 | case+ xs of 125 | | ~list_vt_nil 126 | () => 127 | auxjoin_con(n0) where 128 | { 129 | val _ = $UNISTD.sleep(1) 130 | } 131 | | ~list_vt_cons 132 | (x0, xs) => 133 | stream_vt_cons(x0, auxjoin2(x0, xs)) 134 | // 135 | end // end of [auxjoin_con] 136 | // 137 | and 138 | auxjoin2 139 | ( 140 | x0: string 141 | , 142 | xs: List0_vt(string) 143 | ) : stream_vt(string) = $ldelay 144 | ( 145 | ( 146 | case+ xs of 147 | | ~list_vt_nil 148 | () => ! 149 | (auxjoin($STDLIB.atoi(x0))) 150 | | ~list_vt_cons 151 | (x1, xs) => 152 | stream_vt_cons(x1, auxjoin2(x1, xs)) 153 | ), (list_vt_free(xs)) 154 | ) 155 | // 156 | in 157 | // 158 | auxjoin(0) where 159 | { 160 | val 161 | opt = 162 | stream_by_url_(Channel00Clearall) 163 | val 164 | ((*freed*)) = 165 | (case+ opt of 166 | | ~None_vt() => () 167 | | ~Some_vt(cs) => free(stream2list_vt(cs))) 168 | } (* end of [where] *) 169 | // 170 | end // end of [streamize_channel00] 171 | 172 | end // end of [local] 173 | ``` 174 | 175 | The player can use the following function 176 | to input letters: 177 | 178 | 179 | ```ats 180 | local 181 | // 182 | #staload 183 | STDLIB = "libats/libc/SATS/stdlib.sats" 184 | // 185 | #define 186 | Channel00Insert 187 | "http://cs320.herokuapp.com/api/channel00/insert" 188 | // 189 | in (* in-of-local *) 190 | 191 | fun 192 | GameKeyboard 193 | (): void = { 194 | // 195 | fun 196 | auxmain 197 | ( 198 | lines: 199 | stream_vt(string) 200 | ) : void = 201 | ( 202 | // 203 | case+ !lines of 204 | | ~stream_vt_nil 205 | ((*void*)) => () 206 | | ~stream_vt_cons 207 | (line, lines) => 208 | ( 209 | if 210 | isneqz(line) 211 | then let 212 | // 213 | val url = 214 | string_append3 215 | (Channel00Insert, "/", line) 216 | val err = 217 | $STDLIB.system 218 | ("wget -q -O - " + url + " > /dev/null") 219 | // 220 | in 221 | auxmain(lines) 222 | end // end of [then] 223 | else 224 | ( 225 | auxmain(lines) 226 | ) (* end of [else] *) 227 | ) 228 | // 229 | ) (* end of [auxmain] *) 230 | // 231 | val () = 232 | auxmain(lines) where 233 | { 234 | val 235 | inp = stdin_ref 236 | val 237 | lines= 238 | streamize_fileref_line(inp) 239 | } (* end of [val] *) 240 | // 241 | } (* end of [GameKeyboard] *) 242 | 243 | end // end of [local] 244 | ``` 245 | 246 | Happy programming in ATS!!! 247 | -------------------------------------------------------------------------------- /RECIPE/Hangman2/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-libjson-c": "^1.0.3", 4 | "atscntrb-hx-teaching-bucs": "^1.0.8" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /RECIPE/Hangman3/Hangman3_channel.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | #include 11 | "$PATSHOMELOCS\ 12 | /atscntrb-hx-libjson-c/mylibies.hats" 13 | #include 14 | "$PATSHOMELOCS\ 15 | /atscntrb-hx-libjson-c/mylibies_link.hats" 16 | 17 | #staload $JSON_ML 18 | 19 | (* ****** ****** *) 20 | 21 | #staload 22 | UN = "prelude/SATS/unsafe.sats" 23 | #staload 24 | STDLIB = "libats/libc/SATS/stdlib.sats" 25 | #staload 26 | UNISTD = "libats/libc/SATS/unistd.sats" 27 | 28 | (* ****** ****** *) 29 | 30 | abstype channel_type = ptr 31 | typedef channel = channel_type 32 | 33 | (* ****** ****** *) 34 | // 35 | extern 36 | fun{} 37 | linenum_get(string): int 38 | // 39 | implement 40 | {}(*tmp*) 41 | linenum_get 42 | (line) = $STDLIB.atoi(line) 43 | // 44 | (* ****** ****** *) 45 | // 46 | // HX-2018-01-16: 47 | // [channel_readall] 48 | // returns a representation of 49 | // a JSON-array of JSON-strings 50 | // 51 | extern 52 | fun{} 53 | channel_readall 54 | (ch: channel): Option_vt(string) 55 | // 56 | (* ****** ****** *) 57 | // 58 | extern 59 | fun{} 60 | channel_readall_pause(channel): void 61 | // 62 | implement 63 | {}(*tmp*) 64 | channel_readall_pause 65 | (ch) = 66 | ignoret($UNISTD.usleep(1000000)) 67 | // 68 | (* ****** ****** *) 69 | // 70 | extern 71 | fun{} 72 | streamize_channel 73 | (ch: channel): stream_vt(string) 74 | extern 75 | fun{} 76 | streamize_channel_gte 77 | (ch: channel, n0: int): stream_vt(string) 78 | // 79 | (* ****** ****** *) 80 | // 81 | implement 82 | {}(*tmp*) 83 | streamize_channel 84 | (ch) = 85 | ( 86 | streamize_channel_gte<>(ch, 0(*n0*)) 87 | ) 88 | // 89 | (* ****** ****** *) 90 | 91 | implement 92 | {}(*tmp*) 93 | streamize_channel_gte 94 | (ch, n0) = 95 | auxjoin(0) where 96 | { 97 | // 98 | fun 99 | auxone 100 | (n0: int): 101 | List0_vt(string) = let 102 | // 103 | val opt = 104 | channel_readall<>(ch) 105 | // 106 | in 107 | // 108 | case+ opt of 109 | | ~None_vt() => 110 | list_vt_nil() 111 | | ~Some_vt(jsn) => let 112 | val jsv = 113 | jsonval_ofstring(jsn) 114 | in 115 | case+ jsv of 116 | | JSONarray(jsvs) => 117 | auxone_arr(n0, jsvs, list_vt_nil) 118 | | _ (*non-JSONarray*) => list_vt_nil() 119 | end // end of [Some_vt] 120 | // 121 | end // end of [auxone] 122 | // 123 | and 124 | auxone_arr 125 | ( 126 | n0: int 127 | , 128 | xs: jsonvalist 129 | , 130 | cs: List0_vt(string) 131 | ) : List0_vt(string) = 132 | ( 133 | case+ xs of 134 | | list_nil() => cs 135 | | list_cons(x0, xs) => let 136 | val-JSONstring(x0) = x0 137 | val i0 = linenum_get<>(x0) 138 | in 139 | if 140 | i0 <= n0 141 | then (cs) 142 | else 143 | auxone_arr(n0, xs, list_vt_cons(x0, cs)) 144 | end // end of [list_cons] 145 | ) (* end of [auxone_arr] *) 146 | // 147 | fun 148 | auxjoin 149 | ( 150 | n0: int 151 | ) : 152 | stream_vt(string) = 153 | $ldelay(auxjoin_con(n0)) 154 | // 155 | and 156 | auxjoin_con 157 | ( 158 | n0: int 159 | ) : 160 | stream_vt_con(string) = 161 | let 162 | val xs = auxone(n0) 163 | in 164 | // 165 | case+ xs of 166 | | ~list_vt_nil 167 | () => 168 | auxjoin_con(n0) where 169 | { 170 | val () = 171 | channel_readall_pause<>(ch) 172 | } 173 | | ~list_vt_cons 174 | (x0, xs) => 175 | stream_vt_cons(x0, auxjoin_lst(x0, xs)) 176 | // 177 | end // end of [auxjoin_con] 178 | // 179 | and 180 | auxjoin_lst 181 | ( 182 | x0: string 183 | , 184 | xs: List0_vt(string) 185 | ) : stream_vt(string) = $ldelay 186 | ( 187 | ( 188 | case+ xs of 189 | | ~list_vt_nil 190 | () => ! 191 | (auxjoin($STDLIB.atoi(x0))) 192 | | ~list_vt_cons 193 | (x1, xs) => 194 | stream_vt_cons(x1, auxjoin_lst(x1, xs)) 195 | ), (list_vt_free(xs)) 196 | ) 197 | // 198 | } (* end of [streamize_channel_gte] *) 199 | 200 | (* ****** ****** *) 201 | 202 | (* end of [Hangman3_channel.dats] *) 203 | -------------------------------------------------------------------------------- /RECIPE/Hangman3/Hangman3_player0.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | #include 11 | "$PATSHOMELOCS\ 12 | /atscntrb-hx-libjson-c/mylibies.hats" 13 | #include 14 | "$PATSHOMELOCS\ 15 | /atscntrb-hx-libjson-c/mylibies_link.hats" 16 | 17 | #staload $JSON_ML 18 | 19 | fun 20 | jsonval_int 21 | (x: int) = JSONint(g0i2i(x)) 22 | 23 | (* ****** ****** *) 24 | // 25 | #staload UN = $UNSAFE 26 | // 27 | (* ****** ****** *) 28 | // 29 | #include 30 | "$PATSHOMELOCS\ 31 | /atscntrb-hx-teaching-bucs/mylibies.hats" 32 | // 33 | (* ****** ****** *) 34 | // 35 | abst@ype state_t0ype 36 | abst@ype input_t0ype 37 | // 38 | typedef state = state_t0ype 39 | typedef input = input_t0ype 40 | // 41 | (* ****** ****** *) 42 | 43 | datatype 44 | status = 45 | | STATUSsolved of () 46 | | STATUStimeup of () 47 | | STATUSasking of () 48 | 49 | (* ****** ****** *) 50 | // 51 | extern 52 | fun 53 | state_check 54 | (&state): status 55 | 56 | extern 57 | fun 58 | state_update 59 | (&state >> _, input): int 60 | 61 | extern 62 | fun 63 | state_initize 64 | ( state: &state? >> _ 65 | , ntime: int, word0: string): int 66 | 67 | (* ****** ****** *) 68 | // 69 | extern 70 | fun 71 | GameLoop 72 | (&state >> _, stream_vt(input)): int 73 | and 74 | GameLoop_solved 75 | (&state >> _, stream_vt(input)): int 76 | and 77 | GameLoop_timeup 78 | (&state >> _, stream_vt(input)): int 79 | and 80 | GameLoop_asking 81 | (&state >> _, stream_vt(input)): int 82 | // 83 | (* ****** ****** *) 84 | 85 | fun 86 | is_solved 87 | ( w0: string 88 | , guess: list0(char) 89 | ) : bool = 90 | (w0).forall() 91 | (lam(c0) => is_guessed(c0, guess)) 92 | and 93 | is_guessed 94 | ( c0: char 95 | , guess: list0(char) 96 | ) : bool = 97 | (guess).exists()(lam(c1) => c0=c1) 98 | and 99 | is_contained 100 | ( c0: char 101 | , word0: string 102 | ) : bool = 103 | (word0).exists()(lam(c1) => c0=c1) 104 | 105 | (* ****** ****** *) 106 | 107 | fun 108 | word_choose 109 | ( 110 | // argless 111 | ) : string = let 112 | // 113 | val lines = 114 | streamize_fileref_line 115 | (stdin_ref) 116 | // 117 | in 118 | // 119 | case+ !lines of 120 | | ~stream_vt_nil 121 | ((*void*)) => "camouflage" 122 | | ~stream_vt_cons 123 | (w0, lines) => 124 | let val () = free(lines) in w0 end 125 | // 126 | end // end of [word_choose] 127 | 128 | (* ****** ****** *) 129 | 130 | fun 131 | word_display 132 | ( word0: string 133 | , guess: list0(char) 134 | ) : void = 135 | ( 136 | (word0).foreach() 137 | (lam(c0) => 138 | print_char 139 | (if is_guessed(c0, guess) then c0 else '_') 140 | ) 141 | ) (* end of [word_display] *) 142 | 143 | (* ****** ****** *) 144 | 145 | implement 146 | GameLoop 147 | (state, xs) = let 148 | // 149 | val 150 | status = state_check(state) 151 | // 152 | in 153 | case+ status of 154 | | STATUSsolved() => GameLoop_solved(state, xs) 155 | | STATUStimeup() => GameLoop_timeup(state, xs) 156 | | STATUSasking() => GameLoop_asking(state, xs) 157 | end // end of [GameLoop] 158 | 159 | (* ****** ****** *) 160 | 161 | #define 162 | Channel01Insert 163 | "http://cs320.herokuapp.com/api/channel01/insert" 164 | 165 | (* ****** ****** *) 166 | 167 | #define 168 | Channel00Readall 169 | "http://cs320.herokuapp.com/api/channel00/readall" 170 | 171 | #define 172 | Channel00Clearall 173 | "http://cs320.herokuapp.com/api/channel00/clearall" 174 | #define 175 | Channel01Clearall 176 | "http://cs320.herokuapp.com/api/channel01/clearall" 177 | 178 | (* ****** ****** *) 179 | // 180 | fun 181 | channel01_insert_msg 182 | (msg: string): void = let 183 | val opt = 184 | $BUCS520.streamopt_url_char<> 185 | (string_append3 186 | (Channel01Insert, "/", msg)) 187 | in 188 | case+ opt of 189 | | ~None_vt() => () 190 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 191 | end // end of [channel01_insert_msg] 192 | // 193 | (* ****** ****** *) 194 | 195 | fun 196 | channel00_clearall 197 | ((*void*)): void = let 198 | val opt = 199 | $BUCS520.streamopt_url_char<> 200 | (Channel00Clearall) 201 | in 202 | case+ opt of 203 | | ~None_vt() => () 204 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 205 | end // end of [channel00_clearall] 206 | 207 | fun 208 | channel01_clearall 209 | ((*void*)): void = let 210 | val opt = 211 | $BUCS520.streamopt_url_char<> 212 | (Channel01Clearall) 213 | in 214 | case+ opt of 215 | | ~None_vt() => () 216 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 217 | end // end of [channel01_clearall] 218 | 219 | (* ****** ****** *) 220 | 221 | local 222 | 223 | assume 224 | state_t0ype = @{ 225 | ntime= int 226 | , 227 | word0= string 228 | , 229 | guess= list0(char) 230 | } 231 | 232 | assume input_t0ype = char 233 | 234 | in (* in-of-local *) 235 | 236 | implement 237 | state_check 238 | (state) = let 239 | // 240 | val word0 = state.word0 241 | val guess = state.guess 242 | // 243 | in 244 | // 245 | ( 246 | ifcase 247 | | is_solved 248 | (word0, guess) => STATUSsolved() 249 | | state.ntime = 0 => STATUStimeup() 250 | | _ (*otherwise*) => STATUSasking() 251 | ) 252 | // 253 | end // end of [state_check] 254 | 255 | implement 256 | state_update 257 | (state, input) = let 258 | // 259 | val c0 = input 260 | val nt = state.ntime 261 | val w0 = state.word0 262 | val cs = state.guess 263 | // 264 | val ns = 265 | auxlst(0, xs) where 266 | { 267 | fun 268 | auxlst 269 | ( 270 | i: int 271 | , 272 | xs: stream_vt(char) 273 | ) : List0_vt(int) = 274 | ( 275 | case+ !xs of 276 | | ~stream_vt_nil 277 | () => list_vt_nil() 278 | | ~stream_vt_cons 279 | (x0, xs) => 280 | ( 281 | if x0 != c0 282 | then auxlst(i+1, xs) 283 | else list_vt_cons(i, auxlst(i+1, xs)) 284 | ) (* end of [stream_vt_cons] *) 285 | ) 286 | val xs = streamize_string_char(w0) 287 | } (* end of [val] *) 288 | // 289 | val ns = list_vt_reverse(ns) 290 | val ns = list_vt_mapfree_cloptr(ns, lam(n)=>jsonval_int(n)) 291 | val ns = JSONarray(list_vt2t(ns)) 292 | val ns = jsonval_tostring(ns) 293 | val () = channel01_insert_msg($UN.strptr2string(ns)) 294 | val ((*freed*)) = strptr_free(ns) 295 | // 296 | in 297 | // 298 | ifcase 299 | | is_guessed 300 | (c0, cs) => (0) 301 | | is_contained 302 | (c0, w0) => 303 | (state.guess := list0_cons(c0, cs); 0) 304 | | _ (* otherwise *) => 305 | (state.ntime := nt-1; 306 | state.guess := list0_cons(c0, cs); 1) 307 | // 308 | end // end of [state_update] 309 | 310 | implement 311 | state_initize 312 | ( state 313 | , ntime, word0) = (0) where 314 | { 315 | // 316 | val () = (state.ntime := ntime) 317 | val () = (state.word0 := word0) 318 | val () = (state.guess := list0_nil()) 319 | // 320 | } // end of [state_initize] 321 | 322 | implement 323 | GameLoop_solved 324 | (state, xs) = 325 | state.ntime where 326 | { 327 | val () = free(xs) 328 | val () = println! ("You solved it: ", state.word0) 329 | } 330 | 331 | implement 332 | GameLoop_timeup 333 | (state, xs) = 334 | state.ntime where 335 | { 336 | val () = free(xs) 337 | val () = channel01_insert_msg(state.word0) 338 | val () = println! ("Sorry, you have no more chances.") 339 | } 340 | 341 | implement 342 | GameLoop_asking 343 | (state, xs) = let 344 | // 345 | val () = 346 | println! 347 | ("Chances: ", state.ntime) 348 | val () = 349 | println! 350 | ("Guessed: ", state.guess) 351 | val () = 352 | word_display 353 | (state.word0, state.guess) 354 | // 355 | val () = println!((*void*)) 356 | // 357 | in 358 | // 359 | case+ !xs of 360 | | ~stream_vt_nil() => (~1) where 361 | { 362 | val () = 363 | println! 364 | ("ERROR: no input from the player!!!") 365 | } 366 | | ~stream_vt_cons(x0, xs) => 367 | let 368 | val err = 369 | state_update(state, x0) in GameLoop(state, xs) 370 | end 371 | // 372 | end // end of [GameLoop_asking] 373 | 374 | end // end of [local] 375 | 376 | (* ****** ****** *) 377 | 378 | local 379 | 380 | #staload 381 | "./Hangman3_channel.dats" 382 | 383 | in (* in-of-local *) 384 | 385 | fun 386 | streamize_channel00 387 | ( 388 | // argless 389 | ) : stream_vt(string) = let 390 | // 391 | val 392 | CH0 = $UN.cast{channel}(0) 393 | // 394 | implement 395 | channel_readall<>(ch) = let 396 | val opt = 397 | $BUCS520.streamopt_url_char<> 398 | (Channel00Readall) 399 | in 400 | case+ opt of 401 | | ~None_vt() => 402 | None_vt() 403 | | ~Some_vt(xs) => 404 | Some_vt 405 | (strptr2string 406 | (string_make_stream_vt($UN.castvwtp0(xs))) 407 | ) (* end of [Some_vt] *) 408 | end // end of [channel_readall] 409 | // 410 | in 411 | streamize_channel<>(CH0) 412 | end // end of [streamize_channel00] 413 | 414 | end // end of [local] 415 | 416 | (* ****** ****** *) 417 | // 418 | extern 419 | fun 420 | GameMain(): void 421 | // 422 | implement 423 | GameMain((*void*)) = 424 | { 425 | // 426 | val nt = 6 427 | // 428 | val () = 429 | println! 430 | ("Choose a word:") 431 | val w0 = 432 | word_choose((*void*)) 433 | // 434 | val () = 435 | channel00_clearall() 436 | val () = 437 | channel01_clearall() 438 | // 439 | val () = 440 | channel01_insert_msg 441 | (strptr2string 442 | (jsonval_tostring 443 | (jsonval_int(nw)))) where 444 | { 445 | val nw = sz2i(length(w0)) 446 | } 447 | // 448 | var 449 | state: state 450 | val err = 451 | state_initize(state, nt, w0) 452 | // 453 | val lines = 454 | streamize_channel00() 455 | val lines = 456 | stream_vt_map 457 | (lines) where 458 | { 459 | // 460 | implement 461 | stream_vt_map$fopr 462 | (line) = 463 | trunc 464 | (string2ptr(line)) where 465 | { 466 | // 467 | fun 468 | trunc(p0: ptr): string = let 469 | // 470 | val c0 = $UN.ptr0_get(p0) 471 | // 472 | in 473 | // 474 | if 475 | iseqz(c0) 476 | then "" else 477 | ( 478 | if 479 | (c0 != ':') 480 | then 481 | trunc(ptr_succ(p0)) 482 | else 483 | $UN.cast{string}(ptr_succ(p0)) 484 | ) 485 | // 486 | end // end of [trunc] 487 | } (* end of [stream_vt_map$fopr] *) 488 | } 489 | // 490 | val 491 | cs = auxmain(lines) where 492 | { 493 | // 494 | fun 495 | auxmain 496 | ( 497 | xs: 498 | stream_vt(string) 499 | ) : stream_vt(char) = $ldelay 500 | ( 501 | ( 502 | case+ !xs of 503 | | ~stream_vt_nil() => 504 | stream_vt_nil() 505 | | ~stream_vt_cons(x0, xs) => let 506 | val x0 = g1ofg0(x0) 507 | in 508 | if 509 | iseqz(x0) 510 | then !(auxmain(xs)) 511 | else stream_vt_cons(x0[0], auxmain(xs)) 512 | end // end of [stream_vt_cons] 513 | ) 514 | , (lazy_vt_free(xs)) 515 | ) 516 | } 517 | // 518 | val 519 | ntime = 520 | GameLoop(state, cs) 521 | where 522 | { reassume input_t0ype } 523 | // 524 | val ((*void*)) = println! ("Game Over: ", ntime) 525 | // 526 | } (* end of [GameMain] *) 527 | 528 | (* ****** ****** *) 529 | 530 | implement main0() = GameMain() 531 | 532 | (* ****** ****** *) 533 | 534 | (* end of [Hangman3_player0.dats] *) 535 | -------------------------------------------------------------------------------- /RECIPE/Hangman3/Hangman3_player1.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | #include 11 | "$PATSHOMELOCS\ 12 | /atscntrb-hx-libjson-c/mylibies.hats" 13 | #include 14 | "$PATSHOMELOCS\ 15 | /atscntrb-hx-libjson-c/mylibies_link.hats" 16 | 17 | #staload $JSON_ML 18 | 19 | fun 20 | jsonval_int 21 | (x: int) = JSONint(g0i2i(x)) 22 | 23 | (* ****** ****** *) 24 | // 25 | #staload UN = $UNSAFE 26 | // 27 | (* ****** ****** *) 28 | // 29 | #include 30 | "$PATSHOMELOCS\ 31 | /atscntrb-hx-teaching-bucs/mylibies.hats" 32 | // 33 | (* ****** ****** *) 34 | // 35 | abst@ype state_t0ype 36 | // 37 | typedef state = state_t0ype 38 | // 39 | (* ****** ****** *) 40 | 41 | #define 42 | Channel00Insert 43 | "http://cs320.herokuapp.com/api/channel00/insert" 44 | 45 | (* ****** ****** *) 46 | 47 | #define 48 | Channel01Readall 49 | "http://cs320.herokuapp.com/api/channel01/readall" 50 | 51 | (* ****** ****** *) 52 | // 53 | fun 54 | channel00_insert_msg 55 | (msg: string): void = let 56 | val opt = 57 | $BUCS520.streamopt_url_char<> 58 | (string_append3 59 | (Channel00Insert, "/", msg)) 60 | in 61 | case+ opt of 62 | | ~None_vt() => () 63 | | ~Some_vt(cs) => free(stream2list_vt(cs)) 64 | end // end of [channel00_insert_msg] 65 | // 66 | (* ****** ****** *) 67 | // 68 | extern 69 | fun 70 | state_check 71 | (&state >> _): int 72 | extern 73 | fun 74 | state_update 75 | (&state >> _, char): void 76 | extern 77 | fun 78 | state_initize 79 | ( state: &state? >> _ 80 | , nword: int, ntime: int): void 81 | // 82 | (* ****** ****** *) 83 | 84 | local 85 | 86 | assume 87 | state_t0ype = @{ 88 | ntime= int 89 | , 90 | guess= list0(char) 91 | , 92 | word0=array0(char) 93 | } 94 | 95 | in 96 | 97 | val int_t = TYPE{int}() 98 | 99 | implement 100 | state_check 101 | (state) = 102 | ( 103 | ( 104 | state.word0 105 | ).foldleft(int_t) 106 | (0, lam(r, c) => if c = '_' then r else r+1) 107 | ) 108 | 109 | implement 110 | state_initize 111 | (state, nw, nt) = 112 | { 113 | val () = state.ntime := nt 114 | val () = state.guess := list0_nil() 115 | val () = state.word0 := array0_make_elt(nw, '_') 116 | } 117 | 118 | end // end of [local] 119 | 120 | (* ****** ****** *) 121 | 122 | local 123 | 124 | #staload 125 | "./Hangman3_channel.dats" 126 | 127 | in (* in-of-local *) 128 | 129 | fun 130 | streamize_channel01 131 | ( 132 | // argless 133 | ) : stream_vt(string) = let 134 | // 135 | val 136 | CH1 = $UN.cast{channel}(1) 137 | // 138 | implement 139 | channel_readall<>(ch) = let 140 | val opt = 141 | $BUCS520.streamopt_url_char<> 142 | (Channel01Readall) 143 | in 144 | case+ opt of 145 | | ~None_vt() => 146 | None_vt() 147 | | ~Some_vt(xs) => 148 | Some_vt 149 | (strptr2string 150 | (string_make_stream_vt($UN.castvwtp0(xs))) 151 | ) (* end of [Some_vt] *) 152 | end // end of [channel_readall] 153 | // 154 | in 155 | streamize_channel<>(CH1) 156 | end // end of [streamize_channel01] 157 | 158 | end // end of [local] 159 | 160 | (* ****** ****** *) 161 | // 162 | extern 163 | fun 164 | GameMain(): void 165 | extern 166 | fun 167 | GameLoop 168 | (&state >> _, stream_vt(string), stream_vt(string)): int 169 | and 170 | GameLoop_guess 171 | (&state >> _, stream_vt(string), stream_vt(string)): int 172 | // 173 | implement 174 | GameMain((*void*)) = 175 | { 176 | // 177 | val nt = 6 178 | // 179 | var 180 | state: state 181 | // 182 | val lines = 183 | streamize_channel01() 184 | val lines = 185 | stream_vt_map 186 | (lines) where 187 | { 188 | // 189 | implement 190 | stream_vt_map$fopr 191 | (line) = 192 | trunc 193 | (string2ptr(line)) where 194 | { 195 | // 196 | fun 197 | trunc(p0: ptr): string = let 198 | // 199 | val c0 = $UN.ptr0_get(p0) 200 | // 201 | in 202 | // 203 | if 204 | iseqz(c0) 205 | then "" else 206 | ( 207 | if 208 | (c0 != ':') 209 | then 210 | trunc(ptr_succ(p0)) 211 | else 212 | $UN.cast{string}(ptr_succ(p0)) 213 | ) 214 | // 215 | end // end of [trunc] 216 | } (* end of [stream_vt_map$fopr] *) 217 | } 218 | // 219 | val- 220 | ~stream_vt_cons 221 | (l0, lines) = !lines 222 | val- 223 | JSONint(nw) = 224 | jsonval_ofstring(l0) 225 | // 226 | val nw = 227 | $UN.cast{int}(nw) 228 | val () = 229 | state_initize(state, nw, nt) 230 | // 231 | val 232 | lns = 233 | streamize_fileref_line 234 | (stdin_ref) 235 | val 236 | lns = 237 | stream_vt_filter_cloptr 238 | (lns, lam(ln) => isneqz(ln)) 239 | // 240 | val 241 | ntime = GameLoop(state, lns, lines) 242 | // 243 | } (* end of [GameMain] *) 244 | // 245 | (* ****** ****** *) 246 | // 247 | fun 248 | word_display 249 | (w0: array0(char)): void = 250 | (w0).foreach()(lam(c) => print(c)) 251 | // 252 | (* ****** ****** *) 253 | 254 | implement 255 | GameLoop 256 | ( state 257 | , lns, lines) = let 258 | // 259 | reassume state_t0ype 260 | // 261 | val nt = state.ntime 262 | val w0 = state.word0 263 | val () = word_display(w0) 264 | val () = println!((*void*)) 265 | val () = println!("Chances: ", nt) 266 | // 267 | val 268 | is_solved = 269 | (w0).forall() 270 | (lam(c) => c != '_') 271 | // 272 | in 273 | // 274 | if 275 | is_solved 276 | then 277 | ( 278 | let 279 | val () = free(lns) 280 | val () = free(lines) 281 | val () = 282 | println! ("Solved!") in nt 283 | end 284 | ) 285 | else 286 | ( 287 | if 288 | (nt > 0) 289 | then 290 | GameLoop_guess 291 | (state, lns, lines) 292 | else 293 | let 294 | val () = free(lns) 295 | val () = 296 | println! ("No more chances!") 297 | val () = 298 | ( 299 | case+ !lines of 300 | | ~stream_vt_nil 301 | ((*void*)) => () 302 | | ~stream_vt_cons 303 | (l0, lines) => let 304 | val () = lazy_vt_free(lines) 305 | in 306 | println! ("The chosen word: ", l0) 307 | end // end of [stream_vt_cons] 308 | ) : void // end of [val] 309 | in 310 | (0) 311 | end // end of [else] 312 | ) 313 | // 314 | end // end of [GameLoop] 315 | 316 | (* ****** ****** *) 317 | 318 | implement 319 | GameLoop_guess 320 | ( state 321 | , lns, lines) = let 322 | // 323 | reassume state_t0ype 324 | // 325 | val- 326 | ~stream_vt_cons 327 | (l0, lns) = !lns 328 | // 329 | val 330 | l0 = g1ofg0(l0) 331 | val () = 332 | assertloc(isneqz(l0)) 333 | // 334 | val c0 = l0[0] 335 | val nt = state.ntime 336 | val w0 = state.word0 337 | // 338 | val () = 339 | channel00_insert_msg(l0) 340 | // 341 | val- 342 | ~stream_vt_cons 343 | (l0, lines) = !lines 344 | val- 345 | JSONarray(jsvs) = 346 | jsonval_ofstring(l0) 347 | // 348 | val () = 349 | (jsvs).foreach() 350 | (lam(jsv) => let 351 | val-JSONint(n) = jsv 352 | val n = $UN.cast{int}(n) 353 | in 354 | array0_set_at(w0, n, c0) 355 | end 356 | ) 357 | // 358 | val () = 359 | if length(jsvs) = 0 then state.ntime := nt-1 360 | // 361 | in 362 | GameLoop(state, lns, lines) 363 | end // end of [GameLoop_guess] 364 | 365 | (* ****** ****** *) 366 | 367 | implement main0() = GameMain() 368 | 369 | (* ****** ****** *) 370 | 371 | (* end of [Hangman3_player1.dats] *) 372 | -------------------------------------------------------------------------------- /RECIPE/Hangman3/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: \ 23 | Hangman3_player0_dats 24 | all:: \ 25 | Hangman3_player1_dats 26 | 27 | ###### 28 | 29 | testall:: npm-install 30 | testall:: all cleanall 31 | 32 | ###### 33 | # 34 | Hangman3_player0_dats: \ 35 | Hangman3_player0.dats; \ 36 | $(PATSCC) -I./node_modules \ 37 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $< -latslib -ljson-c 38 | # 39 | ###### 40 | # 41 | Hangman3_player1_dats: \ 42 | Hangman3_player1.dats; \ 43 | $(PATSCC) -I./node_modules \ 44 | -D_GNU_SOURCE -DATS_MEMALLOC_LIBC -o $@ $< -latslib -ljson-c 45 | # 46 | ###### 47 | 48 | clean:: ; rm -f *~ 49 | clean:: ; rm -f *_?ats.o 50 | clean:: ; rm -f *_?ats.c 51 | 52 | cleanall:: clean 53 | cleanall:: ; rm -f node_modules -r 54 | cleanall:: ; rm -f package-lock.json 55 | cleanall:: ; rm -f Hangman3_player0_dats 56 | cleanall:: ; rm -f Hangman3_player1_dats 57 | 58 | ###### 59 | 60 | npm-update:: ; $(NPM) update 61 | npm-install:: ; $(NPM) install 62 | 63 | ###### 64 | 65 | export \ 66 | PATSHOMELOCS = \ 67 | ./node_modules:./../node_modules:./../../node_modules:./../../../node_modules 68 | 69 | ###### end of [Makefile] ###### 70 | -------------------------------------------------------------------------------- /RECIPE/Hangman3/README.md: -------------------------------------------------------------------------------- 1 | # Hangman (3) 2 | 3 | If you have not yet read [Hangman](./Hangman), please 4 | do so first. 5 | 6 | This example gives an implementation of the Hangman game for two 7 | communicating players, where the communication is done through two 8 | web-based uni-directional channels that are untyped. The difficulty in 9 | programming with such untyped channels strongly motivates the need 10 | for typed channels where the types classifying channels are often 11 | referred to as session types. 12 | 13 | Player0 should start first, choosing a word and then sending out its 14 | length. Player1 is given 6 chances to guess the word chosen by 15 | Player0. As the communication between Player0 and Player1 is based on 16 | a simple web service, they can play on any two machines that have 17 | access to the Internet. 18 | 19 | Happy programming in ATS!!! 20 | -------------------------------------------------------------------------------- /RECIPE/Hangman3/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-libjson-c": "^1.0.1", 4 | "atscntrb-hx-teaching-bucs": "^1.0.8" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /RECIPE/Hello/Hello.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include "share/atspre_staload.hats" 4 | #include "share/atspre_staload_libats_ML.hats" 5 | 6 | (* ****** ****** *) 7 | 8 | implement 9 | main0() = println! ("Hello, world!") 10 | 11 | (* ****** ****** *) 12 | 13 | (* end of [Hello.dats] *) 14 | -------------------------------------------------------------------------------- /RECIPE/Hello/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | PATSCC=$(PATSHOME)/bin/patscc 13 | PATSOPT=$(PATSHOME)/bin/patsopt 14 | PATSLIB=$(PATSHOME)/ccomp/atslib 15 | 16 | ###### 17 | 18 | all:: Hello_dats 19 | 20 | ###### 21 | 22 | testall:: all 23 | testall:: regress 24 | testall:: cleanall 25 | 26 | ###### 27 | 28 | regress:: Hello_dats; ./$< 29 | 30 | ###### 31 | 32 | %_dats: %.dats; $(PATSCC) -o $@ $< 33 | 34 | ###### 35 | 36 | clean:: ; rm -f *~ 37 | clean:: ; rm -f *_?ats.o 38 | clean:: ; rm -f *_?ats.c 39 | 40 | cleanall:: clean 41 | cleanall:: ; rm -f Hello_dats 42 | 43 | ###### end of [Makefile] ###### 44 | -------------------------------------------------------------------------------- /RECIPE/Hello/README.md: -------------------------------------------------------------------------------- 1 | # Hello, World! 2 | 3 | I suppose that you have already 4 | gained access to the commands patscc, patsopt 5 | and myatscc. If you have not, there are plenty 6 | of resources on-line that can guide you through 7 | the process of installing ATS (more precisely, ATS2) 8 | on your own machine. For instance, you can find various 9 | scripts [on-line](http://www.ats-lang.org/Downloads.html#Scripts_for_installing_ATS_Postiats) 10 | for installing ATS on Linux and MacOS. 11 | 12 | Let us go through the few lines of code in [Hello.dats](./Hello.dats) quickly. 13 | One can form a line-comment in ATS by starting the line with two slashes (//). One can also 14 | form a block-comment in ATS by using the ML-style of commenting: 15 | 16 | ```ats 17 | (* 18 | ...here-is-a-block-comment... 19 | *) 20 | ``` 21 | 22 | The following lines are for staloading (that is, statically loading) 23 | some library code that the ATS compiler (ATS/Postiats) may need for the purpose 24 | of compilation: 25 | 26 | ```ats 27 | #include "share/atspre_staload.hats" 28 | #include "share/atspre_staload_libats_ML.hats" 29 | ``` 30 | 31 | I will give some explanation elsewhere on using library functions in 32 | the construction of ATS programs. In order to compile a program into 33 | an executable, the special function named `main` need to be 34 | implemented. In the following code, `main0` is a variant of 35 | `main`: 36 | 37 | ```ats 38 | implement 39 | main0() = println! ("Hello", ", world!") 40 | ``` 41 | 42 | Note that the body of `main0` is required to be of the type 43 | `void`. The function-like `println!` prints its arguments to 44 | the standard output and then prints a newline at the end. I use the 45 | name function-like to refer to something in ATS that is like a 46 | function but is not actually a function. 47 | 48 | There is a Makefile provide for compiling the code. One can also use 49 | the following *myatscc* command-line for compilation: 50 | 51 | ```shell 52 | myatscc Hello.dats 53 | ``` 54 | 55 | which should generate an executable of the name *Hello_dats*. By executing 56 | *Hello_dats*, one sees the expected output: 57 | 58 | ```text 59 | >> ./Hello_dats 60 | << Hello, world! 61 | ``` 62 | 63 | Happy programming in ATS!!! 64 | -------------------------------------------------------------------------------- /RECIPE/Makefile_test: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | 7 | SUBDIRS := 8 | SUBDIRS += ./Hello 9 | SUBDIRS += ./HX-intinf 10 | SUBDIRS += ./BinarySearch 11 | SUBDIRS += ./ReadFromSTDIN 12 | SUBDIRS += ./ReadFromSTDIN2 13 | SUBDIRS += ./ReadFromSTDIN3 14 | SUBDIRS += ./Hangman 15 | SUBDIRS += ./Hangman2 16 | SUBDIRS += ./Hangman3 17 | SUBDIRS += ./Tokenizer 18 | SUBDIRS += ./WordFrqncyCount 19 | 20 | .PHONY: testall 21 | 22 | ###### 23 | 24 | testall:: ; for i in $(SUBDIRS); do $(MAKE) -C "$$i" $@; done 25 | 26 | ###### 27 | 28 | cleanall:: ; for i in $(SUBDIRS); do $(MAKE) -C "$$i" $@; done 29 | 30 | ###### end of [Makefile_test] ###### 31 | 32 | -------------------------------------------------------------------------------- /RECIPE/README.md: -------------------------------------------------------------------------------- 1 | # ATS-CodeBook/RECIPE 2 | 3 | For varieties of coding examples in ATS 4 | 5 | ## [Hello](./Hello) 6 | 7 | This example shows how to construct a simple program in ATS, compile 8 | it and then execute it. 9 | 10 | ## [HX-intinf](./HX-intinf) 11 | 12 | This example presents a simple method for using GMP in ATS. 13 | It also makes use of some timing functions for measuring performance. 14 | 15 | ## [BinarySearch](./BinarySearch) 16 | 17 | The program in this example demonstrates a stream-based approach to 18 | locating a zero of a given continuous function in a given interval via 19 | the so-called binary search. 20 | 21 | ## [ReadFromSTDIN](./ReadFromSTDIN) 22 | 23 | This example demonstrates a stream-based approach to constructing an 24 | interactive program that handles input from the user. 25 | 26 | ## [ReadFromSTDIN2](./ReadFromSTDIN2) 27 | 28 | This example is meant to be directly compared with 29 | [ReadFromSTDIN](./ReadFromSTDIN). While the code in this one does 30 | essentially the same as that of [ReadFromSTDIN](./ReadFromSTDIN), it 31 | is written in a different style, which greatly stresses the use of 32 | combinators in functional programming. 33 | 34 | ## [ReadFromSTDIN3](./ReadFromSTDIN3) 35 | 36 | This example does essentially the same as the code in 37 | [ReadFromSTDIN2](./ReadFromSTDIN2) except for using the alarm signal 38 | (SIGALRM) to prevent the possible scenario of waiting indefinitely for 39 | the user's input. 40 | 41 | ## [GuessNumber](./GuessNumber) 42 | 43 | This example implements a very simple game of guessing a number chosen 44 | from the range btween 0 and 100. During each round, the computer 45 | prints out its guess and the player gives a response whether the guess 46 | is less than, greater than or equal to the chosen number. 47 | 48 | ## [Hangman](./Hangman) 49 | 50 | This example gives a straightforward implementation of Hangman, a 51 | famous word-guessing game. A linear stream is employed to handle inputs 52 | from the player. Also, the game-state is passed as a call-by-reference 53 | argument to the game-loop (so as for it to be updated). 54 | 55 | ## [Hangman2](./Hangman2) 56 | 57 | This example implements a distributed version of the Hangman game for 58 | two players, where only the one who does the guessing part of the game 59 | can send messages to the other one through a web-based uni-directional 60 | channel. 61 | 62 | ## [Hangman3](./Hangman3) 63 | 64 | This example implements another distributed version of the Hangman 65 | game for two communicating players, where the communication is done 66 | through two web-based uni-directional channels (that are untyped). 67 | 68 | ## [Tokenizer](./Tokenizer) 69 | 70 | This example gives an implementation of a tokenizer that turns a 71 | linear stream of characters into a linear stream of tokens (for 72 | identifier names and (unsigned) integers. 73 | 74 | ## [CSV-parsing](./CSV-parsing) 75 | 76 | This example presents a way to parse a table in the 77 | CSV format such that each line in the table is converted into 78 | a hashtable (of gvalues declared in *libats/ML/SATS/gvalue.sats*). 79 | 80 | ## [WordFrqncyCount](./WordFrqncyCount) 81 | 82 | This example gives a stream-based implementation that counts words in 83 | a given on-line source and then sorts these words according to their 84 | frequencies. It also explains a bit about using an npm-based package 85 | in ATS. 86 | 87 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | PATSCC=$(PATSHOME)/bin/patscc 13 | PATSOPT=$(PATSHOME)/bin/patsopt 14 | PATSLIB=$(PATSHOME)/ccomp/atslib 15 | 16 | ###### 17 | 18 | all:: ReadFromSTDIN_dats 19 | 20 | ###### 21 | 22 | testall:: all 23 | testall:: regress 24 | testall:: cleanall 25 | 26 | ###### 27 | 28 | %_dats: %.dats; $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 29 | 30 | ###### 31 | 32 | regress:: ReadFromSTDIN_dats; echo 1000000 | ./$< 33 | 34 | ###### 35 | 36 | clean:: ; rm -f *~ 37 | clean:: ; rm -f *_?ats.o 38 | clean:: ; rm -f *_?ats.c 39 | 40 | cleanall:: clean 41 | cleanall:: ; rm -f ReadFromSTDIN_dats 42 | 43 | ###### end of [Makefile] ###### 44 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN/README.md: -------------------------------------------------------------------------------- 1 | # Read from STDIN 2 | 3 | One can certainly use `scanf` to read from 4 | the standard input (STDIN). What I would like to 5 | present in this example is the idea of treating 6 | STDIN as a linear stream of lines (where each line 7 | is represented as a string). For instance, the 8 | following function `echo` prints onto the standard 9 | output each line read from the standard input: 10 | 11 | ```ats 12 | fun 13 | echo() = let 14 | fun 15 | loop(xs: stream_vt(string)): void = 16 | ( 17 | case+ !xs of 18 | | ~stream_vt_nil() => () 19 | | ~stream_vt_cons(x, xs) => (println!(x); loop(xs)) 20 | ) 21 | in 22 | loop(streamize_fileref_line(stdin_ref)) 23 | end // end of [echo] 24 | ``` 25 | 26 | The function `streamize_fileref_line` is often referred to as a 27 | streamization function, which in this case turns a given file handle 28 | (of the type `FILEref`) into a linear stream of strings such that 29 | each string in the stream represents one line of input received from the 30 | file handle. 31 | 32 | The following function `tally` prompts the user to input integers 33 | and then returns at the end the sum of all of the integers read from STDIN: 34 | 35 | ```ats 36 | fun 37 | tally(): int = let 38 | fun 39 | loop 40 | (xs: stream_vt(string), res: int): int = 41 | ( 42 | case+ !xs of 43 | | ~stream_vt_nil() => res 44 | | ~stream_vt_cons(x, xs) => 45 | let 46 | val () = 47 | if isneqz(x) then prompt() 48 | in 49 | loop(xs, res+g0string2int(x)) 50 | end 51 | ) (* end of [loop] *) 52 | 53 | and 54 | prompt(): void = 55 | println! 56 | ("Please input more or type Ctrl-D:") 57 | in 58 | println!("Please input one integer:"); 59 | loop(streamize_fileref_line(stdin_ref), 0) 60 | end // end of [tally] 61 | ``` 62 | Note that the function `isneqz` checks whether a 63 | given string is empty and the function `g0string2int` 64 | converts a given string into the int-value it represents. 65 | 66 | As far as I can tell, linear streams are so far a programming feature 67 | that is only available in ATS. I will gradually present more examples 68 | involving linear streams. 69 | 70 | Happy programming in ATS!!! 71 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN/ReadFromSTDIN.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | (* 11 | fun 12 | echo() = let 13 | fun 14 | loop(xs: stream_vt(string)): void = 15 | ( 16 | case+ !xs of 17 | | ~stream_vt_nil() => () 18 | | ~stream_vt_cons(x, xs) => (println!(x); loop(xs)) 19 | ) 20 | in 21 | loop(streamize_fileref_line(stdin_ref)) 22 | end // end of [echo] 23 | *) 24 | 25 | (* ****** ****** *) 26 | 27 | fun 28 | tally(): int = let 29 | fun 30 | loop 31 | (xs: stream_vt(string), res: int): int = 32 | ( 33 | case+ !xs of 34 | | ~stream_vt_nil() => res 35 | | ~stream_vt_cons(x, xs) => 36 | let 37 | val () = 38 | if isneqz(x) then prompt() 39 | in 40 | // 41 | // HX-2018-01-06: 42 | // [g0string2int] converts a given string into 43 | // the int it represents 44 | // 45 | loop(xs, res+g0string2int(x)) 46 | end 47 | ) (* end of [loop] *) 48 | 49 | and 50 | prompt(): void = 51 | println! 52 | ("Please input more or type Ctrl-D:") 53 | 54 | in 55 | println!("Please input one integer:"); 56 | loop(streamize_fileref_line(stdin_ref), 0) 57 | end // end of [tally] 58 | 59 | (* ****** ****** *) 60 | 61 | implement 62 | main0() = () where 63 | { 64 | val S0 = tally() 65 | val () = println!("The tally of the input integers equals ", S0) 66 | } 67 | 68 | (* ****** ****** *) 69 | 70 | (* end of [ReadFromSTDIN.dats] *) 71 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN2/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | PATSCC=$(PATSHOME)/bin/patscc 13 | PATSOPT=$(PATSHOME)/bin/patsopt 14 | PATSLIB=$(PATSHOME)/ccomp/atslib 15 | 16 | ###### 17 | 18 | all:: ReadFromSTDIN2_dats 19 | 20 | ###### 21 | 22 | testall:: all 23 | testall:: regress 24 | testall:: cleanall 25 | 26 | ###### 27 | 28 | %_dats: %.dats; \ 29 | $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 30 | 31 | ###### 32 | 33 | regress:: ReadFromSTDIN2_dats; echo 1000000 | ./$< 34 | 35 | ###### 36 | 37 | clean:: ; rm -f *~ 38 | clean:: ; rm -f *_?ats.o 39 | clean:: ; rm -f *_?ats.c 40 | 41 | cleanall:: clean 42 | cleanall:: ; rm -f ReadFromSTDIN2_dats 43 | 44 | ###### end of [Makefile] ###### 45 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN2/README.md: -------------------------------------------------------------------------------- 1 | # Read from STDIN (2) 2 | 3 | If you have not yet read [ReadFromSTDIN](./../ReadFromSTDIN), please 4 | do so first. 5 | 6 | The code in this example does essentially the same as the 7 | code in [ReadFromSTDIN](./../ReadFromSTDIN), but it is written in a 8 | different style, which greatly stresses the use of combinators in 9 | functional programming. 10 | 11 | The following function `prompts` returns a linear stream of 12 | integers: 13 | 14 | ```ats 15 | fun 16 | prompts 17 | ( 18 | // argless 19 | ) : stream_vt(int) = 20 | stream_vt_map_cloptr 21 | ( xs 22 | , lam(i) => 23 | (println!("Please input an integer or type Ctrl-D:"); i) 24 | ) where 25 | { 26 | val xs = intGte_stream_vt(0) // HX: generating 0, 1, 2, 3, ... 27 | } 28 | ``` 29 | 30 | For each integer in the stream to be computed, a message (for the 31 | purpose of prompting the user) is printed onto the standard output 32 | (STDOUT). 33 | 34 | The function `tally` can be given the following combinator-based 35 | implementation: 36 | 37 | 38 | ```ats 39 | fun 40 | tally() = let 41 | val ps = prompts() 42 | val xs = 43 | streamize_fileref_line(stdin_ref) 44 | val xs = 45 | (xs).filter()(lam(x) => isneqz(x)) 46 | val ys = 47 | stream_vt_map2_cloptr(ps, xs, lam(p, x) => g0string2int(x)) 48 | in 49 | stream_vt_foldleft_cloptr(ys, 0, lam(r, y) => r + y) 50 | end // end of [tally] 51 | ``` 52 | 53 | The code for `tally` is largely self-explanatory: `ps` refers 54 | to a stream for producing prompts and `xs` to a stream of strings 55 | representing non-empty lines read from STDIN; calling `map2` on 56 | `ps` and `xs` (with some closure-function) builds a stream 57 | `ys` of integers where each integer is converted from a string in 58 | `xs`; calling `foldleft` on `ys` returns the sum of all of 59 | the integers contained in `ys`. 60 | 61 | Happy programming in ATS!!! 62 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN2/ReadFromSTDIN2.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | // 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | // 8 | (* ****** ****** *) 9 | 10 | fun 11 | prompts 12 | ( 13 | // argless 14 | ) : stream_vt(int) = 15 | stream_vt_map_cloptr 16 | ( xs 17 | , lam(i) => 18 | (println!("Please input an integer or type Ctrl-D:"); i) 19 | ) where 20 | { 21 | val xs = intGte_stream_vt(0) // HX: generating 0, 1, 2, 3, ... 22 | } 23 | 24 | (* ****** ****** *) 25 | 26 | fun 27 | tally() = let 28 | val ps = prompts() 29 | val xs = 30 | streamize_fileref_line(stdin_ref) 31 | val xs = 32 | (xs).filter()(lam(x) => isneqz(x)) 33 | val ys = 34 | stream_vt_map2_cloptr(ps, xs, lam(p, x) => g0string2int(x)) 35 | in 36 | stream_vt_foldleft_cloptr(ys, 0, lam(r, y) => r + y) 37 | end // end of [tally] 38 | 39 | (* ****** ****** *) 40 | 41 | implement 42 | main0() = let 43 | val res = tally() in println!("The tally of all the integers equals ", res) 44 | end // end of [main0] 45 | 46 | (* ****** ****** *) 47 | 48 | (* end of [ReadFromSTDIN2.dats] *) 49 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN3/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: ReadFromSTDIN3_dats 23 | 24 | ###### 25 | 26 | testall:: npm-install 27 | testall:: all regress cleanall 28 | 29 | ###### 30 | 31 | %_dats: %.dats; \ 32 | $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 33 | 34 | ###### 35 | 36 | regress:: ReadFromSTDIN3_dats; echo 1000000 | ./$< 37 | 38 | ###### 39 | 40 | clean:: ; rm -f *~ 41 | clean:: ; rm -f *_?ats.o 42 | clean:: ; rm -f *_?ats.c 43 | 44 | cleanall:: clean 45 | cleanall:: ; rm -f ReadFromSTDIN3_dats 46 | cleanall:: ; rm -f ./node_modules -r 47 | cleanall:: ; rm -f ./package-lock.json 48 | 49 | ###### 50 | 51 | npm-update:: ; $(NPM) update 52 | npm-install:: ; $(NPM) install 53 | 54 | ###### 55 | 56 | export \ 57 | PATSHOMELOCS = \ 58 | ./node_modules:./../node_modules:./../../node_modules:./../../../node_modules 59 | 60 | ###### end of [Makefile] ###### 61 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN3/README.md: -------------------------------------------------------------------------------- 1 | # Read from STDIN (3) 2 | 3 | If you have not yet read [ReadFromSTDIN2](./../ReadFromSTDIN2), please 4 | do so first. 5 | 6 | The code in this example does essentially the same as the code in 7 | [ReadFromSTDIN2](./../ReadFromSTDIN2) except for using the alarm signal 8 | (SIGALRM) to prevent the possible scenario of waiting indefinitely for 9 | the user's input. 10 | 11 | The types `line` and `lineto` are defined as follows: 12 | 13 | ```ats 14 | 15 | typedef 16 | line = string 17 | 18 | datavtype 19 | lineto = 20 | | LNTOline of Strptr1 21 | | LNTOtimeout of ((*void*)) 22 | 23 | ``` 24 | 25 | A lineto-value is linear and it represents either a line 26 | (`LNTOline`) or a timeout (`LNTOtimeout`). The following 27 | function `stream_vt_lineto2line` turns a linear stream of 28 | lineto-values into a linear stream of lines: 29 | 30 | 31 | ```ats 32 | fun 33 | stream_vt_lineto2line 34 | ( 35 | xs: 36 | stream_vt(lineto) 37 | ) : stream_vt(line) = $ldelay 38 | ( 39 | case+ !xs of 40 | | ~stream_vt_nil() => 41 | stream_vt_nil() 42 | | ~stream_vt_cons(x0, xs) => 43 | ( 44 | case+ x0 of 45 | | ~LNTOline(line) => 46 | stream_vt_cons 47 | ( strptr2string(line) 48 | , stream_vt_lineto2line(xs)) 49 | | ~LNTOtimeout((*void*)) => 50 | (~(xs); stream_vt_nil((*void*))) 51 | ) 52 | , lazy_vt_free(xs) 53 | ) 54 | ``` 55 | 56 | In the package *atscntrb-hx-teaching-bucs*, there is a function of the 57 | name `streamize_fileref_lineto` that turns the content of a given file 58 | handle into a linear stream of lineto-values. If reading from the file 59 | handle is blocked for more than `nwait` seconds, where `nwait` is the 60 | second argument of `streamize_fileref_lineto`, then `LNTOtimeout()` is 61 | added into the stream. Otherwise, `LNTOline(l0)` is added into the 62 | stream for some linear string `l0` representing the currently line 63 | read from the file handle. And the following function 64 | `streamize_fileref_line_` is just a specialized version of 65 | `streamize_fileref_lineto`: 66 | 67 | ```ats 68 | fun 69 | streamize_fileref_line_ 70 | ( 71 | inp: FILEref 72 | ) : stream_vt(line) = 73 | ( 74 | stream_vt_lineto2line 75 | (streamize_fileref_lineto<>(inp, 5(*nwait=5sec*))) 76 | ) 77 | ``` 78 | 79 | The following code first sets a do-nothing signal 80 | handler for SIGALRM: 81 | 82 | ```ats 83 | #staload 84 | "libats/libc/SATS/signal.sats" 85 | 86 | implement 87 | main0() = let 88 | var 89 | sigact: sigaction 90 | val () = 91 | ptr_nullize 92 | (__assert__() | sigact) where 93 | { 94 | extern 95 | prfun 96 | __assert__ : 97 | () -> is_nullable(sigaction) 98 | } (* end of [val] *) 99 | // 100 | val () = 101 | sigact.sa_handler := 102 | sighandler(lam(sgn) => ((*void*))) 103 | // 104 | val () = 105 | assertloc 106 | (sigaction_null(SIGALRM, sigact) = 0) 107 | // 108 | val res = tally() in println!("The tally of all the integers equals ", res) 109 | // 110 | end // end of [main0] 111 | ``` 112 | 113 | If no signal handler is set for SIGALRM, then an uncaught SIGALRM simply terminates 114 | program execution. 115 | 116 | Happy programming in ATS!!! 117 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN3/ReadFromSTDIN3.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include 4 | "share/atspre_staload.hats" 5 | #include 6 | "share/atspre_staload_libats_ML.hats" 7 | 8 | (* ****** ****** *) 9 | 10 | typedef line = string 11 | 12 | (* ****** ****** *) 13 | 14 | local 15 | 16 | #include 17 | "$PATSHOMELOCS\ 18 | /atscntrb-hx-teaching-bucs/mylibies.hats" 19 | 20 | #staload $BUCS520_2016_FALL 21 | 22 | in (* in-of-local *) 23 | 24 | fun 25 | stream_vt_lineto2line 26 | ( 27 | xs: 28 | stream_vt(lineto) 29 | ) : stream_vt(line) = $ldelay 30 | ( 31 | case+ !xs of 32 | | ~stream_vt_nil() => 33 | stream_vt_nil() 34 | | ~stream_vt_cons(x0, xs) => 35 | ( 36 | case+ x0 of 37 | | ~LNTOline(line) => 38 | stream_vt_cons 39 | ( strptr2string(line) 40 | , stream_vt_lineto2line(xs)) 41 | | ~LNTOtimeout((*void*)) => 42 | (~(xs); stream_vt_nil((*void*))) 43 | ) 44 | , lazy_vt_free(xs) 45 | ) 46 | 47 | fun 48 | streamize_fileref_line_ 49 | ( 50 | inp: FILEref 51 | ) : stream_vt(line) = 52 | ( 53 | stream_vt_lineto2line 54 | (streamize_fileref_lineto<>(inp, 5(*nwait=5sec*))) 55 | ) 56 | 57 | end // end of [local] 58 | 59 | (* ****** ****** *) 60 | 61 | fun 62 | prompts 63 | ( 64 | // argless 65 | ) : stream_vt(int) = 66 | stream_vt_map_cloptr 67 | ( xs 68 | , lam(i) => 69 | (println!("Please input an integer or type Ctrl-D:"); i) 70 | ) where 71 | { 72 | val xs = intGte_stream_vt(0) // HX: generating 0, 1, 2, 3, ... 73 | } 74 | 75 | (* ****** ****** *) 76 | 77 | fun 78 | tally() = let 79 | val ps = prompts() 80 | val xs = 81 | streamize_fileref_line_(stdin_ref) 82 | val xs = (xs).filter()(lam(x) => isneqz(x)) 83 | val ys = 84 | stream_vt_map2_cloptr(ps, xs, lam(p, x) => g0string2int(x)) 85 | in 86 | stream_vt_foldleft_cloptr(ys, 0, lam(r, y) => r + y) 87 | end // end of [tally] 88 | 89 | (* ****** ****** *) 90 | 91 | #staload 92 | "libats/libc/SATS/signal.sats" 93 | 94 | implement 95 | main0() = let 96 | var 97 | sigact: sigaction 98 | val () = 99 | ptr_nullize 100 | (__assert__() | sigact) where 101 | { 102 | extern 103 | prfun 104 | __assert__ : 105 | () -> is_nullable(sigaction) 106 | } (* end of [val] *) 107 | // 108 | val () = 109 | sigact.sa_handler := 110 | sighandler(lam(sgn) => ((*void*))) 111 | // 112 | val () = 113 | assertloc 114 | (sigaction_null(SIGALRM, sigact) = 0) 115 | // 116 | val res = tally() in println!("The tally of all the integers equals ", res) 117 | // 118 | end // end of [main0] 119 | 120 | (* ****** ****** *) 121 | 122 | (* end of [ReadFromSTDIN3.dats] *) 123 | -------------------------------------------------------------------------------- /RECIPE/ReadFromSTDIN3/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-teaching-bucs": "^1.0.5" 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /RECIPE/Tokenizer/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | CAT=cat 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: Tokenizer_dats 23 | 24 | ###### 25 | 26 | testall:: all regress cleanall 27 | 28 | ###### 29 | 30 | %_dats: %.dats; \ 31 | $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 32 | 33 | ###### 34 | 35 | regress:: Tokenizer_dats; $(CAT) ./Tokenizer.dats | ./$< 36 | 37 | ###### 38 | 39 | clean:: ; rm -f *~ 40 | clean:: ; rm -f *_?ats.o 41 | clean:: ; rm -f *_?ats.c 42 | 43 | cleanall:: clean 44 | cleanall:: ; rm -f Tokenizer_dats 45 | 46 | ###### end of [Makefile] ###### 47 | -------------------------------------------------------------------------------- /RECIPE/Tokenizer/README.md: -------------------------------------------------------------------------------- 1 | # Tokenizer 2 | 3 | The code in this example implements a simple 4 | tokenizer that turns a linear stream of characters 5 | into a linear stream of tokens (for identifer names 6 | and (unsigned) integers). 7 | 8 | Happy programming in ATS!!! 9 | -------------------------------------------------------------------------------- /RECIPE/Tokenizer/Tokenizer.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | (* 3 | ** A Tokenizer 4 | ** based on linear streams 5 | *) 6 | (* ****** ****** *) 7 | 8 | #include 9 | "share/atspre_staload.hats" 10 | #include 11 | "share/atspre_staload_libats_ML.hats" 12 | 13 | (* ****** ****** *) 14 | 15 | #staload UN = $UNSAFE 16 | 17 | (* ****** ****** *) 18 | 19 | datatype token = 20 | | TOKide of string // ide=alpha[alnum]* 21 | | TOKint of string // int=digit[digit]* 22 | | TOKchr of (char) // special character 23 | 24 | (* ****** ****** *) 25 | 26 | extern 27 | fun 28 | print_token: print_type(token) 29 | extern 30 | fun 31 | fprint_token: fprint_type(token) 32 | 33 | overload print with print_token 34 | overload fprint with fprint_token 35 | 36 | (* ****** ****** *) 37 | 38 | implement 39 | print_token(tok) = 40 | fprint_token(stdout_ref, tok) 41 | 42 | implement 43 | fprint_token(out, tok) = 44 | ( 45 | case+ tok of 46 | | TOKint(int) => 47 | fprint!(out, "TOKint(", int, ")") 48 | | TOKide(ide) => 49 | fprint!(out, "TOKide(", ide, ")") 50 | | TOKchr(chr) => 51 | fprint!(out, "TOKchr(", chr, ")") 52 | ) 53 | 54 | (* ****** ****** *) 55 | // 56 | extern 57 | fun 58 | tokenize 59 | (cs: stream_vt(char)): stream_vt(token) 60 | // 61 | (* ****** ****** *) 62 | 63 | local 64 | 65 | fun 66 | aux1 67 | ( 68 | c0: char 69 | , 70 | cs: stream_vt(char) 71 | ) : 72 | stream_vt_con(token) = 73 | ( 74 | ifcase 75 | | isalpha(c0) => 76 | aux1_ide(cs, list_vt_sing(c0)) 77 | | isdigit(c0) => 78 | aux1_int(cs, list_vt_sing(c0)) 79 | | _(* else *) => 80 | stream_vt_cons(TOKchr(c0), tokenize(cs)) 81 | ) 82 | 83 | and 84 | aux1_ide 85 | ( 86 | cs: 87 | stream_vt(char) 88 | , 89 | ds: List0_vt(char) 90 | ) : stream_vt_con(token) = 91 | ( 92 | case+ !cs of 93 | | ~stream_vt_nil 94 | () => let 95 | val ide = 96 | string_make_rlist_vt(ds) 97 | in 98 | stream_vt_sing(TOKide(ide)) 99 | end // end of [stream_vt_nil] 100 | | ~stream_vt_cons 101 | (c0, cs) => 102 | ( 103 | ifcase 104 | | isalnum(c0) => 105 | aux1_ide(cs, list_vt_cons(c0, ds)) 106 | | _(* else *) => let 107 | val ide = 108 | string_make_rlist_vt(ds) 109 | in 110 | stream_vt_cons(TOKide(ide), $ldelay(aux1(c0, cs), ~cs)) 111 | end 112 | ) 113 | ) 114 | 115 | and 116 | aux1_int 117 | ( 118 | cs: 119 | stream_vt(char) 120 | , 121 | ds: List0_vt(char) 122 | ) : stream_vt_con(token) = 123 | ( 124 | case+ !cs of 125 | | ~stream_vt_nil 126 | () => let 127 | val int = 128 | string_make_rlist_vt(ds) 129 | in 130 | stream_vt_sing(TOKint(int)) 131 | end // end of [stream_vt_nil] 132 | | ~stream_vt_cons 133 | (c0, cs) => 134 | ( 135 | ifcase 136 | | isalpha(c0) => let 137 | val int = 138 | string_make_rlist_vt(ds) 139 | in 140 | stream_vt_cons 141 | ( TOKint(int) 142 | , $ldelay(aux1_ide(cs, list_vt_sing(c0)), ~cs) 143 | ) 144 | end // end of [isalpha] 145 | | isdigit(c0) => 146 | aux1_int(cs, list_vt_cons(c0, ds)) 147 | | _(* else *) => let 148 | val int = 149 | string_make_rlist_vt(ds) 150 | in 151 | stream_vt_cons(TOKint(int), $ldelay(aux1(c0, cs), ~cs)) 152 | end 153 | ) 154 | ) 155 | 156 | in 157 | 158 | implement 159 | tokenize(cs) = $ldelay 160 | ( 161 | case+ !cs of 162 | | 163 | ~stream_vt_nil() => 164 | stream_vt_nil() 165 | | 166 | ~stream_vt_cons(c0, cs) => aux1(c0, cs) 167 | , 168 | let val () = lazy_vt_free(cs) in (*freed*) end 169 | ) 170 | 171 | end // end of [local] 172 | 173 | (* ****** ****** *) 174 | 175 | implement 176 | main0() = let 177 | // 178 | val 179 | toks = 180 | tokenize 181 | (streamize_fileref_char(stdin_ref)) 182 | // 183 | in 184 | stream_vt_foreach_cloptr 185 | (toks, lam(tok) => println! ("tok = ", tok)) 186 | end // end of [main0] 187 | 188 | (* ****** ****** *) 189 | 190 | (* end of [Tokenizer.dats] *) 191 | -------------------------------------------------------------------------------- /RECIPE/WordFrqncyCount/Makefile: -------------------------------------------------------------------------------- 1 | ###### 2 | # 3 | # A simple Makefile 4 | # 5 | ###### 6 | # 7 | # HX-2018-01-05: 8 | # PATSHOME is environmental 9 | # 10 | ###### 11 | 12 | NPM=npm 13 | 14 | ###### 15 | 16 | PATSCC=$(PATSHOME)/bin/patscc 17 | PATSOPT=$(PATSHOME)/bin/patsopt 18 | PATSLIB=$(PATSHOME)/ccomp/atslib 19 | 20 | ###### 21 | 22 | all:: WordFrqncyCount_dats 23 | 24 | ###### 25 | 26 | testall:: npm-install 27 | testall:: all regress cleanall 28 | 29 | ###### 30 | 31 | %_dats: %.dats; $(PATSCC) -DATS_MEMALLOC_LIBC -o $@ $< -latslib 32 | 33 | ###### 34 | 35 | regress:: WordFrqncyCount_dats; ./$< 36 | 37 | ###### 38 | 39 | clean:: ; rm -f *~ 40 | clean:: ; rm -f *_?ats.o 41 | clean:: ; rm -f *_?ats.c 42 | 43 | cleanall:: clean 44 | cleanall:: ; rm -f node_modules -r 45 | cleanall:: ; rm -f package-lock.json 46 | cleanall:: ; rm -f WordFrqncyCount_dats 47 | 48 | ###### 49 | 50 | npm-update:: ; $(NPM) update 51 | npm-install:: ; $(NPM) install 52 | 53 | ###### 54 | 55 | export \ 56 | PATSHOMELOCS = \ 57 | ./node_modules:./../node_modules:./../../node_modules:./../../../node_modules 58 | 59 | ###### end of [Makefile] ###### 60 | -------------------------------------------------------------------------------- /RECIPE/WordFrqncyCount/README.md: -------------------------------------------------------------------------------- 1 | # Counting Words 2 | 3 | This example gives a stream-based implementation that counts words 4 | in a given on-line source and then sorts these words according to their 5 | frequencies. 6 | 7 | We need a small package of the name *atscntrb-hx-teaching-bucs* to 8 | turn the source referred to by a URL into a linear stream of 9 | characters. This package can be downloaded by executing 10 | `make npm-install` or by issuing the following command-line: 11 | 12 | ```shell 13 | npm install atscntrb-hx-teaching-bucs 14 | ``` 15 | 16 | We can implement a function `stream_by_url_` based on one of the 17 | name `stream_by_command` in the downloaded package: 18 | 19 | ```ats 20 | local 21 | 22 | #include 23 | "$PATSHOMELOCS\ 24 | /atscntrb-hx-teaching-bucs/mylibies.hats" 25 | 26 | #staload 27 | BUCS520 = 28 | $BUCS520_2016_FALL 29 | 30 | in (* in-of-local *) 31 | 32 | extern 33 | fun 34 | stream_by_url_ 35 | (url: string): stream_vt(char) 36 | 37 | implement 38 | stream_by_url_(url) = 39 | $BUCS520.stream_by_command<> 40 | ("wget", $list{string}("-q", "-O", "-", url)) 41 | 42 | end // end of [local] 43 | ``` 44 | 45 | The function `stream_by_url_` calls the command `wget` 46 | (with some options) to fetch the source referred to by a given URL. 47 | One can of course try to implement `stream_by_url_` based 48 | on the command `curl` as well. 49 | 50 | We use the following type aliases in the rest of the presentation: 51 | 52 | ```ats 53 | typedef word = string 54 | typedef nword = (int, string) 55 | ``` 56 | 57 | Given a list of words ordered ascendingly 58 | (according to the standard lexicographic ordering), 59 | the following function returns a list of pairs where 60 | each pair consists of a number and a distinct word 61 | such that the number indicates the number of times 62 | the word occurring in the original given list of words: 63 | 64 | ```ats 65 | extern 66 | fun 67 | list_vt_word2nword 68 | (ws: List_vt(word)): List0_vt(nword) 69 | ``` 70 | 71 | Probably the most interesting function in this example is the following 72 | one that turns a linear stream of chars into a linear stream of words: 73 | 74 | ```ats 75 | extern 76 | fun 77 | stream_vt_char2word 78 | (cs: stream_vt(char)): stream_vt(word) 79 | 80 | implement 81 | stream_vt_char2word 82 | (cs) = 83 | auxmain(cs) where 84 | { 85 | fun 86 | auxmain 87 | ( 88 | cs: stream_vt(char) 89 | ) : stream_vt(word) = 90 | ( 91 | case+ !cs of 92 | | ~stream_vt_nil() => 93 | stream_vt_make_nil() 94 | | ~stream_vt_cons(c0, cs) => 95 | ( 96 | if isalpha(c0) 97 | then $ldelay 98 | (auxmain_con(cs, list_vt_sing(L(c0))), ~(cs)) 99 | else auxmain(cs) 100 | ) 101 | ) 102 | 103 | and 104 | auxmain_con 105 | ( 106 | cs: stream_vt(char), w0: List0_vt(char) 107 | ) : stream_vt_con(word) = 108 | ( 109 | case+ !cs of 110 | | ~stream_vt_nil() => 111 | stream_vt_sing(string_make_rlist_vt(w0)) 112 | | ~stream_vt_cons(c1, cs) => 113 | ( 114 | if isalpha(c1) 115 | then auxmain_con(cs, list_vt_cons(L(c1), w0)) 116 | else stream_vt_cons(string_make_rlist_vt(w0), auxmain(cs)) 117 | ) 118 | ) 119 | } (* end of [stream_vt_char2word] *) 120 | ``` 121 | 122 | Note that each word is just a non-empty sequence of letters in the 123 | English alphabet. Also, each word in the returned stream consists of 124 | only lowercase letters. Both `auxmain` and `auxmain_con` are 125 | tail-recursive, presenting no risk of stack-overflow even when they 126 | are called on a linear stream of infinite length! In general, paying 127 | close attention to addressing potential risk of stack-overflow is of 128 | great importance in constructing code of high quality. 129 | 130 | 131 | The function `stream_vt_char2nword` does the work of assembling: 132 | 133 | ```ats 134 | extern 135 | fun 136 | stream_vt_char2nword 137 | (cs: stream_vt(char)): List0_vt(nword) 138 | 139 | implement 140 | stream_vt_char2nword(cs) = nws where 141 | { 142 | val ws = stream_vt_char2word(cs) 143 | val ws = stream2list_vt(ws) 144 | val ws = list_vt_mergesort_fun(ws, lam(w1, w2) => compare(w1, w2)) 145 | val nws = list_vt_word2nword(ws) 146 | val nws = list_vt_mergesort_fun(nws, lam(nw1, nw2) => ~compare(nw1.0, nw2.0)) 147 | } 148 | ``` 149 | 150 | The code implementing `stream_vt_char2nword` is self-explanatory. 151 | 152 | When the default URL is used, the execution of the program in this example 153 | outputs the following table that lists the first 250 most frequently used words 154 | in the novel [Moby-Dick](http://www.gutenberg.org/files/2701/2701-0.txt) by 155 | Herman Melville: 156 | 157 | ```text 158 | 1 the -> 14715 159 | 2 of -> 6742 160 | 3 and -> 6517 161 | 4 a -> 4805 162 | 5 to -> 4707 163 | 6 in -> 4241 164 | 7 that -> 3100 165 | 8 it -> 2536 166 | 9 his -> 2532 167 | 10 i -> 2127 168 | 11 he -> 1900 169 | 12 s -> 1825 170 | 13 but -> 1823 171 | 14 with -> 1770 172 | 15 as -> 1753 173 | 16 is -> 1751 174 | 17 was -> 1646 175 | 18 for -> 1644 176 | 19 all -> 1545 177 | 20 this -> 1443 178 | 21 at -> 1335 179 | 22 whale -> 1245 180 | 23 by -> 1227 181 | 24 not -> 1173 182 | 25 from -> 1105 183 | 26 on -> 1073 184 | 27 him -> 1069 185 | 28 so -> 1066 186 | 29 be -> 1064 187 | 30 you -> 964 188 | 31 one -> 925 189 | 32 there -> 871 190 | 33 or -> 798 191 | 34 now -> 786 192 | 35 had -> 779 193 | 36 have -> 774 194 | 37 were -> 683 195 | 38 they -> 670 196 | 39 which -> 655 197 | 40 like -> 647 198 | 41 me -> 633 199 | 42 then -> 631 200 | 43 their -> 620 201 | 44 are -> 619 202 | 45 some -> 619 203 | 46 what -> 619 204 | 47 when -> 607 205 | 48 an -> 600 206 | 49 no -> 596 207 | 50 my -> 589 208 | 51 upon -> 568 209 | 52 out -> 539 210 | 53 man -> 530 211 | 54 up -> 526 212 | 55 into -> 523 213 | 56 ship -> 519 214 | 57 ahab -> 517 215 | 58 more -> 509 216 | 59 if -> 501 217 | 60 them -> 474 218 | 61 ye -> 473 219 | 62 we -> 469 220 | 63 sea -> 455 221 | 64 old -> 452 222 | 65 would -> 432 223 | 66 other -> 431 224 | 67 been -> 415 225 | 68 over -> 410 226 | 69 these -> 406 227 | 70 will -> 399 228 | 71 though -> 384 229 | 72 its -> 382 230 | 73 down -> 379 231 | 74 only -> 378 232 | 75 such -> 376 233 | 76 who -> 366 234 | 77 any -> 364 235 | 78 head -> 348 236 | 79 yet -> 345 237 | 80 boat -> 337 238 | 81 long -> 334 239 | 82 time -> 334 240 | 83 her -> 332 241 | 84 captain -> 329 242 | 85 do -> 324 243 | 86 here -> 324 244 | 87 very -> 323 245 | 88 about -> 318 246 | 89 still -> 312 247 | 90 than -> 311 248 | 91 chapter -> 308 249 | 92 great -> 307 250 | 93 those -> 307 251 | 94 said -> 305 252 | 95 before -> 301 253 | 96 two -> 298 254 | 97 has -> 294 255 | 98 must -> 293 256 | 99 t -> 291 257 | 100 most -> 285 258 | 101 seemed -> 283 259 | 102 white -> 281 260 | 103 last -> 278 261 | 104 see -> 275 262 | 105 way -> 273 263 | 106 whales -> 272 264 | 107 thou -> 271 265 | 108 after -> 270 266 | 109 again -> 263 267 | 110 stubb -> 261 268 | 111 how -> 259 269 | 112 did -> 258 270 | 113 your -> 258 271 | 114 may -> 255 272 | 115 queequeg -> 253 273 | 116 little -> 249 274 | 117 can -> 247 275 | 118 round -> 247 276 | 119 while -> 246 277 | 120 sperm -> 245 278 | 121 three -> 245 279 | 122 men -> 244 280 | 123 say -> 244 281 | 124 first -> 239 282 | 125 through -> 235 283 | 126 us -> 234 284 | 127 every -> 232 285 | 128 well -> 230 286 | 129 being -> 225 287 | 130 much -> 224 288 | 131 where -> 223 289 | 132 off -> 220 290 | 133 could -> 217 291 | 134 good -> 216 292 | 135 hand -> 215 293 | 136 same -> 215 294 | 137 our -> 211 295 | 138 side -> 208 296 | 139 ever -> 206 297 | 140 never -> 206 298 | 141 himself -> 205 299 | 142 look -> 205 300 | 143 own -> 205 301 | 144 deck -> 199 302 | 145 starbuck -> 199 303 | 146 almost -> 197 304 | 147 go -> 194 305 | 148 even -> 193 306 | 149 water -> 190 307 | 150 thing -> 188 308 | 151 away -> 186 309 | 152 should -> 185 310 | 153 too -> 185 311 | 154 might -> 183 312 | 155 come -> 180 313 | 156 day -> 179 314 | 157 made -> 178 315 | 158 pequod -> 178 316 | 159 life -> 176 317 | 160 world -> 176 318 | 161 sir -> 175 319 | 162 fish -> 171 320 | 163 many -> 168 321 | 164 among -> 167 322 | 165 far -> 165 323 | 166 seen -> 165 324 | 167 back -> 164 325 | 168 without -> 164 326 | 169 line -> 160 327 | 170 let -> 158 328 | 171 oh -> 157 329 | 172 right -> 157 330 | 173 cried -> 156 331 | 174 eyes -> 156 332 | 175 nor -> 156 333 | 176 aye -> 155 334 | 177 god -> 153 335 | 178 know -> 153 336 | 179 part -> 153 337 | 180 night -> 152 338 | 181 sort -> 152 339 | 182 thought -> 150 340 | 183 once -> 149 341 | 184 boats -> 147 342 | 185 air -> 143 343 | 186 crew -> 141 344 | 187 don -> 140 345 | 188 take -> 137 346 | 189 whole -> 137 347 | 190 full -> 136 348 | 191 half -> 136 349 | 192 against -> 135 350 | 193 tell -> 135 351 | 194 things -> 134 352 | 195 thus -> 134 353 | 196 whaling -> 133 354 | 197 thee -> 131 355 | 198 came -> 130 356 | 199 hands -> 130 357 | 200 mast -> 130 358 | 201 small -> 130 359 | 202 soon -> 130 360 | 203 each -> 129 361 | 204 feet -> 127 362 | 205 both -> 126 363 | 206 under -> 126 364 | 207 something -> 123 365 | 208 till -> 123 366 | 209 think -> 122 367 | 210 between -> 120 368 | 211 she -> 120 369 | 212 why -> 119 370 | 213 found -> 118 371 | 214 just -> 117 372 | 215 place -> 117 373 | 216 called -> 116 374 | 217 saw -> 116 375 | 218 another -> 115 376 | 219 ll -> 115 377 | 220 make -> 115 378 | 221 nothing -> 115 379 | 222 towards -> 115 380 | 223 poor -> 114 381 | 224 thy -> 113 382 | 225 times -> 112 383 | 226 along -> 110 384 | 227 body -> 110 385 | 228 heard -> 110 386 | 229 work -> 110 387 | 230 flask -> 109 388 | 231 high -> 108 389 | 232 stand -> 107 390 | 233 moment -> 105 391 | 234 sight -> 105 392 | 235 end -> 103 393 | 236 voyage -> 103 394 | 237 new -> 102 395 | 238 sail -> 102 396 | 239 sun -> 102 397 | 240 hold -> 99 398 | 241 shall -> 99 399 | 242 does -> 98 400 | 243 strange -> 98 401 | 244 nantucket -> 97 402 | 245 went -> 97 403 | 246 years -> 97 404 | 247 however -> 96 405 | 248 leviathan -> 96 406 | 249 face -> 95 407 | 250 few -> 95 408 | ``` 409 | 410 | It is not surprising to see the word `whale` as the first noun in the list 411 | (word#22): The novel is all about whales and whaling! 412 | 413 | Happy programming in ATS!!! 414 | -------------------------------------------------------------------------------- /RECIPE/WordFrqncyCount/WordFrqncyCount.dats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | 3 | #include "share/atspre_staload.hats" 4 | #include "share/atspre_staload_libats_ML.hats" 5 | 6 | (* ****** ****** *) 7 | 8 | typedef word = string 9 | typedef nword = (int, string) 10 | 11 | (* ****** ****** *) 12 | 13 | extern 14 | fun 15 | print_free_nwordlst 16 | ( i: int, N: int 17 | , nws: List_vt(nword)): void 18 | 19 | implement 20 | print_free_nwordlst 21 | (i, N, nws) = 22 | if 23 | i >= N 24 | then 25 | ( 26 | list_vt_free(nws) 27 | ) 28 | else 29 | ( 30 | case+ nws of 31 | | ~list_vt_nil() => () 32 | | ~list_vt_cons(nw, nws) => 33 | print_free_nwordlst(i+1, N, nws) where 34 | { 35 | val () = println!(i+1, "\t", nw.1, " -> ", nw.0) 36 | } 37 | ) 38 | 39 | (* ****** ****** *) 40 | 41 | local 42 | 43 | #include 44 | "$PATSHOMELOCS\ 45 | /atscntrb-hx-teaching-bucs/mylibies.hats" 46 | (* 47 | #include 48 | "$PATSHOMELOCS\ 49 | /atscntrb-hx-teaching-bucs/mylibies_link.hats" 50 | *) 51 | 52 | #staload 53 | BUCS520 = 54 | $BUCS520_2016_FALL 55 | 56 | in (* in-of-local *) 57 | 58 | extern 59 | fun 60 | stream_by_url_ 61 | (url: string): stream_vt(char) 62 | 63 | implement 64 | stream_by_url_(url) = 65 | $BUCS520.stream_by_command<> 66 | ("wget", $list{string}("-q", "-O", "-", url)) 67 | 68 | end // end of [local] 69 | 70 | (* ****** ****** *) 71 | 72 | extern 73 | fun 74 | list_vt_word2nword 75 | (ws: List_vt(word)): List0_vt(nword) 76 | 77 | implement 78 | list_vt_word2nword 79 | (ws) = let 80 | fun 81 | auxmain 82 | ( 83 | w0: word 84 | , 85 | ws: List_vt(word) 86 | ) : stream_vt(nword) = 87 | $ldelay(auxmain_con(1, w0, ws), free(ws)) 88 | 89 | and 90 | auxmain_con 91 | ( 92 | n0: int 93 | , 94 | w0: word 95 | , 96 | ws: List_vt(word) 97 | ) : stream_vt_con(nword) = 98 | ( 99 | case+ ws of 100 | | ~list_vt_nil() => 101 | stream_vt_sing((n0, w0)) 102 | | ~list_vt_cons(w1, ws) => 103 | if w1 <= w0 104 | then auxmain_con(n0+1, w1, ws) 105 | else stream_vt_cons((n0, w0), auxmain(w1, ws)) 106 | // end of [if] 107 | ) 108 | in 109 | case+ ws of 110 | | ~list_vt_nil() => 111 | list_vt_nil() 112 | | ~list_vt_cons(w0, ws) => 113 | stream2list_vt(auxmain(w0, ws)) 114 | end // end of [list_vt_word2nword] 115 | 116 | (* ****** ****** *) 117 | 118 | #define L(c) tolower(c) 119 | 120 | (* ****** ****** *) 121 | 122 | extern 123 | fun 124 | stream_vt_char2word 125 | (cs: stream_vt(char)): stream_vt(word) 126 | 127 | implement 128 | stream_vt_char2word 129 | (cs) = 130 | auxmain(cs) where 131 | { 132 | fun 133 | auxmain 134 | ( 135 | cs: stream_vt(char) 136 | ) : stream_vt(word) = 137 | ( 138 | case+ !cs of 139 | | ~stream_vt_nil() => 140 | stream_vt_make_nil() 141 | | ~stream_vt_cons(c0, cs) => 142 | ( 143 | if isalpha(c0) 144 | then $ldelay 145 | (auxmain_con(cs, list_vt_sing(L(c0))), ~(cs)) 146 | else auxmain(cs) 147 | ) 148 | ) 149 | 150 | and 151 | auxmain_con 152 | ( 153 | cs: stream_vt(char), w0: List0_vt(char) 154 | ) : stream_vt_con(word) = 155 | ( 156 | case+ !cs of 157 | | ~stream_vt_nil() => 158 | stream_vt_sing(string_make_rlist_vt(w0)) 159 | | ~stream_vt_cons(c1, cs) => 160 | ( 161 | if isalpha(c1) 162 | then auxmain_con(cs, list_vt_cons(L(c1), w0)) 163 | else stream_vt_cons(string_make_rlist_vt(w0), auxmain(cs)) 164 | ) 165 | ) 166 | } (* end of [stream_vt_char2word] *) 167 | 168 | (* ****** ****** *) 169 | 170 | extern 171 | fun 172 | stream_vt_char2nword 173 | (cs: stream_vt(char)): List0_vt(nword) 174 | 175 | implement 176 | stream_vt_char2nword(cs) = nws where 177 | { 178 | val ws = stream_vt_char2word(cs) 179 | val ws = stream2list_vt(ws) 180 | val ws = list_vt_mergesort_fun(ws, lam(w1, w2) => compare(w1, w2)) 181 | val nws = list_vt_word2nword(ws) 182 | val nws = list_vt_mergesort_fun(nws, lam(nw1, nw2) => ~compare(nw1.0, nw2.0)) 183 | } 184 | 185 | (* ****** ****** *) 186 | // 187 | #define 188 | MOBY_DICK 189 | "http://www.gutenberg.org/files/2701/2701-0.txt" 190 | // 191 | (* ****** ****** *) 192 | 193 | #define N 250 194 | 195 | implement 196 | main0(argc, argv) = let 197 | val url = 198 | (if argc >= 2 199 | then argv[1] else MOBY_DICK): string 200 | val output = stream_by_url_(url) 201 | in 202 | print_free_nwordlst(0, N, stream_vt_char2nword(output)); exit(0) 203 | end (* end of [main0] *) 204 | 205 | (* ****** ****** *) 206 | 207 | (* end of [WordFreqCount.dats] *) 208 | -------------------------------------------------------------------------------- /RECIPE/WordFrqncyCount/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "dependencies": { 3 | "atscntrb-hx-teaching-bucs": "^1.0.4" 4 | } 5 | } 6 | --------------------------------------------------------------------------------