├── .gitignore ├── .hgignore ├── Makefile ├── README.md ├── package.mk ├── rebar.config ├── src ├── cut.erl ├── do.erl ├── erlando.app.src ├── error_m.erl ├── error_t.erl ├── identity_m.erl ├── import_as.erl ├── list_m.erl ├── maybe_m.erl ├── monad.erl ├── monad_plus.erl ├── monad_trans.erl ├── omega_m.erl ├── state_t.erl └── test.erl └── test ├── erlando_test.erl └── src ├── test_cut.erl ├── test_do.erl └── test_import_as.erl /.gitignore: -------------------------------------------------------------------------------- 1 | .eunit 2 | .rebar 3 | ebin 4 | -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | \.beam$ 2 | ~$ 3 | ^build/ 4 | ^dist/ 5 | ^cover/ 6 | ^\.eunit/ 7 | ^erl_crash.dump$ 8 | ^c_src/libhstcp.so$ 9 | ^ebin/erlando\.app$ 10 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include ../umbrella.mk -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Erlando 2 | 3 | 4 | 5 | ## Introduction 6 | 7 | Erlando is a set of syntax extensions for Erlang. Currently it 8 | consists of three syntax extensions, all of which take the form of 9 | [parse-transformers](http://www.erlang.org/doc/man/erl_id_trans.html). 10 | 11 | * **Cut**: This adds support for *cut*s to Erlang. These are 12 | inspired by the 13 | [Scheme form of cuts](http://srfi.schemers.org/srfi-26/srfi-26.html). *Cut*s 14 | can be thought of as a light-weight form of abstraction, with 15 | similarities to partial application (or currying). 16 | 17 | * **Do**: This adds support for *do*-syntax and monads to 18 | Erlang. These are heavily inspired by [Haskell](http://haskell.org), 19 | and the monads and libraries are near-mechanical translations from 20 | the Haskell GHC libraries. 21 | 22 | * **Import As**: This adds support for importing remote functions to 23 | the current module namespace with explicit control of the local 24 | function names. 25 | 26 | 27 | 28 | ## Use 29 | 30 | To use any of these parse-transformers, you must add the necessary 31 | `-compile` attributes to your Erlang source files. For example: 32 | 33 | -module(test). 34 | -compile({parse_transform, cut}). 35 | -compile({parse_transform, do}). 36 | -compile({parse_transform, import_as}). 37 | ... 38 | 39 | Then, when compiling `test.erl`, you must ensure `erlc` can locate 40 | `cut.beam` or `do.beam` or `import_as.beam` by passing the suitable 41 | path to `erlc` with a `-pa` or `-pz` argument. For example: 42 | 43 | erlc -Wall +debug_info -I ./include -pa ebin -o ebin src/cut.erl 44 | erlc -Wall +debug_info -I ./include -pa ebin -o ebin src/do.erl 45 | erlc -Wall +debug_info -I ./include -pa ebin -o ebin src/import_as.erl 46 | erlc -Wall +debug_info -I ./include -pa test/ebin -pa ./ebin -o test/ebin test/src/test.erl 47 | 48 | *Note*: If you're using QLC, you may find you need to be careful as to 49 | the placement of the parse-transformer attributes. For example, I've 50 | found that `-compile({parse_transform, cut}).` must occur before 51 | `-include_lib("stdlib/include/qlc.hrl").` 52 | 53 | 54 | 55 | ## Cut 56 | 57 | ### Motivation 58 | 59 | The *cut* parse-transformer is motivated by the frequency with which simple 60 | function abstractions are used in Erlang, and the relatively noisy 61 | nature of declaring `fun`s. For example, it's quite common to see code 62 | like: 63 | 64 | with_resource(Resource, Fun) -> 65 | case lookup_resource(Resource) of 66 | {ok, R} -> Fun(R); 67 | {error, _} = Err -> Err 68 | end. 69 | 70 | my_fun(A, B, C) -> 71 | with_resource(A, fun (Resource) -> 72 | my_resource_modification(Resource, B, C) 73 | end). 74 | 75 | That is, a `fun` is created in order to perform variable capture 76 | from the surrounding scope but to leave holes for further 77 | arguments to be provided. Using a *cut*, the function `my_fun` can be 78 | rewritten as: 79 | 80 | my_fun(A, B, C) -> 81 | with_resource(A, my_resource_modification(_, B, C)). 82 | 83 | 84 | ### Definition 85 | 86 | Normally, the variable `_` can only occur in patterns: that is, where a 87 | match occurs. This can be in assignment, in cases, and in function 88 | heads. For example: 89 | 90 | {_, bar} = {foo, bar}. 91 | 92 | *Cut* uses `_` in expressions to indicate where abstraction should 93 | occur. Abstraction from *cut*s is **always** performed on the 94 | *shallowest* enclosing expression. For example: 95 | 96 | list_to_binary([1, 2, math:pow(2, _)]). 97 | 98 | will create the expression 99 | 100 | list_to_binary([1, 2, fun (X) -> math:pow(2, X) end]). 101 | 102 | and not 103 | 104 | fun (X) -> list_to_binary([1, 2, math:pow(2, X)]) end. 105 | 106 | It is fine to use multiple *cut*s in the same expression, and the 107 | arguments to the created abstraction will match the order in which the 108 | `_` var is found in the expression. For example: 109 | 110 | assert_sum_3(X, Y, Z, Sum) when X + Y + Z == Sum -> ok; 111 | assert_sum_3(_X, _Y, _Z, _Sum) -> {error, not_sum}. 112 | 113 | test() -> 114 | Equals12 = assert_sum_3(_, _, _, 12), 115 | ok = Equals12(9, 2, 1). 116 | 117 | It is perfectly legal to take *cut*s of *cut*s as the abstraction created 118 | by the *cut* is a normal `fun` expression and thus can be re-*cut* as 119 | necessary: 120 | 121 | test() -> 122 | Equals12 = assert_sum_3(_, _, _, 12), 123 | Equals5 = Equals12(_, _, 7), 124 | ok = Equals5(2, 3). 125 | 126 | Note that because a simple `fun` is being constructed by the *cut*, the 127 | arguments are evaluated prior to the *cut* function. For example: 128 | 129 | f1(_, _) -> io:format("in f1~n"). 130 | 131 | test() -> 132 | F = f1(io:format("test line 1~n"), _), 133 | F(io:format("test line 2~n")). 134 | 135 | will print out 136 | 137 | test line 2 138 | test line 1 139 | in f1 140 | 141 | This is because the *cut* creates `fun (X) -> f1(io:format("test line 142 | 1~n"), X) end`. Thus it is clear that `X` must be evaluated first, 143 | before the `fun` can be invoked. 144 | 145 | Of course, no one would be crazy enough to have side-effects in 146 | function argument expressions, so this will never cause any issues! 147 | 148 | *Cut*s are not limited to function calls. They can be used in any 149 | expression where they make sense: 150 | 151 | 152 | #### Tuples 153 | 154 | F = {_, 3}, 155 | {a, 3} = F(a). 156 | 157 | 158 | #### Lists 159 | 160 | dbl_cons(List) -> [_, _ | List]. 161 | 162 | test() -> 163 | F = dbl_cons([33]), 164 | [7, 8, 33] = F(7, 8). 165 | 166 | Note that if you nest a list as a list tail in Erlang, it's still 167 | treated as one expression. For example: 168 | 169 | A = [a, b | [c, d | [e]]] 170 | 171 | is exactly the same (right from the Erlang parser onwards) as: 172 | 173 | A = [a, b, c, d, e] 174 | 175 | That is, those sub-lists, when they're in the tail position, **do not** 176 | form sub-expressions. Thus: 177 | 178 | F = [1, _, _, [_], 5 | [6, [_] | [_]]], 179 | %% This is the same as: 180 | %% [1, _, _, [_], 5, 6, [_], _] 181 | [1, 2, 3, G, 5, 6, H, 8] = F(2, 3, 8), 182 | [4] = G(4), 183 | [7] = H(7). 184 | 185 | However, be very clear about the difference between `,` and `|`: the 186 | tail of a list is **only** defined following a `|`. Following a `,`, 187 | you're just defining another list element. 188 | 189 | F = [_, [_]], 190 | %% This is **not** the same as [_, _] or its synonym: [_ | [_]] 191 | [a, G] = F(a), 192 | [b] = G(b). 193 | 194 | 195 | #### Records 196 | 197 | -record(vector, { x, y, z }). 198 | 199 | test() -> 200 | GetZ = _#vector.z, 201 | 7 = GetZ(#vector { z = 7 }), 202 | SetX = _#vector{x = _}, 203 | V = #vector{ x = 5, y = 4 } = SetX(#vector{ y = 4 }, 5). 204 | 205 | 206 | #### Maps 207 | 208 | test() -> 209 | GetZ = maps:get(z, _), 210 | 7 = GetZ(#{ z => 7 }), 211 | SetX = _#{x => _}, 212 | V = #{ x := 5, y := 4 } = SetX(#{ y => 4 }, 5). 213 | 214 | 215 | #### Case 216 | 217 | F = case _ of 218 | N when is_integer(N) -> N + N; 219 | N -> N 220 | end, 221 | 10 = F(5), 222 | ok = F(ok). 223 | 224 | 225 | See 226 | [test_cut.erl](http://hg.rabbitmq.com/erlando/file/default/test/src/test_cut.erl) 227 | for more examples, including the use of *cut*s in list comprehensions and 228 | binary construction. 229 | 230 | Note that *cut*s are not allowed where the result of the *cut* can only be 231 | useful by interacting with the evaluation scope. For example: 232 | 233 | F = begin _, _, _ end. 234 | 235 | This is not allowed, because the arguments to `F` would have to be 236 | evaluated before the invocation of its body, which would then have no 237 | effect, as they're already fully evaluated by that point. 238 | 239 | 240 | 241 | ## Do 242 | 243 | The *do* parse-transformer permits Haskell-style *do-notation* in 244 | Erlang, which makes using monads, and monad transformers possible and 245 | easy. (Without *do-notation*, monads tend to look like a lot of line 246 | noise.) 247 | 248 | 249 | ### The Inevitable Monad Tutorial 250 | 251 | #### The Mechanics of a Comma 252 | 253 | What follows is a brief and mechanical introduction to monads. It 254 | differs from a lot of the Haskell monad tutorials, because they tend 255 | to view monads as a means of achieving sequencing of operations in 256 | Haskell, which is challenging because Haskell is a lazy 257 | language. Erlang is not a lazy language, but the abstractions 258 | possible from using monads are still worthwhile. 259 | 260 | Let's say we have the three lines of code: 261 | 262 | A = foo(), 263 | B = bar(A, dog), 264 | ok. 265 | 266 | They are three, simple statements, which are evaluated 267 | consecutively. What a monad gives you is control over what happens 268 | between the statements: in Erlang, it is a programmatic comma. 269 | 270 | If you wanted to implement a programmatic comma, how would you do it? 271 | You might start with something like: 272 | 273 | A = foo(), 274 | comma(), 275 | B = bar(A, dog), 276 | comma(), 277 | ok. 278 | 279 | But that's not quite powerful enough, because unless `comma/0` throws 280 | some sort of exception, it can't actually stop the subsequent 281 | expression from being evaluated. Most of the time we'd probably like 282 | the `comma/0` function to be able to act on some variables which are 283 | currently in scope, and that's not possible here either. So we should 284 | extend the function `comma/0` so that it takes the result of the 285 | preceding expression, and can choose whether or not the subsequent 286 | expressions should be evaluated: 287 | 288 | comma(foo(), 289 | fun (A) -> comma(bar(A, dog), 290 | fun (B) -> ok end) 291 | end). 292 | 293 | Thus the function `comma/2` takes all results from the previous 294 | expression, and controls how and whether they are passed to the next 295 | expression. 296 | 297 | As defined, the `comma/2` function is the monadic function `'>>='/2`. 298 | 299 | Now it's pretty difficult to read the program with the `comma/2` 300 | function (especially as Erlang annoyingly doesn't allow us to define 301 | new *infix* functions), which is why some special syntax is 302 | desirable. Haskell has its *do-notation*, and so we've borrowed from 303 | that and abused Erlang's list comprehensions. Haskell also has lovely 304 | type-classes, which we've sort of faked specifically for monads. So, 305 | with the *do* parse-transformer, you can write in Erlang: 306 | 307 | do([Monad || 308 | A <- foo(), 309 | B <- bar(A, dog), 310 | ok]). 311 | 312 | which is readable and straightforward, and this is transformed into: 313 | 314 | Monad:'>>='(foo(), 315 | fun (A) -> Monad:'>>='(bar(A, dog), 316 | fun (B) -> ok end) 317 | end). 318 | 319 | There is no intention that this latter form is any more readable than 320 | the `comma/2` form - it is not. However, it should be clear that the 321 | function `Monad:'>>='/2` now has *complete* control over what happens: 322 | whether the `fun` on the right hand side ever gets invoked (and how often); 323 | and if so, with what parameter values. 324 | 325 | 326 | #### Lots of different types of Monads 327 | 328 | So now that we have some relatively nice syntax for using monads, what 329 | can we do with them? Also, in the code 330 | 331 | do([Monad || 332 | A <- foo(), 333 | B <- bar(A, dog), 334 | ok]). 335 | 336 | what are the possible values of `Monad`? 337 | 338 | The answer to the former question is *almost anything*; and to the 339 | latter question, is *any module name that implements the monad 340 | behaviour*. 341 | 342 | Above, we covered one of the three monadic operators, `'>>='/2`. The 343 | others are: 344 | 345 | * `return/1`: This *lifts* a value into the monad. We'll see examples 346 | of this shortly. 347 | 348 | * `fail/1`: This takes a term describing the error encountered, and 349 | informs whichever monad currently in use that some sort of error has 350 | occurred. 351 | 352 | Note that within *do-notation*, any function call to functions named 353 | `return` or `fail`, are automatically rewritten to invoke `return` or 354 | `fail` within the current monad. 355 | 356 | > Some people familiar with Haskell's monads may be expecting to see a 357 | fourth operator, `'>>'/2`. Interestingly, it turns out that you can't 358 | implement `'>>'/2` in a strict language unless all your monad types are 359 | built on functions. This is because in a strict language, 360 | arguments to functions are evaluated before the function is 361 | invoked. For `'>>='/2`, the second argument is only reduced to a function 362 | prior to invocation of `'>>='/2`. But the second argument to `'>>'/2` is not 363 | a function, and so in strict languages, will be fully reduced prior to 364 | `'>>'/2` being invoked. This is problematic because the `'>>'/2` operator 365 | is meant to be in control of whether or not subsequent expressions are 366 | evaluated. The only solution here would be to make the basic monad 367 | type a function, which would then mean that the second argument to 368 | `'>>='/2` would become a function to a function to a result! 369 | 370 | > However, it is required that `'>>'(A, B)` behaves identically to 371 | `'>>='(A, fun (_) -> B end)`, and so that is what we do: whenever we come to a 372 | `do([Monad || A, B ])`, we rewrite it to `'>>='(A, fun (_) -> B end)` 373 | rather than `'>>'(A, B)`. There is no `'>>'/2` operator in our Erlang monads. 374 | 375 | The simplest monad possible is the Identity-monad: 376 | 377 | -module(identity_m). 378 | -behaviour(monad). 379 | -export(['>>='/2, return/1, fail/1]). 380 | 381 | '>>='(X, Fun) -> Fun(X). 382 | return(X) -> X. 383 | fail(X) -> throw({error, X}). 384 | 385 | This makes our programmatic comma behave just like Erlang's comma 386 | normally does. The **bind** operator (that's the Haskell term for the 387 | `'>>='/2` monadic operator) does not inspect the 388 | values passed to it, and always invokes the subsequent expression function. 389 | 390 | What could we do if we did inspect the values passed to the sequencing 391 | combinators? One possibility results in the Maybe-monad: 392 | 393 | -module(maybe_m). 394 | -behaviour(monad). 395 | -export(['>>='/2, return/1, fail/1]). 396 | 397 | '>>='({just, X}, Fun) -> Fun(X); 398 | '>>='(nothing, _Fun) -> nothing. 399 | 400 | return(X) -> {just, X}. 401 | fail(_X) -> nothing. 402 | 403 | Thus if the result of the preceding expression is `nothing`, the 404 | subsequent expressions are *not* evaluated. This means that we can write 405 | very neat looking code which immediately stops should any failure be 406 | encountered. 407 | 408 | if_safe_div_zero(X, Y, Fun) -> 409 | do([maybe_m || 410 | Result <- case Y == 0 of 411 | true -> fail("Cannot divide by zero"); 412 | false -> return(X / Y) 413 | end, 414 | return(Fun(Result))]). 415 | 416 | If `Y` is equal to 0, then `Fun` will not be invoked, and the result 417 | of the `if_safe_div_zero` function call will be `nothing`. If `Y` is 418 | not equal to 0, then the result of the `if_safe_div_zero` function 419 | call will be `{just, Fun(X / Y)}`. 420 | 421 | We see here that within the *do*-block, there is no mention of `nothing` 422 | or `just`: they are abstracted away by the Maybe-monad. As a result, 423 | it is possible to change the monad in use, without having to rewrite 424 | any further code. 425 | 426 | One common place to use a monad like the Maybe-monad is where you'd 427 | otherwise have a lot of nested case statements in order to detect 428 | errors. For example: 429 | 430 | write_file(Path, Data, Modes) -> 431 | Modes1 = [binary, write | (Modes -- [binary, write])], 432 | case make_binary(Data) of 433 | Bin when is_binary(Bin) -> 434 | case file:open(Path, Modes1) of 435 | {ok, Hdl} -> 436 | case file:write(Hdl, Bin) of 437 | ok -> 438 | case file:sync(Hdl) of 439 | ok -> 440 | file:close(Hdl); 441 | {error, _} = E -> 442 | file:close(Hdl), 443 | E 444 | end; 445 | {error, _} = E -> 446 | file:close(Hdl), 447 | E 448 | end; 449 | {error, _} = E -> E 450 | end; 451 | {error, _} = E -> E 452 | end. 453 | 454 | make_binary(Bin) when is_binary(Bin) -> 455 | Bin; 456 | make_binary(List) -> 457 | try 458 | iolist_to_binary(List) 459 | catch error:Reason -> 460 | {error, Reason} 461 | end. 462 | 463 | can be transformed into the much shorter 464 | 465 | write_file(Path, Data, Modes) -> 466 | Modes1 = [binary, write | (Modes -- [binary, write])], 467 | do([error_m || 468 | Bin <- make_binary(Data), 469 | Hdl <- file:open(Path, Modes1), 470 | Result <- return(do([error_m || 471 | file:write(Hdl, Bin), 472 | file:sync(Hdl)])), 473 | file:close(Hdl), 474 | Result]). 475 | 476 | make_binary(Bin) when is_binary(Bin) -> 477 | error_m:return(Bin); 478 | make_binary(List) -> 479 | try 480 | error_m:return(iolist_to_binary(List)) 481 | catch error:Reason -> 482 | error_m:fail(Reason) 483 | end. 484 | 485 | Note that we have a nested *do*-block so, as with the non-monadic 486 | code, we ensure that once the file is opened, we always call 487 | `file:close/1` even if an error occurs in a subsequent operation. This 488 | is achieved by wrapping the nested *do*-block with a `return/1` call: 489 | even if the inner *do*-block errors, the error is *lifted* to a 490 | non-error value in the outer *do*-block, and thus execution continues to 491 | the subsequent `file:close/1` call. 492 | 493 | Here we are using an Error-monad which is remarkably similar to the 494 | Maybe-monad, but matches the typical Erlang practice of indicating 495 | errors by an `{error, Reason}` tuple: 496 | 497 | -module(error_m). 498 | -behaviour(monad). 499 | -export(['>>='/2, return/1, fail/1]). 500 | 501 | '>>='({error, _Err} = Error, _Fun) -> Error; 502 | '>>='({ok, Result}, Fun) -> Fun(Result); 503 | '>>='(ok, Fun) -> Fun(ok). 504 | 505 | return(X) -> {ok, X}. 506 | fail(X) -> {error, X}. 507 | 508 | 509 | #### Monad Transformers 510 | 511 | Monads can be *nested* by having *do*-blocks inside *do*-blocks, and 512 | *parameterized* by defining a monad as a transformation of another, inner, 513 | monad. The State Transform is a very commonly used monad transformer, 514 | and is especially relevant for Erlang. Because Erlang is a 515 | single-assignment language, it's very common to end up with a lot of 516 | code that incrementally numbers variables: 517 | 518 | State1 = init(Dimensions), 519 | State2 = plant_seeds(SeedCount, State1), 520 | {DidFlood, State3} = pour_on_water(WaterVolume, State2), 521 | State4 = apply_sunlight(Time, State3), 522 | {DidFlood2, State5} = pour_on_water(WaterVolume, State4), 523 | {Crop, State6} = harvest(State5), 524 | ... 525 | 526 | This is doubly annoying, not only because it looks awful, but also 527 | because you have to re-number many variables and references whenever a 528 | line is added or removed. Wouldn't it be nice if we could abstract out the 529 | `State`? We could then have a monad encapsulate the state and provide 530 | it to (and collect it from) the functions we wish to run. 531 | 532 | > Our implementation of monad-transformers (like State) uses a "hidden feature" 533 | of the Erlang distribution called *parameterized modules*. These are 534 | described in [Parameterized Modules in Erlang](http://ftp.sunet.se/pub/lang/erlang/workshop/2003/paper/p29-carlsson.pdf). 535 | 536 | The State-transform can be applied to any monad. If we apply it to the 537 | Identity-monad then we get what we're looking for. The key extra 538 | functionality that the State transformer provides us with is the 539 | ability to `get` and `set` (or just plain `modify`) state from within 540 | the inner monad. If we use both the *do* and *cut* parse-transformers, we 541 | can write: 542 | 543 | StateT = state_t:new(identity_m), 544 | SM = StateT:modify(_), 545 | SMR = StateT:modify_and_return(_), 546 | StateT:exec( 547 | do([StateT || 548 | 549 | StateT:put(init(Dimensions)), 550 | SM(plant_seeds(SeedCount, _)), 551 | DidFlood <- SMR(pour_on_water(WaterVolume, _)), 552 | SM(apply_sunlight(Time, _)), 553 | DidFlood2 <- SMR(pour_on_water(WaterVolume, _)), 554 | Crop <- SMR(harvest(_)), 555 | ... 556 | 557 | ]), undefined). 558 | 559 | We began by creating a State-transform over the Identity-monad: 560 | 561 | StateT = state_t:new(identity_m), 562 | ... 563 | 564 | > This is the syntax for *instantiating* parameterized modules. `StateT` is a 565 | variable referencing a module instance which, in this case, is a monad. 566 | 567 | and we define two shorthands for running functions that either just 568 | modify the state, or modify the state *and* return a result: 569 | 570 | SM = StateT:modify(_), 571 | SMR = StateT:modify_and_return(_), 572 | ... 573 | 574 | There's a bit of bookkeeping required but we achieve our goal: there are no 575 | state variables now to renumber whenever we make a change. We used *cut*s 576 | to leave holes in the functions where State should be fed in; and we 577 | obeyed the protocol that if a function returns both a result and a state, it 578 | is in the form of a `{Result, State}` tuple. The State-transform does the rest. 579 | 580 | 581 | ### Beyond Monads 582 | 583 | There are some standard monad functions such as `join/2` and 584 | `sequence/2` available in the `monad` module. We have also implemented 585 | `monad_plus` which works for monads where there's an obvious sense of 586 | *zero* and *plus* (currently Maybe-monad, List-monad, and Omega-monad). 587 | The associated functions `guard`, `msum` and `mfilter` are available 588 | in the `monad_plus` module. 589 | 590 | In many cases, a fairly mechanical translation from Haskell to Erlang 591 | is possible, so converting other monads or combinators should mostly 592 | be straightforward. However, the lack of type classes in Erlang is 593 | limiting. 594 | 595 | 596 | 597 | ## Import As 598 | 599 | For cosmetic reasons, it is sometimes desirable to import a remote 600 | function into the current module's namespace. This eliminates the need 601 | to continuously prefix calls to that function with its module 602 | name. Erlang can already do this by using the 603 | [`-import` attribute](http://www.erlang.org/doc/reference_manual/modules.html). 604 | However, this always uses the same function name locally as remotely 605 | which can either lead to misleading function names or even 606 | collisions. Consider, for example, wishing to import `length` 607 | functions from two remote modules. Aliasing of the functions is one 608 | solution to this. 609 | 610 | For example: 611 | 612 | -import_as({lists, [{duplicate/2, dup}]}). 613 | 614 | test() -> 615 | [a, a, a, a] = dup(4, a). 616 | 617 | As with `-import`, the left of the tuple is the module name, but the 618 | right of the tuple is a list of pairs, with the left being the 619 | function to import from the module (including arity) and the right 620 | being the local name by which the function is to be known--the 621 | *alias*. The implementation creates a local function, so the alias is 622 | safe to use in, for example, `Var = fun dup/2` expressions. 623 | 624 | 625 | 626 | ## License 627 | 628 | (The MPL) 629 | 630 | Software distributed under the License is distributed on an "AS IS" 631 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 632 | the License for the specific language governing rights and limitations 633 | under the License. 634 | 635 | The Original Code is Erlando. 636 | 637 | The Initial Developer of the Original Code is VMware, Inc. 638 | Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 639 | -------------------------------------------------------------------------------- /package.mk: -------------------------------------------------------------------------------- 1 | STANDALONE_TEST_COMMANDS:=test_do:test() test_cut:test() test_import_as:test() 2 | -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | {erl_opts, [debug_info, warnings_as_errors]}. 3 | {cover_enabled, true}. 4 | -------------------------------------------------------------------------------- /src/cut.erl: -------------------------------------------------------------------------------- 1 | %% This file is a copy of erl_id_trans.erl from the R14B02 Erlang/OTP 2 | %% distribution, with modifications to make it implement Scheme 3 | %% Notation for Specializing Parameters without Currying 4 | %% (http://srfi.schemers.org/srfi-26/srfi-26.html). 5 | 6 | %% All modifications are (C) 2011-2013 VMware, Inc. 7 | 8 | %% 9 | %% ``The contents of this file are subject to the Erlang Public License, 10 | %% Version 1.1, (the "License"); you may not use this file except in 11 | %% compliance with the License. You should have received a copy of the 12 | %% Erlang Public License along with this software. If not, it can be 13 | %% retrieved via the world wide web at http://www.erlang.org/. 14 | %% 15 | %% Software distributed under the License is distributed on an "AS IS" 16 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 17 | %% the License for the specific language governing rights and limitations 18 | %% under the License. 19 | %% 20 | %% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 21 | %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 22 | %% AB. All Rights Reserved.'' 23 | %% 24 | 25 | -module(cut). 26 | 27 | -export([parse_transform/2]). 28 | 29 | parse_transform(Forms, _Options) -> 30 | %%io:format("Before:~n~p~n~n", [Forms]), 31 | put(var_count, 0), 32 | Forms1 = forms(Forms), 33 | %% io:format("After:~n~s~n~n", 34 | %% [erl_prettypr:format(erl_syntax:form_list(Forms1))]), 35 | Forms1. 36 | 37 | %% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). 38 | 39 | forms([F0|Fs0]) -> 40 | F1 = form(F0), 41 | Fs1 = forms(Fs0), 42 | [F1|Fs1]; 43 | forms([]) -> []. 44 | 45 | %% -type form(Form) -> Form. 46 | 47 | form({attribute,Line,Attr,Val}) -> %The general attribute. 48 | {attribute,Line,Attr,Val}; 49 | form({function,Line,Name0,Arity0,Clauses0}) -> 50 | {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), 51 | {function,Line,Name,Arity,Clauses}; 52 | % Mnemosyne, ignore... 53 | form({rule,Line,Name,Arity,Body}) -> 54 | {rule,Line,Name,Arity,Body}; % Dont dig into this 55 | %% Extra forms from the parser. 56 | form({error,E}) -> {error,E}; 57 | form({warning,W}) -> {warning,W}; 58 | form({eof,Line}) -> {eof,Line}. 59 | 60 | %% -type function(atom(), integer(), [Clause]) -> {atom(),integer(),[Clause]}. 61 | 62 | function(Name, Arity, Clauses0) -> 63 | Clauses1 = clauses(Clauses0), 64 | {Name, Arity, Clauses1}. 65 | 66 | %% -type clauses([Clause]) -> [Clause]. 67 | 68 | clauses([C0|Cs]) -> 69 | C1 = clause(C0), 70 | [C1|clauses(Cs)]; 71 | clauses([]) -> []. 72 | 73 | %% -type clause(Clause) -> Clause. 74 | 75 | clause({clause, Line, Head, Guard, Body}) -> 76 | {clause, Line, Head, Guard, exprs(Body)}. 77 | 78 | %% -type pattern(Pattern) -> Pattern. 79 | %% N.B. Only valid patterns are included here. 80 | 81 | pattern({var,Line,V}) -> {var,Line,V}; 82 | pattern({match,Line,L0,R0}) -> 83 | L1 = pattern(L0), 84 | R1 = pattern(R0), 85 | {match,Line,L1,R1}; 86 | pattern({integer,Line,I}) -> {integer,Line,I}; 87 | pattern({char,Line,C}) -> {char,Line,C}; 88 | pattern({float,Line,F}) -> {float,Line,F}; 89 | pattern({atom,Line,A}) -> {atom,Line,A}; 90 | pattern({string,Line,S}) -> {string,Line,S}; 91 | pattern({nil,Line}) -> {nil,Line}; 92 | pattern({cons,Line,H0,T0}) -> 93 | H1 = pattern(H0), 94 | T1 = pattern(T0), 95 | {cons,Line,H1,T1}; 96 | pattern({tuple,Line,Ps0}) -> 97 | Ps1 = pattern_list(Ps0), 98 | {tuple,Line,Ps1}; 99 | %% OTP 17.0: EEP 443: Map pattern 100 | pattern({map, Line, Fields0}) -> 101 | Fields1 = map_fields(Fields0), 102 | {map, Line, Fields1}; 103 | %%pattern({struct,Line,Tag,Ps0}) -> 104 | %% Ps1 = pattern_list(Ps0), 105 | %% {struct,Line,Tag,Ps1}; 106 | pattern({record,Line,Name,Pfs0}) -> 107 | Pfs1 = pattern_fields(Pfs0), 108 | {record,Line,Name,Pfs1}; 109 | pattern({record_index,Line,Name,Field0}) -> 110 | Field1 = pattern(Field0), 111 | {record_index,Line,Name,Field1}; 112 | %% record_field occurs in query expressions 113 | pattern({record_field,Line,Rec0,Name,Field0}) -> 114 | Rec1 = expr(Rec0), 115 | Field1 = expr(Field0), 116 | {record_field,Line,Rec1,Name,Field1}; 117 | pattern({record_field,Line,Rec0,Field0}) -> 118 | Rec1 = expr(Rec0), 119 | Field1 = expr(Field0), 120 | {record_field,Line,Rec1,Field1}; 121 | pattern({bin,Line,Fs}) -> 122 | Fs2 = pattern_grp(Fs), 123 | {bin,Line,Fs2}; 124 | pattern({op,Line,Op,A}) -> 125 | {op,Line,Op,A}; 126 | pattern({op,Line,Op,L,R}) -> 127 | {op,Line,Op,L,R}. 128 | 129 | pattern_grp([{bin_element,L1,E1,S1,T1} | Fs]) -> 130 | S2 = case S1 of 131 | default -> 132 | default; 133 | _ -> 134 | expr(S1) 135 | end, 136 | T2 = case T1 of 137 | default -> 138 | default; 139 | _ -> 140 | bit_types(T1) 141 | end, 142 | [{bin_element,L1,expr(E1),S2,T2} | pattern_grp(Fs)]; 143 | pattern_grp([]) -> 144 | []. 145 | 146 | bit_types([]) -> 147 | []; 148 | bit_types([Atom | Rest]) when is_atom(Atom) -> 149 | [Atom | bit_types(Rest)]; 150 | bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) -> 151 | [{Atom, Integer} | bit_types(Rest)]. 152 | 153 | 154 | %% -type pattern_list([Pattern]) -> [Pattern]. 155 | %% These patterns are processed "in parallel" for purposes of variable 156 | %% definition etc. 157 | 158 | pattern_list([P0|Ps]) -> 159 | P1 = pattern(P0), 160 | [P1|pattern_list(Ps)]; 161 | pattern_list([]) -> []. 162 | 163 | %% -type pattern_fields([Field]) -> [Field]. 164 | %% N.B. Field names are full expressions here but only atoms are allowed 165 | %% by the *linter*!. 166 | 167 | pattern_fields([{record_field,Lf,{atom,La,F},P0}|Pfs]) -> 168 | P1 = pattern(P0), 169 | [{record_field,Lf,{atom,La,F},P1}|pattern_fields(Pfs)]; 170 | pattern_fields([{record_field,Lf,{var,La,'_'},P0}|Pfs]) -> 171 | P1 = pattern(P0), 172 | [{record_field,Lf,{var,La,'_'},P1}|pattern_fields(Pfs)]; 173 | pattern_fields([]) -> []. 174 | 175 | %% -type exprs([Expression]) -> [Expression]. 176 | %% These expressions are processed "sequentially" for purposes of variable 177 | %% definition etc. 178 | 179 | exprs([E0|Es]) -> 180 | E1 = expr(E0), 181 | [E1|exprs(Es)]; 182 | exprs([]) -> []. 183 | 184 | %% -type expr(Expression) -> Expression. 185 | 186 | expr({var, Line, V}) -> {var, Line, V}; 187 | expr({integer, Line, I}) -> {integer, Line, I}; 188 | expr({float, Line, F}) -> {float, Line, F}; 189 | expr({atom, Line, A}) -> {atom, Line, A}; 190 | expr({string, Line, S}) -> {string, Line, S}; 191 | expr({char, Line, C}) -> {char, Line, C}; 192 | expr({nil, Line}) -> {nil, Line}; 193 | expr({cons, Line, H0, T0} = Cons) -> 194 | %% We need to find cut vars in T0 _before_ recursing. 195 | case find_cons_cut_vars([Cons], T0) of 196 | {[], _H1T1} -> 197 | H1 = expr(H0), 198 | T1 = expr(T0), %% They see the same variables 199 | {cons, Line, H1, T1}; 200 | {Pattern, {cons, Line, H1, T1}} -> 201 | H2 = expr(H1), 202 | T2 = expr(T1), 203 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 204 | [{cons, Line, H2, T2}]}]}} 205 | end; 206 | expr({lc, Line, E0, Qs0}) -> 207 | %% Note that it is nonsensical to allow a cut on E0, as in all 208 | %% useful cases, it is defined by some expression of Qs0. Cuts are 209 | %% allowed only on generators of Qs0. 210 | Qs1 = lc_bc_quals(Qs0), 211 | E1 = expr(E0), 212 | Qs = find_comprehension_cut_vars(Qs1), 213 | case Qs of 214 | {[], _Qs2} -> 215 | {lc, Line, E1, Qs1}; 216 | {Pattern, Qs2} -> 217 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 218 | [{lc, Line, E1, Qs2}]}]}} 219 | end; 220 | expr({bc, Line, E0, Qs0}) -> 221 | %% Notes for {lc,...} above apply here too. 222 | Qs1 = lc_bc_quals(Qs0), 223 | E1 = expr(E0), 224 | Qs = find_comprehension_cut_vars(Qs1), 225 | case Qs of 226 | {[], _Qs2} -> 227 | {bc, Line, E1, Qs1}; 228 | {Pattern, Qs2} -> 229 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 230 | [{bc, Line, E1, Qs2}]}]}} 231 | end; 232 | expr({tuple, Line, Es0}) -> 233 | Es1 = expr_list(Es0), 234 | case find_cut_vars(Es1) of 235 | {[], _Es2} -> 236 | {tuple, Line, Es1}; 237 | {Pattern, Es2} -> 238 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 239 | [{tuple, Line, Es2}]}]}} 240 | end; 241 | %% OTP 17.0: EEP 443: Map construction 242 | expr({map, Line, Fields0}) -> 243 | Fields1 = map_fields(Fields0), 244 | case find_map_cut_vars(Fields1) of 245 | {[], _Fields2} -> 246 | {map, Line, Fields1}; 247 | {Pattern, Fields2} -> 248 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 249 | [{map, Line, Fields2}]}]}} 250 | end; 251 | %% OTP 17.0: EEP 443: Map update 252 | expr({map, Line, Expr0, Fields0}) -> 253 | Expr1 = expr(Expr0), 254 | Fields1 = map_fields(Fields0), 255 | case {find_cut_vars([Expr1]), find_map_cut_vars(Fields1)} of 256 | {{[], _Expr2}, {[], _Fields2}} -> 257 | {map, Line, Expr1, Fields1}; 258 | {{Pattern1, [Expr2]}, {Pattern2, Fields2}} -> 259 | {'fun', Line, {clauses, [{clause, Line, Pattern1++Pattern2, [], 260 | [{map, Line, Expr2, Fields2}]}]}} 261 | end; 262 | %%expr({struct,Line,Tag,Es0}) -> 263 | %% Es1 = pattern_list(Es0), 264 | %% {struct,Line,Tag,Es1}; 265 | expr({record_index, Line, Name, Field0}) -> 266 | %% The parser prevents Field0 from being a genuine expression, so 267 | %% can't do a cut here. 268 | Field1 = expr(Field0), 269 | {record_index, Line, Name, Field1}; 270 | expr({record, Line, Name, Inits0}) -> 271 | Inits1 = record_inits(Inits0), 272 | case find_record_cut_vars(Inits1) of 273 | {[], _Inits2} -> 274 | {record, Line, Name, Inits1}; 275 | {Pattern, Inits2} -> 276 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 277 | [{record, Line, Name, Inits2}]}]}} 278 | end; 279 | expr({record_field, Line, Rec0, Name, Field0}) -> 280 | Rec1 = expr(Rec0), 281 | Field1 = expr(Field0), 282 | case find_cut_vars([Rec1]) of 283 | {[], _Rec2} -> 284 | {record_field, Line, Rec1, Name, Field1}; 285 | {Pattern, [Rec2]} -> 286 | {'fun', Line, {clauses, 287 | [{clause, Line, Pattern, [], 288 | [{record_field, Line, Rec2, Name, Field1}]}]}} 289 | end; 290 | expr({record, Line, Rec0, Name, Upds0}) -> 291 | Rec1 = expr(Rec0), 292 | Upds1 = record_updates(Upds0), 293 | Rec = find_cut_vars([Rec1]), 294 | Upds = find_record_cut_vars(Upds1), 295 | case {Rec, Upds} of 296 | {{[], _Rec2}, {[], _Upds2}} -> 297 | {record, Line, Rec1, Name, Upds1}; 298 | {{Pattern1, [Rec2]}, {Pattern2, Upds2}} -> 299 | {'fun', Line, {clauses, [{clause, Line, Pattern1++Pattern2, [], 300 | [{record, Line, Rec2, Name, Upds2}]}]}} 301 | end; 302 | expr({record_field, Line, Rec0, Field0}) -> 303 | %% This only occurs within an mnesia query, let's not cut here 304 | Rec1 = expr(Rec0), 305 | Field1 = expr(Field0), 306 | {record_field, Line, Rec1, Field1}; 307 | expr({block, Line, Es0}) -> 308 | %% Unfold block into a sequence. 309 | %% Nonsensical to allow cuts here. 310 | Es1 = exprs(Es0), 311 | {block, Line, Es1}; 312 | expr({'if', Line, Cs0}) -> 313 | Cs1 = icr_clauses(Cs0), 314 | {'if', Line, Cs1}; 315 | expr({'case', Line, E0, Cs0}) -> 316 | E1 = expr(E0), 317 | Cs1 = icr_clauses(Cs0), 318 | case find_cut_vars([E1]) of 319 | {[], _E2} -> 320 | {'case', Line, E1, Cs1}; 321 | {Pattern, [E2]} -> 322 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 323 | [{'case', Line, E2, Cs1}]}]}} 324 | end; 325 | expr({'receive', Line, Cs0}) -> 326 | Cs1 = icr_clauses(Cs0), 327 | {'receive', Line, Cs1}; 328 | expr({'receive', Line, Cs0, To0, ToEs0}) -> 329 | To1 = expr(To0), 330 | ToEs1 = exprs(ToEs0), 331 | Cs1 = icr_clauses(Cs0), 332 | {'receive', Line, Cs1, To1, ToEs1}; 333 | expr({'try', Line, Es0, Scs0, Ccs0, As0}) -> 334 | %% It doesn't make sense to allow a cut on Es0 (the main 335 | %% expression) because it would have to be evaluated as an arg to 336 | %% the function, and thus would never be caught. Further, it 337 | %% doesn't even make sense to allow cuts in the after, because the 338 | %% only reason for using an after is for being able to side-effect 339 | %% in there, and again, it would have to be evaluated as an arg to 340 | %% the function. So no cuts at all allowed in try. 341 | Es1 = exprs(Es0), 342 | Scs1 = icr_clauses(Scs0), 343 | Ccs1 = icr_clauses(Ccs0), 344 | As1 = exprs(As0), 345 | {'try', Line, Es1, Scs1, Ccs1, As1}; 346 | expr({'fun', Line, Body}) -> 347 | case Body of 348 | {clauses, Cs0} -> 349 | Cs1 = fun_clauses(Cs0), 350 | {'fun', Line, {clauses, Cs1}}; 351 | {function, F, A} -> 352 | {'fun', Line, {function, F, A}}; 353 | {function, M, F, A} -> %% R10B-6: fun M:F/A. 354 | {'fun', Line, {function, M, F, A}} 355 | end; 356 | %% OTP 17.0: EEP 37: Funs with names 357 | expr({named_fun, Line, Name, Cs0}) -> 358 | Cs1 = fun_clauses(Cs0), 359 | {named_fun, Line, Name, Cs1}; 360 | expr({call, Line, F0, As0}) -> 361 | %% N.B. If F an atom then call to local function or BIF, if F a 362 | %% remote structure (see below) then call to other module, 363 | %% otherwise apply to "function". 364 | %% 365 | %% If F0 is a remote call then we want to allow cuts, but we don't 366 | %% want F0 to end up forming a separate function. Thus we have 367 | %% find_call_cut_vars and we brings cuts from within that up here. 368 | F1 = expr(F0), 369 | As1 = expr_list(As0), 370 | F = find_call_cut_vars(F1), 371 | As = find_cut_vars(As1), 372 | case {F, As} of 373 | {{[], _F2}, {[], _As2}} -> 374 | {call, Line, F1, As1}; 375 | {{Pattern1, [F2]}, {Pattern2, As2}} -> 376 | {'fun', Line, {clauses, [{clause, Line, Pattern1++Pattern2, [], 377 | [{call, Line, F2, As2}]}]}} 378 | end; 379 | expr({'catch', Line, E0}) -> 380 | %% No new variables added. 381 | %% See 'try' above for reasoning around no cuts here. 382 | E1 = expr(E0), 383 | {'catch', Line, E1}; 384 | expr({'query', Line, E0}) -> 385 | %% lc expression 386 | E1 = expr(E0), 387 | {'query', Line, E1}; 388 | expr({match, Line, P0, E0}) -> 389 | E1 = expr(E0), 390 | P1 = pattern(P0), 391 | {match, Line, P1, E1}; 392 | expr({bin, Line, Fs}) -> 393 | Fs1 = pattern_grp(Fs), 394 | case find_binary_cut_vars(Fs1) of 395 | {[], _Fs2} -> 396 | {bin, Line, Fs1}; 397 | {Pattern, Fs2} -> 398 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 399 | [{bin, Line, Fs2}]}]}} 400 | end; 401 | expr({op, Line, Op, A0}) -> 402 | A1 = expr(A0), 403 | case find_cut_vars([A1]) of 404 | {[], _A2} -> 405 | {op, Line, Op, A1}; 406 | {Pattern, [A2]} -> 407 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 408 | [{op, Line, Op, A2}]}]}} 409 | end; 410 | expr({op, Line, Op, L0, R0}) -> 411 | L1 = expr(L0), 412 | R1 = expr(R0), %% They see the same variables 413 | case find_cut_vars([L1, R1]) of 414 | {[], _L2R2} -> 415 | {op, Line, Op, L1, R1}; 416 | {Pattern, [L2, R2]} -> 417 | {'fun', Line, {clauses, [{clause, Line, Pattern, [], 418 | [{op, Line, Op, L2, R2}]}]}} 419 | end; 420 | %% The following are not allowed to occur anywhere! 421 | expr({remote, Line, M0, F0}) -> 422 | %% see {call,...} for why cuts aren't here. 423 | M1 = expr(M0), 424 | F1 = expr(F0), 425 | {remote, Line, M1, F1}. 426 | 427 | %% -type expr_list([Expression]) -> [Expression]. 428 | %% These expressions are processed "in parallel" for purposes of variable 429 | %% definition etc. 430 | 431 | expr_list([E0|Es]) -> 432 | E1 = expr(E0), 433 | [E1|expr_list(Es)]; 434 | expr_list([]) -> []. 435 | 436 | %% -type map_fields([MapField]) -> [MapField]. 437 | map_fields([{map_field_assoc, Line, ExpK0, ExpV0}|Fs]) -> 438 | ExpK1 = expr(ExpK0), 439 | ExpV1 = expr(ExpV0), 440 | [{map_field_assoc, Line, ExpK1, ExpV1}|map_fields(Fs)]; 441 | map_fields([{map_field_exact, Line, ExpK0, ExpV0}|Fs]) -> 442 | ExpK1 = expr(ExpK0), 443 | ExpV1 = expr(ExpV0), 444 | [{map_field_exact, Line, ExpK1, ExpV1}|map_fields(Fs)]; 445 | map_fields([]) -> []. 446 | 447 | %% -type record_inits([RecordInit]) -> [RecordInit]. 448 | %% N.B. Field names are full expressions here but only atoms are allowed 449 | %% by the *linter*!. 450 | 451 | record_inits([{record_field, Lf, {atom, La, F}, Val0}|Is]) -> 452 | Val1 = expr(Val0), 453 | [{record_field, Lf, {atom, La, F}, Val1}|record_inits(Is)]; 454 | record_inits([{record_field, Lf, {var, La, '_'}, Val0}|Is]) -> 455 | Val1 = expr(Val0), 456 | [{record_field, Lf, {var, La, '_'}, Val1}|record_inits(Is)]; 457 | record_inits([]) -> []. 458 | 459 | %% -type record_updates([RecordUpd]) -> [RecordUpd]. 460 | %% N.B. Field names are full expressions here but only atoms are allowed 461 | %% by the *linter*!. 462 | 463 | record_updates([{record_field, Lf, {atom, La, F}, Val0}|Us]) -> 464 | Val1 = expr(Val0), 465 | [{record_field, Lf, {atom, La, F}, Val1}|record_updates(Us)]; 466 | record_updates([]) -> []. 467 | 468 | %% -type icr_clauses([Clause]) -> [Clause]. 469 | 470 | icr_clauses([C0|Cs]) -> 471 | C1 = clause(C0), 472 | [C1|icr_clauses(Cs)]; 473 | icr_clauses([]) -> []. 474 | 475 | %% -type lc_bc_quals([Qualifier]) -> [Qualifier]. 476 | %% Allow filters to be both guard tests and general expressions. 477 | 478 | lc_bc_quals([{generate, Line, P0, E0}|Qs]) -> 479 | E1 = expr(E0), 480 | P1 = pattern(P0), 481 | [{generate, Line, P1, E1}|lc_bc_quals(Qs)]; 482 | lc_bc_quals([{b_generate, Line, P0, E0}|Qs]) -> 483 | E1 = expr(E0), 484 | P1 = pattern(P0), 485 | [{b_generate, Line, P1, E1}|lc_bc_quals(Qs)]; 486 | lc_bc_quals([E0|Qs]) -> 487 | E1 = expr(E0), 488 | [E1|lc_bc_quals(Qs)]; 489 | lc_bc_quals([]) -> []. 490 | 491 | %% -type fun_clauses([Clause]) -> [Clause]. 492 | 493 | fun_clauses([C0|Cs]) -> 494 | C1 = clause(C0), 495 | [C1|fun_clauses(Cs)]; 496 | fun_clauses([]) -> []. 497 | 498 | %% Turns out you can't abstract out binary types: 499 | %% 1> X = binary, Y = fun (Z) -> <> end. 500 | %% * 1: syntax error before: X 501 | %% I didn't know that. I still support that in cuts though you can't 502 | %% use it on the grounds that Erlang might fix this at some later 503 | %% point. 504 | find_binary_cut_vars(BinFields) -> 505 | cut_vars( 506 | fun ({bin_element, _Line, Var, Size, Type}) -> 507 | [V || V = {var, _Line1, '_'} <- [Var, Size, Type]]; 508 | (_) -> 509 | [] 510 | end, 511 | fun ({bin_element, Line, Var, Size, Type}, Vars) -> 512 | {[Var1, Size1, Type1], []} = 513 | lists:foldr( 514 | fun ({var, _Line, '_'}, {Res, [V|Vs]}) -> {[V|Res], Vs}; 515 | (V, {Res, Vs}) -> {[V|Res], Vs} 516 | end, {[], Vars}, [Var, Size, Type]), 517 | {bin_element, Line, Var1, Size1, Type1} 518 | end, 519 | BinFields). 520 | 521 | find_map_cut_vars(MapFields) -> 522 | cut_vars( 523 | fun ({map_field_assoc, _Line, {var, _Line1, '_'} = ExpK, {var, _Line2, '_'} = ExpV}) -> [ExpK, ExpV]; 524 | ({map_field_assoc, _Line, {var, _Line1, '_'} = ExpK, _ExpV}) -> [ExpK]; 525 | ({map_field_assoc, _Line, _ExpK, {var, _Line1, '_'} = ExpV}) -> [ExpV]; 526 | ({map_field_assoc, _Line, _ExpK, _ExpV}) -> []; 527 | ({map_field_exact, _Line, {var, _Line1, '_'} = ExpK, {var, _Line2, '_'} = ExpV}) -> [ExpK, ExpV]; 528 | ({map_field_exact, _Line, {var, _Line1, '_'} = ExpK, _ExpV}) -> [ExpK]; 529 | ({map_field_exact, _Line, _ExpK, {var, _Line1, '_'} = ExpV}) -> [ExpV]; 530 | ({map_field_exact, _Line, _ExpK, _ExpV}) -> []; 531 | (_) -> [] 532 | end, 533 | fun ({map_field_assoc, Line, _ExpK , _ExpV }, [ExpK, ExpV]) -> {map_field_assoc, Line, ExpK, ExpV}; 534 | ({map_field_assoc, Line, {var, _Line1, '_'}, ExpV }, [ExpK] ) -> {map_field_assoc, Line, ExpK, ExpV}; 535 | ({map_field_assoc, Line, ExpK , {var, _Line2, '_'}}, [ExpV] ) -> {map_field_assoc, Line, ExpK, ExpV}; 536 | ({map_field_exact, Line, _ExpK , _ExpV }, [ExpK, ExpV]) -> {map_field_assoc, Line, ExpK, ExpV}; 537 | ({map_field_exact, Line, {var, _Line1, '_'}, ExpV }, [ExpK] ) -> {map_field_assoc, Line, ExpK, ExpV}; 538 | ({map_field_exact, Line, ExpK , {var, _Line2, '_'}}, [ExpV] ) -> {map_field_assoc, Line, ExpK, ExpV} 539 | end, 540 | MapFields). 541 | 542 | find_record_cut_vars(RecFields) -> 543 | cut_vars( 544 | fun ({record_field, _Line, _FName, {var, _Line1, '_'} = Var}) -> [Var]; 545 | (_) -> [] 546 | end, 547 | fun ({record_field, Line, FName, _Var}, [Var]) -> 548 | {record_field, Line, FName, Var} 549 | end, 550 | RecFields). 551 | 552 | find_comprehension_cut_vars(Qs) -> 553 | cut_vars( 554 | fun ({generate, _Line, _P0, {var, _Line1, '_'} = Var}) -> [Var]; 555 | ({generate, _Line, _P0, _E0}) -> []; 556 | ({b_generate, _Line, _P0, {var, _Line1, '_'} = Var}) -> [Var]; 557 | ({b_generate, _Line, _P0, _E0}) -> []; 558 | (_) -> [] 559 | end, 560 | fun ({generate, Line, P0, _Var}, [Var]) -> {generate, Line, P0, Var}; 561 | ({b_generate, Line, P0, _Var}, [Var]) -> {b_generate, Line, P0, Var} 562 | end, 563 | Qs). 564 | 565 | find_call_cut_vars(F) -> 566 | cut_vars( 567 | fun ({remote, _Line, M0, F0}) -> [V || V = {var, _Line1, '_'} <- [M0,F0]]; 568 | ({var, _Line, '_'} = Var) -> [Var]; 569 | (_) -> [] 570 | end, 571 | fun ({remote, Line, M0, F0}, Vars) -> 572 | {[M1, F1], []} = 573 | lists:foldr( 574 | fun ({var, _Line, '_'}, {Res, [V|Vs]}) -> {[V|Res], Vs}; 575 | (V, {Res, Vs}) -> {[V|Res], Vs} 576 | end, {[], Vars}, [M0, F0]), 577 | {remote, Line, M1, F1}; 578 | ({var, _Line, _Var}, [Var]) -> Var 579 | end, 580 | [F]). 581 | 582 | find_cons_cut_vars(HeadsRev, {cons, _Line, _Head, Tail} = Cons) -> 583 | find_cons_cut_vars([Cons | HeadsRev], Tail); 584 | find_cons_cut_vars(HeadsRev, Other) -> 585 | Heads = lists:reverse([Other|HeadsRev]), 586 | {Pattern, Heads1} = 587 | cut_vars( 588 | fun ({cons, _Line, {var, _Line1, '_'} = Var, _Tail}) -> [Var]; 589 | ({var, _Line, '_'} = Var) -> [Var]; 590 | (_) -> [] 591 | end, 592 | fun ({cons, Line, {var, _Line1, '_'}, Tail}, [Var]) -> 593 | {cons, Line, Var, Tail}; 594 | ({var, _Line, '_'}, [Var]) -> 595 | Var 596 | end, 597 | Heads), 598 | {Pattern, 599 | lists:foldr( 600 | fun ({cons, Line, Head, _Tail}, Tail) -> {cons, Line, Head, Tail}; 601 | (Tail, undefined) -> Tail 602 | end, undefined, Heads1)}. 603 | 604 | find_cut_vars(As) -> 605 | cut_vars(fun ({var, _Line, '_'} = Var) -> [Var]; 606 | (_) -> [] 607 | end, 608 | fun (_, [{var, _Line, _Var} = Var]) -> Var end, 609 | As). 610 | 611 | cut_vars(TestFun, CombFun, AstFrag) -> 612 | cut_vars(TestFun, CombFun, AstFrag, [], []). 613 | 614 | cut_vars(_TestFun, _CombFun, [], Pattern, AstAcc) -> 615 | {lists:reverse(Pattern), lists:reverse(AstAcc)}; 616 | cut_vars(TestFun, CombFun, [Frag|AstFrags], Pattern, AstAcc) -> 617 | case TestFun(Frag) of 618 | [] -> 619 | cut_vars(TestFun, CombFun, AstFrags, Pattern, [Frag|AstAcc]); 620 | Vars -> 621 | Vars1 = [{var, Line, make_var_name()} || {var, Line, _} <- Vars], 622 | Frag1 = CombFun(Frag, Vars1), 623 | cut_vars(TestFun, CombFun, AstFrags, 624 | Vars1 ++ Pattern, [Frag1|AstAcc]) 625 | end. 626 | 627 | make_var_name() -> 628 | VarCount = get(var_count), 629 | put(var_count, VarCount+1), 630 | list_to_atom("__cut_" ++ integer_to_list(VarCount)). 631 | -------------------------------------------------------------------------------- /src/do.erl: -------------------------------------------------------------------------------- 1 | %% This file is a copy of erl_id_trans.erl from the R14B02 Erlang/OTP 2 | %% distribution, with modifications to make it implement Haskell-style 3 | %% 'do' syntax in Erlang. 4 | 5 | %% All modifications are (C) 2011-2013 VMware, Inc; Eduard Sergeev. 6 | 7 | %% 8 | %% ``The contents of this file are subject to the Erlang Public License, 9 | %% Version 1.1, (the "License"); you may not use this file except in 10 | %% compliance with the License. You should have received a copy of the 11 | %% Erlang Public License along with this software. If not, it can be 12 | %% retrieved via the world wide web at http://www.erlang.org/. 13 | %% 14 | %% Software distributed under the License is distributed on an "AS IS" 15 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 16 | %% the License for the specific language governing rights and limitations 17 | %% under the License. 18 | %% 19 | %% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 20 | %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 21 | %% AB. All Rights Reserved.'' 22 | %% 23 | 24 | -module(do). 25 | 26 | -export([parse_transform/2, format_error/1]). 27 | 28 | parse_transform(Forms, _Options) -> 29 | Forms1 = forms(Forms), 30 | %%io:format("~s~n", [erl_prettypr:format(erl_syntax:form_list(Forms1))]), 31 | Forms1. 32 | 33 | %% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). 34 | 35 | forms([F0|Fs0]) -> 36 | F1 = try form(F0) 37 | catch throw:{Error, Line} -> 38 | {error, {Line, ?MODULE, Error}} 39 | end, 40 | Fs1 = forms(Fs0), 41 | [F1|Fs1]; 42 | forms([]) -> []. 43 | 44 | %% -type form(Form) -> Form. 45 | 46 | form({attribute,Line,Attr,Val}) -> %The general attribute. 47 | {attribute,Line,Attr,Val}; 48 | form({function,Line,Name0,Arity0,Clauses0}) -> 49 | {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), 50 | {function,Line,Name,Arity,Clauses}; 51 | % Mnemosyne, ignore... 52 | form({rule,Line,Name,Arity,Body}) -> 53 | {rule,Line,Name,Arity,Body}; % Dont dig into this 54 | %% Extra forms from the parser. 55 | form({error,E}) -> {error,E}; 56 | form({warning,W}) -> {warning,W}; 57 | form({eof,Line}) -> {eof,Line}. 58 | 59 | %% -type function(atom(), integer(), [Clause]) -> {atom(),integer(),[Clause]}. 60 | 61 | function(Name, Arity, Clauses0) -> 62 | Clauses1 = clauses(Clauses0), 63 | {Name, Arity, Clauses1}. 64 | 65 | %% -type clauses([Clause]) -> [Clause]. 66 | 67 | clauses([C0|Cs]) -> 68 | C1 = clause(C0, []), 69 | [C1|clauses(Cs)]; 70 | clauses([]) -> []. 71 | 72 | %% -type clause(Clause) -> Clause. 73 | 74 | clause({clause, Line, Head, Guard, Body}, MonadStack) -> 75 | {clause, Line, Head, Guard, exprs(Body, MonadStack)}. 76 | 77 | %% -type pattern(Pattern) -> Pattern. 78 | %% N.B. Only valid patterns are included here. 79 | 80 | pattern({var,Line,V}) -> {var,Line,V}; 81 | pattern({match,Line,L0,R0}) -> 82 | L1 = pattern(L0), 83 | R1 = pattern(R0), 84 | {match,Line,L1,R1}; 85 | pattern({integer,Line,I}) -> {integer,Line,I}; 86 | pattern({char,Line,C}) -> {char,Line,C}; 87 | pattern({float,Line,F}) -> {float,Line,F}; 88 | pattern({atom,Line,A}) -> {atom,Line,A}; 89 | pattern({string,Line,S}) -> {string,Line,S}; 90 | pattern({nil,Line}) -> {nil,Line}; 91 | pattern({cons,Line,H0,T0}) -> 92 | H1 = pattern(H0), 93 | T1 = pattern(T0), 94 | {cons,Line,H1,T1}; 95 | pattern({tuple,Line,Ps0}) -> 96 | Ps1 = pattern_list(Ps0), 97 | {tuple,Line,Ps1}; 98 | %% OTP 17.0: EEP 443: Map pattern 99 | pattern({map, Line, Fields0}) -> 100 | Fields1 = map_fields(Fields0, []), 101 | {map, Line, Fields1}; 102 | %%pattern({struct,Line,Tag,Ps0}) -> 103 | %% Ps1 = pattern_list(Ps0), 104 | %% {struct,Line,Tag,Ps1}; 105 | pattern({record,Line,Name,Pfs0}) -> 106 | Pfs1 = pattern_fields(Pfs0), 107 | {record,Line,Name,Pfs1}; 108 | pattern({record_index,Line,Name,Field0}) -> 109 | Field1 = pattern(Field0), 110 | {record_index,Line,Name,Field1}; 111 | %% record_field occurs in query expressions 112 | pattern({record_field,Line,Rec0,Name,Field0}) -> 113 | Rec1 = expr(Rec0, []), 114 | Field1 = expr(Field0, []), 115 | {record_field,Line,Rec1,Name,Field1}; 116 | pattern({record_field,Line,Rec0,Field0}) -> 117 | Rec1 = expr(Rec0, []), 118 | Field1 = expr(Field0, []), 119 | {record_field,Line,Rec1,Field1}; 120 | pattern({bin,Line,Fs}) -> 121 | Fs2 = pattern_grp(Fs), 122 | {bin,Line,Fs2}; 123 | pattern({op,Line,Op,A}) -> 124 | {op,Line,Op,A}; 125 | pattern({op,Line,Op,L,R}) -> 126 | {op,Line,Op,L,R}. 127 | 128 | pattern_grp([{bin_element,L1,E1,S1,T1} | Fs]) -> 129 | S2 = case S1 of 130 | default -> 131 | default; 132 | _ -> 133 | expr(S1, []) 134 | end, 135 | T2 = case T1 of 136 | default -> 137 | default; 138 | _ -> 139 | bit_types(T1) 140 | end, 141 | [{bin_element,L1,expr(E1, []),S2,T2} | pattern_grp(Fs)]; 142 | pattern_grp([]) -> 143 | []. 144 | 145 | bit_types([]) -> 146 | []; 147 | bit_types([Atom | Rest]) when is_atom(Atom) -> 148 | [Atom | bit_types(Rest)]; 149 | bit_types([{Atom, Integer} | Rest]) 150 | when is_atom(Atom) andalso is_integer(Integer) -> 151 | [{Atom, Integer} | bit_types(Rest)]. 152 | 153 | 154 | %% -type pattern_list([Pattern]) -> [Pattern]. 155 | %% These patterns are processed "in parallel" for purposes of variable 156 | %% definition etc. 157 | 158 | pattern_list([P0|Ps]) -> 159 | P1 = pattern(P0), 160 | [P1|pattern_list(Ps)]; 161 | pattern_list([]) -> []. 162 | 163 | %% -type pattern_fields([Field]) -> [Field]. 164 | %% N.B. Field names are full expressions here but only atoms are allowed 165 | %% by the *linter*!. 166 | 167 | pattern_fields([{record_field,Lf,{atom,La,F},P0}|Pfs]) -> 168 | P1 = pattern(P0), 169 | [{record_field,Lf,{atom,La,F},P1}|pattern_fields(Pfs)]; 170 | pattern_fields([{record_field,Lf,{var,La,'_'},P0}|Pfs]) -> 171 | P1 = pattern(P0), 172 | [{record_field,Lf,{var,La,'_'},P1}|pattern_fields(Pfs)]; 173 | pattern_fields([]) -> []. 174 | 175 | %% -type exprs([Expression]) -> [Expression]. 176 | %% These expressions are processed "sequentially" for purposes of variable 177 | %% definition etc. 178 | 179 | exprs([E0|Es], MonadStack) -> 180 | E1 = expr(E0, MonadStack), 181 | [E1|exprs(Es, MonadStack)]; 182 | exprs([], _MonadStack) -> []. 183 | 184 | %% -type expr(Expression) -> Expression. 185 | 186 | expr({var, Line, V}, _MonadStack) -> {var, Line, V}; 187 | expr({integer, Line, I}, _MonadStack) -> {integer, Line, I}; 188 | expr({float, Line, F}, _MonadStack) -> {float, Line, F}; 189 | expr({atom, Line, A}, _MonadStack) -> {atom, Line, A}; 190 | expr({string, Line, S}, _MonadStack) -> {string, Line, S}; 191 | expr({char, Line, C}, _MonadStack) -> {char, Line, C}; 192 | expr({nil, Line}, _MonadStack) -> {nil, Line}; 193 | expr({cons, Line, H0, T0}, MonadStack) -> 194 | H1 = expr(H0, MonadStack), 195 | T1 = expr(T0, MonadStack), %% They see the same variables 196 | {cons, Line, H1, T1}; 197 | expr({lc, Line, E0, Qs0}, MonadStack) -> 198 | Qs1 = lc_bc_quals(Qs0, MonadStack), 199 | E1 = expr(E0, MonadStack), 200 | {lc, Line, E1, Qs1}; 201 | expr({bc, Line, E0, Qs0}, MonadStack) -> 202 | Qs1 = lc_bc_quals(Qs0, MonadStack), 203 | E1 = expr(E0, MonadStack), 204 | {bc, Line, E1, Qs1}; 205 | expr({tuple, Line, Es0}, MonadStack) -> 206 | Es1 = expr_list(Es0, MonadStack), 207 | {tuple, Line, Es1}; 208 | %% OTP 17.0: EEP 443: Map construction 209 | expr({map, Line, Fields0}, MonadStack) -> 210 | Fields1 = map_fields(Fields0, MonadStack), 211 | {map, Line, Fields1}; 212 | %% OTP 17.0: EEP 443: Map update 213 | expr({map, Line, Expr0, Fields0}, MonadStack) -> 214 | Expr1 = expr(Expr0, MonadStack), 215 | Fields1 = map_fields(Fields0, MonadStack), 216 | {map, Line, Expr1, Fields1}; 217 | expr({record_index, Line, Name, Field0}, MonadStack) -> 218 | Field1 = expr(Field0, MonadStack), 219 | {record_index, Line, Name, Field1}; 220 | expr({record, Line, Name, Inits0}, MonadStack) -> 221 | Inits1 = record_inits(Inits0, MonadStack), 222 | {record, Line, Name, Inits1}; 223 | expr({record_field, Line, Rec0, Name, Field0}, MonadStack) -> 224 | Rec1 = expr(Rec0, MonadStack), 225 | Field1 = expr(Field0, MonadStack), 226 | {record_field, Line, Rec1, Name, Field1}; 227 | expr({record, Line, Rec0, Name, Upds0}, MonadStack) -> 228 | Rec1 = expr(Rec0, MonadStack), 229 | Upds1 = record_updates(Upds0, MonadStack), 230 | {record, Line, Rec1, Name, Upds1}; 231 | expr({record_field, Line, Rec0, Field0}, MonadStack) -> 232 | Rec1 = expr(Rec0, MonadStack), 233 | Field1 = expr(Field0, MonadStack), 234 | {record_field, Line, Rec1, Field1}; 235 | expr({block, Line, Es0}, MonadStack) -> 236 | %% Unfold block into a sequence. 237 | Es1 = exprs(Es0, MonadStack), 238 | {block, Line, Es1}; 239 | expr({'if', Line, Cs0}, MonadStack) -> 240 | Cs1 = icr_clauses(Cs0, MonadStack), 241 | {'if', Line, Cs1}; 242 | expr({'case', Line, E0, Cs0}, MonadStack) -> 243 | E1 = expr(E0, MonadStack), 244 | Cs1 = icr_clauses(Cs0, MonadStack), 245 | {'case', Line, E1, Cs1}; 246 | expr({'receive', Line, Cs0}, MonadStack) -> 247 | Cs1 = icr_clauses(Cs0, MonadStack), 248 | {'receive', Line, Cs1}; 249 | expr({'receive', Line, Cs0, To0, ToEs0}, MonadStack) -> 250 | To1 = expr(To0, MonadStack), 251 | ToEs1 = exprs(ToEs0, MonadStack), 252 | Cs1 = icr_clauses(Cs0, MonadStack), 253 | {'receive', Line, Cs1, To1, ToEs1}; 254 | expr({'try', Line, Es0, Scs0, Ccs0, As0}, MonadStack) -> 255 | Es1 = exprs(Es0, MonadStack), 256 | Scs1 = icr_clauses(Scs0, MonadStack), 257 | Ccs1 = icr_clauses(Ccs0, MonadStack), 258 | As1 = exprs(As0, MonadStack), 259 | {'try', Line, Es1, Scs1, Ccs1, As1}; 260 | expr({'fun', Line, Body}, MonadStack) -> 261 | case Body of 262 | {clauses, Cs0} -> 263 | Cs1 = fun_clauses(Cs0, MonadStack), 264 | {'fun', Line, {clauses, Cs1}}; 265 | {function, F, A} -> 266 | {'fun', Line, {function, F, A}}; 267 | {function, M, F, A} -> %% R10B-6: fun M:F/A. 268 | {'fun', Line, {function, M, F, A}} 269 | end; 270 | %% OTP 17.0: EEP 37: Funs with names 271 | expr({named_fun, Line, Name, Cs0}, MonadStack) -> 272 | Cs1 = fun_clauses(Cs0, MonadStack), 273 | {named_fun, Line, Name, Cs1}; 274 | %% do syntax detection: 275 | expr({call, Line, {atom, _Line1, do}, 276 | [{lc, _Line2, {AtomOrVar, _Line3, _MonadModule} = Monad, Qs}]}, 277 | MonadStack) when AtomOrVar =:= atom orelse AtomOrVar =:= var -> 278 | %% 'do' calls of a particular form: 279 | %% do([ MonadMod || Qualifiers ]) 280 | {call, Line, 281 | {'fun', Line, 282 | {clauses, 283 | [{clause, Line, [], [], do_syntax(Qs, [Monad | MonadStack])}]}}, []}; 284 | %% 'return' and 'fail' syntax detection and transformation: 285 | expr({call, Line, {atom, Line1, ReturnOrFail}, As0}, 286 | [Monad|_Monads] = MonadStack) when ReturnOrFail =:= return orelse 287 | ReturnOrFail =:= fail-> 288 | %% 'return' calls of a particular form: 289 | %% return(Arguments), and 290 | %% 'fail' calls of a particular form: 291 | %% fail(Arguments) 292 | %% Transformed to: 293 | %% "Monad:return(Args)" or "Monad:fail(Args)" in monadic context 294 | {call, Line, {remote, Line1, Monad, {atom, Line1, ReturnOrFail}}, 295 | expr_list(As0, MonadStack)}; 296 | expr({call, Line, F0, As0}, MonadStack) -> 297 | %% N.B. If F an atom then call to local function or BIF, if F a 298 | %% remote structure (see below) then call to other module, 299 | %% otherwise apply to "function". 300 | F1 = expr(F0, MonadStack), 301 | As1 = expr_list(As0, MonadStack), 302 | {call, Line, F1, As1}; 303 | expr({'catch', Line, E0}, MonadStack) -> 304 | %% No new variables added. 305 | E1 = expr(E0, MonadStack), 306 | {'catch', Line, E1}; 307 | expr({'query', Line, E0}, MonadStack) -> 308 | %% lc expression 309 | E = expr(E0, MonadStack), 310 | {'query', Line, E}; 311 | expr({match, Line, P0, E0}, MonadStack) -> 312 | E1 = expr(E0, MonadStack), 313 | P1 = pattern(P0), 314 | {match, Line, P1, E1}; 315 | expr({bin, Line, Fs}, _MonadStack) -> 316 | Fs2 = pattern_grp(Fs), 317 | {bin, Line, Fs2}; 318 | expr({op, Line, Op, A0}, MonadStack) -> 319 | A1 = expr(A0, MonadStack), 320 | {op, Line, Op, A1}; 321 | expr({op, Line, Op, L0, R0}, MonadStack) -> 322 | L1 = expr(L0, MonadStack), 323 | R1 = expr(R0, MonadStack), %% They see the same variables 324 | {op, Line, Op, L1, R1}; 325 | %% The following are not allowed to occur anywhere! 326 | expr({remote, Line, M0, F0}, MonadStack) -> 327 | M1 = expr(M0, MonadStack), 328 | F1 = expr(F0, MonadStack), 329 | {remote, Line, M1, F1}. 330 | 331 | %% -type expr_list([Expression]) -> [Expression]. 332 | %% These expressions are processed "in parallel" for purposes of variable 333 | %% definition etc. 334 | 335 | expr_list([E0|Es], MonadStack) -> 336 | E1 = expr(E0, MonadStack), 337 | [E1|expr_list(Es, MonadStack)]; 338 | expr_list([], _MonadStack) -> []. 339 | 340 | %% -type map_fields([MapField]) -> [MapField]. 341 | map_fields([{map_field_assoc, Line, ExpK0, ExpV0}|Fs], MonadStack) -> 342 | ExpK1 = expr(ExpK0, MonadStack), 343 | ExpV1 = expr(ExpV0, MonadStack), 344 | [{map_field_assoc, Line, ExpK1, ExpV1}|map_fields(Fs, MonadStack)]; 345 | map_fields([{map_field_exact, Line, ExpK0, ExpV0}|Fs], MonadStack) -> 346 | ExpK1 = expr(ExpK0, MonadStack), 347 | ExpV1 = expr(ExpV0, MonadStack), 348 | [{map_field_exact, Line, ExpK1, ExpV1}|map_fields(Fs, MonadStack)]; 349 | map_fields([], _MoandStack) -> []. 350 | 351 | %% -type record_inits([RecordInit]) -> [RecordInit]. 352 | %% N.B. Field names are full expressions here but only atoms are allowed 353 | %% by the *linter*!. 354 | 355 | record_inits([{record_field, Lf, {atom, La, F}, Val0}|Is], MonadStack) -> 356 | Val1 = expr(Val0, MonadStack), 357 | [{record_field, Lf, {atom, La, F}, Val1}|record_inits(Is, MonadStack)]; 358 | record_inits([{record_field, Lf, {var, La, '_'}, Val0}|Is], MonadStack) -> 359 | Val1 = expr(Val0, MonadStack), 360 | [{record_field, Lf, {var, La, '_'}, Val1}|record_inits(Is, MonadStack)]; 361 | record_inits([], _MonadStack) -> []. 362 | 363 | %% -type record_updates([RecordUpd]) -> [RecordUpd]. 364 | %% N.B. Field names are full expressions here but only atoms are allowed 365 | %% by the *linter*!. 366 | 367 | record_updates([{record_field, Lf, {atom, La, F}, Val0}|Us], MonadStack) -> 368 | Val1 = expr(Val0, MonadStack), 369 | [{record_field, Lf, {atom, La, F}, Val1}|record_updates(Us, MonadStack)]; 370 | record_updates([], _MonadStack) -> []. 371 | 372 | %% -type icr_clauses([Clause]) -> [Clause]. 373 | 374 | icr_clauses([C0|Cs], MonadStack) -> 375 | C1 = clause(C0, MonadStack), 376 | [C1|icr_clauses(Cs, MonadStack)]; 377 | icr_clauses([], _MonadStack) -> []. 378 | 379 | %% -type lc_bc_quals([Qualifier]) -> [Qualifier]. 380 | %% Allow filters to be both guard tests and general expressions. 381 | 382 | lc_bc_quals([{generate, Line, P0, E0}|Qs], MonadStack) -> 383 | E1 = expr(E0, MonadStack), 384 | P1 = pattern(P0), 385 | [{generate, Line, P1, E1}|lc_bc_quals(Qs, MonadStack)]; 386 | lc_bc_quals([{b_generate, Line, P0, E0}|Qs], MonadStack) -> 387 | E1 = expr(E0, MonadStack), 388 | P1 = pattern(P0), 389 | [{b_generate, Line, P1, E1}|lc_bc_quals(Qs, MonadStack)]; 390 | lc_bc_quals([E0|Qs], MonadStack) -> 391 | E1 = expr(E0, MonadStack), 392 | [E1|lc_bc_quals(Qs, MonadStack)]; 393 | lc_bc_quals([], _MonadStack) -> []. 394 | 395 | %% -type fun_clauses([Clause]) -> [Clause]. 396 | 397 | fun_clauses([C0|Cs], MonadStack) -> 398 | C1 = clause(C0, MonadStack), 399 | [C1|fun_clauses(Cs, MonadStack)]; 400 | fun_clauses([], _MonadStack) -> []. 401 | 402 | %% 'do' syntax transformation: 403 | do_syntax([], [{_AtomOrVar, MLine, _MonadModule} | _MonadStack]) -> 404 | transform_error("A 'do' construct cannot be empty", MLine); 405 | do_syntax([{GenerateOrMatch, Line, _Pattern, _Expr}], _MonadStack) 406 | when GenerateOrMatch =:= generate orelse GenerateOrMatch =:= match -> 407 | transform_error("The last statement in a 'do' construct must be an expression", Line); 408 | do_syntax([{generate, Line, {var, _Line, _Var} = Pattern, Expr} | Exprs], 409 | [Monad | _Monads] = MonadStack) -> 410 | %% "Pattern <- Expr, Tail" where Pattern is a simple variable 411 | %% is transformed to 412 | %% "Monad:'>>='(Expr, fun (Pattern) -> Tail')" 413 | %% without a fail to match clause 414 | [{call, Line, {remote, Line, Monad, {atom, Line, '>>='}}, 415 | [expr(Expr, MonadStack), 416 | {'fun', Line, 417 | {clauses, 418 | [{clause, Line, [Pattern], [], do_syntax(Exprs, MonadStack)}]}}]}]; 419 | do_syntax([{generate, Line, Pattern, Expr} | Exprs], 420 | [Monad | _Monads] = MonadStack) -> 421 | %% "Pattern <- Expr, Tail" where Pattern is not a simple variable 422 | %% is transformed to 423 | %% "Monad:'>>='(Expr, fun (Pattern) -> Tail')" 424 | %% with a fail clause if the function does not match 425 | [{call, Line, {remote, Line, Monad, {atom, Line, '>>='}}, 426 | [expr(Expr, MonadStack), 427 | {'fun', Line, 428 | {clauses, 429 | [{clause, Line, [Pattern], [], do_syntax(Exprs, MonadStack)}, 430 | {clause, Line, [{var, Line, '_'}], [], 431 | [{call, Line, {remote, Line, Monad, {atom, Line, 'fail'}}, 432 | [{atom, Line, 'monad_badmatch'}]}]}]}}]}]; 433 | do_syntax([Expr], MonadStack) -> 434 | [expr(Expr, MonadStack)]; %% Don't do '>>' chaining on the last elem 435 | do_syntax([{match, _Line, _Pattern, _Expr} = Expr | Exprs], 436 | MonadStack) -> 437 | %% Handles 'let binding' in do expression a-la Haskell 438 | [expr(Expr, MonadStack) | do_syntax(Exprs, MonadStack)]; 439 | do_syntax([Expr | Exprs], [Monad | _Monads] = MonadStack) -> 440 | %% "Expr, Tail" is transformed to "Monad:'>>='(Expr, fun (_) -> Tail')" 441 | %% Line is always the 2nd element of Expr 442 | Line = element(2, Expr), 443 | [{call, Line, {remote, Line, Monad, {atom, Line, '>>='}}, 444 | [expr(Expr, MonadStack), 445 | {'fun', Line, 446 | {clauses, 447 | [{clause, Line, 448 | [{var, Line, '_'}], [], do_syntax(Exprs, MonadStack)}]}}]}]. 449 | 450 | %% Use this function to report any parse_transform error. The 451 | %% resulting error message will be displayed as an ordinary 452 | %% compilation error in a standard format. 453 | transform_error(Message, Line) -> 454 | throw({Message, Line}). 455 | 456 | %% This function is called by the Erlang compiler to obtain an error 457 | %% message which will be shown to the user. 458 | format_error(Message) -> 459 | case io_lib:deep_char_list(Message) of 460 | true -> Message; 461 | _ -> io_lib:write(Message) 462 | end. 463 | -------------------------------------------------------------------------------- /src/erlando.app.src: -------------------------------------------------------------------------------- 1 | {application, erlando, 2 | [{description, "Syntax extensions for Erlang"}, 3 | {vsn, "%%VSN%%"}, 4 | {modules, []}, 5 | {registered, []}, 6 | {applications, []}]}. 7 | -------------------------------------------------------------------------------- /src/error_m.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(error_m). 18 | 19 | -export_type([error_m/1]). 20 | 21 | -behaviour(monad). 22 | -export(['>>='/2, return/1, fail/1]). 23 | 24 | %% This is really instance (Error e) => Monad (Either e) with 'error' 25 | %% for Left and 'ok' for Right. 26 | -type error_m(A) :: ok | {ok, A} | {error, any()}. 27 | 28 | 29 | -spec '>>='(error_m(A), fun( (A) -> error_m(B) )) -> error_m(B). 30 | '>>='({error, _Err} = Error, _Fun) -> Error; 31 | '>>='({ok, Result}, Fun) -> Fun(Result); 32 | '>>='(ok, Fun) -> Fun(ok). 33 | 34 | 35 | -spec return(A) -> error_m(A). 36 | return(ok) -> ok; 37 | return(X ) -> {ok, X}. 38 | 39 | 40 | -spec fail(any()) -> error_m(_A). 41 | fail(X) -> 42 | {error, X}. 43 | -------------------------------------------------------------------------------- /src/error_t.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(error_t). 18 | -compile({parse_transform, do}). 19 | 20 | -export_type([error_t/2]). 21 | 22 | -behaviour(monad_trans). 23 | -export([new/1, '>>='/3, return/2, fail/2, run/2, lift/2]). 24 | 25 | -opaque error_t(M, A) :: monad:monadic(M, ok | {ok, A} | {error, any()}). 26 | 27 | 28 | -spec new(M) -> TM when TM :: monad:monad(), M :: monad:monad(). 29 | new(M) -> 30 | {?MODULE, M}. 31 | 32 | 33 | -spec '>>='(error_t(M, A), fun( (A) -> error_t(M, B) ), M) -> error_t(M, B). 34 | '>>='(X, Fun, {?MODULE, M}) -> 35 | do([M || R <- X, 36 | case R of 37 | {error, _Err} = Error -> return(Error); 38 | {ok, Result} -> Fun(Result); 39 | ok -> Fun(ok) 40 | end 41 | ]). 42 | 43 | 44 | -spec return(A, M) -> error_t(M, A). 45 | return(ok, {?MODULE, M}) -> M:return(ok); 46 | return(X , {?MODULE, M}) -> M:return({ok, X}). 47 | 48 | %% This is the equivalent of 49 | %% fail msg = ErrorT $ return (Left (strMsg msg)) 50 | %% from the instance (Monad m, Error e) => Monad (ErrorT e m) 51 | %% 52 | %% http://hackage.haskell.org/packages/archive/mtl/1.1.0.2/doc/html/src/Control-Monad-Error.html#ErrorT 53 | %% 54 | %% I.e. note that calling fail on the outer monad is not a failure of 55 | %% the inner monad: it is success of the inner monad, but the failure 56 | %% is encapsulated. 57 | -spec fail(any(), M) -> error_t(M, _A). 58 | fail(E, {?MODULE, M}) -> 59 | M:return({error, E}). 60 | 61 | 62 | -spec run(error_t(M, A), M) -> monad:monadic(M, ok | {ok, A} | {error, any()}). 63 | run(EM, _M) -> EM. 64 | 65 | 66 | -spec lift(monad:monadic(M, A), M) -> error_t(M, A). 67 | lift(X, {?MODULE, M}) -> 68 | do([M || A <- X, 69 | return({ok, A})]). 70 | -------------------------------------------------------------------------------- /src/identity_m.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(identity_m). 18 | -behaviour(monad). 19 | 20 | -export_type([identity_m/1]). 21 | 22 | -export(['>>='/2, return/1, fail/1]). 23 | 24 | 25 | -type identity_m(A) :: A. 26 | 27 | 28 | -spec '>>='(identity_m(A), fun( (A) -> identity_m(B) )) -> identity_m(B). 29 | '>>='(X, Fun) -> Fun(X). 30 | 31 | 32 | -spec return(A) -> identity_m(A). 33 | return(X) -> X. 34 | 35 | 36 | -spec fail(any()) -> identity_m(_A). 37 | fail(E) -> 38 | throw({error, E}). 39 | -------------------------------------------------------------------------------- /src/import_as.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(import_as). 18 | 19 | -export([parse_transform/2]). 20 | 21 | parse_transform(Forms, _Options) -> 22 | %% io:format("Before:~n~p~n~n", [Forms]), 23 | {[], Forms1} = lists:foldl(fun import_as/2, {[], []}, Forms), 24 | Forms2 = lists:reverse(Forms1), 25 | %% io:format("After:~n~s~n~n", 26 | %% [erl_prettypr:format(erl_syntax:form_list(Forms2))]), 27 | Forms2. 28 | 29 | import_as({attribute, Line, import_as, {Module, Aliases}}, Acc) -> 30 | import_as({attribute, Line, import_as, [{Module, Aliases}]}, Acc); 31 | import_as({attribute, Line, import_as, List}, {Funs, Acc}) 32 | when is_list(List) -> 33 | Funs1 = 34 | lists:foldl( 35 | fun ({Module, Aliases}, Acc1) when is_list(Aliases) -> 36 | [alias_fun(Module, Line, Alias) || Alias <- Aliases] ++ Acc1; 37 | (WrongThing, Acc1) -> 38 | [general_error_fun(Line, WrongThing) | Acc1] 39 | end, Funs, List), 40 | {Funs1, Acc}; 41 | import_as({attribute, Line, import_as, WrongThing}, {Funs, Acc}) -> 42 | {Funs, [general_error(Line, WrongThing) | Acc]}; 43 | import_as({eof, Line}, {Funs, Acc}) -> 44 | {Acc1, Line1} = 45 | lists:foldl( 46 | fun (Fun, {AccN, LineN}) -> {[Fun(LineN) | AccN], LineN + 1} end, 47 | {Acc, Line}, Funs), 48 | {[], [{eof, Line1} | Acc1]}; 49 | import_as(Other, {Funs, Acc}) -> 50 | {Funs, [Other | Acc]}. 51 | 52 | alias_fun(Module, _AttLine, {{Dest, Arity}, Alias}) when is_atom(Module) andalso 53 | is_atom(Dest) andalso 54 | is_atom(Alias) andalso 55 | is_integer(Arity) -> 56 | fun (Line) -> 57 | Vars = [{var, Line, list_to_atom("Var_" ++ integer_to_list(N))} || 58 | N <- lists:seq(1, Arity)], 59 | Body = {call, Line, 60 | {remote, Line, {atom, Line, Module}, {atom, Line, Dest}}, 61 | Vars}, 62 | {function, Line, Alias, Arity, [{clause, Line, Vars, [], [Body]}]} 63 | end; 64 | alias_fun(_Module, AttLine, WrongThing) -> 65 | fun (_Line) -> 66 | Str = io_lib:format("~p", [WrongThing]), 67 | {error, {AttLine, erl_parse, 68 | ["-import_as: Expected a pair of " 69 | "{target_fun/arity, alias}, not: ", Str]}} 70 | end. 71 | 72 | general_error_fun(AttLine, WrongThing) -> 73 | fun (_Line) -> general_error(AttLine, WrongThing) end. 74 | 75 | general_error(AttLine, WrongThing) -> 76 | Str = io_lib:format("~p", [WrongThing]), 77 | {error, {AttLine, erl_parse, ["-import_as: invalid attribute value: ", Str]}}. 78 | -------------------------------------------------------------------------------- /src/list_m.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | %% List Monad. Mainly just for fun! As normal, this is depth first. 18 | 19 | -module(list_m). 20 | 21 | -behaviour(monad). 22 | -export(['>>='/2, return/1, fail/1]). 23 | 24 | -behaviour(monad_plus). 25 | -export([mzero/0, mplus/2]). 26 | 27 | 28 | %% Note that using a list comprehension is (obviously) cheating, but 29 | %% it's easier to read. The "real" implementation is also included for 30 | %% completeness. 31 | -spec '>>='([A], fun( (A) -> [B] )) -> [B]. 32 | '>>='(X, Fun) -> lists:append([Fun(E) || E <- X]). 33 | %% lists:foldr(fun (E, Acc) -> Fun(E) ++ Acc end, [], X). 34 | 35 | 36 | -spec return(A) -> [A]. 37 | return(X) -> [X]. 38 | 39 | 40 | -spec fail(any()) -> [_A]. 41 | fail(_E) -> []. 42 | 43 | 44 | -spec mzero() -> [_A]. 45 | mzero() -> []. 46 | 47 | 48 | -spec mplus([A], [A]) -> [A]. 49 | mplus(X, Y) -> 50 | lists:append(X, Y). 51 | -------------------------------------------------------------------------------- /src/maybe_m.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(maybe_m). 18 | 19 | -export_type([maybe/1]). 20 | 21 | -behaviour(monad). 22 | -export(['>>='/2, return/1, fail/1]). 23 | 24 | -behaviour(monad_plus). 25 | -export([mzero/0, mplus/2]). 26 | 27 | -type maybe(A) :: {just, A} | nothing. 28 | 29 | 30 | -spec '>>='(maybe(A), fun( (A) -> maybe(B) )) -> maybe(B). 31 | '>>='({just, X}, Fun) -> Fun(X); 32 | '>>='(nothing, _Fun) -> nothing. 33 | 34 | 35 | -spec return(A) -> maybe(A). 36 | return(X) -> {just, X}. 37 | 38 | 39 | -spec fail(any()) -> maybe(_A). 40 | fail(_X) -> nothing. 41 | 42 | 43 | -spec mzero() -> maybe(_A). 44 | mzero() -> nothing. 45 | 46 | 47 | -spec mplus(maybe(A), maybe(A)) -> maybe(A). 48 | mplus(nothing, Y) -> Y; 49 | mplus(X, _Y) -> X. 50 | -------------------------------------------------------------------------------- /src/monad.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(monad). 18 | -compile({parse_transform, do}). 19 | 20 | -export_type([monad/0, monadic/2]). 21 | 22 | -export([join/2, sequence/2]). 23 | 24 | -type monad() :: module() | {module(), monad()}. 25 | -type monadic(_M, _A) :: any(). 26 | 27 | 28 | %% Monad primitives 29 | -callback '>>='(monadic(M, A), fun( (A) -> monadic(M, B) )) -> monadic(M, B) when M :: monad(). 30 | -callback return(A) -> monadic(M, A) when M :: monad(). 31 | -callback fail(any()) -> monadic(M, _A) when M :: monad(). 32 | 33 | 34 | %% Utility functions 35 | -spec join(M, monadic(M, monadic(M, A))) -> monadic(M, A). 36 | join(Monad, X) -> 37 | do([Monad || Y <- X, 38 | Y]). 39 | 40 | 41 | -spec sequence(M, [monadic(M, A)]) -> monadic(M, [A]). 42 | sequence(Monad, Xs) -> 43 | sequence(Monad, Xs, []). 44 | 45 | sequence(Monad, [], Acc) -> 46 | do([Monad || return(lists:reverse(Acc))]); 47 | sequence(Monad, [X|Xs], Acc) -> 48 | do([Monad || E <- X, 49 | sequence(Monad, Xs, [E|Acc])]). 50 | -------------------------------------------------------------------------------- /src/monad_plus.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(monad_plus). 18 | -compile({parse_transform, do}). 19 | -compile({parse_transform, cut}). 20 | 21 | -export_type([monad/0, monadic/2]). 22 | 23 | -export([guard/2, msum/2, mfilter/3]). 24 | 25 | -type monad() :: module() | {module(), monad()}. 26 | -type monadic(_M, _A) :: any(). 27 | 28 | 29 | %% MonadPlus primitives 30 | -callback mzero() -> monadic(_M, _A). 31 | -callback mplus(monadic(M, A), monadic(M, A)) -> monadic(M, A). 32 | 33 | 34 | %% Utility functions 35 | -spec guard(M, boolean()) -> monadic(M, ok). 36 | guard(Monad, true) -> Monad:return(ok); 37 | guard(Monad, false) -> Monad:fail(""). 38 | 39 | 40 | -spec msum(M, [monadic(M, A)]) -> monadic(M, A). 41 | msum(Monad, List) -> 42 | lists:foldr(Monad:mplus(_, _), Monad:mzero(), List). 43 | 44 | 45 | -spec mfilter(M, fun( (A) -> boolean() ), monadic(M, A)) -> monadic(M, A). 46 | mfilter(Monad, Pred, X) -> 47 | do([Monad || A <- X, 48 | case Pred(A) of 49 | true -> return(A); 50 | false -> Monad:mzero() 51 | end]). 52 | -------------------------------------------------------------------------------- /src/monad_trans.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | 11 | -module(monad_trans). 12 | -compile({parse_transform, do}). 13 | 14 | %% Monad primitives 15 | -callback '>>='(monad:monadic(TM, A), fun( (A) -> monad:monadic(TM, B) ), M) -> monad:monadic(TM, B) when TM :: monad:monad(), M :: monad:monad(). 16 | -callback return(A, M) -> monad:monadic(TM, A) when TM :: monad:monad(), M :: monad:monad(). 17 | -callback fail(any(), M) -> monad:monadic(TM, _A) when TM :: monad:monad(), M :: monad:monad(). 18 | 19 | %% Lift a computation form the argument monad to the constructed 20 | %% monad. 21 | -callback lift(monad:monadic(M, A), M) -> monad:monadic(TM, A) when TM :: monad:monad(), M :: monad:monad(). 22 | -------------------------------------------------------------------------------- /src/omega_m.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | %% This is the Omega monad which is like the list monad, but does not 18 | %% depth first, and not breadth first traversal. This implementation 19 | %% is based on Luke Palmer's Control.Monad.Omega module for Haskell 20 | %% (http://hackage.haskell.org/packages/archive/control-monad-omega/latest/doc/html/Control-Monad-Omega.html). As 21 | %% the documentation there states: 22 | %% 23 | %% Warning: Omega is only a monad when the results are interpreted 24 | %% as a set; that is, a valid transformation according to the monad 25 | %% laws may change the order of the results. However, the same set 26 | %% of results will always be reachable. 27 | %% 28 | 29 | -module(omega_m). 30 | 31 | -behaviour(monad). 32 | -export(['>>='/2, return/1, fail/1]). 33 | -export([diagonal/1]). 34 | 35 | -behaviour(monad_plus). 36 | -export([mzero/0, mplus/2]). 37 | 38 | 39 | -spec '>>='([A], fun( (A) -> [B] )) -> [B]. 40 | '>>='(X, Fun) -> 41 | diagonal([Fun(E) || E <- X]). 42 | 43 | 44 | -spec return(A) -> [A]. 45 | return(X) -> [X]. 46 | 47 | 48 | -spec fail(any()) -> [_A]. 49 | fail(_X) -> []. 50 | 51 | 52 | -spec mzero() -> [_A]. 53 | mzero() -> []. 54 | 55 | 56 | -spec mplus([A], [A]) -> [A]. 57 | mplus(X, Y) -> 58 | lists:append(X, Y). 59 | 60 | %% [[a, b, c, d], 61 | %% [e, f, g, h], 62 | %% [i, j, k, l], 63 | %% [m, n, o, p]]. 64 | %% 65 | %% diagonal traverses diagonally from north-west corner, heading east 66 | %% then south-west. I.e. 67 | %% [a, b, e, c, f, i, d, g, j, m, h, k, n, l, o, p] 68 | -spec diagonal([[A]]) -> [A]. 69 | diagonal(LoL) -> lists:append(stripe(LoL)). 70 | 71 | stripe([]) -> []; 72 | stripe([[]|Xss]) -> stripe(Xss); 73 | stripe([[X|Xs]|Xss]) -> [[X] | zip_cons(Xs, stripe(Xss))]. 74 | 75 | zip_cons([], Ys) -> Ys; 76 | zip_cons(Xs, []) -> [[X] || X <- Xs]; 77 | zip_cons([X|Xs], [Y|Ys]) -> [[X|Y] | zip_cons(Xs, Ys)]. 78 | -------------------------------------------------------------------------------- /src/state_t.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(state_t). 18 | -compile({parse_transform, do}). 19 | -behaviour(monad_trans). 20 | 21 | -export_type([state_t/3]). 22 | 23 | -export([new/1, '>>='/3, return/2, fail/2]). 24 | -export([get/1, put/2, eval/3, exec/3, run/3, 25 | modify/2, modify_and_return/2, lift/2]). 26 | 27 | -opaque state_t(S, M, A) :: fun( (S) -> monad:monadic(M, {A, S}) ). 28 | 29 | 30 | -spec new(M) -> TM when TM :: monad:monad(), M :: monad:monad(). 31 | new(M) -> 32 | {?MODULE, M}. 33 | 34 | 35 | -spec '>>='(state_t(S, M, A), fun( (A) -> state_t(S, M, B) ), M) -> state_t(S, M, B). 36 | '>>='(X, Fun, {?MODULE, M}) -> 37 | fun (S) -> 38 | do([M || {A, S1} <- X(S), 39 | (Fun(A))(S1)]) 40 | end. 41 | 42 | 43 | -spec return(A, M) -> state_t(_S, M, A). 44 | return(A, {?MODULE, M}) -> 45 | fun (S) -> 46 | M:return({A, S}) 47 | end. 48 | 49 | 50 | -spec fail(any(), M) -> state_t(_S, M, _A). 51 | fail(E, {?MODULE, M}) -> 52 | fun (_) -> 53 | M:fail(E) 54 | end. 55 | 56 | 57 | -spec get(M) -> state_t(S, M, S). 58 | get({?MODULE, M}) -> 59 | fun (S) -> 60 | M:return({S, S}) 61 | end. 62 | 63 | 64 | -spec put(S, M) -> state_t(S, M, ok). 65 | put(S, {?MODULE, M}) -> 66 | fun (_) -> 67 | M:return({ok, S}) 68 | end. 69 | 70 | 71 | -spec eval(state_t(S, M, A), S, M) -> monad:monadic(M, A). 72 | eval(SM, S, {?MODULE, M}) -> 73 | do([M || {A, _S1} <- SM(S), 74 | return(A)]). 75 | 76 | 77 | -spec exec(state_t(S, M, _A), S, M) -> monad:monadic(M, S). 78 | exec(SM, S, {?MODULE, M}) -> 79 | do([M || {_A, S1} <- SM(S), 80 | return(S1)]). 81 | 82 | 83 | -spec run(state_t(S, M, A), S, M) -> monad:monadic(M, {A, S}). 84 | run(SM, S, _M) -> SM(S). 85 | 86 | 87 | -spec modify(fun( (S) -> S ), M) -> state_t(S, M, ok). 88 | modify(Fun, {?MODULE, M}) -> 89 | fun (S) -> 90 | M:return({ok, Fun(S)}) 91 | end. 92 | 93 | 94 | -spec modify_and_return(fun( (S) -> {A, S} ), M) -> state_t(S, M, A). 95 | modify_and_return(Fun, {?MODULE, M}) -> 96 | fun (S) -> 97 | M:return(Fun(S)) 98 | end. 99 | 100 | 101 | -spec lift(monad:monadic(M, A), M) -> state_t(_S, M, A). 102 | lift(X, {?MODULE, M}) -> 103 | fun (S) -> 104 | do([M || A <- X, 105 | return({A, S})]) 106 | end. 107 | -------------------------------------------------------------------------------- /src/test.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(test). 18 | -export([test/2]). 19 | -compile({parse_transform, do}). 20 | 21 | test(Funs, Options) -> 22 | ErrorT = error_t:new(identity_m), 23 | Result = ErrorT:run(test_funs(ErrorT, Funs)), 24 | case proplists:get_bool(report, Options) of 25 | true -> 26 | Name = proplists:get_value(name, Options, anonymous), 27 | case Result of 28 | {ok, passed} -> 29 | io:format("Test suite '~p' passed.~n", [Name]); 30 | {error, Reason} -> 31 | io:format("Test suite '~p' failed with ~p.~n", 32 | [Name, Reason]) 33 | end; 34 | false -> 35 | ok 36 | end, 37 | case Result of 38 | {ok, passed} -> ok; 39 | _ -> Result 40 | end. 41 | 42 | 43 | test_funs(ErrorT, []) -> 44 | ErrorT:return(passed); 45 | 46 | test_funs(ErrorT, [{Module, {Label, FunName}}|Funs]) 47 | when is_atom(Module) andalso is_atom(FunName) -> 48 | do([ErrorT || hoist(ErrorT, Label, fun () -> Module:FunName() end), 49 | test_funs(ErrorT, Funs)]); 50 | 51 | test_funs(ErrorT, [{Module, FunName}|Funs]) 52 | when is_atom(Module) andalso is_atom(FunName) 53 | andalso is_function({Module, FunName}, 0) -> 54 | do([ErrorT || hoist(ErrorT, FunName, fun () -> Module:FunName() end), 55 | test_funs(ErrorT, Funs)]); 56 | 57 | test_funs(ErrorT, [{_Module, []}|Funs]) -> 58 | test_funs(ErrorT, Funs); 59 | 60 | test_funs(ErrorT, [{Module, [FunName|FunNames]}|Funs]) 61 | when is_atom(Module) andalso is_atom(FunName) -> 62 | test_funs(ErrorT, [{Module, FunName}, {Module, FunNames} | Funs]); 63 | 64 | test_funs(ErrorT, [{Label, Fun}|Funs]) when is_function(Fun, 0) -> 65 | do([ErrorT || hoist(ErrorT, Label, Fun), 66 | test_funs(ErrorT, Funs)]); 67 | 68 | test_funs(ErrorT, [Fun|Funs]) when is_function(Fun, 0) -> 69 | do([ErrorT || hoist(ErrorT, anonymous_function, Fun), 70 | test_funs(ErrorT, Funs)]). 71 | 72 | 73 | hoist(ErrorT, Label, PlainFun) -> 74 | do([ErrorT || 75 | try 76 | PlainFun(), 77 | return(passed) 78 | catch 79 | Class:Reason -> 80 | fail({Label, Class, Reason, erlang:get_stacktrace()}) 81 | end]). 82 | -------------------------------------------------------------------------------- /test/erlando_test.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is Alex Kropivny. 14 | %% Copyright (c) 2011-2013 Alex Kropivny; VMware, Inc; Eduard Sergeev. 15 | %% All rights reserved. 16 | %% 17 | 18 | -module(erlando_test). 19 | -export([all_test_/0]). 20 | 21 | all_test_() -> 22 | Modules = [test_cut, 23 | test_do, 24 | test_import_as], 25 | [{Mod,Fun} || Mod <- Modules, 26 | Fun <- extract_tests(Mod)]. 27 | 28 | extract_tests(Mod) -> 29 | [Fun || {Fun, 0} <- Mod:module_info(exports), 30 | lists:prefix("test_", atom_to_list(Fun))]. 31 | -------------------------------------------------------------------------------- /test/src/test_cut.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(test_cut). 18 | -compile({parse_transform, cut}). 19 | -compile({parse_transform, do}). 20 | 21 | -compile(export_all). 22 | 23 | -record(r, { f1 = false, 24 | f2 = wibble, 25 | f3 = juice }). 26 | 27 | test_cut() -> 28 | F0 = foo(a, b, _, 5+6, _), 29 | F1 = F0(_, e), 30 | ok = F1(c), 31 | F2 = _(1,2), 32 | 3 = F2(fun erlang:'+'/2), 33 | -1 = F2(fun erlang:'-'/2), 34 | F3 = _:foo(a, b, c, _, e), 35 | ok = F3(?MODULE, 11), 36 | F4 = _:_(_), %% this isn't getting silly at all... 37 | true = 3 == F4(math, sqrt, 9). 38 | 39 | foo(a, b, c, 11, e) -> ok. 40 | 41 | test_cut_nested() -> 42 | F = f1(1, f2(1 + _), _), 43 | %% should be: 44 | %% F = \X -> f1(1, f2(\Y -> 1 + Y), X) 45 | ok = F(3). 46 | 47 | f1(N, M, L) when N + M =:= L -> ok. 48 | f2(Nf) -> Nf(1). 49 | 50 | test_cut_op() -> 51 | F = 1 + _, 52 | 3 = F(2). 53 | 54 | test_cut_unary_op() -> 55 | F = -_, 56 | 0 = 1 + F(1). 57 | 58 | test_cut_tuple() -> 59 | {foo, _} = {foo, F} = {foo, {bar, _}}, 60 | {bar, qux} = F(qux). 61 | 62 | test_cut_record() -> 63 | true = #r{} =/= #r{f3 = _}, 64 | orange = ((#r{f3 = _})(orange))#r.f3, 65 | {r, foo, bar, baz} = (#r{f1 = _, f3 = _, f2 = _})(foo, baz, bar), 66 | R = #r{}, 67 | F = R#r{f3 = _, f2 = _}, 68 | wobble = (F(orange, wobble))#r.f2, 69 | Getter = _#r.f2, 70 | wibble = Getter(R), 71 | Setter = _#r{f2 = gerbil}, 72 | gerbil = Getter(Setter(R)), 73 | Setter2 = _#r{f2 = _}, 74 | hamster = Getter(Setter2(R, hamster)). 75 | 76 | test_cut_record_nested() -> 77 | F = #r{f1 = #r{f1 = _, f3 = _}, f2 = _}, 78 | R = F(apple), 79 | F1 = R#r.f1, 80 | #r{f1 = orange, f3 = banana} = F1(orange, banana). 81 | 82 | test_cut_map() -> 83 | true = #{} =/= #{f3 => _}, 84 | orange = maps:get(f3, (#{f3 => _})(orange)), 85 | #{f1 := foo, f2 := bar, f3 := baz} 86 | = (#{f1 => _, f3 => _, f2 => _})(foo, baz, bar), 87 | M = #{f1 => false, f2 => wibble, f3 => juice}, 88 | F = M#{f3 => _, f2 => _}, 89 | wobble = maps:get(f2, F(orange, wobble)), 90 | Getter = maps:get(f2, _), 91 | wibble = Getter(M), 92 | Setter = _#{f2 := gerbil}, 93 | gerbil = Getter(Setter(M)), 94 | Setter2 = _#{f2 := _}, 95 | hamster = Getter(Setter2(M, hamster)). 96 | 97 | test_cut_map_nested() -> 98 | F = #{f1 => #{f1 => _, f3 => _}, f2 => _}, 99 | M = F(apple), 100 | F1 = maps:get(f1, M), 101 | #{f1 := orange, f3 := banana} = F1(orange, banana). 102 | 103 | test_cut_binary() -> 104 | <<"AbA", _/binary>> = (<<65, _, 65>>)($b), 105 | F = <<_:_>>, 106 | G = F(15, _), 107 | <<>> = G(0), 108 | <<1:1/unsigned, 1:1/unsigned, 1:1/unsigned, 1:1/unsigned>> = G(4). 109 | 110 | test_cut_list() -> 111 | F = [_|_], 112 | [a,b] = F(a,[b]), 113 | G = [_, _ | [33]], 114 | [a,b,33] = G(a,b), 115 | 116 | H = [1, _, _, [_], 5 | [6, [_] | [_]]], 117 | %% This is the same as: 118 | %% [1, _, _, [_], 5, 6, [_], _] 119 | %% And thus becomes 120 | %% \A, B, C -> [1, A, B, \D -> [D], 5, 6, \E -> [E], C] 121 | [1, 2, 3, H1, 5, 6, H2, 8] = H(2, 3, 8), 122 | [4] = H1(4), 123 | [7] = H2(7), 124 | 125 | I = [_, [_]], 126 | [a, I1] = I(a), 127 | [b] = I1(b). 128 | 129 | test_cut_case() -> 130 | F = case _ of 131 | N when is_integer(N) andalso 0 =:= (N rem 2) -> 132 | even; 133 | N when is_integer(N) -> 134 | odd; 135 | _ -> 136 | not_a_number 137 | end, 138 | even = F(1234), 139 | odd = F(6789), 140 | not_a_number = F(my_atom). 141 | 142 | test_cut_comprehensions() -> 143 | F = << <<(1 + (X*2))>> || _ <- _, X <- _ >>, %% Note, this'll only be a /2 ! 144 | <<"AAA">> = F([a,b,c], [32]), 145 | F1 = [ {X, Y, Z} || X <- _, Y <- _, Z <- _, 146 | math:pow(X,2) + math:pow(Y,2) == math:pow(Z,2) ], 147 | [{3,4,5}, {4,3,5}, {6,8,10}, {8,6,10}] = 148 | lists:usort(F1(lists:seq(1,10), lists:seq(1,10), lists:seq(1,10))). 149 | 150 | test_cut_named_fun() -> 151 | Add = _ + _, 152 | Fib = fun Self (0) -> 1; 153 | Self (1) -> 1; 154 | Self (N) -> (Add(_, _))(N, Self(N-1)) 155 | end, 156 | true = (Fib(_))(10) =:= 55. 157 | 158 | test() -> 159 | test:test([{?MODULE, [test_cut, 160 | test_cut_nested, 161 | test_cut_op, 162 | test_cut_unary_op, 163 | test_cut_tuple, 164 | test_cut_map, 165 | test_cut_map_nested, 166 | test_cut_record, 167 | test_cut_record_nested, 168 | test_cut_binary, 169 | test_cut_list, 170 | test_cut_case, 171 | test_cut_comprehensions, 172 | test_cut_named_fun]}], 173 | [report, {name, ?MODULE}]). 174 | -------------------------------------------------------------------------------- /test/src/test_do.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc; Eduard Sergeev. 15 | %% All rights reserved. 16 | %% 17 | 18 | -module(test_do). 19 | -compile({parse_transform, do}). 20 | 21 | -compile(export_all). 22 | 23 | test_sequence() -> 24 | List = lists:seq(1,5), 25 | ListM = [do([maybe_m || return(N)]) || N <- List], 26 | {just, List} = monad:sequence(maybe_m, ListM). 27 | 28 | test_join() -> 29 | {just, 5} = monad:join(maybe_m, 30 | maybe_m:return(maybe_m:return(5))), 31 | {just, 5} = monad:join(maybe_m, 32 | do([maybe_m || return(maybe_m:return(5))])), 33 | {just, 5} = monad:join(maybe_m, 34 | do([maybe_m || return(do([maybe_m || return(5)]))])). 35 | 36 | test_maybe() -> 37 | nothing = maybe(atom), 38 | {just, 9} = maybe(3). 39 | 40 | maybe(Arg) -> 41 | do([maybe_m 42 | || monad_plus:guard(maybe_m, is_number(Arg)), 43 | return(Arg*Arg)]). 44 | 45 | test_fib() -> 46 | true = lists:all(fun ({X, Y}) -> X =:= Y end, 47 | [{fib_m(N), fib_rec(N)} || N <- lists:seq(0, 20)]). 48 | 49 | %% Classic monadic implementation of fibonnaci 50 | fib_m(N) -> 51 | StateT = state_t:new(identity_m), 52 | {_, R} = StateT:exec( 53 | monad:sequence(StateT, 54 | lists:duplicate(N, fib_m_step(StateT))), {0, 1}), 55 | R. 56 | 57 | fib_m_step(StateT) -> StateT:modify(fun ({X, Y}) -> {Y, X+Y} end). 58 | 59 | %% Classic recursive implementation of fibonnaci 60 | fib_rec(N) when N >= 0 -> fib_rec(N, 0, 1). 61 | fib_rec(0, _X, Y) -> Y; 62 | fib_rec(N, X, Y) -> fib_rec(N-1, Y, X+Y). 63 | 64 | test_list() -> 65 | %% Demonstrate equivalence of list comprehensions and list monad 66 | A = [{X,Y} || X <- "abcd", 67 | Y <- [1,2]], 68 | A = do([list_m || X <- "abcd", 69 | Y <- [1,2], 70 | return({X,Y})]), 71 | %% Classic pythagorean triples 72 | P = [{X, Y, Z} || Z <- lists:seq(1,20), 73 | X <- lists:seq(1,Z), 74 | Y <- lists:seq(X,Z), 75 | math:pow(X,2) + math:pow(Y,2) == math:pow(Z,2)], 76 | P = do([list_m || Z <- lists:seq(1,20), 77 | X <- lists:seq(1,Z), 78 | Y <- lists:seq(X,Z), 79 | monad_plus:guard( 80 | list_m, math:pow(X,2) + math:pow(Y,2) == math:pow(Z,2)), 81 | return({X,Y,Z})]). 82 | 83 | test_omega() -> 84 | A = [{X,Y,Z} || X <- "abcd", 85 | Y <- lists:seq(1,5), 86 | Z <- lists:seq(11,15)], 87 | B = do([omega_m || X <- "abcd", 88 | Y <- lists:seq(1,5), 89 | Z <- lists:seq(11,15), 90 | return({X,Y,Z})]), 91 | true = A =/= B, 92 | true = A =:= lists:usort(B). 93 | 94 | test_error_t_list() -> 95 | M = error_t:new(list_m), 96 | R = M:run(do([M || E1 <- M:lift([1, 2, 3]), 97 | E2 <- M:lift([4, 5, 6]), 98 | case (E1 * E2) rem 2 of 99 | 0 -> return({E1, E2}); 100 | _ -> fail(not_even_product) 101 | end])), 102 | R = [{ok, {1, 4}}, {error, not_even_product}, {ok, {1, 6}}, 103 | {ok, {2, 4}}, {ok, {2, 5}}, {ok, {2, 6}}, 104 | {ok, {3, 4}}, {error, not_even_product}, {ok, {3, 6}}], 105 | 106 | %% Compare with the non-error_t version, which will remove failures: 107 | S = do([list_m || E1 <- [1, 2, 3], 108 | E2 <- [4, 5, 6], 109 | case (E1 * E2) rem 2 of 110 | 0 -> return({E1, E2}); 111 | _ -> fail(not_even_product) 112 | end]), 113 | S = [{1, 4}, {1, 6}, {2, 4}, {2, 5}, {2, 6}, {3, 4}, {3, 6}]. 114 | 115 | %% Tests for 'let-match binding' (a-la 'let' in Haskell's 'do' 116 | %% expression) But instead of 'let' here we use 'match' (=) expression 117 | %% in 'do([])': 118 | test_let_match() -> 119 | T1 = do([maybe_m || R <- return(2), 120 | R2 = R*R, 121 | return(R2*R2)]), 122 | T1 = do([maybe_m || R <- return(2), 123 | return(R*R*R*R)]), 124 | %% Failure test 125 | T2 = do([error_m || A <- return(42), 126 | {B,C} <- fail(test), 127 | BC = B*C, 128 | return(BC+A)]), 129 | T2 = do([error_m || A <- return(42), 130 | {B,C} <- fail(test), 131 | return(B*C+A)]), 132 | 133 | Fun = fun({X,Y}) -> {Y,X} end, %% Mysterious function 134 | T3 = do([error_m || R <- return({1,42}), 135 | {R1,R2} = Fun(R), 136 | return(R1+R2)]), 137 | T3 = do([error_m || R <- return({1,42}), 138 | %% No better way without 'let'? 139 | %% Well, only via extra 'return' 140 | return(element(1,Fun(R)) + element(2,Fun(R)))]), 141 | 142 | DivRem = fun(N,M) -> {N div M,N rem M} end, 143 | T4 = do([error_m || {N,M} <- return({42,3}), 144 | {D,R} = DivRem(N,M), 145 | E <- T3, 146 | S = D+R+E, 147 | return({D,R,S})]), 148 | T4 = do([error_m || {N,M} <- return({42,3}), 149 | %% Can hack it with extra 'return' (and '>>=' 150 | %% as result) 151 | {D,R} <- return(DivRem(N,M)), 152 | E <- T3, 153 | return({D,R,D+R+E})]), 154 | 155 | T5 = do([list_m || X <- [1,2,3], 156 | X2 = X*X, 157 | Y <- lists:seq(1,X2), 158 | Y2 = {Y,X2}, 159 | Z = Y + X2, 160 | return({X2,Y,Y2,Z})]), 161 | T5 = do([list_m || X <- [1,2,3], 162 | Y <- lists:seq(1,X*X), 163 | return({X*X,Y,{Y,X*X},Y+X*X})]). 164 | 165 | test_let_first() -> 166 | M = do([list_m || A = 3, 167 | X <- [1,2,A], 168 | Y <- [A,A+1], 169 | return({X,Y})]), 170 | M = fun() -> 171 | A = 3, 172 | do([list_m || X <- [1,2,A], 173 | Y <- [A,A+1], 174 | return({X,Y})]) 175 | end(). 176 | 177 | test_let_escapes() -> 178 | M1 = do([maybe_m || A = 5, 179 | return(A)]), 180 | M2 = do([maybe_m || A = 6, 181 | return(A)]), 182 | M1 = do([maybe_m || return(5)]), 183 | M2 = do([maybe_m || return(6)]), 184 | 185 | %% Demonstrate that bindings do not escape. 186 | M3 = do([maybe_m || return(_A = 5)]), 187 | M3 = do([maybe_m || return((_A = 7) - 2)]), 188 | _A = 6. 189 | 190 | test_named_fun() -> 191 | Fib = fun Self (0) -> identity_m:return(1); 192 | Self (1) -> identity_m:return(1); 193 | Self (N) -> do([identity_m || M <- Self(N-1), 194 | return(N+M)]) 195 | end, 196 | true = Fib(10) =:= 55. 197 | 198 | test_maps() -> 199 | M1 = do([maybe_m || A = #{ a => b }, 200 | X <- return(A), 201 | Y <- return(X#{ a := c, b => d }), 202 | return(Y) 203 | ]), 204 | {just, #{ a := c, b := d }} = M1. 205 | 206 | test() -> 207 | test:test([{?MODULE, [test_sequence, 208 | test_join, 209 | test_maybe, 210 | test_fib, 211 | test_list, 212 | test_omega, 213 | test_error_t_list, 214 | test_let_match, 215 | test_let_first, 216 | test_let_escapes, 217 | test_nemd_fun, 218 | test_maps]}], 219 | [report, {name, ?MODULE}]). 220 | -------------------------------------------------------------------------------- /test/src/test_import_as.erl: -------------------------------------------------------------------------------- 1 | %% The contents of this file are subject to the Mozilla Public License 2 | %% Version 1.1 (the "License"); you may not use this file except in 3 | %% compliance with the License. You may obtain a copy of the License 4 | %% at http://www.mozilla.org/MPL/ 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and 9 | %% limitations under the License. 10 | %% 11 | %% The Original Code is Erlando. 12 | %% 13 | %% The Initial Developer of the Original Code is VMware, Inc. 14 | %% Copyright (c) 2011-2013 VMware, Inc. All rights reserved. 15 | %% 16 | 17 | -module(test_import_as). 18 | 19 | -compile({parse_transform, import_as}). 20 | -compile({parse_transform, cut}). 21 | 22 | -import_as({lists, [{seq/3, ls}]}). 23 | -import_as([{lists, [{seq/2, ls}, {sum/1, sum}]}, {lists, [{reverse/1, rev}]}]). 24 | 25 | -export([test_import_as/0, test/0]). 26 | 27 | test_import_as() -> 28 | L = rev(lists:seq(1, 10)), 29 | L = lists:reverse(ls(1, 10)), 30 | L = rev(ls(1, 10)), 31 | Fun1 = rev(_), 32 | [c, b, a] = Fun1([a, b, c]), 33 | Fun2 = fun rev/1, 34 | [b, a] = Fun2([a, b]), 35 | [1, 3, 5, 7, 9] = ls(1, 10, 2), 36 | 25 = sum(rev(ls(1, 10, 2))). 37 | 38 | test() -> 39 | test:test([{?MODULE, [test_import_as]}], [report, {name, ?MODULE}]). 40 | --------------------------------------------------------------------------------