├── .gitattributes ├── .gitignore ├── .travis.yml ├── AUTHORS ├── COPYING ├── ChangeLog.org ├── Makefile ├── README.md ├── TODO.org ├── Tour.md ├── code_of_conduct.md ├── epo ├── make-release.sh ├── priv └── lang │ ├── alpaca.de_DE.po │ ├── alpaca.en_US.po │ ├── alpaca.es_MX.po │ └── alpaca.pot ├── rebar.config ├── rebar.lock ├── src ├── alpaca.app.src ├── alpaca.erl ├── alpaca.hrl ├── alpaca_app.erl ├── alpaca_ast.hrl ├── alpaca_ast_gen.erl ├── alpaca_codegen.erl ├── alpaca_error_format.erl ├── alpaca_exhaustiveness.erl ├── alpaca_parser.yrl ├── alpaca_printer.erl ├── alpaca_scan.xrl ├── alpaca_scanner.erl ├── alpaca_sup.erl ├── alpaca_typer.erl ├── ast.erl └── builtin_types.hrl ├── test ├── alpaca_SUITE.erl ├── error.alp └── stacktrace_tests.erl └── test_files ├── alpaca_format.alp ├── alpaca_native_ast.alp ├── apply_to_expression.alp ├── asserts.alp ├── basic_adt.alp ├── basic_binary.alp ├── basic_compile_file.alp ├── basic_map_test.alp ├── basic_math.alp ├── basic_module_with_tests.alp ├── basic_pid_test.alp ├── basic_type_signature.alp ├── batch_export.alp ├── circles.alp ├── comments.alp ├── curry.alp ├── curry_import.alp ├── default.alp ├── destructuring.alp ├── dictionary.alp ├── different_clause_styles.alp ├── error_tests.alp ├── exhaustiveness_cases.alp ├── export_all_arities.alp ├── failing_test.alp ├── forward_label_reference.alp ├── function_pattern_args.alp ├── future_ast.alp ├── higher_order_functions.alp ├── import_test.alp ├── lambda_examples.alp ├── lambda_in_test.alp ├── list_items.alp ├── list_opts.alp ├── multiple_underscore_test.alp ├── option_example.alp ├── polymorphic_record_test.alp ├── radius.alp ├── receiver_type.alp ├── record_map_match_order.alp ├── records_with_x.alp ├── same_name_diff_arity.alp ├── simple_example.alp ├── simple_records.alp ├── string_concat.alp ├── tests_and_imports.alp ├── type_import.alp ├── unexported_adts.alp ├── update_record.alp ├── use_default.alp ├── use_lambda.alp ├── use_option.alp ├── use_radius.alp ├── use_update_record.alp └── values.alp /.gitattributes: -------------------------------------------------------------------------------- 1 | *.alp linguist-language=OCaml 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .rebar3 2 | _* 3 | .eunit 4 | *.o 5 | *.beam 6 | *.plt 7 | *.swp 8 | *.swo 9 | .erlang.cookie 10 | ebin 11 | log 12 | erl_crash.dump 13 | .rebar 14 | _rel 15 | _deps 16 | _plugins 17 | _tdeps 18 | logs 19 | _build 20 | /src/mlfe_parser.erl 21 | /src/mlfe_scan.erl 22 | /src/alpaca_parser.erl 23 | /src/alpaca_scan.erl 24 | /src/alpaca_compiled_po.erl 25 | /priv/lang/*.mo 26 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: erlang 2 | install: 'true' 3 | otp_release: 4 | - 20.0 5 | - 19.3 6 | env: 7 | global: 8 | - REBAR_VSN=3.4.3 9 | - PATH=./rebar3-$REBAR_VSN:$PATH 10 | - ALPACA_VERSION_TO_USE=v0.2.8 11 | - ALPACA_BASE_URL=https://github.com/alpaca-lang/alpaca/releases/download/$ALPACA_VERSION_TO_USE 12 | cache: 13 | directories: 14 | - .rebar3-$REBAR_VSN 15 | - /home/travis/.cache/rebar3 16 | before_install: 17 | - if [ ! -f rebar3-$REBAR_VSN/rebar3 ]; then wget --no-check-certificate https://github.com/erlang/rebar3/archive/$REBAR_VSN.tar.gz; 18 | fi 19 | - if [ -f $REBAR_VSN.tar.gz ]; then tar xvzf $REBAR_VSN.tar.gz; fi 20 | - cd rebar3-$REBAR_VSN 21 | - if [ ! -f ./rebar3 ]; then ./bootstrap; fi 22 | - cd .. 23 | before_script: [] 24 | script: 25 | - export ALPACA_BASE=alpaca_${TRAVIS_OTP_RELEASE} 26 | - export ALPACA_PKG=${ALPACA_BASE}.tgz 27 | - export ALPACA_TO_USE=${ALPACA_BASE_URL}/${ALPACA_PKG} 28 | - wget $ALPACA_TO_USE 29 | - tar xvzf $ALPACA_PKG 30 | - export ALPACA_ROOT=`pwd`/alpaca-${ALPACA_VERSION_TO_USE}_${TRAVIS_OTP_RELEASE} 31 | - echo "ALPACA_ROOT is set to ${ALPACA_ROOT}" 32 | - make full_build 33 | - bash ./make-release.sh 34 | before_deploy: 35 | - export RELEASE_ARTIFACT=$(ls alpaca*.tgz) 36 | - echo "Deploying $RELEASE_ARTIFACT to GitHub" 37 | deploy: 38 | provider: releases 39 | api_key: 40 | secure: BAZxkGa98jJ6+JurzaUuGKO9pcuatjh0TMKLxSnYarVrikb9xWnM/wmmn2ajCvTgcl8wYppbQEpcgCJLb6m6ZI9L9ZBksii9ECacp2x2vDrGZ0QBhM/0tg9aHvUAhn7U2FRszqZwGnYlx/7Vb2hZ7Y8S3ojqLuuzturjRjtMkEPhLuLcHEAB/BPiqkdF/b0BRHGvYH2OhIyK4LKejSVL59sSRMzpt9x1c8r9+p6z12IHcsgek0vjQsmUJP3f4bE10FKRQkHBkzIOIqfSMFQ3+Ss/oVhWdHFRq47yfcPHiDAdU3UeVREHjMElRoqi6smJ7YSiyNMGWWS8ZmWjAi+nz/HNM4hdkCwy/GYlyjHjnjZR+fpHAyblHG3cphrpT6sBKZ2I9aC7sjoVIJWd6MShlaI929zKSxnqTzchPc8RL1qHD2vLaTtYiQ0tI7vJ01sCm9X2QpaYMvm46awhEmf3yl4b+Be0vUW/BLNvKBNQzmQ7Q+RaSrkA4USGu4Ilb4mH9jAX3evngJ0zkua/E4bWZ19oD0BJXoui2wzRiNhXJR8VCHVESji9R0Rp6yVhE3Mme0j1ssCMUDbQvBXptKe7HNDIpFcpGgTitWJZKXAE6+wUe8kadeMsU1nVhMkMFrVganrKZvieHIXWLsCYZqseGWOKkDYlaWvezljFbHzpGLU= 41 | file: "${RELEASE_ARTIFACT}" 42 | repo: alpaca-lang/alpaca 43 | skip_cleanup: true 44 | on: 45 | tags: true 46 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | In alphabetic order: 2 | 3 | Daniel Abrahamsson - https://github.com/danab 4 | Dave Jeffrey - https://github.com/lepoetemaudit 5 | Eric Bailey - https://github.com/yurrriq 6 | Jamu Kakar - https://github.com/jkakar 7 | Jeremy Pierre - https://github.com/j14159 8 | Norbert Melzer - https://github.com/Nobbz 9 | Radosław Szymczyszyn - https://github.com/erszcz 10 | Tilman Holschuh - https://github.com/ypaq 11 | Tuncer Ayaz - https://github.com/tuncer 12 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | Copyright 2016 Jeremy Pierre 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /ChangeLog.org: -------------------------------------------------------------------------------- 1 | * v0.2.8 2 | Newest to oldest additions in each section. 3 | 4 | ** New 5 | - destructure/pattern match in ~let~ bindings, [[https://github.com/j14159][j14159]] 6 | - ~alpaca_printer~, type formatting and printing for compiler feedback, [[https://github.com/lepoetemaudit][lepoetemaudit]] 7 | - build for OTP 20, [[https://github.com/getong][getong]] 8 | - logical operators (and, or, xor), [[https://github.com/Licenser][Licenser]] 9 | - explicit type signatures for top-level bindings, e.g. ~val add: fn int int -> int~, [[https://github.com/lepoetemaudit][lepoetemaudit]] 10 | - nicely formatted and humane compiler output with colours, [[https://github.com/Licenser][Licenser]] 11 | - local/inner functions can be curried, [[https://github.com/lepoetemaudit][lepoetemaudit]] 12 | - able to specify default types and functions to be imported in a project, [[https://github.com/lepoetemaudit][lepoetemaudit]] 13 | - infix functions starting with ~<~ are now right-associative, [[https://github.com/lepoetemaudit][lepoetemaudit]] 14 | - generate a module's dependencies from source to support partial compilation, [[https://github.com/lepoetemaudit][lepoetemaudit]] 15 | - support loading of pre-compiled ~BEAM~ files rather than requiring every module in source form, [[https://github.com/lepoetemaudit][lepoetemaudit]] 16 | - quoted atoms, [[https://github.com/lepoetemaudit][lepoetemaudit]] 17 | - German error message translation, [[https://github.com/ypaq][ypaq]] 18 | - Spanish error message translation, [[https://github.com/arpunk][arpunk]] and [[https://github.com/yurrriq][yurrriq]] 19 | - symbol, integer, and float AST nodes defined in Alpaca itself, [[https://github.com/j14159][j14159]] 20 | - enable internationalization and formatting of error messages, [[https://github.com/danabr][danabr]] 21 | 22 | ** Fixes 23 | - wildcard variables (the `_` variable) in function head matches are now renamed properly, [[https://github.com/j14159][j14159]] 24 | - partial record matching works, no more cycles in reference cells, [[https://github.com/j14159][j14159]] 25 | - type inferencer reference cells in ETS, no more processes, [[https://github.com/j14159][j14159]] 26 | - unsized binaries work correctly when constructing binaries, [[https://github.com/lepoetemaudit][lepoetemaudit]] 27 | - simple expressions don't require parens, e.g. ~[1 + 2, 3 + 4]~, [[https://github.com/lepoetemaudit][lepoetemaudit]] 28 | - lambdas inside match expressions now work correctly, [[https://github.com/lepoetemaudit][lepoetemaudit]] 29 | - don't re-type modules for every module-qualified function call, [[https://github.com/lepoetemaudit][lepoetemaudit]] 30 | - correctly rewrite the internals of unbound lambdas, [[https://github.com/j14159][j14159]] 31 | - don't perform exhaustiveness checks on already-compiled modules, [[https://github.com/lepoetemaudit][lepoetemaudit]] 32 | - fix unification failure for nested ADTs, [[https://github.com/j14159][j14159]] 33 | - ~fn~ as a reserved word in tests, [[https://github.com/Licenser][Licenser]] 34 | - purge warnings removed for cleaner test output, [[https://github.com/Licenser][Licenser]] 35 | - substantial test and warnings cleanup, [[https://github.com/Licenser][Licenser]] 36 | - fixed variable lookup failure in exhaustiveness checks, [[https://github.com/j14159][j14159]] 37 | - broken BIF fixes (~!=~, ~/~), [[https://github.com/lepoetemaudit][lepoetemaudit]] 38 | - fix lambdas in records, [[https://github.com/j14159][j14159]] 39 | - properly escape ~\~ sequences in strings, [[https://github.com/lepoetemaudit][lepoetemaudit]] 40 | - usage example correction, [[https://github.com/monkeygroover][monkeygroover]] 41 | - rewrite imported functions in tests, [[https://github.com/j14159][j14159]] 42 | - rewrite lambdas in tests, [[https://github.com/j14159][j14159]] 43 | - allow forward references to top-level bindings, [[https://github.com/j14159][j14159]] 44 | - parameterized ~pid~ type fix when using ~is_pid~, [[https://github.com/j14159][j14159]] 45 | 46 | * v0.2.7 47 | ** New 48 | - parser and AST generation errors report in a uniform manner and are specified, https://github.com/danabr 49 | - lambdas (anonymous functions), https://github.com/j14159 50 | - function type specs have same syntax as lambdas, https://github.com/danabr 51 | - generation ~test/0~ for EUnit, https://github.com/j14159 52 | 53 | ** Fixes 54 | - correct arity for curried versions of functions, https://github.com/lepoetemaudit 55 | - built-in types are no longer reserved words, https://github.com/danabr 56 | - type arity errors unified, https://github.com/danabr 57 | - bad variables in errors (throw, error, exit) are errors, https://github.com/j14159 58 | - all parser and AST generation errors include line numbers, https://github.com/danabr 59 | - line numbers for module definitions, https://github.com/danabr 60 | - line numbers for unexported functions, https://github.com/danabr 61 | - all clauses can lead with a ~|~, https://github.com/j14159 62 | 63 | * v0.2.6 64 | ** New 65 | - top-level ~let~ deprecates all significant whitespace, https://github.com/lepoetemaudit 66 | - same function name allowed for different arity, https://github.com/j14159 67 | - Alpaca's compiled modules prefixed with ~alpaca_~, https://github.com/lepoetemaudit 68 | - zero-arity functions constrained to literals for use as values, https://github.com/lepoetemaudit 69 | - property-based testing with PropEr, generates full modules for testing, https://github.com/ypaq 70 | - import functions from other modules, https://github.com/j14159 71 | - exhaustiveness checking for top-level functions, https://github.com/danabr 72 | - functions as ADT members, https://github.com/danabr 73 | - automatic currying of top-level functions, https://github.com/lepoetemaudit 74 | - type aliases for arrow types, https://github.com/danabr 75 | - record transformations, https://github.com/j14159 76 | 77 | ** Fixes 78 | - apply arguments to an expression that evaluates to a function, https://github.com/j14159 79 | - many whitespace fixes, https://github.com/lepoetemaudit and https://github.com/ypaq 80 | - unused code and warnings cleanup, https://github.com/jkakar 81 | - FFI calls must refer to missing variables, https://github.com/danabr 82 | - unit value code generation, https://github.com/danabr 83 | - reduced number of reserved words, https://github.com/danabr 84 | - module-qualified constructors and types default to private, https://github.com/j14159 85 | - more obvious typing of higher order types, https://github.com/danabr 86 | - unified internal types for lists and maps, https://github.com/danabr 87 | - referring to nonexistent types and type variables are errors, https://github.com/j14159 88 | - unified error handling in AST generation, https://github.com/danabr 89 | 90 | * v0.2.5 91 | - early infix function support (operators, e.g. ~|>~) from https://github.com/lepoetemaudit 92 | - multiple instances of ~_~ permitted in patterns 93 | - ~throw/1~, ~exit1/~, and ~error/1~ are now available 94 | - patterns in function arguments, e.g. ~g f Some x = Some (f x)~ or ~get_x {x=x} = x~ 95 | - types default to private in their defining module with explicit export and import in others 96 | - minor type inferencer fixes for records and tuples 97 | 98 | * v0.2.4 99 | - fixes for type aliases and unions involving them: https://github.com/danabr 100 | - early record support with row polymorphism 101 | - fixes for unification of the value type portion of maps 102 | * v0.2.3 103 | - comment syntax fixes: https://github.com/danabr 104 | - formatting and cleanup: https://github.com/tuncer 105 | - polymorphic ADT unification fix: https://github.com/danabr 106 | - renamed ~call_erlang~ to ~beam~ for clarity: https://github.com/tuncer 107 | - built-in parametric types (e.g. list, map) can be parameterized by ADTs: https://github.com/danabr 108 | - fix for polymorphic process spawning: https://github.com/j14159 109 | * v0.2.2 110 | - Haskell-style comments, from https://github.com/tuncer 111 | - nested comments are errors, from https://github.com/yurrriq 112 | - file renaming (cleanup) from https://github.com/tuncer (scanner -> mlfe_scanner) 113 | - new compiler entry points from https://github.com/tuncer 114 | * v0.2.1 115 | - unary minus fix (parser corrections) from https://github.com/danabr. Makes ~symbol-1~ work as ~symbol - 1~ does. 116 | * v0.2.0 117 | - dialyzer and xref fixes, Travis CI integration, courtesy of https://github.com/NobbZ 118 | - module_info synthesized by the compiler, courtesy of https://github.com/erszcz 119 | - typos and clarifications from https://github.com/tjweir, https://github.com/saem, https://github.com/ypaq, https://github.com/omarkj, https://github.com/yurrriq 120 | - binaries, thanks to https://github.com/yurrriq and https://github.com/talentdeficit for feedback and ideas 121 | - basic map support 122 | - change to `spawn` syntax, it now takes a (syntactic) function application instead of function and arg list, thanks to https://github.com/ypaq for feedback 123 | - a "language tour" document, thanks to https://github.com/ypaq and https://github.com/saem for initial feedback and corrections 124 | - a simple unit test form/hook for creating basic EUnit-compatible tests 125 | - UTF-8 strings, compiled as binaries 126 | - character lists for Erlang string support 127 | - lots of little type inferencer/checker fixes 128 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | LOCAL_VERSION=alpaca-test 2 | ALPACA=alpaca-${LOCAL_VERSION} 3 | 4 | clean: 5 | rm -rf alpaca-${LOCAL_VERSION} 6 | rebar3 clean 7 | 8 | compile: 9 | rebar3 compile 10 | VERSION=${LOCAL_VERSION} bash ./make-release.sh 11 | 12 | eunit: 13 | ALPACA_ROOT=${ALPACA} rebar3 eunit 14 | 15 | full_build: clean compile 16 | ALPACA_ROOT=${ALPACA} rebar3 compile 17 | ALPACA_ROOT=${ALPACA} rebar3 xref 18 | ALPACA_ROOT=${ALPACA} rebar3 eunit 19 | ALPACA_ROOT=${ALPACA} rebar3 ct 20 | ALPACA_ROOT=${ALPACA} rebar3 as default compile 21 | -------------------------------------------------------------------------------- /TODO.org: -------------------------------------------------------------------------------- 1 | * Records 2 | Along the lines of row polymorphism in OCaml and Elm. We should be able to specify concrete record types up front but also create them in an ad-hoc manner. Addition and removal of record members is not something I'm planning on including at the moment. 3 | 4 | Up front: 5 | #+BEGIN_SRC 6 | type rec1 = {x: float, y: int, z: atom} 7 | type rec2 = {x: float, y: int} 8 | 9 | -- call this with any mix of rec1 and rec2: 10 | add_two_xs a b = 11 | match (a, b) with 12 | ({x = x1}, {x = x2}) -> x1 + x2 13 | #+END_SRC 14 | 15 | Or ad-hoc: 16 | #+BEGIN_SRC 17 | add_two_xs a b = 18 | match (a, b) with 19 | ({x = x1}, {x = x2}) -> x1 + x2 20 | 21 | {- Results in the integer `3` without any specific record types 22 | defined prior to this call: 23 | -} 24 | add_two_xs {x=2, y=3} {x=1} 25 | #+END_SRC 26 | 27 | Compiling records as maps probably is easiest but in talking with others there seems to be a case (speed, natural ordering) for compiling to tuples at the expense of more compiler-generated code. This precludes binary dependencies as the compiler must be able to build record handling code for any records sent from a user's program to a dependency that expects records. 28 | 29 | A compiler switch to optionally compile to maps might be helpful for those concerned with hot code reloading. 30 | 31 | Initial compilation support is targetting only maps as this is the fastest path to deliver something we can actually try out. 32 | 33 | Still TODO: 34 | - field punning, ~{x, y}~ in a match instead of ~{x=x1, y=y1}~ so we don't have to bind completely separate variable names when there's no overlap. 35 | - field access, e.g. ~foo.x~ to access the ~x~ member instead of needing a pattern match to get to it. 36 | - compilation to tuples. This will require keeping a global record of all explicit (and distinct) record instantiations from each module so that we can generate every pattern required. 37 | 38 | * Type Ascriptions/Specifications 39 | It would be good if we could *partially* specify the types of functions, leaving it up to the inferencer to fill in the blanks. There are two options at the moment: 40 | - types as part of documentation 41 | - separate type specifications (somewhat like Haskell) 42 | 43 | I currently prefer the former so that documentation correctness has the capability to be somewhat enforced. 44 | 45 | ** Types In Documentation 46 | Use doc strings to specify types so that the correctness of documentation is enforced: 47 | #+BEGIN_SRC 48 | type even_odd = Even int | Odd int 49 | 50 | {- Determine if @x[int] is even or odd. -} 51 | f x = match x % 2 with 52 | 0 -> Even x 53 | | _ -> Odd x 54 | #+END_SRC 55 | In the above example, we specify that ~x~ must be an integer and leave it up to the inferencer to figure out the return type. The following change should *fail* to type-check and thus not compile: 56 | #+BEGIN_SRC 57 | type even_odd = Even int | Odd int 58 | 59 | {- Determine if @x[float] is even or odd. 60 | 61 | Because @x must be an integer to work with the modulo operator (%), 62 | this documentation string and the method are at odds so this should 63 | fail to type. 64 | -} 65 | f x = match x % 2 with 66 | 0 -> Even x 67 | | _ -> Odd x 68 | #+END_SRC 69 | 70 | Fully specified, something like the following: 71 | #+BEGIN_SRC 72 | type even_odd = Even int | Odd int 73 | 74 | {- Determine if @x[int] is even or odd. 75 | @return[even_odd] 76 | -} 77 | f x = match x % 2 with 78 | 0 -> Even x 79 | | _ -> Odd x 80 | #+END_SRC 81 | 82 | This approach requires the full integration of comments into the AST. 83 | 84 | ** Separate Specifications 85 | Alternatively we could use fairly typical specifications that still allow for partially specifying types when it's convenient. Using the same example: 86 | #+BEGIN_SRC 87 | type even_odd = Even int | Odd int 88 | 89 | f x = match x % 2 with 90 | 0 -> Even x 91 | | _ -> Odd x 92 | #+END_SRC 93 | 94 | In the above it would be convenient if any of the following would work: 95 | #+BEGIN_SRC 96 | -- let the inferencer figure out the return type: 97 | f: int -> _ 98 | 99 | -- let the inferencer figure out the parameter type: 100 | f: _ -> even_odd 101 | 102 | -- be explicit: 103 | f: int -> even_odd 104 | #+END_SRC 105 | Records 106 | 107 | * ML-style Signatures, Modules, and Functors 108 | All of these will be useful and signatures with modules could form the basis of something like behaviours (compile modules to actual modules with a namespace prefix). 109 | 110 | It would be good if modules could be inferenced, to that end [[https://www.mpi-sws.org/~rossberg/1ml/][1ML]]'s approach is under consideration but I don't have a firm enough grasp of it yet. Motivating example from [[https://www.mpi-sws.org/~rossberg/1ml/1ml.pdf][1ML – Core and Modules United (F-ing First-class Modules)]]: 111 | 112 | #+BEGIN_SRC 113 | module Table = if size > threshold then HashMap else TreeMap 114 | #+END_SRC 115 | 116 | Current reading list to figure it all out: 117 | - [[https://www.cs.cmu.edu/~rwh/papers/sharing/popl94.pdf][A Type-Theoretic Approach to Higher-Order Modules with Sharing]] 118 | - [[http://www.mpi-sws.org/~dreyer/papers/thoms/full.pdf][A Type System for Higher-Order Modules (Expanded Version)]] 119 | - [[http://www.mpi-sws.org/~skilpat/modsem/notes2.pdf][Type Systems for Modules Notes for Meeting #2]] - this is helping me grasp some of the underlying themes 120 | 121 | I'm not yet sure how 1ML will play with row polymorphism. 122 | 123 | * Code Formatter 124 | Similar to `go fmt`, a reformatting utility that operates on the AST directly in order to correctly format source files. This likely requires: 125 | - comments as legitimate AST nodes 126 | - overhaul/regularization of existing AST nodes to allow comments to be attached to them (preserves expression-orientedness) 127 | -------------------------------------------------------------------------------- /code_of_conduct.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at `j.14159` [at] `gmail.com`. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at [http://contributor-covenant.org/version/1/4][version] 72 | 73 | [homepage]: http://contributor-covenant.org 74 | [version]: http://contributor-covenant.org/version/1/4/ 75 | -------------------------------------------------------------------------------- /epo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alpaca-lang/alpaca/aa2bb5594dda8292ca0bffb8e8a6ebc0f60e8dbc/epo -------------------------------------------------------------------------------- /make-release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # If travis-ci is building a tag then use that as the version, otherwise mark 4 | # this release with the hash from travis-ci or let the CLI override VERSION 5 | # entirely: 6 | VERSION=${VERSION:-${TRAVIS_TAG:-${TRAVIS_COMMIT:-unversioned}}_${TRAVIS_OTP_RELEASE}} 7 | 8 | # Where we're copying .beam files from: 9 | ALPACA_BEAMS=_build/default/lib/alpaca/ebin 10 | 11 | echo "Building release with version $VERSION" 12 | 13 | REL_BASE=alpaca-$VERSION 14 | BEAM_TARGET=$REL_BASE/beams 15 | SRC_TARGET=$REL_BASE/src 16 | 17 | mkdir -p $BEAM_TARGET 18 | mkdir -p $SRC_TARGET 19 | 20 | cp README.md $REL_BASE 21 | cp Tour.md $REL_BASE 22 | cp code_of_conduct.md $REL_BASE 23 | cp $ALPACA_BEAMS/*.beam $BEAM_TARGET 24 | cp src/* $SRC_TARGET 25 | 26 | tar cvzf alpaca_$TRAVIS_OTP_RELEASE.tgz $REL_BASE 27 | 28 | -------------------------------------------------------------------------------- /priv/lang/alpaca.de_DE.po: -------------------------------------------------------------------------------- 1 | msgid "" 2 | msgstr "" 3 | "Project-Id-Version: alpaca\n" 4 | "POT-Creation-Date: 2017-03-21 21:14+0100\n" 5 | "PO-Revision-Date: \n" 6 | "Last-Translator: Tilman Holschuh \n" 7 | "Language-Team: \n" 8 | "Language: de_DE\n" 9 | "MIME-Version: 1.0\n" 10 | "Content-Type: text/plain; charset=UTF-8\n" 11 | "Content-Transfer-Encoding: 8bit\n" 12 | "Plural-Forms: nplurals=2; plural=(n != 1);\n" 13 | "X-Generator: Poedit 1.8.7.1\n" 14 | 15 | msgid "builtin_type_arity_error %(type) %(num_expected) %(num_supplied)" 16 | msgstr "" 17 | "Falsche Anzahl an Parametern für eingebauten Typ\"%(type)\".\n" 18 | "Erwartet %(num_expected), erhalten %(num_supplied)." 19 | 20 | msgid "duplicate_definition %(id)" 21 | msgstr "Mehrfache Definition von \"%(id)\"." 22 | 23 | msgid "duplicate_type_definition %(id)" 24 | msgstr "Der Typ \"%(id)\" wurde bereits definiert." 25 | 26 | msgid "function_not_exported %(mod) %(fun)" 27 | msgstr "Das Modul \"%(mod)\" exportiert die Funktion \"%(fun)\" nicht." 28 | 29 | msgid "incomplete_expression" 30 | msgstr "Ausdruck endet unerwartet." 31 | 32 | msgid "invalid_bin_qualifier %(qualifier)" 33 | msgstr "" 34 | "Inkorrekte Binärqualifizierung für \"%(qualifier)\".\n" 35 | "Erlaubt sind \"end\", \"sign\", \"size\", \"type\" und \"unit.\"" 36 | 37 | msgid "invalid_bin_type %(type)" 38 | msgstr "" 39 | "Inkorrekter Anteil in Binärtyp \"%(type)\".\n" 40 | "Erlaubt sind \"binary\", \"float\", \"int\" und \"utf8\"." 41 | 42 | msgid "invalid_endianness %(endianness)" 43 | msgstr "" 44 | "Inkorrekte Byte-Reihenfolge \"%(endianness)\".\n" 45 | "Erlaubt sind \"big\", \"little\" und \"native\"." 46 | 47 | msgid "invalid_fun_parameter" 48 | msgstr "Inkorrektes Funktionsargumentmuster." 49 | 50 | msgid "invalid_top_level_construct" 51 | msgstr "Dieses Konstrukt darf nicht auf oberster Ebene vorkommen." 52 | 53 | msgid "module_rename %(old) %(new)." 54 | msgstr "Erneute Definition des Modulnamens \"%(old)\" durch \"%(new)\"." 55 | 56 | msgid "no_module" 57 | msgstr "" 58 | "Kein Modul definiert.\n" 59 | "Module werden wie folgt definiert: \"module foo\"." 60 | 61 | msgid "no_module %(mod)" 62 | msgstr "Das Modul \"%(mod)\" wurde nicht gefunden." 63 | 64 | msgid "type_parameter_given_to_primitive_builtin_type %(type)" 65 | msgstr "" 66 | "Typparamter wurden dem eingebauten Typ \"%(type)\" gegeben, der aber keine " 67 | "Parameter erwartet." 68 | 69 | msgid "unexpected_token %(token)" 70 | msgstr "Syntaxfehler nahe \"%(token)\"." 71 | 72 | msgid "unknown_error %(raw_error_term)" 73 | msgstr "" 74 | "%(raw_error_term)\n" 75 | "Wir bitten um Verzeihung, bisweilen wurde noch keine geeignete Fehlermeldung " 76 | "für diesen Fehler erstellt.\n" 77 | "Wir würden uns freuen, wenn Sie uns Ihr Problem beschreiben, und helfen Ihnen " 78 | "gerne weiter unter: https://www.github.com/alpaca-lang/alpaca/issues." 79 | -------------------------------------------------------------------------------- /priv/lang/alpaca.en_US.po: -------------------------------------------------------------------------------- 1 | msgid "" 2 | msgstr "" 3 | "Project-Id-Version: alpaca\n" 4 | "POT-Creation-Date: 2017-03-20 06:43+0100\n" 5 | "PO-Revision-Date: \n" 6 | "Last-Translator: \n" 7 | "Language-Team: \n" 8 | "Language: en_US\n" 9 | "MIME-Version: 1.0\n" 10 | "Content-Type: text/plain; charset=UTF-8\n" 11 | "Content-Transfer-Encoding: 8bit\n" 12 | "Plural-Forms: nplurals=2; plural=(n != 1);\n" 13 | "X-Generator: Poedit 1.8.7.1\n" 14 | 15 | msgid "builtin_type_arity_error %(type) %(num_expected) %(num_supplied)" 16 | msgstr "" 17 | "Wrong number of type parameters provided for builtin type \"%(type)\".\n" 18 | "Expected %(num_expected), but got %(num_supplied)." 19 | 20 | msgid "duplicate_definition %(id)" 21 | msgstr "Duplicate definition of \"%(id)\"." 22 | 23 | msgid "duplicate_type_definition %(id)" 24 | msgstr "Type \"%(id)\" has already been defined." 25 | 26 | msgid "function_not_exported %(mod) %(fun)" 27 | msgstr "No function \"%(fun)\" exported from module \"%(mod)\"." 28 | 29 | msgid "incomplete_expression" 30 | msgstr "Unexpected end of expression." 31 | 32 | msgid "invalid_bin_qualifier %(qualifier)" 33 | msgstr "" 34 | "Invalid binary qualifier \"%(qualifier)\".\n" 35 | "Valid qualifiers are \"end\", \"sign\", \"size\", \"type\" and \"unit.\"" 36 | 37 | msgid "invalid_bin_type %(type)" 38 | msgstr "" 39 | "Invalid binary part type \"%(type)\".\n" 40 | "Valid types are \"binary\", \"float, \"int\", and \"utf8\"." 41 | 42 | msgid "invalid_endianness %(endianness)" 43 | msgstr "" 44 | "Invalid endianness \"%(endianness)\". Did you mean \"big\", \"little\", or " 45 | "\"native\"?" 46 | 47 | msgid "invalid_fun_parameter" 48 | msgstr "Invalid pattern for function argument." 49 | 50 | msgid "invalid_top_level_construct" 51 | msgstr "This construct may not appear at the top level." 52 | 53 | msgid "module_rename %(old) %(new)." 54 | msgstr "Redefinition of module name from \"%(old)\" to \"%(new)\"." 55 | 56 | msgid "no_module" 57 | msgstr "" 58 | "No module name defined.\n" 59 | "You may define it like this: \"module foo\"." 60 | 61 | msgid "no_module %(mod)" 62 | msgstr "Cannot find any module named \"%(mod)\"." 63 | 64 | msgid "type_parameter_given_to_primitive_builtin_type %(type)" 65 | msgstr "" 66 | "Type parameter provided for built in type \"%(type)\", but none were " 67 | "expected." 68 | 69 | msgid "unexpected_token %(token)" 70 | msgstr "Syntax error before \"%(token)\"." 71 | 72 | msgid "unknown_error %(raw_error_term)" 73 | msgstr "" 74 | "%(raw_error_term)\n" 75 | "Sorry, we do not have a proper message for this error yet.\n" 76 | "Please consider filing an issue at https://www.github.com/alpaca-lang/alpaca/" 77 | "issues." 78 | -------------------------------------------------------------------------------- /priv/lang/alpaca.es_MX.po: -------------------------------------------------------------------------------- 1 | msgid "" 2 | msgstr "" 3 | "Project-Id-Version: alpaca\n" 4 | "POT-Creation-Date: \n" 5 | "PO-Revision-Date: \n" 6 | "Language-Team: \n" 7 | "MIME-Version: 1.0\n" 8 | "Content-Type: text/plain; charset=UTF-8\n" 9 | "Content-Transfer-Encoding: 8bit\n" 10 | "Plural-Forms: nplurals=2; plural=(n != 1);\n" 11 | "X-Generator: Poedit 1.8.12\n" 12 | "Last-Translator: Eric Bailey \n" 13 | "Language: es_MX\n" 14 | 15 | msgid "builtin_type_arity_error %(type) %(num_expected) %(num_supplied)" 16 | msgstr "" 17 | "Número incorrecto de parámetros de tipo proporcionados\n" 18 | "para el tipo incorporado \"%(type)\".\n" 19 | "Se esperaba $(num_expected), pero se consiguió %(num_supplied)." 20 | 21 | msgid "duplicate_definition %(id)" 22 | msgstr "Definición duplicada de \"%(id)\"." 23 | 24 | msgid "duplicate_type_definition %(id)" 25 | msgstr "Tipo \"%(id)\" ya se ha definido." 26 | 27 | msgid "function_not_exported %(mod) %(fun)" 28 | msgstr "No hay ninguna función \"%(fun)\" que se exporte desde el módulo \"%(mod)\"." 29 | 30 | msgid "incomplete_expression" 31 | msgstr "Final inesperado de la expresión." 32 | 33 | msgid "invalid_bin_qualifier %(qualifier)" 34 | msgstr "" 35 | "Calificador binario no válido \"%(qualifier)\".\n" 36 | "Los calificadores válidos son \"end\",\n" 37 | "\"sign\", \"size\", \"type\" y \"unit\"." 38 | 39 | msgid "invalid_bin_type %(type)" 40 | msgstr "" 41 | "Tipo de parte binaria no válido \"%(type).\"\n" 42 | "Los tipos válidos son \"binary\", \"float\", \"int\" y \"utf8\"." 43 | 44 | msgid "invalid_endianness %(endianness)" 45 | msgstr "Endianidad inválida \"%{endianness}\". Quiso decir \"big\", \"little\", o \"native\"?" 46 | 47 | msgid "invalid_fun_parameter" 48 | msgstr "Patrón inválido para el argumento de la función." 49 | 50 | msgid "invalid_top_level_construct" 51 | msgstr "Esta construcción no puede aparecer en el nivel superior." 52 | 53 | msgid "module_rename %(old) %(new)." 54 | msgstr "Renombre de módulo de \"%(old)\" a \"%(new)\"." 55 | 56 | msgid "no_module" 57 | msgstr "" 58 | "El módulo no tiene nombre.\n" 59 | "Se puede definir así: \"module foo\"." 60 | 61 | msgid "no_module %(mod)" 62 | msgstr "No se puede encontrar ningún módulo llamado \"%(mod)\"." 63 | 64 | msgid "type_parameter_given_to_primitive_builtin_type %(type)" 65 | msgstr "" 66 | "Parámetro de tipo proporcionado para el tipo incorporado \"%(type)\",\n" 67 | "pero no se esperaba ninguno." 68 | 69 | msgid "unexpected_token %(token)" 70 | msgstr "Error de sintaxis antes de \"%(token)\"." 71 | 72 | msgid "unknown_error %(raw_error_term)" 73 | msgstr "" 74 | "%(raw_error_term)\n" 75 | "Discúlpenos, aun no tenemos un mensaje apropiado para este error.\n" 76 | "Por favor, considere enviar un problema a https://www.github.com/alpaca-lang/alpaca." 77 | -------------------------------------------------------------------------------- /priv/lang/alpaca.pot: -------------------------------------------------------------------------------- 1 | 2 | msgid "" 3 | msgstr "" 4 | "Project-Id-Version: alpaca\n" 5 | "POT-Creation-Date: 2017-06-14 16:46+0200\n" 6 | "Plural-Forms: nplurals=1; plural=1;\n" 7 | 8 | msgid "builtin_type_arity_error %(type) %(num_expected) %(num_supplied)" 9 | msgstr "" 10 | 11 | msgid "duplicate_definition %(id)" 12 | msgstr "" 13 | 14 | msgid "duplicate_type_definition %(id)" 15 | msgstr "" 16 | 17 | msgid "function_not_exported %(mod) %(fun)" 18 | msgstr "" 19 | 20 | msgid "incomplete_expression" 21 | msgstr "" 22 | 23 | msgid "invalid_bin_qualifier %(qualifier)" 24 | msgstr "" 25 | 26 | msgid "invalid_bin_type %(type)" 27 | msgstr "" 28 | 29 | msgid "invalid_endianness %(endianness)" 30 | msgstr "" 31 | 32 | msgid "invalid_fun_parameter" 33 | msgstr "" 34 | 35 | msgid "invalid_top_level_construct" 36 | msgstr "" 37 | 38 | msgid "module_rename %(old) %(new)." 39 | msgstr "" 40 | 41 | msgid "no_module" 42 | msgstr "" 43 | 44 | msgid "no_module %(mod)" 45 | msgstr "" 46 | 47 | msgid "type_parameter_given_to_primitive_builtin_type %(type)" 48 | msgstr "" 49 | 50 | msgid "unexpected_token %(token)" 51 | msgstr "" 52 | 53 | msgid "unknown_error %(raw_error_term)" 54 | msgstr "" 55 | -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | {erl_opts, [debug_info, warnings_as_errors, {gettext, alpaca_compiled_po}]}. 2 | {xrl_opts, [{report, true}, {verbose, true}]}. 3 | {deps, [ {epo_runtime, {git, "git://github.com/brigadier/epo_runtime.git", 4 | {tag, "0.3"}}}, 5 | cf 6 | ]}. 7 | {dialyzer, [{warnings, [unknown]}]}. 8 | 9 | {profiles, [ 10 | {shell, [ 11 | {deps, [sync]} 12 | ]}, 13 | 14 | {test, [ 15 | {deps, [proper]} 16 | ]} 17 | ]}. 18 | 19 | {pre_hooks, [{compile, "./epo scan"}, {compile, "./epo compile"}]}. 20 | -------------------------------------------------------------------------------- /rebar.lock: -------------------------------------------------------------------------------- 1 | {"1.1.0", 2 | [{<<"cf">>,{pkg,<<"cf">>,<<"0.3.1">>},0}, 3 | {<<"epo_runtime">>, 4 | {git,"git://github.com/brigadier/epo_runtime.git", 5 | {ref,"a3e50e7cebb526f833757e867bbe914c1da7baa3"}}, 6 | 0}]}. 7 | [ 8 | {pkg_hash,[ 9 | {<<"cf">>, <<"5CB902239476E141EA70A740340233782D363A31EEA8AD37049561542E6CD641">>}]} 10 | ]. 11 | -------------------------------------------------------------------------------- /src/alpaca.app.src: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | 19 | {application, alpaca, 20 | [{description, "alpaca"}, 21 | {vsn, "0.1.0"}, 22 | {registered, []}, 23 | {mod, {'alpaca_app', []}}, 24 | {applications, 25 | [compiler, 26 | kernel, 27 | stdlib, 28 | epo_runtime 29 | ]}, 30 | {env,[]}, 31 | {modules, []}, 32 | 33 | {contributors, []}, 34 | {licenses, []}, 35 | {links, []} 36 | ]}. 37 | -------------------------------------------------------------------------------- /src/alpaca.hrl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | -record(compiled_module, { 19 | name :: atom(), 20 | filename :: string(), 21 | bytes :: binary()}). 22 | 23 | -type compile_res() :: {ok, list(#compiled_module{})} | {error, term()}. 24 | -------------------------------------------------------------------------------- /src/alpaca_app.erl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | %%------------------------------------------------------------------- 19 | %% @doc mlfe public API 20 | %% @end 21 | %%------------------------------------------------------------------- 22 | 23 | -module(alpaca_app). 24 | 25 | -behaviour(application). 26 | 27 | %% Application callbacks 28 | -export([ start/2 29 | , stop/1 30 | ]). 31 | 32 | %%==================================================================== 33 | %% API 34 | %%==================================================================== 35 | 36 | start(_StartType, _StartArgs) -> 37 | alpaca_sup:start_link(). 38 | 39 | %%-------------------------------------------------------------------- 40 | stop(_State) -> 41 | ok. 42 | 43 | %%==================================================================== 44 | %% Internal functions 45 | %%==================================================================== 46 | -------------------------------------------------------------------------------- /src/alpaca_ast.hrl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | %%% ## Type-Tracking Data Types 19 | %%% 20 | %%% These are all of the specs the typer uses to track Alpaca types. 21 | 22 | -type typ_name() :: atom(). 23 | 24 | -type qvar() :: {qvar, typ_name()}. 25 | -type tvar() :: {unbound, typ_name(), integer()} 26 | | {link, typ()}. 27 | %% list of parameter types, return type: 28 | -type t_arrow() :: {t_arrow, list(typ()), typ()}. 29 | 30 | -record(adt, {name=undefined :: undefined|string(), 31 | module=undefined :: atom(), 32 | vars=[] :: list({string(), typ()}), 33 | members=[] :: list(typ())}). 34 | -type t_adt() :: #adt{}. 35 | 36 | -type t_adt_constructor() :: {t_adt_cons, string()}. 37 | 38 | %% Processes that are spawned with functions that are not receivers are not 39 | %% allowed to be sent messages. 40 | -type t_pid() :: {t_pid, typ()}. 41 | 42 | -type t_receiver() :: {t_receiver, typ(), typ()}. 43 | 44 | -type t_list() :: {t_list, typ()}. 45 | 46 | -type t_map() :: {t_map, typ(), typ()}. 47 | 48 | -type t_tuple() :: {t_tuple, list(typ())}. 49 | 50 | %% pattern, optional guard, result. Currently I'm doing nothing with 51 | %% present guards. 52 | %% TODO: the guards don't need to be part of the type here. Their 53 | %% only role in typing is to constrain the pattern's typing. 54 | -type t_clause() :: {t_clause, typ(), t_arrow()|undefined, typ()}. 55 | 56 | %%% `t_rec` is a special type that denotes an infinitely recursive function. 57 | %%% Since all functions here are considered recursive, the return type for 58 | %%% any function must begin as `t_rec`. `t_rec` unifies with anything else by 59 | %%% becoming that other thing and as such should be in its own reference cell. 60 | -type t_const() :: t_rec 61 | | t_int 62 | | t_float 63 | | t_atom 64 | | t_bool 65 | | t_string 66 | | t_chars 67 | | t_unit. 68 | 69 | -type typ() :: undefined 70 | | qvar() 71 | | tvar() 72 | | t_arrow() 73 | | t_adt() 74 | | t_adt_constructor() 75 | | t_const() 76 | | t_binary 77 | | t_list() 78 | | t_map() 79 | | t_record() 80 | | t_tuple() 81 | | t_clause() 82 | | t_pid() 83 | | t_receiver() 84 | | alpaca_typer:cell(). % a reference cell for a type. 85 | 86 | %%% ## ALPACA AST Nodes 87 | 88 | -record(alpaca_comment, { 89 | multi_line=false :: boolean(), 90 | line=0 :: integer(), 91 | text="" :: string()}). 92 | -type alpaca_comment() :: #alpaca_comment{}. 93 | 94 | %% Literals: 95 | 96 | -record(a_unit, { line=0 :: integer()}). 97 | -type alpaca_unit() :: #a_unit{}. 98 | 99 | -record(a_bool, { line=0 :: integer() 100 | , val :: boolean() 101 | }). 102 | -type alpaca_bool() :: {bool, integer(), boolean()}. 103 | 104 | -record(a_atom, { line=0 :: integer() 105 | , val :: atom() 106 | }). 107 | -type alpaca_atom() :: #a_atom{}. 108 | 109 | -record(a_int, { line=0 :: integer() 110 | , val=0 :: integer() 111 | }). 112 | -type alpaca_int() :: #a_int{}. 113 | 114 | -record(a_flt, { line=0 :: integer() 115 | , val=0 :: float() 116 | }). 117 | -type alpaca_float() :: #a_flt{}. 118 | 119 | -record(a_str, { line=0 :: integer() 120 | , val :: string() 121 | }). 122 | -type alpaca_string() :: #a_str{}. 123 | 124 | -record(a_lab, { line=0 :: integer() 125 | , name :: binary() 126 | , original=none :: none | binary() 127 | }). 128 | -type alpaca_label() :: #a_lab{}. 129 | 130 | %% Reference to a label that resides in a different namespace (a label 131 | %% qualified with a namespace). Examples are functions in other modules or 132 | %% labels for a record. 133 | %% 134 | %% Arity can be 'none' if the user is specifying a record label or wishes to 135 | %% default to the first exported version of the label in another module when 136 | %% used inline. Imports and exports that don't specify arity will also be 137 | %% recorded as qualified labels temporarily without arity. 138 | -record(a_qlab, { line=0 :: integer() 139 | , space :: alpaca_label() 140 | , label :: alpaca_label() 141 | , arity=none :: none | integer() 142 | }). 143 | -type alpaca_qualified_label() :: #a_qlab{}. 144 | 145 | -type alpaca_number() :: alpaca_int()|alpaca_float(). 146 | 147 | -type alpaca_error() :: {raise_error, 148 | integer(), 149 | throw|error|exit, 150 | alpaca_value_expression()}. 151 | 152 | %%% The variable _, meaning "don't care": 153 | -type alpaca_any() :: {any, integer()}. 154 | 155 | -type alpaca_const() :: alpaca_unit() 156 | | alpaca_any() 157 | | alpaca_number() 158 | | alpaca_bool() 159 | | alpaca_atom() 160 | | alpaca_string() 161 | . 162 | 163 | %%% ### Binaries 164 | 165 | -record(alpaca_binary, {line=0 :: integer(), 166 | segments=[] :: list(alpaca_bits())}). 167 | -type alpaca_binary() :: #alpaca_binary{}. 168 | 169 | -type alpaca_bits_type() :: int | float | binary | utf8. 170 | 171 | -record(alpaca_bits, {line=0 :: integer(), 172 | %% Used to signal whether or not the bitstring is simply 173 | %% using default size and unit values. If it is *not* 174 | %% and the `type` is `binary` *and* the bitstring is the 175 | %% last segment in a binary, it's size must be set to 176 | %% `'all'` with unit 8 to capture all remaining bits. 177 | %% This is in keeping with how Erlang compiles to Core 178 | %% Erlang. 179 | default_sizes=true :: boolean(), 180 | value=#a_lab{} :: alpaca_label()|alpaca_number()|alpaca_string(), 181 | size=8 :: non_neg_integer()|all, 182 | unit=1 :: non_neg_integer(), 183 | type=int :: alpaca_bits_type(), 184 | sign=unsigned :: signed | unsigned, 185 | endian=big :: big | little | native}). 186 | -type alpaca_bits() :: #alpaca_bits{}. 187 | 188 | %%% ### AST Nodes For Types 189 | %%% 190 | %%% AST nodes that describe the basic included types and constructs for 191 | %%% defining and instantiating ADTs (type constructors). 192 | 193 | -type alpaca_base_type() :: t_atom 194 | | t_int 195 | | t_float 196 | | t_string 197 | | t_pid 198 | | t_bool 199 | | t_chars 200 | | t_unit. 201 | 202 | -type alpaca_type_name() :: {type_name, integer(), string()}. 203 | -type alpaca_type_var() :: {type_var, integer(), string()}. 204 | 205 | -record(alpaca_type_tuple, { 206 | members=[] :: list(alpaca_base_type() 207 | | alpaca_type_var() 208 | | alpaca_poly_type()) 209 | }). 210 | -type alpaca_type_tuple() :: #alpaca_type_tuple{}. 211 | 212 | -type alpaca_list_type() :: {t_list, alpaca_base_type()|alpaca_poly_type()}. 213 | 214 | -type alpaca_map_type() :: {t_map, 215 | alpaca_base_type()|alpaca_poly_type(), 216 | alpaca_base_type()|alpaca_poly_type()}. 217 | 218 | -type alpaca_pid_type() :: {t_list, alpaca_base_type()|alpaca_poly_type()}. 219 | 220 | -type alpaca_poly_type() :: alpaca_type() 221 | | alpaca_type_tuple() 222 | | alpaca_list_type() 223 | | alpaca_map_type() 224 | | alpaca_pid_type(). 225 | 226 | %%% ### Record Type Tracking 227 | %%% 228 | %%% These will do double-duty for both defining record types for ADTs 229 | %%% as well as to type records as they occur. 230 | -record(t_record_member, { 231 | name=undefined :: atom(), 232 | type=undefined :: typ()}). 233 | -type t_record_member() :: #t_record_member{}. 234 | 235 | -record(t_record, { 236 | is_pattern=false :: boolean(), 237 | members=[] :: list(t_record_member()), 238 | row_var=undefined :: typ()}). 239 | 240 | -type t_record() :: #t_record{}. 241 | 242 | %%% ADT Type Tracking 243 | 244 | -record(type_constructor, { 245 | line=0 :: integer(), 246 | module=undefined :: atom(), 247 | name="" :: string() 248 | }). 249 | -type alpaca_constructor_name() :: #type_constructor{}. 250 | 251 | -record(alpaca_constructor, { 252 | type=undefined :: typ() | alpaca_type(), 253 | name=#type_constructor{} :: alpaca_constructor_name(), 254 | arg=none :: none 255 | | alpaca_base_type() 256 | | alpaca_type_var() 257 | | alpaca_type() 258 | | alpaca_type_tuple() 259 | }). 260 | -type alpaca_constructor() :: #alpaca_constructor{}. 261 | 262 | -type alpaca_types() :: alpaca_type() 263 | | alpaca_type_tuple() 264 | | alpaca_base_type() 265 | | alpaca_list_type() 266 | | alpaca_map_type() 267 | | alpaca_pid_type(). 268 | 269 | -record(alpaca_type, { 270 | line=0 :: integer(), 271 | module=undefined :: atom(), 272 | name={type_name, -1, ""} :: alpaca_type_name(), 273 | vars=[] :: list(alpaca_type_var() 274 | | {alpaca_type_var(), typ()}), 275 | members=[] :: list(alpaca_constructor() 276 | | alpaca_type_var() 277 | | alpaca_types()) 278 | }). 279 | -type alpaca_type() :: #alpaca_type{}. 280 | 281 | -record(alpaca_type_alias, { 282 | line=0 :: integer(), 283 | module=undefined :: atom(), 284 | name={type_name, -1, ""} :: alpaca_type_name(), 285 | target=undefined :: alpaca_types() 286 | }). 287 | -type alpaca_type_alias() :: #alpaca_type{}. 288 | 289 | -record(alpaca_type_apply, { 290 | type=undefined :: typ(), 291 | name=#type_constructor{} :: alpaca_constructor_name(), 292 | arg=none :: none | alpaca_expression()}). 293 | -type alpaca_type_apply() :: #alpaca_type_apply{}. 294 | 295 | %%% ### Lists 296 | 297 | -record(alpaca_cons, {type=undefined :: typ(), 298 | line=0 :: integer(), 299 | head=undefined :: undefined|alpaca_expression(), 300 | tail={nil, 0} :: alpaca_expression() 301 | }). 302 | 303 | -type alpaca_cons() :: #alpaca_cons{}. 304 | -type alpaca_nil() :: {nil, integer()}. 305 | -type alpaca_list() :: alpaca_cons() | alpaca_nil(). 306 | 307 | %%% ### Maps 308 | %%% 309 | %%% For both map literals and map patterns 310 | 311 | -record(alpaca_map_pair, {type=undefined :: typ(), 312 | line=0 :: integer(), 313 | is_pattern=false :: boolean(), 314 | key=undefined :: alpaca_value_expression(), 315 | val=undefined :: alpaca_value_expression()}). 316 | -type alpaca_map_pair() :: #alpaca_map_pair{}. 317 | 318 | %% The `structure` field tracks what we're actually using the map for. 319 | %% The code generation stage will add a member to the compiled map that 320 | %% indicates what the purpose of the map is so that pattern matches can 321 | %% be correct, e.g. we don't want the order of maps and records to matter 322 | %% in a pattern match because then compilation details are a concern for 323 | %% a user. 324 | -record(alpaca_map, {type=undefined :: typ(), 325 | line=0 :: integer(), 326 | is_pattern=false :: boolean(), 327 | structure=map :: map | record, 328 | pairs=[] :: list(alpaca_map_pair())}). 329 | -type alpaca_map() :: #alpaca_map{}. 330 | 331 | -record(alpaca_map_add, {type=undefined :: typ(), 332 | line=0 :: integer(), 333 | to_add=#alpaca_map_pair{} :: alpaca_map_pair(), 334 | existing=#alpaca_map{} :: alpaca_value_expression()}). 335 | -type alpaca_map_add() :: #alpaca_map_add{}. 336 | 337 | %%% ### Tuples 338 | 339 | -record(alpaca_tuple, {type=undefined :: typ(), 340 | line=-1 :: integer(), 341 | arity=0 :: integer(), 342 | values=[] :: list(alpaca_expression()) 343 | }). 344 | -type alpaca_tuple() :: #alpaca_tuple{}. 345 | 346 | %%% ### Record AST Nodes 347 | 348 | -record(alpaca_record_member, { 349 | line=-1 :: integer(), 350 | name=undefined :: atom(), 351 | type=undefined :: typ(), 352 | val=ast:label(-1, <<"">>) :: alpaca_value_expression()}). 353 | -type alpaca_record_member() :: #alpaca_record_member{}. 354 | 355 | -record(alpaca_record, {arity=0 :: integer(), 356 | line=0 :: integer(), 357 | is_pattern=false :: boolean(), 358 | members=[] :: list(alpaca_record_member())}). 359 | -type alpaca_record() :: #alpaca_record{}. 360 | 361 | -record(alpaca_record_transform, { 362 | line=-1 :: integer(), 363 | additions=[] :: list(alpaca_record_member()), 364 | existing :: alpaca_value_expression()}). 365 | -type alpaca_record_transform() :: #alpaca_record_transform{}. 366 | 367 | %%% Pattern Matching 368 | 369 | -type type_check() :: is_integer 370 | | is_float 371 | | is_atom 372 | | is_bool 373 | | is_list 374 | | is_string 375 | | is_chars 376 | | is_binary. 377 | 378 | %% TODO: revisit this in alpaca_typer.erl as well as scanning and parsing: 379 | -record(alpaca_type_check, {type=undefined :: undefined|type_check(), 380 | line=0 :: integer(), 381 | expr=undefined :: undefined|alpaca_label()}). 382 | -type alpaca_type_check() :: #alpaca_type_check{}. 383 | 384 | -record(alpaca_clause, {type=undefined :: typ(), 385 | line=0 :: integer(), 386 | pattern=ast:label(0, <<"_">>) :: alpaca_expression(), 387 | guards=[] :: list(alpaca_expression()), 388 | result=ast:label(-1, <<"">>) :: alpaca_expression() 389 | }). 390 | -type alpaca_clause() :: #alpaca_clause{}. 391 | 392 | -record(alpaca_match, {type=undefined :: typ(), 393 | line=0 :: integer(), 394 | match_expr=ast:label(0, <<"_">>) :: alpaca_expression(), 395 | clauses=[#alpaca_clause{}] :: nonempty_list(alpaca_clause()) 396 | }). 397 | -type alpaca_match() :: #alpaca_match{}. 398 | 399 | %%% ### Erlang FFI 400 | %%% 401 | %%% A call to an Erlang function via the Foreign Function Interface. 402 | %%% Only the result of these calls is typed. 403 | -record(alpaca_ffi, {type=undefined :: typ(), 404 | line=-1 :: integer(), 405 | module={atom, 0, ""} :: alpaca_atom(), 406 | function_name=undefined :: undefined|alpaca_atom(), 407 | args={nil, 0} :: alpaca_list(), 408 | clauses=[] :: list(alpaca_clause()) 409 | }). 410 | -type alpaca_ffi() :: #alpaca_ffi{}. 411 | 412 | %%% ### Processes 413 | 414 | -record(alpaca_spawn, {type=undefined :: typ(), 415 | line=0 :: integer(), 416 | module=undefined :: atom(), 417 | from_module=undefined :: atom(), 418 | function=ast:label(-1, <<"">>) :: alpaca_label(), 419 | args=[] :: list(alpaca_expression())}). 420 | -type alpaca_spawn() :: #alpaca_spawn{}. 421 | 422 | -record(alpaca_send, {type=undefined :: typ(), 423 | line=0 :: integer(), 424 | message=undefined :: undefined|alpaca_value_expression(), 425 | pid=undefined :: undefined|alpaca_expression()}). 426 | -type alpaca_send() :: #alpaca_send{}. 427 | 428 | -record(alpaca_receive, {type=undefined :: typ(), 429 | line=0 :: integer(), 430 | clauses=[#alpaca_clause{}] :: nonempty_list(alpaca_clause()), 431 | timeout=infinity :: infinity | integer(), 432 | timeout_action=undefined :: undefined 433 | | alpaca_value_expression()}). 434 | -type alpaca_receive() :: #alpaca_receive{}. 435 | 436 | %%% ### Module Building Blocks 437 | 438 | -record(alpaca_test, {type=undefined :: typ(), 439 | line=0 :: integer(), 440 | name={string, 0, ""} :: alpaca_string(), 441 | expression={unit, 0} :: alpaca_expression()}). 442 | -type alpaca_test() :: #alpaca_test{}. 443 | 444 | %%% Expressions that result in values: 445 | -type alpaca_value_expression() :: alpaca_const() 446 | | alpaca_label() 447 | | alpaca_qualified_label() 448 | | alpaca_list() 449 | | alpaca_binary() 450 | | alpaca_map() 451 | | alpaca_map_add() 452 | | alpaca_record() 453 | | alpaca_record_transform() 454 | | alpaca_tuple() 455 | | alpaca_apply() 456 | | alpaca_type_apply() 457 | | alpaca_match() 458 | | alpaca_receive() 459 | | alpaca_clause() 460 | | alpaca_fun() 461 | | alpaca_spawn() 462 | | alpaca_send() 463 | | alpaca_ffi(). 464 | 465 | -type alpaca_expression() :: alpaca_comment() 466 | | alpaca_value_expression() 467 | | alpaca_binding() 468 | | alpaca_type_check() 469 | | alpaca_binding() 470 | | alpaca_type_import() 471 | | alpaca_type_export() 472 | | alpaca_error(). 473 | 474 | %% When calling BIFs like erlang:'+' it seems core erlang doesn't want 475 | %% the arity specified as part of the function name. alpaca_bif_name() 476 | %% is a way to indicate what the ALPACA function name is and the corresponding 477 | %% actual Erlang BIF. Making the distinction between the ALPACA and Erlang 478 | %% name to support something like '+' for integers and '+.' for floats. 479 | -type alpaca_bif_name() :: 480 | { bif 481 | , AlpacaFun::atom() 482 | , Line::integer() 483 | , Module::atom() 484 | , ErlangFun::atom() 485 | }. 486 | 487 | %%% A function application can occur in one of 4 ways: 488 | %%% 489 | %%% - an Erlang BIF 490 | %%% - intra-module, a function defined in the module it's being called 491 | %%% within or one in scope from a let binding 492 | %%% - inter-module (a "call" in core erlang), calling a function defined 493 | %%% in a different module 494 | %%% - a function bound to a variable 495 | %%% 496 | %%% The distinction is particularly important between the first and third 497 | %%% since core erlang wants the arity specified in the first case but _not_ 498 | %%% in the third. 499 | 500 | -record(alpaca_apply, {type=undefined :: typ(), 501 | line=0 :: integer(), 502 | expr=undefined :: undefined 503 | | alpaca_label() 504 | | {alpaca_label(), integer()} 505 | | alpaca_qualified_label() 506 | | alpaca_bif_name() 507 | | alpaca_expression(), 508 | args=[] :: list(alpaca_expression()) 509 | }). 510 | -type alpaca_apply() :: #alpaca_apply{}. 511 | 512 | -record(alpaca_fun_version, { 513 | line=0 :: integer(), 514 | args=[] :: list(alpaca_value_expression()), 515 | guards=[] :: list(alpaca_expression()), 516 | body=undefined :: undefined|alpaca_expression() 517 | }). 518 | 519 | %% The name field in an #alpaca_fun{} is there for the typer's convenience. 520 | %% When typing an #alpaca_binding{}, the typer inserts the bound name into the 521 | %% function to enable "let rec" behaviour. We could relax this later to allow 522 | %% for non-recursive let behaviour but I can't think of a good reason to go for 523 | %% that at the immediate moment. 524 | -record(alpaca_fun, { 525 | line=0 :: integer(), 526 | type=undefined :: typ(), 527 | arity=0 :: integer(), 528 | name=undefined :: undefined | string(), 529 | versions=[] :: list(#alpaca_fun_version{}) 530 | }). 531 | -type alpaca_fun() :: #alpaca_fun{}. 532 | 533 | -record(alpaca_type_signature, { 534 | line=0 :: integer(), 535 | name=undefined :: undefined | alpaca_label(), 536 | type=undefined :: typ(), 537 | vars=undefined :: list(alpaca_type_var()) 538 | }). 539 | 540 | -type alpaca_type_signature() :: #alpaca_type_signature{}. 541 | 542 | %% `body` remains `undefined` for top-level expressions and otherwise for 543 | %% things like function and variable bindings within a top-level function. 544 | -record(alpaca_binding, { 545 | line=0 :: integer(), 546 | name=undefined :: undefined | alpaca_label(), 547 | type=undefined :: typ(), 548 | bound_expr=undefined :: undefined | alpaca_expression(), 549 | body=undefined :: undefined | alpaca_expression(), 550 | signature=undefined :: alpaca_type_signature() 551 | }). 552 | 553 | -type alpaca_binding() :: #alpaca_binding{}. 554 | 555 | -record(alpaca_type_import, { module=undefined :: alpaca_label() 556 | , type=undefined :: alpaca_label()}). 557 | -type alpaca_type_import() :: #alpaca_type_import{}. 558 | 559 | -record(alpaca_type_export, {line=0 :: integer(), 560 | names=[] :: list(string())}). 561 | -type alpaca_type_export() :: #alpaca_type_export{}. 562 | 563 | -record(alpaca_module, { 564 | name = none :: none | binary(), 565 | filename=undefined :: string() | undefined, 566 | function_exports=[] :: list({string(), integer()}|string()), 567 | function_imports=[] :: list({string(), {atom(), integer()}|string()}), 568 | types=[] :: list(alpaca_type()), 569 | type_imports=[] :: list(alpaca_type_import()), 570 | type_exports=[] :: list(string()), 571 | functions=[] :: list(alpaca_binding()), 572 | tests=[] :: list(alpaca_test()), 573 | precompiled=false :: boolean(), 574 | hash=undefined :: binary() | undefined, 575 | typed=false :: boolean() 576 | }). 577 | -type alpaca_module() :: #alpaca_module{}. 578 | -------------------------------------------------------------------------------- /src/alpaca_error_format.erl: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 3 | %%% you may not use this file except in compliance with the License. 4 | %%% You may obtain a copy of the License at 5 | %%% 6 | %%% http://www.apache.org/licenses/LICENSE-2.0 7 | %%% 8 | %%% Unless required by applicable law or agreed to in writing, software 9 | %%% distributed under the License is distributed on an "AS IS" BASIS, 10 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 11 | %%% See the License for the specific language governing permissions and 12 | %%% limitations under the License. 13 | 14 | %% Formatting and translation of error messages. 15 | -module(alpaca_error_format). 16 | 17 | -export([fmt/2]). 18 | 19 | -ignore_xref([ fmt/2 ]). 20 | 21 | -compile({parse_transform, epo_gettext}). 22 | 23 | %% number of lines to show before or after the errorrous line 24 | -define(CTX_AREA, 2). 25 | -define(RE_OPTS, [{return, binary}, unicode, ucp]). 26 | 27 | %% This function expects all strings passed in to it as part of error messages 28 | %% (e.g. function names) to be valid unicode strings. 29 | -spec fmt({error, term()}, Locale::string()) -> binary(). 30 | fmt({error, {parse_error, F, Line, E}}, Locale) -> 31 | File = unicode:characters_to_binary(F, utf8), 32 | {Msg, HlFn} = case fmt_parse_error(E, Locale) of 33 | {MsgC, HlFnC} -> 34 | {MsgC, HlFnC}; 35 | MsgC -> 36 | {MsgC, hl_fn("")} 37 | end, 38 | MsgI = ident(Msg), 39 | SourceDir = filename:dirname(File), 40 | Module = filename:rootname(filename:basename(File)), 41 | FileLine = case File of 42 | <<"">> -> 43 | cf("~!_c~ts~!!:~!c~p~!!", [File, Line]); 44 | _ -> 45 | cf("~!__~ts/~!_c~ts~!!~!__.alp~!!:~!c~p~!!", 46 | [SourceDir, Module, Line]) 47 | end, 48 | case get_context(SourceDir, Module, Line, HlFn) of 49 | "" -> 50 | cf("~ts~n~ts~n", [FileLine, MsgI]); 51 | Ctx -> 52 | cf("~ts~n~ts~n~n~ts~n", [FileLine, MsgI, Ctx]) 53 | end; 54 | 55 | fmt({error, Err}, Locale) -> 56 | Msg = fmt_parse_error(Err, Locale), 57 | <>. 58 | 59 | ident(S) -> 60 | re:replace(S, "^", " ", [multiline, global | ?RE_OPTS]). 61 | 62 | fmt_parse_error({duplicate_definition, Id}, Locale) -> 63 | t(__(<<"duplicate_definition %(id)">>), Locale, [{id, red(Id)}]); 64 | fmt_parse_error({duplicate_type, Id}, Locale) -> 65 | t(__(<<"duplicate_type_definition %(id)">>), Locale, [{id, red(Id)}]); 66 | fmt_parse_error({function_not_exported, Mod, Name}, Locale) -> 67 | t(__(<<"function_not_exported %(mod) %(fun)">>), Locale, 68 | [{'fun', red(Name)}, {mod, bold(atom_to_binary(Mod, utf8))}]); 69 | fmt_parse_error({invalid_bin_qualifier, Str}, Locale) -> 70 | t(__(<<"invalid_bin_qualifier %(qualifier)">>), Locale, 71 | [{qualifier, red(Str)}]); 72 | fmt_parse_error({invalid_bin_type, Str}, Locale) -> 73 | t(__(<<"invalid_bin_type %(type)">>), Locale, 74 | [{type, red(Str)}]); 75 | fmt_parse_error({invalid_endianness, Str}, Locale) -> 76 | t(__(<<"invalid_endianness %(endianness)">>), Locale, 77 | [{endianness, red(Str)}]); 78 | fmt_parse_error({invalid_fun_parameter, _}, Locale) -> 79 | t(__(<<"invalid_fun_parameter">>), Locale); 80 | fmt_parse_error({invalid_top_level_construct, _}, Locale) -> 81 | t(__(<<"invalid_top_level_construct">>), Locale); 82 | fmt_parse_error({module_rename, Old, New}, Locale) -> 83 | t(__(<<"module_rename %(old) %(new).">>), Locale, 84 | [{old, green(atom_to_binary(Old, utf8))}, 85 | {new, red(atom_to_binary(New, utf8))}]); 86 | fmt_parse_error(no_module, Locale) -> 87 | t(__(<<"no_module">>), Locale); 88 | fmt_parse_error({no_module, Mod}, Locale) when is_atom(Mod) -> 89 | fmt_parse_error({no_module, atom_to_binary(Mod, utf8)}, Locale); 90 | fmt_parse_error({no_module, Mod}, Locale) -> 91 | t(__(<<"no_module %(mod)">>), Locale, [{mod, red(Mod)}]); 92 | fmt_parse_error({syntax_error, ""}, Locale) -> 93 | t(__(<<"incomplete_expression">>), Locale); 94 | fmt_parse_error({syntax_error, Token}, Locale) -> 95 | {t(__(<<"unexpected_token %(token)">>), Locale, 96 | [{token, red(Token)}]), hl_fn(Token)}; 97 | fmt_parse_error({wrong_type_arity, t_atom, _A}, Locale) -> 98 | simple_type_arity_error("atom", Locale); 99 | fmt_parse_error({wrong_type_arity, t_binary, _A}, Locale) -> 100 | simple_type_arity_error("binary", Locale); 101 | fmt_parse_error({wrong_type_arity, t_bool, _A}, Locale) -> 102 | simple_type_arity_error("bool", Locale); 103 | fmt_parse_error({wrong_type_arity, t_float, _A}, Locale) -> 104 | simple_type_arity_error("float", Locale); 105 | fmt_parse_error({wrong_type_arity, t_int, _A}, Locale) -> 106 | simple_type_arity_error("int", Locale); 107 | fmt_parse_error({wrong_type_arity, t_list, A}, Locale) -> 108 | poly_type_arity_error("list", 1, A, Locale); 109 | fmt_parse_error({wrong_type_arity, t_map, A}, Locale) -> 110 | poly_type_arity_error("map", 2, A, Locale); 111 | fmt_parse_error({wrong_type_arity, t_pid, A}, Locale) -> 112 | poly_type_arity_error("pid", 1, A, Locale); 113 | fmt_parse_error({wrong_type_arity, t_string, _A}, Locale) -> 114 | simple_type_arity_error("string", Locale); 115 | fmt_parse_error(Unknown, Locale) -> 116 | E = fmt_unknown_error(Unknown, Locale), 117 | <<"(╯°□°）╯︵ ┻━┻ "/utf8, E/binary>>. 118 | 119 | simple_type_arity_error(LiteralType, Locale) -> 120 | t(__(<<"type_parameter_given_to_primitive_builtin_type %(type)">>), Locale, 121 | [{type, red(LiteralType)}]). 122 | 123 | poly_type_arity_error(LiteralType, ExpectedArity, ActualArity, Locale) -> 124 | t(__(<<"builtin_type_arity_error %(type) %(num_expected) %(num_supplied)">>), 125 | Locale, 126 | [{type, bold(LiteralType)}, 127 | {num_expected, green(integer_to_binary(ExpectedArity))}, 128 | {num_supplied, red(integer_to_binary(ActualArity))}]). 129 | 130 | fmt_unknown_error(Err, Locale) -> 131 | t(__(<<"unknown_error %(raw_error_term)">>), Locale, 132 | [{raw_error_term, io_lib:format("~tp", [Err])}]). 133 | 134 | t(MsgId, Locale) -> 135 | t(MsgId, Locale, []). 136 | 137 | t(MsgId, Locale, Replacements) -> 138 | Translated = case epo_gettext:gettext(alpaca_compiled_po, MsgId, Locale) of 139 | MsgId -> epo_gettext:gettext(alpaca_compiled_po, MsgId, "en_US"); 140 | Translation -> Translation 141 | end, 142 | replace(Translated, Replacements). 143 | 144 | replace(TranslatedStr, Replacements) -> 145 | lists:foldl(fun({FromAtom, To}, Str) -> 146 | FromStr = "%\\(" ++ atom_to_list(FromAtom) ++ "\\)", 147 | re:replace(Str, FromStr, To, [global | ?RE_OPTS]) 148 | end, TranslatedStr, Replacements). 149 | 150 | 151 | get_context(SourceDir, Module, Target, Fn) -> 152 | case file:open(io_lib:format("~ts/~ts.alp", [SourceDir, Module]), 153 | [read, binary]) of 154 | {ok, Device} -> 155 | read_lines(Device, 1, Target, Fn, []); 156 | _E -> 157 | "" 158 | end. 159 | 160 | read_lines(Device, Line, Target, Fn, Acc) 161 | when Line < Target - ?CTX_AREA -> 162 | case io:get_line(Device, "") of 163 | eof -> 164 | file:close(Device), 165 | lists:reverse(Acc); 166 | _Txt -> 167 | read_lines(Device, Line + 1, Target, Fn, Acc) 168 | end; 169 | read_lines(Device, Line, Target, _Fn, Acc) 170 | when Line > Target + ?CTX_AREA -> 171 | file:close(Device), 172 | lists:reverse(Acc); 173 | 174 | read_lines(Device, Line, Target, Fn, Acc) -> 175 | case io:get_line(Device, "") of 176 | eof -> 177 | file:close(Device), 178 | lists:reverse(Acc); 179 | Txt -> 180 | L1 = case Line of 181 | Target -> 182 | cf(" ~!r~4b~!!: ~ts", [Line, Fn(Txt)]); 183 | _ -> 184 | cf(" ~!c~4b~!!: ~ts", [Line, Txt]) 185 | end, 186 | read_lines(Device, Line + 1, Target, Fn, [L1 | Acc]) 187 | end. 188 | 189 | red(S) -> 190 | cf("~!r~ts", [S]). 191 | 192 | green(S) -> 193 | cf("~!g~ts", [S]). 194 | 195 | bold(S) -> 196 | cf("~!^~ts", [S]). 197 | 198 | cf(Fmt, Args) -> 199 | unicode:characters_to_binary(cf:format(Fmt, Args), utf8). 200 | 201 | 202 | %% Helper function to generate a 'highlighter' to display syntax errors 203 | %% in line. 204 | hl_fn("") -> 205 | fun(X) -> 206 | X 207 | end; 208 | hl_fn(O) -> 209 | P = re:replace(O, "[.^$*+?()[{\\\|\s#]", "\\\\&", [global | ?RE_OPTS]), 210 | R = red(O), 211 | fun(L) -> 212 | re:replace(L, ["(.*)", P, "(.*?)$"], ["\\1", R, "\\2"], ?RE_OPTS) 213 | end. 214 | 215 | -ifdef(TEST). 216 | -include_lib("eunit/include/eunit.hrl"). 217 | 218 | test_fmt(Error) -> 219 | CF = application:get_env(cf, colour_term), 220 | application:set_env(cf, colour_term, false), 221 | R = fmt(Error, "en_US"), 222 | application:set_env(cf, colour_term, CF), 223 | R. 224 | 225 | test_fmt_c(Error) -> 226 | CF = application:get_env(cf, colour_term), 227 | application:set_env(cf, colour_term, true), 228 | R = fmt(Error, "en_US"), 229 | application:set_env(cf, colour_term, CF), 230 | R. 231 | fmt_unknown_parse_error_test() -> 232 | File = "/tmp/file.alp", 233 | Line = 10, 234 | ParseError = unknown, 235 | Error = {error, {parse_error, File, Line, ParseError}}, 236 | Msg = test_fmt(Error), 237 | Expected = <<"/tmp/file.alp:10\n", 238 | " (╯°□°）╯︵ ┻━┻ "/utf8, "unknown\n" 239 | " Sorry, we do not have a proper message for this error yet.\n" 240 | " Please consider filing an issue at " 241 | "https://www.github.com/alpaca-lang/alpaca/issues.\n">>, 242 | ?assertEqual(Expected, Msg). 243 | 244 | fmt_unknown_error_test() -> 245 | application:set_env(cf, colour_term, false), 246 | Error = {error, unknown}, 247 | Msg = test_fmt(Error), 248 | Expected = <<"(╯°□°）╯︵ ┻━┻ "/utf8, "unknown\n" 249 | "Sorry, we do not have a proper message for this error yet.\n" 250 | "Please consider filing an issue at " 251 | "https://www.github.com/alpaca-lang/alpaca/issues.\n">>, 252 | ?assertEqual(Expected, Msg). 253 | 254 | en_us_fallback_test() -> 255 | File = "/tmp/file.alp", 256 | Line = 10, 257 | ParseError = {syntax_error, "blah"}, 258 | Error = {error, {parse_error, File, Line, ParseError}}, 259 | Msg = test_fmt(Error), 260 | Expected = <<"/tmp/file.alp:10\n" 261 | " Syntax error before \"blah\".\n">>, 262 | ?assertEqual(Expected, Msg). 263 | 264 | syntax_error_hl_test() -> 265 | File = "test/error.alp", 266 | Line = 11, 267 | ParseError = {syntax_error, "="}, 268 | Error = {error, {parse_error, File, Line, ParseError}}, 269 | Msg = test_fmt(Error), 270 | Expected = <<"test/error.alp:11\n" 271 | " Syntax error before \"=\".\n\n" 272 | " 9: let format ast_node = format_ast 0 ast_node\n" 273 | " 10: \n" 274 | " 11: let max_len = = 80\n" 275 | " 12: \n" 276 | " 13: let format_ast depth Symbol {name=name} =\n\n">>, 277 | ?assertEqual(Expected, Msg). 278 | 279 | syntax_error_hl_c_test() -> 280 | File = "test/error.alp", 281 | Line = 11, 282 | ParseError = {syntax_error, "="}, 283 | Error = {error, {parse_error, File, Line, ParseError}}, 284 | Msg = test_fmt_c(Error), 285 | Expected = 286 | <<"\e[4mtest/\e[0;36m\e[4merror\e[0m\e[4m.alp\e[0m:" 287 | "\e[0;36m11\e[0m\e[0m\n" 288 | " Syntax error before \"\e[0;31m=\e[0m\".\n\n" 289 | " \e[0;36m 9\e[0m: let format ast_node = format_ast 0 ast_node\n" 290 | "\e[0m \e[0;36m 10\e[0m: \n" 291 | "\e[0m \e[0;31m 11\e[0m: let max_len = \e[0;31m=\e[0m 80\n" 292 | "\e[0m \e[0;36m 12\e[0m: \n" 293 | "\e[0m \e[0;36m 13\e[0m: let format_ast depth Symbol " 294 | "{name=name} =\n\e[0m\n\e[0m">>, 295 | ?assertEqual(Expected, Msg). 296 | 297 | en_us_syntax_color_test() -> 298 | File = "/tmp/file.alp", 299 | Line = 10, 300 | ParseError = {syntax_error, "blah"}, 301 | Error = {error, {parse_error, File, Line, ParseError}}, 302 | Msg = test_fmt_c(Error), 303 | Expected = <<"\e[4m/tmp/\e[0;36m\e[4mfile\e[0m\e[4m.alp\e[0m:" 304 | "\e[0;36m10\e[0m\e[0m\n" 305 | " Syntax error before \"\e[0;31mblah\e[0m\".\n\e[0m">>, 306 | ?assertEqual(Expected, Msg). 307 | 308 | function_not_exported_test() -> 309 | File = "/tmp/module.alp", 310 | Line = 10, 311 | ParseError = {function_not_exported, module, <<"fun">>}, 312 | Error = {error, {parse_error, File, Line, ParseError}}, 313 | Msg = test_fmt(Error), 314 | Expected = <<"/tmp/module.alp:10\n" 315 | " No function \"fun\" exported from module \"module\".\n">>, 316 | ?assertEqual(Expected, Msg). 317 | 318 | function_not_exported_c_test() -> 319 | File = "/tmp/module.alp", 320 | Line = 10, 321 | ParseError = {function_not_exported, module, <<"fun">>}, 322 | Error = {error, {parse_error, File, Line, ParseError}}, 323 | Msg = test_fmt_c(Error), 324 | Expected = <<"\e[4m/tmp/\e[0;36m\e[4mmodule\e[0m\e[4m.alp\e[0m:" 325 | "\e[0;36m10\e[0m\e[0m\n" 326 | " No function \"\e[0;31mfun\e[0m\" exported from module " 327 | "\"\e[1mmodule\e[0m\".\n\e[0m">>, 328 | ?assertEqual(Expected, Msg). 329 | 330 | buildin_type_arity_test() -> 331 | File = "/tmp/module.alp", 332 | Line = 10, 333 | ParseError = {wrong_type_arity, t_pid, 42}, 334 | Error = {error, {parse_error, File, Line, ParseError}}, 335 | Msg = test_fmt(Error), 336 | Expected = <<"/tmp/module.alp:10\n" 337 | " Wrong number of type parameters provided for builtin type ", 338 | "\"pid\".\n" 339 | " Expected 1, but got 42.\n">>, 340 | ?assertEqual(Expected, Msg). 341 | 342 | buildin_type_arity_c_test() -> 343 | File = "/tmp/module.alp", 344 | Line = 10, 345 | ParseError = {wrong_type_arity, t_pid, 42}, 346 | Error = {error, {parse_error, File, Line, ParseError}}, 347 | Msg = test_fmt_c(Error), 348 | Expected = <<"\e[4m/tmp/\e[0;36m\e[4mmodule\e[0m\e[4m.alp\e[0m:" 349 | "\e[0;36m10\e[0m\e[0m\n" 350 | " Wrong number of type parameters provided for builtin type" 351 | " \"\e[1mpid\e[0m\".\n" 352 | " Expected \e[0;32m1\e[0m, but got \e[0;31m42\e[0m.\n\e[0m">>, 353 | ?assertEqual(Expected, Msg). 354 | 355 | 356 | 357 | real_error_test() -> 358 | Source = "let add a b = a + b", 359 | Error = {error, _} = alpaca:compile({text, Source}), 360 | Msg = test_fmt(Error), 361 | Expected = <<":1\n" 362 | " No module name defined.\n" 363 | " You may define it like this: \"module foo\".\n">>, 364 | ?assertEqual(Expected, Msg). 365 | 366 | -endif. 367 | -------------------------------------------------------------------------------- /src/alpaca_exhaustiveness.erl: -------------------------------------------------------------------------------- 1 | %% Performs exhaustiveness checking of pattern matches. 2 | %% 3 | %% Only deals with top level functions, as the typer currently does not 4 | %% expose type information on the expression level. 5 | -module(alpaca_exhaustiveness). 6 | 7 | -export([check_exhaustiveness/1]). 8 | -export([print_warning/1]). 9 | 10 | -include("alpaca_ast.hrl"). 11 | 12 | -type pattern() :: {missing_pattern, term()}. 13 | -type warning() :: {partial_function, warning_mfa(), [pattern()]}. 14 | -type warning_mfa() :: {Mod::atom(), Fun::string(), Arity::non_neg_integer()}. 15 | 16 | print_warning({partial_function, {M, F, A}, Patterns}) -> 17 | io:format("Warning: Partial function ~p.~s/~w. Missing patterns:~n", 18 | [M, F, A]), 19 | lists:foreach(fun(P) -> print_pattern(P, F) end, Patterns). 20 | 21 | print_pattern({missing_pattern, Args}, FName) -> 22 | Formatted = lists:map(fun format_pattern/1, Args), 23 | io:format(" let ~s ~s = ...~n", [FName, string:join(Formatted, " ")]). 24 | 25 | format_pattern({t_adt_cons, C, none}) -> C; 26 | format_pattern({t_adt_cons, C, Arg}) -> 27 | "(" ++ C ++ " " ++ format_pattern(Arg) ++ ")"; 28 | format_pattern({t_bool, Bool}) -> atom_to_list(Bool); 29 | format_pattern({t_list, empty}) -> "[]"; 30 | format_pattern({t_list, P}) -> 31 | "(" ++ format_pattern(P) ++ " :: _)"; 32 | format_pattern(t_map) -> "#{}"; 33 | format_pattern({t_tuple, Elems}) -> 34 | Parts = lists:map(fun(E) -> format_pattern(E) end, Elems), 35 | "(" ++ string:join(Parts, ", ") ++ ")"; 36 | format_pattern(t_unit) -> "()"; 37 | format_pattern({t_record, Assignments}) -> 38 | Fields = lists:map(fun({K, V}) -> 39 | atom_to_list(K) ++ " = " ++ format_pattern(V) end, 40 | maps:to_list(Assignments)), 41 | "{ " ++ string:join(Fields, ", ") ++ " }"; 42 | format_pattern('_') -> "_". 43 | 44 | -spec check_exhaustiveness([alpaca_module()]) -> [warning()]. 45 | check_exhaustiveness(Mods) -> 46 | lists:flatmap(fun(M) -> check_exhaustiveness(M, Mods) end, Mods). 47 | 48 | check_exhaustiveness(#alpaca_module{precompiled=true}, _AllMods) -> 49 | []; 50 | check_exhaustiveness(#alpaca_module{functions=Funs}=M, AllMods) -> 51 | lists:flatmap(fun(F) -> check_exhaustiveness(M, F, AllMods) end, Funs). 52 | 53 | check_exhaustiveness(Mod, #alpaca_binding{type=Type, bound_expr=Bound}=F, AllMods) -> 54 | case Bound of 55 | #alpaca_fun{} -> 56 | case Type of 57 | {t_arrow, FunArgTypes, _} -> 58 | check_exhaustiveness(Mod, F, FunArgTypes, AllMods); 59 | {t_receiver, _, {t_arrow, FunArgTypes, _}} -> 60 | check_exhaustiveness(Mod, F, FunArgTypes, AllMods); 61 | _ -> % Top level value 62 | [] 63 | end; 64 | _ -> 65 | [] 66 | end. 67 | 68 | check_exhaustiveness(Mod, #alpaca_binding{ 69 | name=#a_lab{name=Name}, 70 | bound_expr=#alpaca_fun{}=F}, 71 | FunArgTypes, AllMods) -> 72 | #alpaca_fun{arity=Arity, versions=FunArgPatterns} = F, 73 | case missing_patterns(Mod, FunArgTypes, FunArgPatterns, AllMods) of 74 | [] -> 75 | []; 76 | MissingPatterns -> 77 | MFA = {Mod#alpaca_module.name, Name, Arity}, 78 | [{partial_function, MFA, MissingPatterns}] 79 | end. 80 | 81 | missing_patterns(Mod, FunArgTypes, FunArgPatterns, AllMods) -> 82 | CoveringPatterns = covering_patterns(FunArgTypes, Mod, AllMods), 83 | ProvidedPatterns = extract_patterns(FunArgPatterns), 84 | lists:flatmap(fun({t_tuple, FunArgs}=CovP) -> 85 | case lists:any(fun(P) -> covered(CovP, P) end, ProvidedPatterns) of 86 | true -> []; 87 | false -> [{missing_pattern, FunArgs}] 88 | end 89 | end, CoveringPatterns). 90 | 91 | covering_patterns(FunArgTypes, Mod, AllMods) -> 92 | covering_patterns({t_tuple, FunArgTypes}, Mod, AllMods, sets:new(), []). 93 | 94 | covering_patterns(#adt{name=Name, vars=Vars}, Mod, AllMods, SeenADTs, _Vars) -> 95 | wildcard_if_seen(Name, Mod, AllMods, SeenADTs, Vars); 96 | covering_patterns(#alpaca_type{members=[], name={type_name, _, Name}, 97 | vars=Vars}, Mod, AllMods, SeenADTs, _Vars) -> 98 | wildcard_if_seen(Name, Mod, AllMods, SeenADTs, Vars); 99 | covering_patterns(#alpaca_type{members=Members}, Mod, AllMods, SeenADTs, 100 | Vars) -> 101 | lists:flatmap(fun(C) -> 102 | covering_patterns(C, Mod, AllMods, SeenADTs, Vars) 103 | end, Members); 104 | covering_patterns(#alpaca_type_tuple{members=Members}, Mod, AllMods, SeenADTs, 105 | Vars) -> 106 | covering_patterns({t_tuple, Members}, Mod, AllMods, SeenADTs, Vars); 107 | covering_patterns(#alpaca_constructor{name=#type_constructor{name=N}, arg=none}, 108 | _Mod, _AllMods, _SeenADTs, _Vars) -> 109 | [{t_adt_cons, N, none}]; 110 | covering_patterns(#alpaca_constructor{name=#type_constructor{name=N}, arg=Arg}, 111 | Mod, AllMods, SeenADTs, Vars) -> 112 | ArgPatterns = covering_patterns(Arg, Mod, AllMods, SeenADTs, Vars), 113 | lists:map(fun(A) -> {t_adt_cons, N, A} end, ArgPatterns); 114 | covering_patterns({t_arrow, _, _}, _Mod, _AllMods, _SeenADTs, _Vars) -> 115 | ['_']; 116 | covering_patterns(t_atom, _Mod, _AllMods, _SeenADTs, _Vars) -> 117 | ['_']; 118 | covering_patterns(t_binary, _Mod, _AllMods, _SeenADTs, _Vars) -> 119 | ['_']; 120 | covering_patterns(t_bool, _Mod, _AllMods, _SeenADTs, _Vars) -> 121 | [{t_bool, true}, {t_bool, false}]; 122 | covering_patterns(t_chars, _Mod, _AllMods, _SeenADTs, _Vars) -> 123 | ['_']; 124 | covering_patterns(t_float, _Mod, _AllMods, _SeenADTs, _Vars) -> 125 | ['_']; 126 | covering_patterns(t_int, _Mod, _AllMods, _SeenADTs, _Vars) -> 127 | ['_']; 128 | covering_patterns({t_list, Elem}, Mod, AllMods, SeenADTs, Vars) -> 129 | ElemPatterns = covering_patterns(Elem, Mod, AllMods, SeenADTs, Vars), 130 | Base = lists:map(fun(E) -> {t_list, E} end, ElemPatterns), 131 | [{t_list, empty}|Base]; 132 | %% We explicitly ignore maps. 133 | %% Consider this example: 134 | %% let foo #{true => false, false => true} = ... 135 | %% 136 | %% The most helpful patterns to report would be: 137 | %% let foo #{true => false, false => false} = ... 138 | %% let foo #{true => true, false => true } = ... 139 | %% let foo #{true => true, false => false } = ... 140 | %% 141 | %% However, to do this, we would need to know all the keys that are used 142 | %% in the patterns, and we do not get that information from the type. 143 | covering_patterns({t_map, _KeyT, _ValT}, _Mod, _AllMods, _SeenADTs, _Vars) -> 144 | [t_map]; 145 | covering_patterns(#t_record{members=Ms}, Mod, AllMods, SeenADTs, Vars) -> 146 | Assignments = record_field_assignments(Ms, Mod, AllMods, SeenADTs, Vars), 147 | lists:map(fun(A) -> {t_record, A} end, Assignments); 148 | covering_patterns(t_string, _Mod, _AllMods, _SeenADTs, _Vars) -> 149 | ['_']; 150 | covering_patterns({t_tuple, Ms}, Mod, AllMods, SeenADTs, Vars) -> 151 | lists:map(fun(A) -> {t_tuple, maps:values(A)} end, 152 | tuple_patterns(Ms, 1, Mod, AllMods, SeenADTs, Vars)); 153 | covering_patterns(t_unit, _Mod, _AllMods, _SeenADTs, _Vars) -> 154 | [t_unit]; 155 | covering_patterns({type_var, _, Var}, Mod, AllMods, SeenADTs, Vars) -> 156 | {Var, C} = lists:keyfind(Var, 1, Vars), 157 | covering_patterns(C, Mod, AllMods, SeenADTs, Vars); 158 | covering_patterns({unbound, _, _}, _Mod, _AllMods, _SeenADTs, _Vars) -> 159 | ['_']. 160 | 161 | wildcard_if_seen(Name, Mod, AllMods, SeenADTs0, Vars) -> 162 | case sets:is_element(Name, SeenADTs0) of 163 | true -> 164 | ['_']; 165 | false -> 166 | {ok, T} = lookup_type(Name, Mod, AllMods), 167 | SeenADTs = sets:add_element(Name, SeenADTs0), 168 | %% User-defined ADTs may bind concrete types or new variable names 169 | %% to existing ADT variables, causing name lookup failures. Here 170 | %% we replace any user-supplied or synthetic names with the original 171 | %% type definition's variable names so that lookup in 172 | %% covering_patterns/5 does not fail. 173 | Vars2 = case T of 174 | #alpaca_type{vars=Vs} -> 175 | F = fun({{type_var, _, _}, ActualV}) -> ActualV; 176 | ({{_, Bound}, {_, _, ActualV}}) -> {ActualV, Bound} 177 | end, 178 | lists:map(F, lists:zip(Vars, Vs)); 179 | _ -> 180 | Vars 181 | end, 182 | covering_patterns(T, Mod, AllMods, SeenADTs, Vars2) 183 | end. 184 | 185 | lookup_type(Name, Mod, AllMods) -> 186 | case lookup_type(Mod#alpaca_module.types, Name) of 187 | {ok, _}=Res -> 188 | Res; 189 | {not_found, _} -> 190 | lookup_type_from_imports(Name, Mod, AllMods) 191 | end. 192 | 193 | lookup_type([], Name) -> 194 | {not_found, Name}; 195 | lookup_type([#alpaca_type{name={type_name, _, Name}}=T|_], Name) -> 196 | {ok, T}; 197 | lookup_type([_|Rest], Name) -> 198 | lookup_type(Rest, Name). 199 | 200 | lookup_type_from_imports(Name, #alpaca_module{type_imports=Imports}, 201 | AllMods) -> 202 | %% This used to be a simple keyfind before (almost) all identifiers became 203 | %% "labels" instead of raw binary or string names. 204 | Filtered = lists:filter( fun(#alpaca_type_import{type=#a_lab{name=N}}) when Name =:= N -> 205 | true; 206 | (_) -> false 207 | end 208 | , Imports 209 | ), 210 | 211 | case Filtered of 212 | [#alpaca_type_import{module=#a_lab{name=ModName}}] -> 213 | Mod = lists:keyfind(ModName, #alpaca_module.name, AllMods), 214 | lookup_type(Mod#alpaca_module.types, Name); 215 | _ -> % abstract/hidden type in another module. 216 | {ok, {unbound, '_', 1}} 217 | end. 218 | 219 | record_field_assignments([], _Mod, _AllMods, _SeenADTs, _Vars) -> 220 | [#{}]; 221 | record_field_assignments([#t_record_member{name=Key, type=T}|Rest], Mod, 222 | AllMods, SeenADTs, 223 | Vars) -> 224 | RestAssignments = record_field_assignments(Rest, Mod, AllMods, SeenADTs, 225 | Vars), 226 | lists:flatmap(fun(C) -> 227 | lists:map(fun(A) -> maps:put(Key, C, A) end, RestAssignments) 228 | end, covering_patterns(T, Mod, AllMods, SeenADTs, Vars)). 229 | 230 | tuple_patterns([], _Ix, _Mod, _AllMods, _SeenADTs, _Vars) -> 231 | [#{}]; 232 | tuple_patterns([T|Rest], Ix, Mod, AllMods, SeenADTs, Vars) -> 233 | RestPatterns = tuple_patterns(Rest, Ix+1, Mod, AllMods, SeenADTs, Vars), 234 | lists:flatmap(fun(C) -> 235 | lists:map(fun(A) -> maps:put(Ix, C, A) end, RestPatterns) 236 | end, covering_patterns(T, Mod, AllMods, SeenADTs, Vars)). 237 | 238 | extract_patterns(FunArgPatterns) -> 239 | lists:map(fun(#alpaca_fun_version{args=Args}) -> 240 | #alpaca_tuple{values=Args} 241 | end, FunArgPatterns). 242 | 243 | covered(extraneous_record_field, _) -> 244 | false; 245 | covered('_', Pattern) -> 246 | matches_wildcard(Pattern); 247 | covered({t_adt_cons, Name, PArg}, Pattern) -> 248 | matches_constructor(Pattern, Name, PArg); 249 | covered({t_bool, Boolean}, Pattern) -> 250 | matches_bool(Pattern, Boolean); 251 | covered({t_list, empty}, Pattern) -> 252 | matches_empty_list(Pattern); 253 | covered({t_list, Elem}, Pattern) -> 254 | matches_list(Pattern, Elem); 255 | covered(t_map, _Pattern) -> 256 | true; 257 | covered({t_record, Assignments}, Pattern) -> 258 | matches_record(Pattern, Assignments); 259 | covered({t_tuple, Members}, Pattern) -> 260 | matches_tuple(Pattern, Members); 261 | covered(t_unit, Pattern) -> 262 | matches_unit(Pattern). 263 | 264 | matches_bool(#a_bool{val=Bool}, Bool) -> 265 | true; 266 | matches_bool(Other, _Bool) -> 267 | matches_wildcard(Other). 268 | 269 | matches_constructor(#alpaca_type_apply{name=#type_constructor{name=Name}, 270 | arg=none}, Name, none) -> 271 | true; 272 | matches_constructor(#alpaca_type_apply{name=#type_constructor{name=Name}, 273 | arg=Arg}, Name, PArg) -> 274 | covered(PArg, Arg); 275 | matches_constructor(P, _Name, _PArg) -> 276 | matches_wildcard(P). 277 | 278 | matches_empty_list({nil, _}) -> 279 | true; 280 | matches_empty_list(P) -> 281 | matches_wildcard(P). 282 | 283 | matches_list(#alpaca_cons{head=H, tail=T}, E) -> 284 | covered(E, H) andalso matches_wildcard(T); 285 | matches_list(P, _E) -> 286 | matches_wildcard(P). 287 | 288 | matches_record(#alpaca_record{members=Ms}, Assignments) -> 289 | %% `extraneous_record_field` covers the situation in issue #260 290 | %% (https://github.com/alpaca-lang/alpaca/issues/260) where we have an 291 | %% "extra" record field that should not mask an incomplete match with a 292 | %% crash: 293 | lists:all(fun(#alpaca_record_member{name=N, val=P}) -> 294 | covered(maps:get(N, Assignments, extraneous_record_field), P) 295 | end, Ms); 296 | matches_record(P, _Assignments) -> 297 | matches_wildcard(P). 298 | 299 | matches_tuple(#alpaca_tuple{values=Patterns}, TElems) -> 300 | matches(Patterns, TElems); 301 | matches_tuple(P, _TElems) -> 302 | matches_wildcard(P). 303 | 304 | matches([], []) -> true; 305 | matches([Pattern|Patterns], [CP|CPs]) -> 306 | covered(CP, Pattern) andalso matches(Patterns, CPs). 307 | 308 | matches_unit(#a_unit{}) -> 309 | true; 310 | matches_unit(P) -> 311 | matches_wildcard(P). 312 | 313 | matches_wildcard({'_', _}) -> 314 | true; 315 | matches_wildcard(#a_lab{}) -> 316 | true; 317 | matches_wildcard(_) -> 318 | false. 319 | 320 | -ifdef(TEST). 321 | 322 | -include_lib("eunit/include/eunit.hrl"). 323 | 324 | atom_coverage_test() -> 325 | Code = 326 | "module coverage\n\n" 327 | "let complete_wildcard :ok = :ok\n" 328 | "let complete_wildcard _ = :ok\n\n" 329 | "let missing_wildcard :ok = :ok\n\n", 330 | ?assertMatch([ 331 | {partial_function, {<<"coverage">>, <<"missing_wildcard">>, 1}, 332 | [{missing_pattern,['_']}]} 333 | ], run_checks([Code])). 334 | 335 | arrow_coverage_test() -> 336 | Code = 337 | "module coverage\n\n" 338 | "let complete_wildcard f = (f 1) + 1\n\n", 339 | ?assertMatch([], run_checks([Code])). 340 | 341 | binary_coverage_test() -> 342 | Code = 343 | "module coverage\n\n" 344 | "let complete_wildcard <<\"\">> = :ok\n" 345 | "let complete_wildcard _ = :ok\n\n" 346 | "let missing_wildcard <<\"\">> = :ok\n\n", 347 | ?assertMatch([ 348 | {partial_function, {<<"coverage">>, <<"missing_wildcard">>, 1}, 349 | [{missing_pattern,['_']}]} 350 | ], run_checks([Code])). 351 | 352 | boolean_coverage_test() -> 353 | Code = 354 | "module coverage\n\n" 355 | "let complete_boolean true = :ok\n" 356 | "let complete_boolean false = :ok\n\n" 357 | "let complete_wildcard false = :ok\n" 358 | "let complete_wildcard _ = :ok\n\n" 359 | "let missing_true false = :ok\n\n" 360 | "let missing_false false = :ok\n\n", 361 | ?assertMatch([ 362 | {partial_function, {<<"coverage">>, <<"missing_true">>, 1}, 363 | [{missing_pattern,[{t_bool,true}]}]}, 364 | {partial_function, {<<"coverage">>, <<"missing_false">>, 1}, 365 | [{missing_pattern,[{t_bool,true}]}]} 366 | ], run_checks([Code])). 367 | 368 | erlang_string_coverage_test() -> 369 | Code = 370 | "module coverage\n\n" 371 | "let complete_wildcard c\"\" = :ok\n" 372 | "let complete_wildcard _ = :ok\n\n" 373 | "let missing_wildcard c\"\" = :ok\n\n", 374 | ?assertMatch([ 375 | {partial_function, {<<"coverage">>, <<"missing_wildcard">>, 1}, 376 | [{missing_pattern,['_']}]} 377 | ], run_checks([Code])). 378 | 379 | float_coverage_test() -> 380 | Code = 381 | "module coverage\n\n" 382 | "let complete_wildcard 1.0 = :ok\n" 383 | "let complete_wildcard _ = :ok\n\n" 384 | "let missing_wildcard 1.0 = :ok\n\n", 385 | ?assertMatch([ 386 | {partial_function, {<<"coverage">>, <<"missing_wildcard">>, 1}, 387 | [{missing_pattern,['_']}]} 388 | ], run_checks([Code])). 389 | 390 | int_coverage_test() -> 391 | Code = 392 | "module coverage\n\n" 393 | "let complete_wildcard 1 = :ok\n" 394 | "let complete_wildcard _ = :ok\n\n" 395 | "let missing_wildcard 1 = :ok\n\n", 396 | ?assertMatch([ 397 | {partial_function, {<<"coverage">>, <<"missing_wildcard">>, 1}, 398 | [{missing_pattern,['_']}]} 399 | ], run_checks([Code])). 400 | 401 | string_coverage_test() -> 402 | Code = 403 | "module coverage\n\n" 404 | "let complete_wildcard \"\" = :ok\n" 405 | "let complete_wildcard _ = :ok\n\n" 406 | "let missing_wildcard \"\" = :ok\n\n", 407 | ?assertMatch([ 408 | {partial_function, {<<"coverage">>, <<"missing_wildcard">>, 1}, 409 | [{missing_pattern,['_']}]} 410 | ], run_checks([Code])). 411 | 412 | unit_coverage_test() -> 413 | Code = 414 | "module coverage\n\n" 415 | "let complete_unit () = :ok\n\n", 416 | ?assertMatch([], run_checks([Code])). 417 | 418 | tuple_coverage_test() -> 419 | Code = 420 | "module coverage\n\n" 421 | "let complete (true, true) = :ok\n" 422 | "let complete (true, false) = :ok\n" 423 | "let complete (false, true) = :ok\n" 424 | "let complete (false, false) = :ok\n" 425 | "let complete_wildcard (true, _) = :ok\n" 426 | "let complete_wildcard _ = :ok\n\n" 427 | "let missing (true, true) = :ok\n" 428 | "let missing (false, _) = :ok\n\n", 429 | ?assertMatch([ 430 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 431 | [{missing_pattern,[{t_tuple,[{t_bool,true},{t_bool,false}]}]}]} 432 | ], run_checks([Code])). 433 | 434 | list_coverage_test() -> 435 | Code = 436 | "module coverage\n\n" 437 | "let complete_wildcard [] = :ok\n" 438 | "let complete_wildcard _ :: _ = :ok\n\n" 439 | "let missing [true, false] = :ok\n\n", 440 | ?assertMatch([ 441 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 442 | [{missing_pattern,[{t_list, empty}]}, 443 | {missing_pattern,[{t_list, {t_bool, true}}]}, 444 | {missing_pattern,[{t_list, {t_bool, false}}]}]} 445 | ], run_checks([Code])). 446 | 447 | map_coverage_test() -> 448 | Code = 449 | "module coverage\n\n" 450 | "let missing #{true => false} = :ok\n\n", 451 | ?assertMatch([], run_checks([Code])). 452 | 453 | record_coverage_test() -> 454 | Code = 455 | "module coverage\n\n" 456 | "let complete {x = ()} = :ok\n\n" 457 | "let complete_wildcard {x = false, y = true} = :ok\n" 458 | "let complete_wildcard _ = :ok\n\n" 459 | "let missing {x = false, y = false} = :ok\n" 460 | "let missing {x = true} = :ok\n\n", 461 | ?assertMatch([ 462 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 463 | [{missing_pattern, 464 | [{t_record, #{x := {t_bool, false}, y := {t_bool, true}}}]}]} 465 | ], run_checks([Code])). 466 | 467 | basic_adt_coverage_test() -> 468 | Code = 469 | "module coverage\n\n" 470 | "type color = Red | Green | Blue\n\n" 471 | "let complete Red = :ok\n" 472 | "let complete Green = :ok\n" 473 | "let complete Blue = :ok\n\n" 474 | "let complete_wildcard Red = :ok\n" 475 | "let complete_wildcard color = :ok\n\n" 476 | "let missing Red = :ok\n\n", 477 | ?assertMatch([ 478 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 479 | [{missing_pattern,[{t_adt_cons,"Green",none}]}, 480 | {missing_pattern,[{t_adt_cons,"Blue",none}]}]} 481 | ], run_checks([Code])). 482 | 483 | parameterized_adt_coverage_test() -> 484 | Code = 485 | "module coverage\n\n" 486 | "type option 'a = None | Some 'a\n\n" 487 | "let complete None = :ok\n" 488 | "let complete (Some false) = :ok\n" 489 | "let complete (Some true) = :ok\n\n" 490 | "let complete_wildcard (Some false) = :ok\n" 491 | "let complete_wildcard _ = :ok\n\n" 492 | "let missing (Some false) = :ok\n\n", 493 | ?assertMatch([ 494 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 495 | [{missing_pattern,[{t_adt_cons,"None",none}]}, 496 | {missing_pattern,[{t_adt_cons,"Some",{t_bool, true}}]}]} 497 | ], run_checks([Code])). 498 | 499 | recursive_adt_test() -> 500 | Code = 501 | "module coverage\n\n" 502 | "type tree = Leaf | Tree (tree, bool, tree)\n\n" 503 | "let complete Leaf = :ok\n" 504 | "let complete (Tree (_, true, _)) = :ok\n" 505 | "let complete (Tree (_, false, _)) = :ok\n\n" 506 | "let complete_wildcard Leaf = :ok\n" 507 | "let complete_wildcard _ = :ok\n\n" 508 | "let missing (Tree (Leaf, false, _)) = :ok\n\n", 509 | ?assertMatch([ 510 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 511 | [{missing_pattern,[{t_adt_cons,"Leaf",none}]}, 512 | {missing_pattern,[{t_adt_cons,"Tree",{t_tuple, ['_', {t_bool, true}, '_']}}]}, 513 | {missing_pattern,[{t_adt_cons,"Tree",{t_tuple, ['_', {t_bool, false}, '_']}}]} 514 | ]}], run_checks([Code])). 515 | 516 | multi_arg_test() -> 517 | Code = 518 | "module coverage\n\n" 519 | "let complete true true true = :ok\n" 520 | "let complete true true false = :ok\n" 521 | "let complete true false true = :ok\n" 522 | "let complete true false false = :ok\n" 523 | "let complete false true true = :ok\n" 524 | "let complete false true false = :ok\n" 525 | "let complete false false true = :ok\n" 526 | "let complete false false false = :ok\n" 527 | "let complete_wildcard true true true = :ok\n" 528 | "let complete_wildcard _ _ _ = :ok\n\n" 529 | "let missing false true false = :ok\n" 530 | "let missing true _ _ = :ok\n\n", 531 | ?assertMatch([ 532 | {partial_function, {<<"coverage">>, <<"missing">>, 3}, 533 | [{missing_pattern, [{t_bool,false},{t_bool,true},{t_bool,true}]}, 534 | {missing_pattern, [{t_bool,false},{t_bool,false},{t_bool,true}]}, 535 | {missing_pattern, [{t_bool,false},{t_bool,false},{t_bool,false}]} 536 | ]}], run_checks([Code])). 537 | 538 | imported_type_test() -> 539 | Mod1 = 540 | "module provider\n\n" 541 | "type color = Red | Green | Blue\n\n" 542 | "export_type color", 543 | Mod2 = 544 | "module consumer\n\n" 545 | "import_type provider.color\n\n" 546 | "let missing Red = :ok\n" 547 | "let missing Blue = :ok\n\n", 548 | ?assertMatch([ 549 | {partial_function, {<<"consumer">>, <<"missing">>, 1}, 550 | [{missing_pattern, [{t_adt_cons, "Green", none}]} 551 | ]}], run_checks([Mod1, Mod2])). 552 | 553 | foreign_type_test() -> 554 | Mod1 = 555 | "module provider\n\n" 556 | "export is_color_of_grass/1\n\n" 557 | "type color = Red | Green | Blue\n\n" 558 | "let is_color_of_grass Green = true\n" 559 | "let is_color_of_grass _ = false\n\n", 560 | Mod2 = 561 | "module consumer\n\n" 562 | "let complete color = provider.is_color_of_grass color\n\n", 563 | ?assertMatch([], run_checks([Mod1, Mod2])). 564 | 565 | receiver_test() -> 566 | Code = 567 | "module coverage\n\n" 568 | "let missing true = receive with\n" 569 | " i, is_integer i -> :ok\n\n", 570 | ?assertMatch([ 571 | {partial_function, {<<"coverage">>, <<"missing">>, 1}, 572 | [{missing_pattern, [{t_bool, false}]} 573 | ]}], run_checks([Code])). 574 | 575 | top_level_value_test() -> 576 | Code = 577 | "module coverage\n\n" 578 | "let one = 1\n\n", 579 | ?assertMatch([], run_checks([Code])). 580 | 581 | overloaded_record_test() -> 582 | %% Example taken from future_ast.alp: 583 | Code = 584 | "module m \n" 585 | "type renameable = Named string | Renamed { name: string, original: string } \n" 586 | "type label = Symbol { line: int, name: renameable } \n" 587 | "let label_rename (Symbol {line=l, name=Named n}) new_name = \n" 588 | " Symbol {line=l, name=Renamed {name=new_name, original=n}} \n" 589 | %% Using `orig` here should result in a non-exhaustive match warning instead 590 | %% of a crash as found in issue #260: 591 | "let label_rename (Symbol {line=l, name=Renamed {orig=o}}) new_name = \n" 592 | " Symbol {line=l, name=Renamed {name=new_name, original=o}}", 593 | ?assertEqual( 594 | [{partial_function, {<<"m">>, <<"label_rename">>, 2}, 595 | [{missing_pattern, 596 | [{t_adt_cons,"Symbol", 597 | {t_record, 598 | #{line => '_', 599 | name => 600 | {t_adt_cons, 601 | "Renamed", 602 | {t_record, #{name => '_', original => '_'}}}}}}, 603 | '_']}]}], 604 | run_checks([Code])). 605 | 606 | 607 | run_checks(ModeCodeListings) -> 608 | NamedSources = lists:map(fun(C) -> {?FILE, C} end, ModeCodeListings), 609 | {ok, ParsedMods} = alpaca_ast_gen:make_modules(NamedSources), 610 | {ok, TypedMods} = alpaca_typer:type_modules(ParsedMods), 611 | io:format("TypedMods:~n~p~n", [TypedMods]), 612 | Warnings = check_exhaustiveness(TypedMods), 613 | %% To test the formatter does not crash 614 | lists:foreach(fun print_warning/1, Warnings), 615 | Warnings. 616 | -endif. 617 | -------------------------------------------------------------------------------- /src/alpaca_printer.erl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2017 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | % 17 | %%% This module pretty prints Alpaca types from their AST representation. 18 | %%% This is useful for error messages, pretty printing module documentation, 19 | %%% shells and debugging. User defined types are also supported. 20 | 21 | -module(alpaca_printer). 22 | 23 | -export([format_type/1, format_binding/1, format_module/1, format_module/2]). 24 | 25 | -include("alpaca_ast.hrl"). 26 | 27 | -ifdef(TEST). 28 | -include_lib("eunit/include/eunit.hrl"). 29 | -endif. 30 | 31 | -ignore_xref([format_type/1, format_binding/1, format_module/1, format_module/2]). 32 | 33 | %% If a type has multiple parts, we may need to add parens so it is 34 | %% unambigious for types like t_arrow, t_list etc., 35 | infer_parens(<<"(", _Rest/binary>> = TypeRep) -> TypeRep; 36 | infer_parens(<<"{", _Rest/binary>> = TypeRep) -> TypeRep; 37 | infer_parens(TypeRepr) -> 38 | case binary:split(TypeRepr, <<" ">>) of 39 | [_] -> TypeRepr; 40 | [_, _] -> 41 | <<"(", TypeRepr/binary, ")">> 42 | end. 43 | 44 | %% Simple primitive types 45 | format_t(t_int) -> <<"int">>; 46 | format_t(t_float) -> <<"float">>; 47 | format_t(t_string) -> <<"string">>; 48 | format_t(t_binary) -> <<"binary">>; 49 | format_t(t_atom) -> <<"atom">>; 50 | format_t(t_unit) -> <<"()">>; 51 | format_t(t_bool) -> <<"boolean">>; 52 | format_t(t_chars) -> <<"chars">>; 53 | format_t(t_rec) -> <<"rec">>; 54 | 55 | %% Complex types 56 | format_t({t_tuple, TupleTypes}) -> 57 | FormattedTypes = lists:map(fun(T) -> format_t(T) end, TupleTypes), 58 | TupleList = list_to_binary(lists:join(<<", ">>, FormattedTypes)), 59 | <<"(", TupleList/binary, ")">>; 60 | 61 | format_t({t_list, ListType}) -> 62 | SubTypeRepr = infer_parens(format_type_arg(ListType)), 63 | <<"list ", SubTypeRepr/binary>>; 64 | 65 | format_t(#t_record{members=Members}) -> 66 | SubTypeReprs = lists:map(fun(T) -> format_t(T) end, Members), 67 | MembersList = list_to_binary(lists:join(<<", ">>, SubTypeReprs)), 68 | <<"{", MembersList/binary, "}">>; 69 | 70 | format_t(#t_record_member{name=Name, type=Type}) -> 71 | NameRepr = list_to_binary(atom_to_list(Name)), 72 | TypeRepr = format_t(Type), 73 | <>; 74 | 75 | %% Function types 76 | format_t({t_arrow, Args, RetType}) -> 77 | ArgReprs = lists:map(fun(T) -> infer_parens(format_t(T)) end, Args), 78 | ArgsList = list_to_binary(lists:join(<<" ">>, ArgReprs)), 79 | RetRepr = format_t(RetType), 80 | <<"fn ", ArgsList/binary, " -> ", RetRepr/binary>>; 81 | 82 | format_t({unbound, N, _}) -> 83 | Num = atom_to_binary(N, utf8), 84 | <<"!!", Num/binary>>; 85 | 86 | format_t(#adt{name=Name, vars=Vars}) -> 87 | case Vars of 88 | [] -> Name; 89 | _ -> ArgReprs = lists:map(fun({_, T}) -> 90 | infer_parens(format_t(T)) 91 | end, 92 | Vars), 93 | 94 | ArgsList = list_to_binary(lists:join(<<" ">>, ArgReprs)), 95 | 96 | <> 97 | end; 98 | 99 | format_t({t_map, Key, Val}) -> 100 | KeyRepr = infer_parens(format_t(Key)), 101 | ValRepr = infer_parens(format_t(Val)), 102 | <<"map ", KeyRepr/binary, " ", ValRepr/binary>>; 103 | 104 | format_t({t_pid, Type}) -> 105 | TypeRepr = infer_parens(format_t(Type)), 106 | <<"pid ", TypeRepr/binary>>; 107 | 108 | format_t({t_receiver, Initial, ReceiveFun}) -> 109 | InitialRepr = infer_parens(format_t(Initial)), 110 | ReceiveFunRepr = infer_parens(format_t(ReceiveFun)), 111 | <<"receiver ", InitialRepr/binary, " ", ReceiveFunRepr/binary>>; 112 | 113 | %% Catch all 114 | format_t(Unknown) -> io:format("unknown type ~p", [Unknown]). 115 | 116 | format_type(Type) -> 117 | Repr = format_t(Type), 118 | %% Deal with any type vars 119 | case re:run(Repr, <<"!!t([0-9]+)">>, [global, {capture, first, binary}]) of 120 | {match, Matches} -> 121 | TypeVars = lists:usort(lists:map(fun([M]) -> M end, Matches)), 122 | apply_type_vars(Repr, TypeVars, 97); 123 | _ -> 124 | Repr 125 | end. 126 | 127 | apply_type_vars(Str, [], _NextVar) -> 128 | Str; 129 | 130 | apply_type_vars(Str, [TV | Rest], NextVar) -> 131 | NewStr = re:replace(Str, TV, <<"'", NextVar>>, [global, {return, binary}]), 132 | apply_type_vars(NewStr, Rest, NextVar+1). 133 | 134 | format_binding(#alpaca_binding{type=Type, name=#a_lab{name=Name}}) -> 135 | TypeSigRepr = format_type(Type), 136 | TypeVarsRepr = case re:run(TypeSigRepr, <<"'[a-z]">>, 137 | [global, {capture, first, binary}]) of 138 | nomatch -> 139 | <<"">>; 140 | 141 | {match, Vars} -> 142 | TypeVars = lists:usort(lists:map(fun([M]) -> M end, Vars)), 143 | list_to_binary(lists:join(" ", TypeVars) ++ " ") 144 | end, 145 | <<"val ", Name/binary, " ", TypeVarsRepr/binary, ": ", TypeSigRepr/binary>>. 146 | 147 | format_type_arg({type_var, _, TVName}) -> list_to_binary("'" ++ TVName); 148 | format_type_arg(none) -> <<"">>; 149 | format_type_arg({alpaca_type_tuple, Args}) -> 150 | ArgsFmt = lists:map(fun format_type_arg/1, Args), 151 | Joined = lists:join(", ", ArgsFmt), 152 | list_to_binary("(" ++ Joined ++ ")"); 153 | format_type_arg(#alpaca_type{vars=Vars, name={_, _, Name}}) -> 154 | TypeVars = case length(Vars) > 0 of 155 | true -> 156 | VarsFmt = lists:map(fun({type_var, _, TVName}) -> 157 | "'" ++ TVName; 158 | ({{type_var, _, _}, T}) -> 159 | format_type_arg(T) 160 | end, 161 | Vars), 162 | list_to_binary(" " ++ lists:join(" ", VarsFmt)); 163 | false -> 164 | <<"">> 165 | end, 166 | <>; 167 | 168 | 169 | format_type_arg(Other) -> format_type(Other). 170 | 171 | format_type_def(#alpaca_type{vars=Vars, name={_, _, Name}, members=Members}) -> 172 | TypeVars = case length(Vars) > 0 of 173 | true -> list_to_binary( 174 | lists:join(" ", lists:map(fun({type_var, _, TVName}) -> 175 | 176 | " '" ++ TVName 177 | end, 178 | Vars))); 179 | false -> <<"">> 180 | end, 181 | MemberRepr = list_to_binary(lists:join(" | ", lists:map( 182 | fun 183 | (#alpaca_constructor{name=#type_constructor{name=N}, arg=none}) -> 184 | list_to_binary(N); 185 | (#alpaca_constructor{name=#type_constructor{name=N}, arg=Arg}) -> 186 | list_to_binary(N ++ " " ++ infer_parens(format_type_arg(Arg))); 187 | ({type_var, _, _, T}) -> format_type(T); 188 | (Other) -> 189 | format_type_arg(Other) 190 | end, 191 | Members))), 192 | <<"type ", Name/binary, TypeVars/binary, " = ", MemberRepr/binary>>; 193 | format_type_def(#alpaca_type_alias{name={_, _, Name}, target=T}) -> 194 | TargetRepr = format_type_arg(T), 195 | <<"type ", Name/binary, " = ", TargetRepr/binary>>. 196 | 197 | format_module(#alpaca_module{functions=Funs, 198 | name=ModName, 199 | types=ModTypes, 200 | type_exports=TypeExports, 201 | function_exports=FunExports}, Opts) -> 202 | %% Sort funs by line 203 | SortedFuns = lists:sort( 204 | fun(#alpaca_binding{name=#a_lab{line = L1}}, 205 | #alpaca_binding{name=#a_lab{line = L2}}) -> 206 | L1 =< L2 207 | end, 208 | Funs), 209 | {PublicFuns, PrivateFuns} = lists:partition( 210 | fun(#alpaca_binding{name=#a_lab{name=FunName}, type=T}) -> 211 | lists:any(fun(#a_lab{name=N}) when is_binary(N) -> N == FunName; 212 | ({#a_lab{name=N}, Arity}) when is_binary(N) -> 213 | case T of 214 | {t_arrow, Args, _} -> 215 | (N == FunName) and (length(Args) == Arity); 216 | _ -> N == FunName 217 | end; 218 | (_O) -> false 219 | end, 220 | FunExports) 221 | end, 222 | SortedFuns), 223 | 224 | {PublicTypes, PrivateTypes} = lists:partition( 225 | fun(#alpaca_type{name={_, _, TName}}) -> 226 | lists:member(TName, TypeExports); 227 | (#alpaca_type_alias{name={_, _, TName}}) -> 228 | lists:member(TName, TypeExports) 229 | end, 230 | ModTypes), 231 | Bindings = lists:map(fun format_binding/1, PublicFuns), 232 | BindingsRepr = list_to_binary(lists:join("\n\n", Bindings)), 233 | 234 | Types = lists:reverse(lists:map(fun format_type_def/1, PublicTypes)), 235 | TypesRepr = list_to_binary(lists:join("\n\n", Types)), 236 | PublicTypeHeader = <<"-- Exported types\n", 237 | "-----------------\n\n">>, 238 | PublicFunHeader = <<"-- Exported functions\n" 239 | "---------------------\n\n">>, 240 | ModAndPublic = <<"module ", ModName/binary, "\n\n", 241 | PublicTypeHeader/binary, 242 | TypesRepr/binary, 243 | "\n\n", 244 | PublicFunHeader/binary, 245 | BindingsRepr/binary, 246 | "\n">>, 247 | 248 | case lists:member(internal, Opts) of 249 | false -> 250 | ModAndPublic; 251 | true -> 252 | PrivateTypeHeader = 253 | <<"\n-- Internal types\n" 254 | "-----------------\n\n">>, 255 | 256 | PrivateFunHeader = 257 | <<"-- Internal functions\n" 258 | "---------------------\n\n">>, 259 | 260 | PrivateTypesMap = 261 | lists:reverse(lists:map(fun format_type_def/1, PrivateTypes)), 262 | PrivateTypesRepr = 263 | list_to_binary(lists:join("\n\n", PrivateTypesMap)), 264 | 265 | PrivateBindings = lists:map(fun format_binding/1, PrivateFuns), 266 | PrivateBindingsRepr = list_to_binary(lists:join("\n\n", PrivateBindings)), 267 | 268 | <> 275 | end; 276 | 277 | 278 | format_module(Name, Opts) when is_atom(Name) -> 279 | Attrs = Name:module_info(attributes), 280 | Module = proplists:get_value(alpaca_typeinfo, Attrs), 281 | format_module(Module, Opts). 282 | 283 | format_module(Module) -> 284 | format_module(Module, []). 285 | 286 | -ifdef(TEST). 287 | 288 | simple_builtin_types_test_() -> 289 | [?_assertMatch(<<"int">>, format_type(t_int)), 290 | ?_assertMatch(<<"string">>, format_type(t_string)), 291 | ?_assertMatch(<<"float">>, format_type(t_float)), 292 | ?_assertMatch(<<"binary">>, format_type(t_binary)), 293 | ?_assertMatch(<<"atom">>, format_type(t_atom)), 294 | ?_assertMatch(<<"boolean">>, format_type(t_bool)), 295 | ?_assertMatch(<<"chars">>, format_type(t_chars)), 296 | ?_assertMatch(<<"rec">>, format_type(t_rec)), 297 | ?_assertMatch(<<"()">>, format_type(t_unit)) 298 | ]. 299 | 300 | tuples_test_() -> 301 | [?_assertMatch( 302 | <<"(int, float)">>, 303 | format_type({t_tuple, [t_int, t_float]}))]. 304 | 305 | lists_test_() -> 306 | [?_assertMatch( 307 | <<"list string">>, 308 | format_type({t_list, t_string})), 309 | 310 | ?_assertMatch( 311 | <<"list (list int)">>, 312 | format_type({t_list, {t_list, t_int}}))]. 313 | 314 | record_test_() -> 315 | [?_assertMatch( 316 | <<"{name : string, age : int}">>, 317 | format_type(#t_record{members=[#t_record_member{name=name, type=t_string}, 318 | #t_record_member{name=age, type=t_int}]})) 319 | ]. 320 | 321 | function_test_() -> 322 | [?_assertMatch( 323 | <<"fn int int -> int">>, 324 | format_type({t_arrow, [t_int, t_int], t_int})), 325 | ?_assertMatch( 326 | <<"fn int -> rec">>, 327 | format_type({t_arrow, [t_int], t_rec}))]. 328 | 329 | pid_test() -> 330 | ?assertMatch(<<"pid int">>, format_type({t_pid, t_int})). 331 | 332 | simple_binding_test() -> 333 | [Binding] = get_bindings("module types;; let add x y = x + y"), 334 | ?assertMatch(<<"val add : fn int int -> int">>, format_binding(Binding)). 335 | 336 | parameterized_binding_test() -> 337 | [Binding] = get_bindings("module types;; let identity a = a"), 338 | ?assertMatch(<<"val identity 'a : fn 'a -> 'a">>, format_binding(Binding)). 339 | 340 | format_module_test() -> 341 | Code = "module my_lovely_lovely_mod\n" 342 | "export hello, add, pair, identity\n" 343 | "export_type maybe\n" 344 | "export_type alias\n" 345 | "export_type my_tuple\n" 346 | "export_type others\n" 347 | "type maybe 'a = Just 'a | Nothing\n" 348 | "type alias = int\n" 349 | "type my_tuple = (int, int)\n" 350 | "type others = (maybe int, alias)\n" 351 | " type compound = MyList (string, (list alias))\n" 352 | "type mixed = HaveTuple (maybe my_tuple)\n" 353 | "let hello = \"hello world\"" 354 | "let add x y = x + y\n" 355 | "val pair : fn int -> my_tuple\n" 356 | "let pair x = (x, x)\n" 357 | "let identity x = x\n" 358 | "let private () = :private", 359 | {ok, Res} = alpaca:compile({text, Code}), 360 | [{compiled_module, N, FN, Bin}] = Res, 361 | {module, N} = code:load_binary(N, FN, Bin), 362 | ModAndExported = 363 | <<"module my_lovely_lovely_mod\n\n" 364 | "-- Exported types\n" 365 | "-----------------\n\n" 366 | "type maybe 'a = Just 'a | Nothing\n\n" 367 | "type alias = int\n\n" 368 | "type my_tuple = (int, int)\n\n" 369 | "type others = (maybe int, alias)\n\n" 370 | "-- Exported functions\n" 371 | "---------------------\n\n" 372 | "val hello : string\n\n" 373 | "val add : fn int int -> int\n\n" 374 | "val pair : fn int -> (int, int)\n\n" 375 | "val identity 'a : fn 'a -> 'a\n" 376 | >>, 377 | 378 | ?assertEqual(ModAndExported, format_module(N)), 379 | 380 | Internal = 381 | <<"\n-- Internal types\n" 382 | "-----------------\n\n" 383 | "type compound = MyList (string, list alias)\n\n" 384 | "type mixed = HaveTuple (maybe my_tuple)\n\n" 385 | "-- Internal functions\n" 386 | "---------------------\n\n" 387 | "val private : fn () -> atom\n" 388 | >>, 389 | 390 | ModExportedAndInternal = 391 | <>, 392 | 393 | ?assertEqual(ModExportedAndInternal, format_module(N, [internal])). 394 | 395 | from_module_test() -> 396 | Code = "module types\n" 397 | "val apply 'a 'b : fn (fn 'a -> 'b) 'a -> 'b\n" 398 | "let apply f x = f x\n" 399 | "type maybe 'a = Just 'a | Nothing\n" 400 | "let just something = Just something\n" 401 | "let make_map x = #{\"key\" => x * x}\n" 402 | "let make_receiver x = receive with y -> x * y\n" 403 | "let make_pid () = spawn make_receiver 10", 404 | 405 | Funs = get_bindings(Code), 406 | 407 | [#alpaca_binding{type=PidType}, 408 | #alpaca_binding{type=ReceiverType}, 409 | #alpaca_binding{type=MapType}, 410 | #alpaca_binding{type=JustType}, 411 | #alpaca_binding{type=ApplyType}] = Funs, 412 | 413 | ?assertMatch(<<"fn (fn 'a -> 'b) 'a -> 'b">>, format_type(ApplyType)), 414 | ?assertMatch(<<"fn 'a -> maybe 'a">>, format_type(JustType)), 415 | ?assertMatch(<<"fn int -> map string int">>, format_type(MapType)), 416 | ?assertMatch(<<"fn () -> pid int">>, format_type(PidType)), 417 | ?assertMatch(<<"receiver int (fn int -> int)">>, format_type(ReceiverType)). 418 | 419 | get_bindings(Code) -> 420 | {ok, Res} = alpaca:compile({text, Code}), 421 | [{compiled_module, N, FN, Bin}] = Res, 422 | {module, N} = code:load_binary(N, FN, Bin), 423 | Attrs = N:module_info(attributes), 424 | Types = proplists:get_value(alpaca_typeinfo, Attrs), 425 | code:purge(N), 426 | #alpaca_module{functions=Funs} = Types, 427 | Funs. 428 | 429 | -endif. 430 | -------------------------------------------------------------------------------- /src/alpaca_scan.xrl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | Definitions. 19 | D = [0-9] 20 | L = [a-z] 21 | U = [A-Z] 22 | SYM = {L}[a-zA-Z0-9_]* 23 | O = [\.\*<>\|\$~\^=\?\+@%/&] 24 | OL = [\.\*>\|\$~\^=\?\+@%/&] 25 | OR = [<] 26 | OPR = {OR}{O}* 27 | OPL = {OL}{O}* 28 | ATOM = :[a-zA-Z0-9_\*]* 29 | TYPE = {U}[a-zA-Z0-9_]* 30 | WS = [\000-\s] 31 | BRK = \n(\n)+ 32 | FLOAT_MATH = (\+\.)|(\-\.)|(\*\.)|(\/\.) 33 | TYPE_CHECK = is_integer|is_float|is_atom|is_bool|is_list|is_string|is_chars|is_pid|is_binary 34 | 35 | Rules. 36 | %% Separators 37 | , : {token, {',', TokenLine}}. 38 | / : {token, {'/', TokenLine}}. 39 | \. : {token, {'.', TokenLine}}. 40 | 41 | \( : {token, {'(', TokenLine}}. 42 | \) : {token, {')', TokenLine}}. 43 | \| : {token, {'|', TokenLine}}. 44 | \:\: : {token, {cons_infix, TokenLine}}. 45 | \: : {token, {':', TokenLine}}. 46 | \[ : {token, {'[', TokenLine}}. 47 | \] : {token, {']', TokenLine}}. 48 | () : {token, {unit, ast:unit(TokenLine)}}. 49 | #{ : {token, {map_open, TokenLine}}. 50 | { : {token, {open_brace, TokenLine}}. 51 | } : {token, {close_brace, TokenLine}}. 52 | => : {token, {map_arrow, TokenLine}}. 53 | 54 | %% Reserved words 55 | let : {token, {'let', TokenLine}}. 56 | in : {token, {in, TokenLine}}. 57 | fn : {token, {fn, TokenLine}}. 58 | val : {token, {val, TokenLine}}. 59 | \x{03BB} : {token, {fn, TokenLine}}. % unicode lower-case lambda 60 | match : {token, {match, TokenLine}}. 61 | with : {token, {with, TokenLine}}. 62 | beam : {token, {beam, TokenLine}}. 63 | module : {token, {module, TokenLine}}. 64 | export : {token, {export, TokenLine}}. 65 | import : {token, {import, TokenLine}}. 66 | type : {token, {type_declare, TokenLine}}. 67 | export_type : {token, {export_type, TokenLine}}. 68 | import_type : {token, {import_type, TokenLine}}. 69 | spawn : {token, {spawn, TokenLine}}. 70 | send : {token, {send, TokenLine}}. 71 | receive : {token, {'receive', TokenLine}}. 72 | receiver : {token, {receiver, TokenLine}}. 73 | after : {token, {'after', TokenLine}}. 74 | test : {token, {'test', TokenLine}}. 75 | and : {token, {'and', TokenLine}}. 76 | or : {token, {'or', TokenLine}}. 77 | xor : {token, {'xor', TokenLine}}. 78 | 79 | error|exit|throw : {token, {'raise_error', TokenLine, TokenChars}}. 80 | 81 | true|false : {token, {boolean, ast:bool(TokenLine, list_to_atom(TokenChars))}}. 82 | 83 | %% Type variables (nicked from OCaml): 84 | '{SYM} : {token, {type_var, TokenLine, string:substr(TokenChars, 2)}}. 85 | 86 | %% User-defined type constructors 87 | {TYPE} : {token, {type_constructor, TokenLine, TokenChars}}. 88 | 89 | %% Type assertions/checks for guards 90 | 91 | {TYPE_CHECK} : {token, {type_check_tok, list_to_atom(TokenChars), TokenLine}}. 92 | 93 | %% Integer 94 | {D}+ : {token, {int, ast:int(TokenLine, list_to_integer(TokenChars))}}. 95 | 96 | %% Float 97 | {D}+\.{D}+ : {token, {float, ast:float(TokenLine, list_to_float(TokenChars))}}. 98 | 99 | %% Binaries 100 | << : {token, {bin_open, TokenLine}}. 101 | >> : {token, {bin_close, TokenLine}}. 102 | 103 | %% Symbol 104 | {SYM} : 105 | Chars = unicode:characters_to_binary(TokenChars, utf8), 106 | {token, {label, ast:label(TokenLine, Chars)}}. 107 | 108 | %% Atom 109 | {ATOM} : {token, {atom, ast:atom(TokenLine, list_to_atom(tl(TokenChars)))}}. 110 | {ATOM}"(\\"*|\\.|[^"\\])*" : 111 | S = string:substr(TokenChars, 3, TokenLen - 3), 112 | {token, {atom, ast:atom(TokenLine, list_to_atom(S))}}. 113 | 114 | %% String 115 | "(\\"*|\\.|[^"\\])*" : 116 | S = string:substr(TokenChars, 2, TokenLen - 2), 117 | unescape(S, TokenLine, TokenChars). 118 | 119 | %% Chars 120 | c"(\\"*|\\.|[^"\\])*" : 121 | S = string:substr(TokenChars, 3, TokenLen - 3), 122 | {token, {chars, TokenLine, S}}. 123 | 124 | 125 | %% Operators (infixes) 126 | 127 | = : {token, {assign, TokenLine}}. 128 | 129 | == : {token, {eq, TokenLine}}. 130 | != : {token, {neq, TokenLine}}. 131 | > : {token, {gt, TokenLine}}. 132 | < : {token, {lt, TokenLine}}. 133 | >= : {token, {gte, TokenLine}}. 134 | =< : {token, {lte, TokenLine}}. 135 | 136 | - : {token, {minus, TokenLine}}. 137 | \+ : {token, {plus, TokenLine}}. 138 | 139 | 140 | [\*\/\%] : {token, {int_math, TokenLine, TokenChars}}. 141 | {FLOAT_MATH} : {token, {float_math, TokenLine, TokenChars}}. 142 | -> : {token, {'->', TokenLine}}. 143 | \x{2192} : {token, {'->', TokenLine}}. % unicode rightwards arrow 144 | _ : {token, {'_', TokenLine}}. 145 | 146 | %% Non-predefined infixes 147 | 148 | {OPL} : {token, {infixl, TokenLine, TokenChars}}. 149 | {OPR} : {token, {infixr, TokenLine, TokenChars}}. 150 | 151 | %% Whitespace ignore 152 | {WS} : skip_token. 153 | \;\; : {token, {break, TokenLine}}. 154 | 155 | %% Comments 156 | --[^\n]* : 157 | Text = string:sub_string(TokenChars, 3), 158 | {token, {comment_line, TokenLine, Text}}. 159 | {-([^-]|(-+[^-}]))*-+} : 160 | validate_comment(TokenLine, string:sub_string(TokenChars, 3, length(TokenChars)-2)). 161 | . : {error, "Unexpected token: " ++ TokenChars}. 162 | 163 | 164 | Erlang code. 165 | 166 | -dialyzer({nowarn_function, yyrev/2}). 167 | 168 | -ignore_xref([format_error/1, string/2, token/2, token/3, tokens/2, tokens/3]). 169 | 170 | validate_comment(TokenLine, TokenChars) -> 171 | case string:str(TokenChars, "{-") of 172 | 0 -> {token, {comment_lines, TokenLine, TokenChars}}; 173 | _ -> {error, {nested_comment, TokenChars}} 174 | end. 175 | 176 | unescape(String, TokenLine, TokenChars) -> 177 | case unescape(String, []) of 178 | {ok, Res} -> {token, {string, ast:string(TokenLine, lists:reverse(Res))}}; 179 | {error, _} = Err -> {error, {Err, TokenLine, TokenChars}} 180 | end. 181 | unescape([], Acc) -> {ok, Acc}; 182 | unescape([$\\, Char | Rest], Acc) -> 183 | Res = case Char of 184 | $n -> $\n; 185 | $f -> $\f; 186 | $r -> $\r; 187 | $v -> $\v; 188 | $" -> $\"; 189 | $e -> $\e; 190 | $b -> $\b; 191 | $t -> $\t; 192 | $\\ -> $\\; 193 | _ -> {error, "Bad control sequence"} 194 | end, 195 | case Res of 196 | {error, _} = E -> E; 197 | _ -> unescape(Rest, [Res | Acc]) 198 | end; 199 | unescape([C | Rest], Acc) -> unescape(Rest, [C | Acc]). 200 | -------------------------------------------------------------------------------- /src/alpaca_scanner.erl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | -module(alpaca_scanner). 4 | -export([scan/1]). 5 | 6 | -ifdef(TEST). 7 | -include_lib("eunit/include/eunit.hrl"). 8 | -endif. 9 | 10 | -include("alpaca_ast.hrl"). 11 | 12 | scan(Code) when is_list(Code) -> 13 | case alpaca_scan:string(Code) of 14 | {ok, Tokens, Num} -> {ok, infer_breaks(Tokens), Num}; 15 | Error -> Error 16 | end; 17 | scan(Code) when is_binary(Code) -> 18 | scan(binary:bin_to_list(Code)). 19 | 20 | infer_breaks(Tokens) -> 21 | %% Reduce tokens from the right, inserting a break (i.e. ';;') before 22 | %% top level constructs including let, type, exports, imports and module. 23 | %% To avoid inserting breaks in let... in... we track the level of these 24 | %% (as we're folding right, an 'in' increases the level by one, a 'let' 25 | %% decreases by one if the current level > 0) 26 | %% We also track whether we're in a binary as 'type' has a different 27 | %% semantic there 28 | 29 | Reducer = fun(Token, {LetLevel, InBinary, Acc}) -> 30 | {Symbol, Line} = case Token of 31 | {S, L} when is_integer(L) -> {S, L}; 32 | _Other -> {other, 0} 33 | end, 34 | InferBreak = fun() -> 35 | {0, InBinary, [{break, Line} | [ Token | Acc]]} 36 | 37 | end, 38 | Pass = fun() -> 39 | {LetLevel, InBinary, [Token | Acc]} 40 | end, 41 | ChangeLetLevel = fun(Diff) -> 42 | {LetLevel + Diff, InBinary, [Token | Acc]} 43 | end, 44 | BinOpen = fun(State) -> 45 | {LetLevel, State, [Token | Acc]} 46 | end, 47 | case Symbol of 48 | 'in' -> ChangeLetLevel(+1); 49 | 'let' -> case LetLevel of 50 | 0 -> InferBreak(); 51 | _ -> ChangeLetLevel(-1) 52 | end; 53 | 'type_declare' -> case InBinary of 54 | true -> Pass(); 55 | false -> InferBreak() 56 | end; 57 | 'bin_open' -> BinOpen(false); 58 | 'bin_close' -> BinOpen(true); 59 | 'test' -> InferBreak(); 60 | 'module' -> InferBreak(); 61 | 'export' -> InferBreak(); 62 | 'export_type' -> InferBreak(); 63 | 'import_type' -> InferBreak(); 64 | 'import' -> InferBreak(); 65 | 'val' -> InferBreak(); 66 | _ -> Pass() 67 | end 68 | end, 69 | {0, false, Output} = lists:foldr(Reducer, {0, false, []}, Tokens), 70 | %% Remove initial 'break' if one was inferred 71 | case Output of 72 | [{break, _} | Rest] -> Rest; 73 | _ -> Output 74 | end. 75 | 76 | -ifdef(TEST). 77 | 78 | number_test_() -> 79 | [ 80 | ?_assertEqual({ok, [{int, #a_int{line=1, val=5}}], 1}, scan("5")), 81 | ?_assertEqual({ok, [{float, #a_flt{line=1, val=3.14}}], 1}, scan("3.14")), 82 | ?_assertEqual({ok, [{float, #a_flt{line=1, val=102.0}}], 1}, scan("102.0")) 83 | ]. 84 | 85 | tuple_test_() -> 86 | EmptyTupleExpected = {ok, [{'(', 1}, {')', 1}], 1}, 87 | [ 88 | ?_assertEqual({ok, [ 89 | {'(', 1}, 90 | {int, #a_int{line=1, val=1}}, 91 | {')', 1}], 1}, 92 | scan("(1)")), 93 | ?_assertEqual(EmptyTupleExpected, scan("()")), 94 | ?_assertEqual(EmptyTupleExpected, scan("( )")), 95 | ?_assertEqual({ok, [ 96 | {'(', 1}, 97 | {int, #a_int{line=1, val=1}}, 98 | {',', 1}, 99 | {int, #a_int{line=1, val=2}}, 100 | {',', 1}, 101 | {int, #a_int{line=1, val=3}}, 102 | {')', 1}], 1}, 103 | scan("(1, 2, 3)")) 104 | ]. 105 | 106 | label_test_() -> 107 | [?_assertMatch({ok, [{label, #a_lab{line = 1, name = <<"mySym">>}}], 1}, 108 | scan("mySym")), 109 | ?_assertMatch({ok, [{label, #a_lab{line = 1, name = <<"mySym1">>}}], 1}, 110 | scan("mySym1")), 111 | ?_assertMatch({ok, [{label, #a_lab{line = 1, name = <<"mysym">>}}], 1}, 112 | scan("mysym"))]. 113 | 114 | atom_test_() -> 115 | [?_assertEqual({ok, [{atom, #a_atom{line=1, val=myAtom}}], 1}, scan(":myAtom"))]. 116 | 117 | quoted_atom_test_() -> 118 | [?_assertEqual({ok, [{atom, #a_atom{line=1, val='Quoted.Atom-Value'}}], 1}, 119 | scan(":\"Quoted.Atom-Value\""))]. 120 | 121 | string_escape_test_() -> 122 | [?_assertEqual({ok, [{string, #a_str{line=1, val="one\ntwo\n\tthree"}}], 1}, 123 | scan("\"one\\ntwo\\n\\tthree\"")), 124 | ?_assertEqual({ok, [{string, #a_str{line=1, val="this is a \"quoted\" string"}}], 1}, 125 | scan("\"this is a \\\"quoted\\\" string\"")), 126 | ?_assertEqual({ok, [{string, #a_str{line=1, val="C:\\MYCMD.BAT"}}], 1}, 127 | scan("\"C:\\\\MYCMD.BAT\"")), 128 | ?_assertMatch({error,{1,alpaca_scan, 129 | {user,{{error,"Bad control sequence"}, 130 | 1, _}}}, 131 | 1}, 132 | scan("\"\\! \\} \\<\""))]. 133 | 134 | 135 | let_test() -> 136 | Code = "let label = 5", 137 | ExpectedTokens = [{'let', 1}, 138 | {label, #a_lab{line = 1, 139 | name = <<"label">>, 140 | original = none}}, 141 | {assign, 1}, 142 | {int, #a_int{line=1, val=5}}], 143 | ?assertEqual({ok, ExpectedTokens, 1}, scan(Code)). 144 | 145 | infer_test() -> 146 | Code = "module hello\nlet a = 0\nlet b = 1", 147 | ExpectedTokens = [{'module', 1}, {label, 148 | #a_lab{line = 1, 149 | name = <<"hello">>, 150 | original = none}}, 151 | {break, 2}, 152 | {'let', 2}, {label, #a_lab{line = 2, 153 | name = <<"a">>, 154 | original = none}}, 155 | {assign, 2}, {int, #a_int{line=2, val=0}}, 156 | {break, 3}, 157 | {'let', 3}, {label, #a_lab{line = 3, 158 | name = <<"b">>, 159 | original = none}}, 160 | {assign, 3}, {int, #a_int{line=3, val=1}} 161 | ], 162 | ?assertEqual({ok, ExpectedTokens, 3}, scan(Code)). 163 | 164 | infer_bin_test() -> 165 | Code = "module bin_test\nlet a = << 10 : type = int >>", 166 | ExpectedTokens = [{'module', 1}, 167 | {label, #a_lab{line = 1, 168 | name = <<"bin_test">>, 169 | original = none}}, 170 | {break, 2}, 171 | {'let', 2}, {label, #a_lab{line = 2, 172 | name = <<"a">>, 173 | original = none}}, 174 | {assign, 2}, 175 | {bin_open, 2}, {int, #a_int{line=2, val=10}}, 176 | {':', 2}, {type_declare, 2}, 177 | {assign, 2}, {label, #a_lab{line = 2, 178 | name = <<"int">>, 179 | original = none}}, 180 | {bin_close, 2} 181 | ], 182 | ?assertEqual({ok, ExpectedTokens, 2}, scan(Code)). 183 | 184 | unexpected_token_test_() -> 185 | [?_assertMatch( 186 | {error, {1,alpaca_scan,{user, "Unexpected token: ;"}}, 1}, 187 | scan("module bin ; hello")), 188 | ?_assertMatch( 189 | {error, {1,alpaca_scan,{user, "Unexpected token: '"}}, 1}, 190 | scan("module bin ' hello"))]. 191 | -endif. 192 | -------------------------------------------------------------------------------- /src/alpaca_sup.erl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | 19 | %%------------------------------------------------------------------- 20 | %% @doc alpaca top level supervisor. 21 | %% @end 22 | %%------------------------------------------------------------------- 23 | 24 | -module('alpaca_sup'). 25 | 26 | -behaviour(supervisor). 27 | 28 | %% API 29 | -export([start_link/0]). 30 | 31 | %% Supervisor callbacks 32 | -export([init/1]). 33 | 34 | -define(SERVER, ?MODULE). 35 | 36 | %%==================================================================== 37 | %% API functions 38 | %%==================================================================== 39 | 40 | start_link() -> 41 | supervisor:start_link({local, ?SERVER}, ?MODULE, []). 42 | 43 | %%==================================================================== 44 | %% Supervisor callbacks 45 | %%==================================================================== 46 | 47 | %% Child :: {Id,StartFunc,Restart,Shutdown,Type,Modules} 48 | init([]) -> 49 | {ok, { {one_for_all, 0, 1}, []} }. 50 | 51 | %%==================================================================== 52 | %% Internal functions 53 | %%==================================================================== 54 | -------------------------------------------------------------------------------- /src/ast.erl: -------------------------------------------------------------------------------- 1 | -module(ast). 2 | 3 | %% Exports are divided into three categories based on purpose: 4 | %% 1. Functions that make AST nodes. 5 | %% 2. Functions that retrieve values from AST node contents. 6 | %% 3. Functions that manipulate or mutate (making a copy of) AST nodes. 7 | 8 | %% Functions that construct AST node values: 9 | -export([ unit/1 10 | , bool/2 11 | , atom/2 12 | , int/2 13 | , float/2 14 | , string/2 15 | , label/2 16 | , qlab/3 17 | , qlab/4 18 | ]). 19 | 20 | %% Functions that retrieve parts of AST nodes: 21 | -export([line/1, 22 | label_name/1 23 | ]). 24 | 25 | %% Functions that mutate/manipulate AST node internals: 26 | -export([label_rename/2]). 27 | 28 | -include("alpaca_ast.hrl"). 29 | 30 | line(#a_unit{line=L}) -> 31 | L; 32 | line(#a_bool{line=L}) -> 33 | L; 34 | line(#a_atom{line=L}) -> 35 | L; 36 | line(#a_int{line=L}) -> 37 | L; 38 | line(#a_flt{line=L}) -> 39 | L; 40 | line(#a_str{line=L}) -> 41 | L; 42 | line(#a_lab{line=L}) -> 43 | L; 44 | line(#a_qlab{line=L}) -> 45 | L. 46 | 47 | unit(Line) -> 48 | #a_unit{line=Line}. 49 | 50 | bool(Line, Val) -> 51 | #a_bool{line=Line, val=Val}. 52 | 53 | %% Multiple types accepted by `atom` simply for convenience. 54 | atom(Line, Val) when is_list(Val) -> 55 | #a_atom{line=Line, val=list_to_atom(Val)}; 56 | atom(Line, Val) when is_binary(Val) -> 57 | #a_atom{line=Line, val=binary_to_atom(Val, utf8)}; 58 | atom(Line, Val) when is_atom(Val) -> 59 | #a_atom{line=Line, val=Val}. 60 | 61 | int(Line, Val) -> 62 | #a_int{line=Line, val=Val}. 63 | 64 | float(Line, Val) -> 65 | #a_flt{line=Line, val=Val}. 66 | 67 | string(Line, Val) -> 68 | #a_str{line=Line, val=Val}. 69 | 70 | label(Line, Name) -> 71 | #a_lab{line=Line, name=Name}. 72 | 73 | qlab(Line, #a_lab{}=Space, #a_lab{}=Label) -> 74 | #a_qlab{line=Line, space=Space, label=Label, arity=none}. 75 | 76 | qlab(Line, #a_lab{}=Space, #a_lab{}=Label, Arity) -> 77 | #a_qlab{line=Line, space=Space, label=Label, arity=Arity}. 78 | 79 | label_name(#a_lab{name=N}) -> 80 | N. 81 | 82 | %% Used for renaming labels as part of Alpaca's final AST generation stage, 83 | %% after parsing with `yecc`. See alpaca_ast_gen:rename_bindings/2 for more 84 | %% details. 85 | label_rename(#a_lab{name=Orig}=S, NewName) -> 86 | S#a_lab{name=NewName, original=Orig}. 87 | -------------------------------------------------------------------------------- /src/builtin_types.hrl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% 4 | %%% Copyright 2016 Jeremy Pierre 5 | %%% 6 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %%% you may not use this file except in compliance with the License. 8 | %%% You may obtain a copy of the License at 9 | %%% 10 | %%% http://www.apache.org/licenses/LICENSE-2.0 11 | %%% 12 | %%% Unless required by applicable law or agreed to in writing, software 13 | %%% distributed under the License is distributed on an "AS IS" BASIS, 14 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %%% See the License for the specific language governing permissions and 16 | %%% limitations under the License. 17 | 18 | -define(all_bifs, [ 19 | ?t_int_add, ?t_int_sub, 20 | ?t_int_mul, ?t_int_div, ?t_int_rem, 21 | ?t_float_add, ?t_float_sub, 22 | ?t_float_mul, ?t_float_div, 23 | 24 | ?t_equality, ?t_neq, 25 | ?t_gt, ?t_lt, ?t_gte, ?t_lte 26 | ]). 27 | 28 | -define(t_int_math, {t_arrow, [t_int, t_int], t_int}). 29 | 30 | -define(t_int_add, {'+', ?t_int_math}). 31 | -define(t_int_sub, {'-', ?t_int_math}). 32 | -define(t_int_mul, {'*', ?t_int_math}). 33 | -define(t_int_div, {'/', ?t_int_math}). 34 | -define(t_int_rem, {'%', ?t_int_math}). 35 | 36 | -define(t_float_math, {t_arrow, [t_float, t_float], t_float}). 37 | 38 | -define(t_float_add, {'+.', ?t_float_math}). 39 | -define(t_float_sub, {'-.', ?t_float_math}). 40 | -define(t_float_mul, {'*.', ?t_float_math}). 41 | -define(t_float_div, {'/.', ?t_float_math}). 42 | 43 | -define(compare, {t_arrow, [{unbound, eq_a, 1}, {unbound, eq_a, 1}], t_bool}). 44 | -define(t_equality, {'=:=', ?compare}). 45 | -define(t_neq, {'!=', ?compare}). 46 | -define(t_gt, {'>', ?compare}). 47 | -define(t_lt, {'<', ?compare}). 48 | -define(t_gte, {'>=', ?compare}). 49 | -define(t_lte, {'=<', ?compare}). 50 | 51 | -define(all_type_checks, [{is_integer, t_int}, 52 | {is_float, t_float}, 53 | {is_atom, t_atom}, 54 | {is_bool, t_bool}, 55 | {is_list, t_list}, 56 | {is_pid, t_pid}, 57 | {is_string, t_string}, 58 | {is_chars, t_chars}, 59 | {is_binary, t_binary}]). 60 | -------------------------------------------------------------------------------- /test/alpaca_SUITE.erl: -------------------------------------------------------------------------------- 1 | -module(alpaca_SUITE). 2 | 3 | %%-compile(export_all). 4 | 5 | -export([ 6 | all/0, 7 | proper_compile/1, 8 | g_function/0, 9 | g_function_name/0, 10 | g_function_body/0, 11 | g_basic_value/0, 12 | g_boolean/0, 13 | g_number/0, 14 | g_float/0, 15 | g_atom/0, 16 | g_string/0, 17 | g_char_list/0, 18 | g_binary/0 19 | ]). 20 | 21 | -include_lib("common_test/include/ct.hrl"). 22 | -include_lib("proper/include/proper.hrl"). 23 | -include_lib("eunit/include/eunit.hrl"). 24 | 25 | all() -> [proper_compile]. 26 | 27 | proper_compile(_Config) -> 28 | NumTests = list_to_integer(os:getenv("NUMTESTS", "1000")), 29 | ?assert(proper:quickcheck(prop_can_compile_module_def(), [{numtests, NumTests}])), 30 | ?assert(proper:quickcheck(prop_can_compile_type_decl(), [{numtests, NumTests}, 31 | {max_size, 10} 32 | ])). 33 | 34 | prop_can_compile_module_def() -> 35 | ?FORALL(ModuleDef, g_module_def(), can_compile(ModuleDef)). 36 | 37 | g_module_def() -> 38 | ?LET(Module, g_module(), to_binary([Module], [])). 39 | 40 | prop_can_compile_type_decl() -> 41 | ?FORALL(Code, g_module_with_type_declaration(), can_compile(Code)). 42 | 43 | g_module_with_type_declaration() -> 44 | ?LET({Module, 45 | TypeDecl}, 46 | {g_module(), 47 | g_type_declaration([])}, 48 | ?LET(MoreTypeDecl, g_type_declaration([TypeDecl]), 49 | to_binary([Module, TypeDecl, MoreTypeDecl], []))). 50 | 51 | can_compile(Code) -> 52 | ?WHENFAIL(ct:pal("failed to compile:~n~ts~n", [Code]), 53 | ?TIMEOUT(timer:seconds(5), 54 | case alpaca:compile({text, Code}) of 55 | {ok, _} -> true; 56 | {error, _} -> false 57 | end)). 58 | 59 | %%% Module generators 60 | 61 | %% @doc Generate module declaration. 62 | g_module() -> 63 | ?LET(Mod, g_module_name(), {module, Mod}). 64 | 65 | %% @doc Generate a module name. 66 | %% Module names are turned into atoms. The module name is internally prefixed 67 | %% with 'alpaca_'. Atom max length is 255. 68 | %% @end 69 | g_module_name() -> 70 | ?LET(N, integer(1, 248), 71 | ?LET(Module, 72 | ?SUCHTHAT(Name, g_sym(N), not lists:member(Name, keywords())), 73 | Module)). 74 | 75 | %%% Type generators 76 | 77 | g_type_declaration(KnownTypes) -> 78 | ?LET({Name, Params}, {g_type_name(KnownTypes), list(g_type_param())}, 79 | ?LET(Type, ?SUCHTHAT(T, g_type_top_level_def(Name, Params, KnownTypes), 80 | is_valid_type(T, KnownTypes)), 81 | {type, Name, Params, Type})). 82 | 83 | is_valid_type(Type, KnownTypes) -> 84 | Constructors = lists:flatten(extract_constructors(Type) ++ 85 | [extract_constructors(T) || T <- KnownTypes]), 86 | %% unique constructors 87 | is_unique(Constructors). 88 | 89 | g_type_name(KnownTypes) -> 90 | ?LET(TypeName, 91 | ?SUCHTHAT(Name, g_sym(), is_valid_type_name(Name, KnownTypes)), 92 | TypeName). 93 | 94 | is_valid_type_name(Name, KnownTypes) -> 95 | %% unique type name 96 | not lists:member(Name, [extract_type_name(T) || T <- KnownTypes]) 97 | andalso 98 | %% name is not a keyword 99 | not lists:member(Name, keywords()). 100 | 101 | g_type_param() -> 102 | ?LET(Param, g_sym(), list_to_binary([$', Param])). 103 | 104 | g_type_top_level_def(Name, Params, KnownTypes) -> 105 | ?SIZED(Size, g_type_top_level_def(Name, Params, KnownTypes, Size)). 106 | g_type_top_level_def(Name, Params, KnownTypes, 0) -> 107 | oneof([g_type_constructor_name(), 108 | g_type_def(Name, Params, KnownTypes), 109 | g_type_construct(g_type_def(Name, Params, KnownTypes))]); 110 | g_type_top_level_def(Name, Params, KnownTypes, Size) -> 111 | oneof([g_type_top_level_def(Name, Params, KnownTypes, 0), 112 | ?LAZY(g_type_union(Name, Params, KnownTypes, Size)) 113 | ]). 114 | 115 | g_type_construct(Of) -> 116 | ?LET(Constructor, g_type_constructor_name(), 117 | {construct, Constructor, Of}). 118 | 119 | g_type_constructor_name() -> 120 | ?LET(N, non_neg_integer(), 121 | ?LET({U, Rest}, 122 | {g_u(), vector(N, oneof([g_d(), g_l(), g_u(), $_]))}, 123 | {constructor, list_to_binary([U, Rest])})). 124 | 125 | g_type_union(Name, Params, KnownTypes, 1) -> 126 | g_type_top_level_def(Name, Params, KnownTypes, 0); 127 | g_type_union(Name, Params, KnownTypes, Size) -> 128 | ?LET(OfTypes, vector(Size, g_type_top_level_def(Name, Params, KnownTypes, 0)), 129 | {union, OfTypes}). 130 | 131 | g_type_def(Name, Params, KnownTypes) -> 132 | ?SIZED(Size, g_type_def(Name, Params, KnownTypes, Size)). 133 | 134 | g_type_def(Name, Params, KnownTypes, 0) -> 135 | oneof([g_base_type(), 136 | Name 137 | ] 138 | ++ [oneof(Params) || length(Params) > 0] 139 | ++ [oneof([extract_type_name(KnownType) || KnownType <- KnownTypes]) 140 | || length(KnownTypes) > 0] 141 | ); 142 | g_type_def(Name, Params, KnownTypes, Size) -> 143 | oneof([g_type_def(Name, Params, KnownTypes, 0), 144 | ?LAZY(g_type_list(g_type_def(Name, Params, KnownTypes, Size div 2))), 145 | ?LAZY(g_type_map(g_type_def(Name, Params, KnownTypes, Size div 2), 146 | g_type_def(Name, Params, KnownTypes, Size div 2))), 147 | ?LAZY(g_type_pid(g_type_def(Name, Params, KnownTypes, Size div 2))), 148 | ?LAZY(g_type_tuple(Name, Params, KnownTypes, Size div 2)), 149 | ?LAZY(g_type_record(Name, Params, KnownTypes, Size div 2)) 150 | ]). 151 | 152 | g_base_type() -> 153 | oneof(base_types()). 154 | 155 | g_type_list(Of) -> 156 | {list, Of}. 157 | 158 | g_type_map(KeyType, ValueType) -> 159 | {map, KeyType, ValueType}. 160 | 161 | g_type_pid(Of) -> 162 | {pid, Of}. 163 | 164 | g_type_tuple(Name, Params, KnownTypes, N) when N =< 1 -> 165 | g_type_def(Name, Params, KnownTypes, 0); 166 | g_type_tuple(Name, Params, KnownTypes, Size) -> 167 | ?LET(OfTypes, 168 | vector(Size, g_type_def(Name, Params, KnownTypes, Size div 2)), 169 | {tuple, OfTypes}). 170 | 171 | g_type_record(Name, Params, KnownTypes, N) when N =< 0 -> 172 | g_type_def(Name, Params, KnownTypes, 0); 173 | g_type_record(Name, Params, KnownTypes, Size) -> 174 | ?LET({Keys, OfTypes}, 175 | {?SUCHTHAT(Symbols, vector(Size, g_record_key()), is_unique(Symbols)), 176 | vector(Size, g_type_def(Name, Params, KnownTypes, Size div 2))}, 177 | {record, Keys, OfTypes}). 178 | 179 | g_record_key() -> 180 | ?LET(N, 181 | integer(1, 255), 182 | ?SUCHTHAT(Name, g_sym(N), not lists:member(Name, keywords()))). 183 | 184 | to_binary([], Acc) -> 185 | g_sprinkle(lists:flatten(lists:reverse(Acc))); 186 | to_binary([{module, Mod} | Rest], Acc) -> 187 | to_binary(Rest, [[<<"module">> , Mod, g_breaks()]| Acc]); 188 | to_binary([{type, Name, Params, Type} | Rest], Acc) -> 189 | to_binary(Rest, 190 | [[<<"type">>, Name, Params, $=, to_binary(Type), g_breaks()] | Acc]). 191 | 192 | to_binary({construct, Constructor, Of}) -> 193 | [to_binary(Constructor), to_binary(Of)]; 194 | to_binary({union, OfTypes}) -> 195 | lists:join($|, [to_binary(Type) || Type <- OfTypes]); 196 | to_binary({list, Of}) -> 197 | [<<"list">>, $(, to_binary(Of), $)]; 198 | to_binary({map, KeyType, ValueType}) -> 199 | [<<"map">>, $(, to_binary(KeyType), $), $(, to_binary(ValueType), $)]; 200 | to_binary({pid, Of}) -> 201 | [<<"pid">>, $(, to_binary(Of), $)]; 202 | to_binary({tuple, OfTypes}) -> 203 | [$(, lists:join($,, [to_binary(Type) || Type <- OfTypes]), $)]; 204 | to_binary({record, Keys, OfTypes}) -> 205 | [${, lists:join($,, [[K, $:, to_binary(T)] || {K, T} <- lists:zip(Keys, OfTypes)]), $}]; 206 | to_binary({constructor, Constructor}) -> 207 | Constructor; 208 | to_binary(Binary) when is_binary(Binary) -> 209 | Binary. 210 | 211 | %%% Function generators 212 | 213 | g_function() -> 214 | ?LET({Name, Body}, 215 | {g_function_name(), g_function_body()}, 216 | {function, Name, Body}). 217 | 218 | g_function_name() -> 219 | ?LET(Fun, g_sym(), Fun). 220 | 221 | g_function_body() -> 222 | g_basic_value(). 223 | 224 | %%% Value generators 225 | 226 | %% Basic values 227 | 228 | g_basic_value() -> 229 | oneof([g_boolean(), g_number(), g_atom(), g_string(), g_char_list(), 230 | g_binary()]). 231 | 232 | g_boolean() -> 233 | oneof(["true", "false"]). 234 | 235 | g_number() -> 236 | oneof([g_d(), g_float()]). 237 | 238 | g_float() -> 239 | ?LET({D, R}, {g_d(), g_d()}, list_to_binary([D, ".", R])). 240 | 241 | g_atom() -> 242 | ?LET(N, integer(1, 255), 243 | ?LET(Atom, vector(N, oneof([g_l(), g_u(), g_d(), $*, $_])), 244 | list_to_binary([$:, Atom]))). 245 | 246 | g_string() -> 247 | ?LET(String, string(), list_to_binary([$", String, $"])). 248 | 249 | g_char_list() -> 250 | ?LET(String, string(), list_to_binary([$c, $", String, $"])). 251 | 252 | g_binary() -> 253 | binary(). 254 | 255 | 256 | %%% Comments generators 257 | 258 | %% @doc Add comments to an iolist of tokens. 259 | g_sprinkle_comments(Tokens) -> 260 | ?LET(CommentedTokens, 261 | [{oneof(["", g_comment()]), Token} || Token <- Tokens], 262 | [[C, T] || {C, T} <- CommentedTokens]). 263 | 264 | %% @doc Generate either a line or a block comment. 265 | g_comment() -> 266 | oneof([g_line_comment(), g_block_comment()]). 267 | 268 | g_line_comment() -> 269 | ?LET(Comment, ?SUCHTHAT(Str, string(), not lists:member($\n, Str)), 270 | [<<"--">>, unicode:characters_to_binary(Comment), $\n]). 271 | 272 | g_block_comment() -> 273 | ?LET(Comment, 274 | ?SUCHTHAT(Str, string(), 275 | nomatch == re:run(unicode:characters_to_binary(Str), "({-|-})", 276 | [{capture, none}])), 277 | [<<"{-">>, unicode:characters_to_binary(Comment), <<"-}">>]). 278 | 279 | %%% Whitespace generators 280 | 281 | g_sprinkle_whitespace(Tokens) -> 282 | ?LET({Begin, 283 | Spaces, 284 | End, 285 | Newlines}, 286 | {list(oneof([g_space(), g_tab()])), 287 | vector(length(Tokens) - 1, g_whitespace()), 288 | list(oneof([g_space(), g_tab()])), 289 | list(g_newline())}, 290 | begin 291 | Line = lists:zipwith(fun(Token, Space) -> [Token, Space] end, 292 | Tokens, Spaces ++ [""]), 293 | [Begin, Line, End, Newlines] 294 | end). 295 | 296 | %% @doc Generate at least one whitespace. 297 | g_whitespace() -> 298 | non_empty(oneof([g_space(), g_tab(), $\f, $\v, $\n])). 299 | 300 | g_tab() -> $\t. 301 | 302 | g_space() -> " ". 303 | 304 | g_newline() -> 305 | oneof([$\n, <<"\r\n">>]). 306 | 307 | g_breaks() -> 308 | non_empty(oneof([g_break(), g_newline()])). 309 | 310 | g_break() -> <<";;">>. 311 | 312 | %%% Helpers. 313 | 314 | %% @doc Generate lower case letter. 315 | g_l() -> 316 | integer($a, $z). 317 | 318 | %% @doc Generate upper case letter. 319 | g_u() -> 320 | integer($A, $Z). 321 | 322 | %% @doc Generate number. 323 | g_d() -> 324 | integer($0, $9). 325 | 326 | g_sym() -> 327 | ?LET(N, pos_integer(), g_sym(N)). 328 | 329 | g_sym(N) -> 330 | ?LET({L, Rest}, 331 | {g_l(), vector(N - 1, oneof([g_d(), g_l(), g_u(), $_]))}, 332 | list_to_binary([L, Rest])). 333 | 334 | %% @doc Generate whitespace and comments and add them into an iolist of tokens. 335 | g_sprinkle(Tokens) -> 336 | ?LET(SpacedTokens, g_sprinkle_whitespace(Tokens), 337 | ?LET(CommentedTokens, g_sprinkle_comments(SpacedTokens), 338 | list_to_binary(CommentedTokens))). 339 | 340 | %%% Extraction functions 341 | 342 | extract_constructors({constructor, Constructor}) -> 343 | [Constructor]; 344 | extract_constructors({construct, Constructor, _}) -> 345 | extract_constructors(Constructor); 346 | extract_constructors({union, OfTypes}) -> 347 | [extract_constructors(Type) || Type <- OfTypes]; 348 | extract_constructors({type, _, _, Type}) -> 349 | lists:flatten(extract_constructors(Type)); 350 | extract_constructors(_) -> 351 | []. 352 | 353 | extract_type_name({type, Name, _, _}) -> Name. 354 | 355 | keywords() -> 356 | [<<"let">>, 357 | <<"val">>, 358 | <<"in">>, 359 | <<"fn">>, 360 | <<"match">>, 361 | <<"with">>, 362 | <<"beam">>, 363 | <<"module">>, 364 | <<"export">>, 365 | <<"type">>, 366 | <<"export_type">>, 367 | <<"import_type">>, 368 | <<"spawn">>, 369 | <<"send">>, 370 | <<"receive">>, 371 | <<"after">>, 372 | <<"test">>, 373 | <<"error">>, 374 | <<"exit">>, 375 | <<"throw">>, 376 | <<"true">>, 377 | <<"false">>, 378 | <<"fn">>, 379 | <<"and">>, 380 | <<"xor">>, 381 | <<"or">> 382 | ] 383 | ++ base_types(). 384 | 385 | base_types() -> 386 | [<<"atom">>, 387 | <<"int">>, 388 | <<"float">>, 389 | <<"string">>, 390 | <<"bool">>, 391 | <<"binary">>, 392 | <<"chars">>, 393 | <<"()">> 394 | ]. 395 | 396 | is_unique(List) -> 397 | List -- lists:usort(List) == []. 398 | -------------------------------------------------------------------------------- /test/error.alp: -------------------------------------------------------------------------------- 1 | module alpaca_format 2 | 3 | export format/1 4 | 5 | import_type alpaca_native_ast.ast 6 | 7 | import_type alpaca_native_ast.symbol 8 | 9 | let format ast_node = format_ast 0 ast_node 10 | 11 | let max_len = = 80 12 | 13 | let format_ast depth Symbol {name=name} = 14 | let end_of_line = depth + (s_len name) in 15 | (end_of_line, name) 16 | 17 | --format depth Apply (sym, _) = 18 | 19 | let s_len s = beam :string :len [s] with 20 | l, is_integer l -> l 21 | -------------------------------------------------------------------------------- /test/stacktrace_tests.erl: -------------------------------------------------------------------------------- 1 | %%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %%% ex: ft=erlang ts=4 sw=4 et 3 | %%% Copyright 2018 Jeremy Pierre 4 | %%% 5 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %%% you may not use this file except in compliance with the License. 7 | %%% You may obtain a copy of the License at 8 | %%% 9 | %%% http://www.apache.org/licenses/LICENSE-2.0 10 | %%% 11 | %%% Unless required by applicable law or agreed to in writing, software 12 | %%% distributed under the License is distributed on an "AS IS" BASIS, 13 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %%% See the License for the specific language governing permissions and 15 | %%% limitations under the License. 16 | 17 | %% Some basic tests to check that source (line and file) annotations show up in 18 | %% stack traces. Far from exhaustive, just the beginning of making sure we can 19 | %% get decent runtime feedback on failures. 20 | -module(stacktrace_tests). 21 | -include_lib("eunit/include/eunit.hrl"). 22 | -include("alpaca.hrl"). 23 | 24 | simple_badarith_test() -> 25 | Mod = 26 | "module arith_err \n" 27 | "export main/1 \n" 28 | "let main x = 1 + x", 29 | {error, error, badarith, Trace} = 30 | run_for_trace( 31 | [{"arith_err.alp", Mod}], 32 | fun() -> alpaca_arith_err:main(atom) end), 33 | Expected = {alpaca_arith_err, main, 1, [{file, "arith_err.alp"}, {line, 3}]}, 34 | ?assertMatch([Expected | _], Trace). 35 | 36 | indirect_badarith_test() -> 37 | Mod = 38 | "module indirect_arith \n" 39 | "export foo/1 \n" 40 | "let bar x = x + 1 \n" 41 | "let foo y = bar y", 42 | {error, error, badarith, Trace} = 43 | run_for_trace( 44 | [{"indirect_arith.alp", Mod}], 45 | fun() -> alpaca_indirect_arith:foo(atom_again) end), 46 | Expected1 = {alpaca_indirect_arith, bar, 1, [{file, "indirect_arith.alp"}, {line, 3}]}, 47 | ?assertMatch([Expected1 | _], Trace). 48 | 49 | fun_pattern_test() -> 50 | Mod = 51 | "module fun_pattern \n" 52 | "export f/1 \n" 53 | "let f 0 = :zero \n" 54 | "let f 1 = :one \n", 55 | {error, error, if_clause, Trace} = 56 | run_for_trace( 57 | [{"fun_pattern.alp", Mod}], 58 | fun() -> alpaca_fun_pattern:f(2) end), 59 | %% Incorrect line number, see the following issue: 60 | %% https://github.com/alpaca-lang/alpaca/issues/263 61 | Expected = {alpaca_fun_pattern, f, 1, [{file, "fun_pattern.alp"}, {line, 4}]}, 62 | ?assertMatch([Expected | _], Trace). 63 | 64 | throw_test() -> 65 | Mod = 66 | "module t \n" 67 | "export f/1 \n" 68 | "let f () = throw :wat", 69 | {error, throw, wat, Trace} = run_for_trace( 70 | [{"t.alp", Mod}], 71 | fun() -> alpaca_t:f({}) end), 72 | ?assertMatch([{alpaca_t, f, 1, [{file, "t.alp"}, {line, 3}]} | _], Trace). 73 | 74 | multi_module_test() -> 75 | Mod1 = 76 | "module a \n" 77 | "export f/1 \n" 78 | "let f x = x + 1", 79 | Mod2 = 80 | "module b \n" 81 | "export g/1 \n" 82 | "let g x = a.f x", 83 | {error, error, badarith, Trace} = run_for_trace( 84 | [{"a.alp", Mod1}, {"b.alp", Mod2}], 85 | fun() -> alpaca_b:g(an_atom) end), 86 | %% Somewhat surprising, I thought I might get the full trace through module 87 | %% b as well. 88 | ?assertMatch([{alpaca_a, f, 1, [{file, "a.alp"}, {line, 3}]} | _], Trace). 89 | 90 | %% A wrapper that compiles the provided code for one or more modules and 91 | %% executes the provided operation. Captures any resulting stack trace so that 92 | %% the caller can check correctness. 93 | run_for_trace(ModulesWithFilenames, Expr) -> 94 | % Temporary, callers should change: 95 | ToCompile = [{FN, Code} || {FN, Code} <- ModulesWithFilenames], 96 | {ok, Compiled} = alpaca:compile({text_set, ToCompile}), 97 | Ms = lists:map( 98 | fun(#compiled_module{name=M, filename=F, bytes=B}) -> {M, F, B} end, 99 | Compiled 100 | ), 101 | [code:load_binary(M, F, B) || {M, F, B} <- Ms], 102 | 103 | Ret = try Expr() of 104 | Res -> {ok, Res} 105 | catch Type:Detail -> 106 | Trace = erlang:get_stacktrace(), 107 | {error, Type, Detail, Trace} 108 | end, 109 | [pd(M) || {M, _, _} <- Ms], 110 | Ret. 111 | 112 | %% Purge and delete the given module from the VM. 113 | pd(Module) -> 114 | code:purge(Module), 115 | code:delete(Module). 116 | 117 | -------------------------------------------------------------------------------- /test_files/alpaca_format.alp: -------------------------------------------------------------------------------- 1 | module alpaca_format 2 | 3 | export format/1 4 | 5 | import_type alpaca_native_ast.ast 6 | 7 | import_type alpaca_native_ast.symbol 8 | 9 | let format ast_node = format_ast 0 ast_node 10 | 11 | let max_len = 80 12 | 13 | let format_ast depth Symbol {name=name} = 14 | let end_of_line = depth + (s_len name) in 15 | (end_of_line, name) 16 | 17 | --format depth Apply (sym, _) = 18 | 19 | let s_len s = beam :string :len [s] with 20 | l, is_integer l -> l 21 | -------------------------------------------------------------------------------- /test_files/alpaca_native_ast.alp: -------------------------------------------------------------------------------- 1 | module alpaca_native_ast 2 | 3 | export_type ast, symbol, expr 4 | 5 | type symbol = Symbol {name: string, line: int} 6 | 7 | type expr = Apply (symbol, list expr) 8 | 9 | type ast = 10 | symbol 11 | | expr 12 | | Comment {multi_line: bool, 13 | line: int, 14 | text: string} 15 | | Fun {name: symbol, 16 | arity: int, 17 | versions: list {line: int, args: list ast, body: expr}} -------------------------------------------------------------------------------- /test_files/apply_to_expression.alp: -------------------------------------------------------------------------------- 1 | module apply_to_expression 2 | 3 | export foo/1, uses_fun/1 4 | 5 | let foo () = 6 | let f x = x + x in 7 | let g () = f in 8 | (g ()) 2 9 | 10 | let returns_fun () = 11 | let f x = x + x in 12 | f 13 | 14 | let uses_fun x = 15 | (returns_fun ()) x 16 | -------------------------------------------------------------------------------- /test_files/asserts.alp: -------------------------------------------------------------------------------- 1 | module asserts 2 | 3 | export assert_equal/2 4 | 5 | let assert_equal a b = 6 | match (a == b) with 7 | true -> true 8 | | false -> throw (:not_equal, a, b) -------------------------------------------------------------------------------- /test_files/basic_adt.alp: -------------------------------------------------------------------------------- 1 | module basic_adt 2 | 3 | export len/1 4 | 5 | export_type my_list, opt 6 | 7 | {- simple linked list, 8 | multi-line comment. 9 | -} 10 | type my_list 'x = Cons ('x, my_list 'x) | Nil 11 | 12 | type opt 'a = None | Some 'a 13 | 14 | let len l = match l with 15 | Nil -> 0 16 | -- single line comment should be ignored: 17 | | Cons (_, tail) -> 1 + (len tail) 18 | -------------------------------------------------------------------------------- /test_files/basic_binary.alp: -------------------------------------------------------------------------------- 1 | module basic_binary 2 | 3 | export count_one_twos/1, first_three_bits/1, utf8_bins/1, drop_hello/1 4 | 5 | let count_one_twos bin = 6 | match bin with 7 | <<1: size=8, 2: size=8, rest: type=binary>> -> 1 + (count_one_twos rest) 8 | | _ -> 0 9 | 10 | let first_three_bits bin = 11 | match bin with 12 | <> -> x 13 | | _ -> 0 14 | 15 | let utf8_bins () = 16 | <<"안녕": type=utf8>> 17 | 18 | let drop_hello bin = 19 | match bin with 20 | <<"hello": type=utf8, rest: type=utf8>> -> rest -------------------------------------------------------------------------------- /test_files/basic_compile_file.alp: -------------------------------------------------------------------------------- 1 | module basic_compile_file 2 | 3 | export double/1 4 | 5 | let double n = n*2 6 | -------------------------------------------------------------------------------- /test_files/basic_map_test.alp: -------------------------------------------------------------------------------- 1 | module basic_map_test 2 | 3 | export get/2, add/3, test_map/1, test_tuple_key_map/1 4 | 5 | type map_result 'x = Ok 'x | NotFound 6 | 7 | let test_map () = #{:one => 1, :two => 2} 8 | 9 | let test_tuple_key_map () = 10 | #{(:one, 1) => "a", (:two, 2) => "b"} 11 | 12 | let get k m = match m with 13 | #{k => v} -> Ok v 14 | | _ -> NotFound 15 | 16 | let add k v m = #{k => v | m} -------------------------------------------------------------------------------- /test_files/basic_math.alp: -------------------------------------------------------------------------------- 1 | module basic_math 2 | 3 | export add2/1, add/2, dec/1, dec_alt/1, neg_float/1 4 | 5 | let add2 x = add x (+2) 6 | 7 | let add x y = x + y 8 | 9 | let dec a = a-1 10 | 11 | let dec_alt a = a+-1 12 | 13 | let neg_float f = f *. -1.0 14 | -------------------------------------------------------------------------------- /test_files/basic_module_with_tests.alp: -------------------------------------------------------------------------------- 1 | module basic_module_with_tests 2 | 3 | export add/2, sub/2 4 | 5 | let add x y = x + y 6 | 7 | let sub x y = x - y 8 | 9 | test "add 2 and 2" = test_equal (add 2 2) 4 10 | 11 | test "subtract 2 from 4" = test_equal (sub 4 2) 3 12 | 13 | let format_msg base x y = 14 | let m = beam :io_lib :format [base, [x, y]] with msg -> msg in 15 | beam :lists :flatten [m] with msg, is_chars msg -> msg 16 | 17 | let test_equal x y = 18 | match (x == y) with 19 | true -> :passed 20 | | false -> 21 | let msg = format_msg "Not equal: ~w and ~w" x y in 22 | beam :erlang :error [msg] with _ -> :failed -------------------------------------------------------------------------------- /test_files/basic_pid_test.alp: -------------------------------------------------------------------------------- 1 | module basic_pid_test 2 | 3 | export pid_fun/1, start_pid_fun/1 4 | 5 | type t = Add int | Fetch (pid int) 6 | 7 | let pid_fun x = receive with 8 | Add i -> pid_fun x + i 9 | | Fetch sender -> 10 | let sent = send x sender in 11 | pid_fun x 12 | 13 | let start_pid_fun x = spawn pid_fun x 14 | -------------------------------------------------------------------------------- /test_files/basic_type_signature.alp: -------------------------------------------------------------------------------- 1 | module basic_type_signature 2 | 3 | export add 4 | 5 | -- Primitive top level 'constant' bindings 6 | val name : string 7 | let name = "Alpaca" 8 | 9 | val birthday : int 10 | let birthday = 2701 11 | 12 | -- Simple functions 13 | val add : fn int int -> int 14 | let add x y = x + y 15 | 16 | -- Polymorphic functions 17 | val identity 'a : fn 'a -> 'a 18 | let identity x = x 19 | 20 | -- ADTs as params and return values 21 | type maybe 'a = Just 'a | Nothing 22 | 23 | val return 'a : fn 'a -> maybe 'a 24 | let return x = Just x 25 | 26 | -- Higher order functions 27 | val apply 'a 'b : fn (fn 'a -> 'b) 'a -> 'b 28 | let apply f x = f x 29 | 30 | -- Infix functions 31 | val (<|) 'a 'b : fn (fn 'a -> 'b) 'a -> 'b 32 | let (<|) f x = apply f x 33 | 34 | val (|>) 'a 'b : fn 'a (fn 'a -> 'b) -> 'b 35 | let (|>) x f = f x 36 | 37 | -- Concrete typing of a polymorphic ADT 38 | val maybeDouble : fn (maybe int) -> (maybe int) 39 | let maybeDouble (Just x) = return <| x * 2 40 | let maybeDouble Nothing = Nothing 41 | 42 | -- Tuples 43 | val fst 'a 'b: fn ('a, 'b) -> 'a 44 | let fst (x, y) = x 45 | 46 | -- Records 47 | val getName : fn { name : string } -> string 48 | let getName { name = n } = n 49 | 50 | -- Arrays 51 | val hd 'a : fn (list 'a) -> (maybe 'a) 52 | let hd [] = Nothing 53 | let hd (first :: _) = Just first 54 | 55 | -- Pids 56 | 57 | -- (receivers are typed with their 'receive' type and a function with its input 58 | -- and return value; return can also be 'rec' if it recurses infinitely) 59 | 60 | val make_receiver : receiver int (fn () -> int) 61 | let make_receiver () = receive with 62 | v -> v 63 | 64 | val make_pid : fn () -> pid int 65 | let make_pid () = spawn make_receiver () 66 | 67 | let run_pid () = 68 | let p = make_pid () in 69 | send 35 p 70 | -------------------------------------------------------------------------------- /test_files/batch_export.alp: -------------------------------------------------------------------------------- 1 | module batch_export 2 | 3 | export mult/2, foo 4 | 5 | let foo x = x 6 | 7 | let foo x y = x + y 8 | 9 | let mult x y = x * y 10 | -------------------------------------------------------------------------------- /test_files/circles.alp: -------------------------------------------------------------------------------- 1 | module circles 2 | 3 | export new/1, area/1 4 | 5 | type radius = float 6 | 7 | type circle = Circle radius 8 | 9 | let new r = 10 | Circle r 11 | 12 | let area c = 13 | let pi = 3.14159 in 14 | match c with 15 | Circle r -> pi *. (r *. r) 16 | -------------------------------------------------------------------------------- /test_files/comments.alp: -------------------------------------------------------------------------------- 1 | module comments 2 | 3 | export double/1 4 | 5 | -- single line comment 6 | 7 | {- single line block comment -} 8 | 9 | {- multi-line 10 | block } 11 | bar 12 | comment 13 | -} 14 | 15 | let double n = n*2 16 | 17 | {--} 18 | {---} 19 | {- --} 20 | 21 | -- EOF 22 | -------------------------------------------------------------------------------- /test_files/curry.alp: -------------------------------------------------------------------------------- 1 | module curry 2 | 3 | export foo/1 4 | export local 5 | export filter 6 | export (|>) 7 | 8 | let (|>) x f = f x 9 | 10 | let many_args x y z o = 11 | x + y + z + o 12 | 13 | let non_curry x = 14 | x + x 15 | 16 | let add x y = 17 | x + y 18 | 19 | let whatever i a = 20 | i 21 | 22 | let filter_ pred l acc = 23 | match l with 24 | [] -> acc 25 | | hd :: tail -> 26 | match pred hd with 27 | true -> filter_ pred tail hd :: acc 28 | | false -> filter_ pred tail acc 29 | 30 | let filter pred l = 31 | filter_ pred l [] 32 | 33 | let eq a b = 34 | a == b 35 | 36 | let filtered_list () = 37 | [1, 2, 3] 38 | |> filter (eq 2) 39 | 40 | let local () = 41 | let f x y = x + y in 42 | f 10 43 | 44 | let foo () = 45 | let many_args_curry = many_args 1 in 46 | let unused_curry = many_args_curry 2 4 1 in 47 | let adder = add 6 in 48 | (whatever 6 "yeh" |> add 5 |> add 5, adder 20, filtered_list ()) 49 | 50 | -------------------------------------------------------------------------------- /test_files/curry_import.alp: -------------------------------------------------------------------------------- 1 | module curry_import 2 | 3 | export run_filter 4 | 5 | import curry.filter 6 | import curry.(|>) 7 | 8 | let eq x y = 9 | x == y 10 | 11 | let run_filter () = 12 | [1, 2, 3] |> filter (eq 3) 13 | -------------------------------------------------------------------------------- /test_files/default.alp: -------------------------------------------------------------------------------- 1 | module default 2 | 3 | export identity, always 4 | export_type box 5 | 6 | type box 'a = Box 'a 7 | 8 | let identity x = x 9 | 10 | let always x _ = x 11 | -------------------------------------------------------------------------------- /test_files/destructuring.alp: -------------------------------------------------------------------------------- 1 | module destructuring 2 | 3 | export test_it, g, add_first_2_in_list, fail_on_tuple_without_1 4 | 5 | let f r = let {x=x, y=y} = r in x + y 6 | let g t = let (x, y) = t in f {x=x, y=y} 7 | let test_it () = g (5, 6) 8 | 9 | let add_first_2_in_list l = let x :: y :: _ = l in x + y 10 | 11 | let fail_on_tuple_without_1 t = let (1, _) = t in "got 1!" -------------------------------------------------------------------------------- /test_files/dictionary.alp: -------------------------------------------------------------------------------- 1 | module dictionary 2 | 3 | type option 'a = Some 'a | None 4 | 5 | type dictionary 'k 'v = Dictionary (fn 'k -> option 'v) 6 | 7 | export new/1, lookup/2, insert/3, test_int_dict 8 | 9 | let new () = 10 | let ret k = None in 11 | Dictionary ret 12 | 13 | let lookup k (Dictionary m) = m k 14 | 15 | let insert k v (Dictionary m) = 16 | let ret k2 = 17 | match (k2 == k) with 18 | true -> Some v 19 | | false -> m k 20 | in Dictionary ret 21 | 22 | let test_int_dict () = 23 | let empty = new () in 24 | let filled = insert :a 1 empty in 25 | match lookup :a filled with 26 | Some 1 -> 27 | let res = lookup :a empty in 28 | res == None 29 | | None -> false 30 | -------------------------------------------------------------------------------- /test_files/different_clause_styles.alp: -------------------------------------------------------------------------------- 1 | module different_clause_styles 2 | 3 | export leading_pipe/1, or_pipe/1 4 | 5 | -- test a match where every clause leads with a pipe. 6 | let leading_pipe x = match x with 7 | | 0 -> :zero 8 | | _ -> :not_zero 9 | 10 | -- test a match where pipes are treated strictly as "or". 11 | let or_pipe x = match x with 12 | 0 -> :zero 13 | | _ -> :not_zero 14 | -------------------------------------------------------------------------------- /test_files/error_tests.alp: -------------------------------------------------------------------------------- 1 | module error_tests 2 | 3 | export raise_throw/1, raise_error/1, raise_exit/1, throw_or_int/1 4 | 5 | let raise_throw () = throw "this should be a throw" 6 | 7 | let raise_exit () = exit "exit here" 8 | 9 | let raise_error () = error "and an error" 10 | 11 | let throw_or_int x = match x with 12 | 0 -> throw "oh no zero!" 13 | | _ -> x * 2 14 | -------------------------------------------------------------------------------- /test_files/exhaustiveness_cases.alp: -------------------------------------------------------------------------------- 1 | module record_types 2 | 3 | export make_export, make_exports 4 | export make_t 5 | 6 | type opt 'a = Some 'a | None 7 | 8 | type module_ast = Module {line: int, name: atom} 9 | | Exports list {line: int, name: string, arity: opt int} 10 | 11 | let make_export l n = {line=l, name=n, arity=None} 12 | let make_export l n a = {line=l, name=n, arity=Some a} 13 | 14 | let make_exports es = Exports es 15 | 16 | type t = T map string (opt int) 17 | 18 | let make_t x = T #{"x" => x} 19 | 20 | type tt 't = TT map string (opt 't) 21 | 22 | let make_tt x = TT #{"x" => x} 23 | 24 | type u = U opt int 25 | 26 | let make_u x = U Some x 27 | 28 | let int_u U Some u = u 29 | 30 | type v = V list (opt int) 31 | 32 | let make_v vs = V vs 33 | 34 | type int_opt = opt int 35 | 36 | type x = X int_opt 37 | 38 | let make_x x = X Some x 39 | 40 | type z = Z (int, opt int) 41 | 42 | let make_z z = Z (z, Some z) 43 | 44 | type r = R list {x: int, y: opt int} 45 | 46 | let make_r r = R r 47 | -------------------------------------------------------------------------------- /test_files/export_all_arities.alp: -------------------------------------------------------------------------------- 1 | module export_all_arities 2 | 3 | export (|>) 4 | 5 | export foo, sub/2 6 | 7 | let (|>) x y = y x 8 | 9 | let foo x = x + 10 10 | 11 | let foo x y = x + y 12 | 13 | let sub x y = x - y -------------------------------------------------------------------------------- /test_files/failing_test.alp: -------------------------------------------------------------------------------- 1 | module failing_test 2 | 3 | export double 4 | 5 | let double x = x + x 6 | 7 | let assert_equal x y = 8 | match x == y with 9 | | true -> true 10 | | false -> throw (:not_equal, x, y) 11 | 12 | test "fails" = 13 | assert_equal (double 2) 5 14 | -------------------------------------------------------------------------------- /test_files/forward_label_reference.alp: -------------------------------------------------------------------------------- 1 | module forward_label_reference 2 | 3 | export hof_fail, val_fail 4 | 5 | let apply f x = f x 6 | 7 | let hof_fail () = 8 | apply add10 5 9 | 10 | let val_fail () = 11 | 10 + value 12 | 13 | -- As these are both declared AFTER their usage, neither 14 | -- of the above functions will compile 15 | 16 | let add10 x = x + 10 17 | let value = 5 18 | -------------------------------------------------------------------------------- /test_files/function_pattern_args.alp: -------------------------------------------------------------------------------- 1 | module function_pattern_args 2 | 3 | export is_zero/1, both_zero/2, make_xy/2, make_y/1, get_x/1, get_opt_x/1 4 | 5 | export double_maybe_x/1, doubler/1 6 | 7 | let is_zero 0 = true 8 | let is_zero x = false 9 | let both_zero 0 0 = true 10 | let both_zero x y = false 11 | let make_xy x y = {x=x, y=y} 12 | let make_y y = {y=y} 13 | let get_x {x=x} = x 14 | 15 | type option 'a = None | Some 'a 16 | 17 | let get_opt_x {x=x} = Some x 18 | let get_opt_x {} = None 19 | let my_map f None = None 20 | let my_map f (Some a) = Some (f a) 21 | 22 | let double x = x * x 23 | let doubler x = my_map double (Some x) 24 | 25 | let double_maybe_x rec = my_map double (get_opt_x rec) 26 | 27 | {- 28 | Mimics an issue I ran into working with elli and relatively specific pattern 29 | matches. Underscores/wildcards weren't getting renamed correctly due to the 30 | code generator's environment changes being ignored when making patterns. 31 | -} 32 | let handle_event :a b _ = :ok 33 | let handle_event _ _ _ = :whatever 34 | -------------------------------------------------------------------------------- /test_files/future_ast.alp: -------------------------------------------------------------------------------- 1 | {- 2 | Possible future Alpaca-native AST. Mostly using this for testing right now as 3 | trying things out has turned up a few bugs (e.g. record alias `binding` and 4 | issue #234). 5 | 6 | This module is broken in four main sections: 7 | 8 | 1. Documentation and comments. This is kept separate from the following 9 | sections dealing with the main language constructs since it can be 10 | attached to each of them as well. 11 | 2. The main module construct, with speculative portions for signatures in 12 | future. It's likely that signatures will be how visibility of module 13 | members will be controlled in future. 14 | 3. Type expressions, including both things that are expressible in the Alpaca 15 | language itself (e.g. `int`) as well as synthetic portions used only by the 16 | type checker. 17 | 4. Core expressions like bindings, constants, symbols, etc. 18 | 19 | Each section desribes things that can be used to describe the next. With the 20 | exception of signatures for instance, modules logically group, namespace, and 21 | thus describe types. Types themselves describe functions and values. 22 | 23 | TODO: modules are essentially a kind of product type. Perhaps there is a 24 | different stratification that should read something like 25 | 26 | - documentation/comments 27 | - (types about products, products) 28 | - (types about other expressions, expressions) 29 | -} 30 | module ast 31 | 32 | export_type binding, moduleAst, expr, symbol 33 | 34 | export line 35 | 36 | export mod 37 | export int, int_val 38 | export float, float_val 39 | export string 40 | export bind, bind_body, bind_expr 41 | export symbol, symbol_name, symbol_rename 42 | 43 | {- 1. Documentation 44 | 45 | -} 46 | 47 | {- A comment string may or may not be semantically linked to an AST node. 48 | `Attached` indicates that there is no empty line between the comment text and 49 | the following AST node, e.g. 50 | 51 | ``` 52 | -- This is conceptually a docstring for the function foo. 53 | let foo x = ... 54 | ``` 55 | 56 | A source code formatter needs to re-link this particular comment to that 57 | specific version of `foo`, and a documentation generator also needs to know 58 | that it is relevant for both `foo` and _that particular version_ of `foo`. 59 | 60 | On the other hand, we don't want the commented-out version of `foo` below to 61 | be attached to `bar` as a docstring so we indicate it is *not* semantically 62 | related by leaving a blank line, and using the `Orphan` constructor in the 63 | AST: 64 | 65 | ``` 66 | -- let foo x = x + x 67 | 68 | let bar y = ... 69 | ``` 70 | 71 | `Trailing` is for comments that follow an AST node, rather than precede it: 72 | 73 | ``` 74 | let foo x = 75 | let _ = someSideEffect () in -- A trailing comment. 76 | ... 77 | ``` 78 | 79 | Only formatters will care about this but it's still important not to lose 80 | track. 81 | -} 82 | type docAnchor = Attached | Trailing | Orphan 83 | 84 | type docStyle = Multiline | Block 85 | 86 | type docs = { style: docStyle 87 | , anchor: docAnchor 88 | , text: list string 89 | } 90 | 91 | {- 2. Modules 92 | 93 | All language constructs must live within a module. 94 | 95 | -} 96 | type moduleHash = Unhashed | Hashed binary 97 | 98 | type moduleQualifier = Unqual | Qual string 99 | 100 | type moduleAst = Module { name: atom 101 | , filename: string 102 | , typ: typ 103 | -- This is not strictly accurate, should also include 104 | -- bare strings: 105 | , functionExports: list (string, int) 106 | -- Also needs to include bare strings as an alternative 107 | -- to the `(atom, int)` tuple: 108 | , functionImports: list (string, (atom, int)) 109 | , types: list typeDef 110 | , typeImports: typeDefImport 111 | , typeExports: list string 112 | , bindings: list binding 113 | , tests: list testDef 114 | , precompiled: bool 115 | , hash: moduleHash 116 | , typed: bool 117 | } 118 | | ModuleBinding binding 119 | 120 | {- 3. Types 121 | 122 | There are two ways to specify a type: 123 | 124 | 1. An actual type declaration, e.g. `type x = X int`. 125 | 2. A type specification for a function. I'm starting to think that this can 126 | be viewed as sugar for binding a type declaration to a function name, or 127 | even "sealing" a function with a specific type. (Maybe this is already 128 | the way Standard ML people talk about this sort of thing? My ignorance 129 | is vast.) 130 | 131 | These are correspondingly type declarations (typeDef) and type specifications 132 | (typeSpec). 133 | -} 134 | type typeVar = { line: int, name: string } 135 | 136 | type quantifiers = Unbound {name: string, level: int} 137 | | Uni 138 | | Exi 139 | 140 | {- Types for the type checker. -} 141 | type typ = Untyped 142 | | -- The infinitely recursive type: 143 | TRec 144 | | TInt 145 | | TFloat 146 | | TString 147 | | TArrow (list typ, typ) 148 | | TypeDef typeDef 149 | 150 | {- `TypeUnit` is intended to be used for two things: 151 | 152 | 1. The actual `()` or `unit` type expression. 153 | 2. Type constructors (variants) without arguments. 154 | 155 | An example illustrating the type constructor case: 156 | 157 | ``` 158 | module example 159 | type aOrB = A | B int 160 | ``` 161 | 162 | would result in 163 | 164 | ``` 165 | { line = 1 166 | , mod = "example" 167 | , name = "aOrB" 168 | , vars = [] 169 | , members = [ TypeConstructor { line = 1 170 | , mod = "example" 171 | , name = "A" 172 | , expr = TypeUnit 173 | } 174 | , TypeConstructor { line = 1 175 | , mod = "example" 176 | , name = "B" 177 | , expr = TypeRef { line = 1 178 | -- Unqualified by module: 179 | , mod = None 180 | , name = "int" 181 | , vars = [] 182 | } 183 | } 184 | ] 185 | } 186 | ``` 187 | -} 188 | type typeExpr = TypeUnit 189 | | TypeVar typeVar 190 | | TypeRef { line: int 191 | , mod: moduleQualifier 192 | , name: string 193 | , vars: list typeVar 194 | } 195 | | TypeConstructor { line: int 196 | , mod: string 197 | , name: string 198 | , expr: typeExpr 199 | } 200 | 201 | -- Type specification for a binding: 202 | type typeSpec = { line: int 203 | , name: string 204 | , vars: list typeExpr 205 | , spec: typ 206 | } 207 | 208 | type typeDef = { line: int 209 | , mod: atom 210 | , name: string 211 | -- A type alias would have one member and no variables: 212 | , vars: list typeVar 213 | , members: list typeExpr 214 | } 215 | 216 | type typeDefImport = { userModule: atom 217 | , typeName: string 218 | } 219 | 220 | {- 4. Expressions. 221 | 222 | -} 223 | type binding = { line: int 224 | , name: expr 225 | , typ: typ 226 | , bound: expr 227 | , body: expr 228 | } 229 | 230 | type renameable = Named string | Renamed { name: string, original: string } 231 | 232 | {- Test definitions -} 233 | 234 | type testDef = { typ: typ 235 | , line: int 236 | , name: string 237 | , expr: expr 238 | } 239 | 240 | {- Product types handled a bit separately for now. This includes only tuples 241 | and records at the moment but as mentioned in the preamble, signatures (and 242 | thus modules) could also be considered product types. 243 | -} 244 | type recordMember = { line: int 245 | , typ: typ 246 | , label: string 247 | , value: expr 248 | } 249 | 250 | type product = Tuple { typ: typ 251 | , line: int 252 | , values: list expr 253 | } 254 | | Record { typ: typ 255 | , line: int 256 | , isPattern: bool 257 | , members: list recordMember 258 | } 259 | | RecordTransform { typ: typ 260 | , line: int 261 | , additions: list recordMember 262 | , existing: expr 263 | } 264 | 265 | type expr = Unit { line: int } 266 | -- The variable/expression `_`: 267 | | Wildcard { line: int } 268 | | Atom { line: int, value: string } 269 | | Bool { line: int, value: bool } 270 | | Int { line: int, value: int } 271 | | Float { line: int, value: float } 272 | | String { line: int, value: string } 273 | | Symbol { line: int, name: renameable } 274 | | Product product 275 | | Binding binding 276 | 277 | let line Float {line=l} = l 278 | let line Int {line=l} = l 279 | let line Symbol {line=l} = l 280 | let line Binding {line=l} = l 281 | let line String {line=l} = l 282 | 283 | 284 | let int line v = Int {line=line, value=v} 285 | 286 | let int_val Int {line=_, value=v} = v 287 | 288 | let float line v = Float {line=line, value=v} 289 | 290 | let float_val Float {line=_, value=v} = v 291 | 292 | let string line value = String {line=line, value=value} 293 | 294 | let bind name line bound body = 295 | Binding { line=line 296 | , name=name 297 | , bound=bound 298 | , body=body 299 | , typ=Untyped 300 | } 301 | 302 | let bind_body (Binding b_rec) body = Binding {body=body | b_rec} 303 | 304 | let bind_expr (Binding b_rec) expr = Binding {bound=expr | b_rec} 305 | 306 | let symbol line name = Symbol { line=line, name=Named name } 307 | 308 | let symbol_name Symbol {name=Named n} = n 309 | let symbol_name Symbol {name=Renamed {name=n}} = n 310 | 311 | let symbol_rename (Symbol {line=l, name=Named n}) new_name = 312 | Symbol {line=l, name=Renamed {name=new_name, original=n}} 313 | -- Interesting! This is not a type error, but rather requires that the record 314 | -- coming in simply has `orig` on top of `name` and `original`. Didn't think of 315 | -- this at all as a possible library-writer-side problem. 316 | let symbol_rename (Symbol {line=l, name=Renamed {original=o}}) new_name = 317 | Symbol {line=l, name=Renamed {name=new_name, original=o}} 318 | -------------------------------------------------------------------------------- /test_files/higher_order_functions.alp: -------------------------------------------------------------------------------- 1 | module higher_order_functions 2 | 3 | export new/1, lookup/2, insert/3 4 | 5 | type option 'x = None | Some 'x 6 | 7 | let new () = 8 | let ret k = None in ret 9 | 10 | let lookup k d = d k 11 | 12 | let insert k v d = 13 | let d2 k2 = 14 | match (k2 == k) with 15 | true -> Some v 16 | | false -> d k 17 | in d2 18 | -------------------------------------------------------------------------------- /test_files/import_test.alp: -------------------------------------------------------------------------------- 1 | module import_test 2 | 3 | export test_pipe/1, test_pipe_far_call/1, test_specified_arity/1 4 | 5 | import export_all_arities.[(|>), foo, sub/2] 6 | 7 | let add_ten x = x + 10 8 | 9 | let test_pipe () = 2 |> foo 10 | 11 | let test_pipe_far_call () = 2 |> export_all_arities.foo 12 | 13 | let test_specified_arity () = 14 | let f = export_all_arities.foo/2 in 15 | f 2 3 16 | 17 | -------------------------------------------------------------------------------- /test_files/lambda_examples.alp: -------------------------------------------------------------------------------- 1 | module lambda_examples 2 | 3 | export map_lambda, no_sugar_internal_binding, no_sugar_top_binding 4 | export map_to_make_t, nested_fun, use_lambda 5 | export use_literal_fun_with_patterns, literal_fun_and_guards 6 | export fun_in_record, fun_in_record_in_record 7 | 8 | let map f [] = [] 9 | let map f (h :: t) = (f h) :: (map f t) 10 | 11 | -- Use a literal lambda/anonymous function: 12 | let map_lambda () = map (fn x -> x + 1) [1, 2, 3] 13 | 14 | -- Skip function binding syntax sugar for internal functions. 15 | let no_sugar_internal_binding () = 16 | let f = fn x -> x + 1 in 17 | f 2 18 | 19 | -- Skip the syntax sugar for function bindings at the top level. 20 | let no_sugar_top_binding = fn x -> x + 1 21 | 22 | type t 'a = T 'a 23 | 24 | let map_to_make_t list = 25 | T (map (fn x -> x + 1) list) 26 | 27 | let nested_fun () = 28 | map (fn x -> (fn y -> y + 1) x) [1, 2, 3] 29 | 30 | let use_lambda = λ x → x + 1 31 | 32 | let use_literal_fun_with_patterns () = 33 | map (fn | 0 -> :zero | _ -> :not_zero) [0, 1, 0, 2] 34 | 35 | type int_and_float = int | float 36 | 37 | let literal_fun_and_guards () = 38 | let f = 39 | fn 40 | | x, is_integer x -> :int 41 | | _ -> :not_int 42 | in map f [1, 1.0, 2, 2.0] 43 | 44 | let fun_in_record () = 45 | let r = {f=fn x -> x + x} in 46 | match r with 47 | | {f=f} -> f 2 48 | 49 | let fun_in_record_in_record () = 50 | let r = {x=1, r={f=fn x -> x + 1}} in 51 | apply_nested_rec_fun r 2 52 | 53 | let apply_nested_rec_fun r x = 54 | match r with 55 | | {r={f=f}} -> f x -------------------------------------------------------------------------------- /test_files/lambda_in_test.alp: -------------------------------------------------------------------------------- 1 | module lambda_in_test 2 | 3 | let apply f a = f a 4 | 5 | test "lambda" = 6 | apply (fn x -> x + 1) 1 -------------------------------------------------------------------------------- /test_files/list_items.alp: -------------------------------------------------------------------------------- 1 | module list_items 2 | 3 | export getList, getMatrix 4 | 5 | let get_seventeen () = 17 6 | 7 | -- Simple expressions / function application 8 | let getList () = [2 + 2, get_seventeen ()] 9 | 10 | -- Sublists 11 | let getMatrix () = [ [0, 0, 0, 0] 12 | , [0, 1, 0, 0] 13 | , [0, 0, 1, 0] 14 | , [0, 0, 0, 1] ] 15 | -------------------------------------------------------------------------------- /test_files/list_opts.alp: -------------------------------------------------------------------------------- 1 | module list_opts 2 | 3 | export head_opt/1 4 | 5 | import_type basic_adt.my_list 6 | 7 | import_type basic_adt.opt 8 | 9 | let head_opt Cons (h, _) = Some h 10 | 11 | let head_opt Nil = None 12 | -------------------------------------------------------------------------------- /test_files/multiple_underscore_test.alp: -------------------------------------------------------------------------------- 1 | module multiple_underscore_test 2 | 3 | export list_check/1, map_check/1, tuple_check/1 4 | 5 | let list_check () = 6 | match [1, 2] with 7 | _ :: _ -> :list 8 | 9 | let map_check m = 10 | match m with 11 | #{:x => _, :y => _, :z => _} -> "all three" 12 | | #{:x => _, :y => _} -> "just two" 13 | 14 | let tuple_check t = 15 | match t with 16 | (_, _, _) -> "three" 17 | -------------------------------------------------------------------------------- /test_files/option_example.alp: -------------------------------------------------------------------------------- 1 | module option_example 2 | 3 | export_type option 4 | 5 | export some, map 6 | 7 | type option 'a = Some 'a | None 8 | 9 | let some x = Some x 10 | 11 | let map _ None = None 12 | let map f Some x = Some (f x) 13 | 14 | let ident x = x 15 | 16 | test "mapping a Some 1 with identity should result in Some 1" = 17 | asserts.assert_equal Some 1 (map ident Some 1) 18 | 19 | test "mapping a None with identity should result in None" = 20 | let f x = x in 21 | asserts.assert_equal (map f None) None 22 | 23 | val orElse 'a : fn 'a (option 'a) -> 'a 24 | let orElse default op = 25 | match op with 26 | | None -> default 27 | | Some value -> value 28 | 29 | 30 | val flatten 'a: fn (option 'a) -> 'a 31 | let flatten op = orElse (None) op 32 | 33 | test "flattening a nested option should remove one layer" = 34 | let o = Some Some 2 in 35 | asserts.assert_equal (flatten o) (Some 2) 36 | -------------------------------------------------------------------------------- /test_files/polymorphic_record_test.alp: -------------------------------------------------------------------------------- 1 | module polymorphic_record_test 2 | 3 | export with_y/1, with_y_and_throwaway_x/1 4 | 5 | let f r = 6 | match r with 7 | {x=xx} -> (xx + 1, r) 8 | 9 | let with_y () = 10 | let res = f {x=1, foo="bar"} in 11 | match res with 12 | (_, {foo=ff}) -> ff 13 | 14 | let with_y_and_throwaway_x() = 15 | let res = f {x=1, foo="baz"} in 16 | match res with 17 | (_, {x=_, foo=ff}) -> ff 18 | -------------------------------------------------------------------------------- /test_files/radius.alp: -------------------------------------------------------------------------------- 1 | module radius 2 | 3 | type radius = Radius int 4 | 5 | export make_radius/1, radius_to_int/1 6 | 7 | let make_radius i = 8 | match i with 9 | x, is_integer x -> Radius x 10 | 11 | let radius_to_int r = 12 | match r with 13 | Radius i -> i 14 | -------------------------------------------------------------------------------- /test_files/receiver_type.alp: -------------------------------------------------------------------------------- 1 | module receiver_type 2 | 3 | {- The `rec` type here doesn't properly constrain types assigned to `R` to only 4 | be infinitely recursive as so far we simply let `rec` unify with everything. 5 | I think we might want to consider treating `rec` in some positions to unify/4 6 | as a particular bound. 7 | -} 8 | type r = R receiver int (fn int -> rec) 9 | type s = S receiver int (fn int -> int) 10 | 11 | let adder_cell x = 12 | receive with 13 | y -> adder_cell (y + x) 14 | 15 | let main () = R adder_cell 16 | 17 | let one_receive x = 18 | receive with 19 | y -> x + y 20 | 21 | let use_s () = S one_receive -------------------------------------------------------------------------------- /test_files/record_map_match_order.alp: -------------------------------------------------------------------------------- 1 | module record_map_match_order 2 | 3 | export check_map/1, check_record/1 4 | 5 | type record_map_union = map atom int | {x: int} 6 | 7 | let get_x rec_or_map = 8 | match rec_or_map with 9 | #{:x => xx} -> xx 10 | | {x = xx} -> xx 11 | 12 | let check_map () = get_x #{:x => 1} 13 | 14 | let check_record () = get_x {x=2} -------------------------------------------------------------------------------- /test_files/records_with_x.alp: -------------------------------------------------------------------------------- 1 | module records_with_x 2 | 3 | export make_xy/2, make_xyz/3, get_x/1, get_x_and_the_record/1 4 | 5 | let make_xy x y = {x=x, y=y} 6 | 7 | let make_xyz x y z = {x=x, y=y, z=z} 8 | 9 | let get_x rec = 10 | match rec with 11 | {x=x} -> x 12 | 13 | {- No matter what type of record you pass in, the record in the 14 | returned tuple will always remember the full set of its fields 15 | in the return type. E.g. if you pass in {x=1, y=2, z=3}, the 16 | return type won't forget about y and z, the full type returned 17 | by this function will be (if you pass that exact record): 18 | 19 | (int, {x: int, y: int, z: int}) 20 | 21 | -} 22 | let get_x_and_the_record rec = 23 | match rec with 24 | {x=x} -> (x, rec) -------------------------------------------------------------------------------- /test_files/same_name_diff_arity.alp: -------------------------------------------------------------------------------- 1 | module same_name_diff_arity 2 | 3 | export seq/1 4 | 5 | let seq x = seq 0 x 6 | 7 | let seq current top = match current with 8 | x, x > top -> [] 9 | | x -> x :: (seq (current + 1) top) -------------------------------------------------------------------------------- /test_files/simple_example.alp: -------------------------------------------------------------------------------- 1 | -- An example module 2 | 3 | module simple_example 4 | 5 | -- a basic top-level function: 6 | let add2 x = x + 2 7 | 8 | -- a basic infix function 9 | let (|>) x f = f x 10 | 11 | let something_with_let_bindings x = 12 | -- a function: 13 | let adder a b = a + b in 14 | -- a variable (immutable): 15 | let x_plus_2 = adder x 2 in 16 | add2 x 17 | 18 | -- a polymorphic ADT: 19 | type messages 'x = 'x | Fetch pid 'x 20 | 21 | {- A function that can be spawned to receive `messages int` 22 | messages, that increments its state by received integers 23 | and can be queried for its state 24 | -} 25 | let will_be_a_process x = receive with 26 | i -> will_be_a_process (x + i) 27 | | Fetch sender -> 28 | let sent = send x sender in 29 | will_be_a_process x 30 | 31 | let start_a_process init = spawn will_be_a_process init 32 | -------------------------------------------------------------------------------- /test_files/simple_records.alp: -------------------------------------------------------------------------------- 1 | module simple_records 2 | 3 | export fname/1, lname/1, sample_person/1 4 | 5 | let fname r = 6 | match r with 7 | {fname=f}, is_string f -> f 8 | 9 | let lname r = 10 | match r with 11 | {lname=l}, is_string l -> l 12 | 13 | let make_person fname lname = 14 | {fname=fname, lname=lname} 15 | 16 | {- Make an example person and extract first and last names in a tuple. 17 | Purpose here is to ensure everything type checks correctly as well 18 | as being able to destructure a record. 19 | -} 20 | let sample_person () = 21 | let r = make_person "sample" "person" in 22 | (fname r, lname r) 23 | -------------------------------------------------------------------------------- /test_files/string_concat.alp: -------------------------------------------------------------------------------- 1 | module string_concat 2 | 3 | export hello/1 4 | 5 | let hello x = beam :string :concat [c"Hello, ", x] with 6 | s, is_chars s -> s 7 | -------------------------------------------------------------------------------- /test_files/tests_and_imports.alp: -------------------------------------------------------------------------------- 1 | module tests_and_imports 2 | 3 | import asserts.assert_equal 4 | 5 | test "example" = 6 | assert_equal 2 2 -------------------------------------------------------------------------------- /test_files/type_import.alp: -------------------------------------------------------------------------------- 1 | module type_import 2 | 3 | import_type basic_adt.my_list 4 | 5 | export test_output/1 6 | 7 | let test_output () = 8 | let l = Cons (1, Cons (2, Nil)) in 9 | basic_adt.len l -------------------------------------------------------------------------------- /test_files/unexported_adts.alp: -------------------------------------------------------------------------------- 1 | {- We want to ensure that if the types exist but aren't exported we get an 2 | appropriate compiler error. 3 | 4 | The module name doesn't match the filename so that we can reuse the 5 | list_opts module for tests. 6 | -} 7 | 8 | module basic_adt 9 | 10 | export len/1 11 | 12 | {- simple linked list, 13 | multi-line comment. 14 | -} 15 | type my_list 'x = Cons ('x, my_list 'x) | Nil 16 | 17 | type opt 'a = None | Some 'a 18 | 19 | let len l = match l with 20 | Nil -> 0 21 | -- single line comment should be ignored: 22 | | Cons (_, tail) -> 1 + (len tail) 23 | -------------------------------------------------------------------------------- /test_files/update_record.alp: -------------------------------------------------------------------------------- 1 | module update_record 2 | 3 | export adds_x 4 | 5 | let adds_x x_val rec = {x=x_val | rec} 6 | -------------------------------------------------------------------------------- /test_files/use_default.alp: -------------------------------------------------------------------------------- 1 | module use_default 2 | 3 | export main/1 4 | 5 | -- `identity`, `always` and `box` are defined in the `default` module 6 | 7 | let main () = let same = identity (Box 42) in 8 | always same (Box 1) -------------------------------------------------------------------------------- /test_files/use_lambda.alp: -------------------------------------------------------------------------------- 1 | {- Tests for the compilation and use of a lambda defined and applied in the same 2 | expression. For fix of issue #196. 3 | 4 | With thanks to https://github.com/lepoetemaudit for the initial test cases. 5 | -} 6 | module use_lambda 7 | 8 | export useLambda, useLambdaTuple, matchLambda, ffiLambda 9 | 10 | val apply 'a 'b : fn (fn 'a -> 'b) 'a -> 'b 11 | let apply f x = f x 12 | 13 | -- Used to fail: 14 | let useLambda x = 15 | apply (fn y -> x + y) 10 16 | 17 | let useLambdaTuple x = 18 | apply (fn (_, y) -> x + y) (:ignored, 10) 19 | 20 | let boundLambda x = 21 | let lambda = (fn y -> x + y) in 22 | apply lambda 10 23 | 24 | let useLet x = 25 | apply (let f y = x + y in f) 10 26 | 27 | -- Used to fail 28 | val matchLambda : fn bool -> fn int -> int 29 | let matchLambda v = 30 | match v with 31 | | true -> fn x -> x * x 32 | | false -> fn x -> (x + x) + 1 33 | 34 | val boundMatchLambda : fn bool -> fn int -> int 35 | let boundMatchLambda v = 36 | match v with 37 | | true -> (let f y = y * y in f) 38 | | false -> (let f y = y + y in f) 39 | 40 | -- FFI and receive expressions are similar to match expressions 41 | val ffiLambda 'a : fn 'a -> fn int -> int 42 | let ffiLambda r = 43 | beam :io :format [r] with 44 | _ -> fn x -> x * x 45 | 46 | let wait () = 47 | receive with 48 | x, is_integer x -> fn y -> y * 10 49 | 50 | -------------------------------------------------------------------------------- /test_files/use_option.alp: -------------------------------------------------------------------------------- 1 | module use_option 2 | 3 | export option_to_atom 4 | 5 | import_type option_example.option 6 | 7 | let option_to_atom opt = 8 | match opt with 9 | | None -> :none 10 | | Some _ -> :some 11 | -------------------------------------------------------------------------------- /test_files/use_radius.alp: -------------------------------------------------------------------------------- 1 | module use_radius 2 | 3 | export test_radius/1 4 | 5 | let test_radius () = (radius.radius_to_int (radius.make_radius 1)) -------------------------------------------------------------------------------- /test_files/use_update_record.alp: -------------------------------------------------------------------------------- 1 | module use_update_record 2 | 3 | export main, overwrite_x, add_2_members, add_3_members 4 | 5 | let main () = update_record.adds_x 5 {b=2} 6 | let overwrite_x () = update_record.adds_x 2 {x=3.0} 7 | let add_2_members () = {a=1, b=2 | {c=3}} 8 | let add_3_members () = {a=1, b=2, c=3 | {x=1.0, z="this is z"}} -------------------------------------------------------------------------------- /test_files/values.alp: -------------------------------------------------------------------------------- 1 | module values 2 | 3 | export test_values/1 4 | 5 | type simple_adt = AnInt int | AString string | AFloat float | 6 | ARecord { x: int } | ABinary binary | AList (list int) | 7 | AnADT simple_adt | AnAtom atom | ABool bool | Chars chars | 8 | ATuple (int, string) | Unit () 9 | 10 | let test_int = 41 11 | let test_string = "Vicugna pacos" 12 | let test_float = 0.5 13 | let test_record = {x = 19} 14 | let test_binary = <<1: size=8, 2: size=8>> 15 | let test_array = [1, 2, 3, 4] 16 | let test_adt = AnInt 5 17 | let test_atom = :nope 18 | let test_bool = true 19 | let test_chars = c"x" 20 | let test_tuple = (100, "100") 21 | let test_unit = () 22 | 23 | let wrapped_int = AnInt 41 24 | let wrapped_string = AString "Vicugna pacos" 25 | let wrapped_float = AFloat 0.5 26 | let wrapped_record = ARecord {x = 19} 27 | let wrapped_binary = ABinary <<1: size=8, 2: size=8>> 28 | let wrapped_array = AList [1, 2, 3, 4] 29 | let wrapped_adt = AnADT (AnInt 5) 30 | let wrapped_atom = AnAtom :nope 31 | let wrapped_bool = ABool true 32 | let wrapped_chars = Chars c"x" 33 | let wrapped_tuple = ATuple (100, "100") 34 | let wrapped_unit = Unit () 35 | 36 | -- Note the use of the value of test_int in an expression 37 | let test_values () = (test_int + 1, test_string) 38 | --------------------------------------------------------------------------------