├── .github └── workflows │ └── perl-prove.yml ├── .gitignore ├── ARCHITECTURE.md ├── Changes ├── LICENSE ├── Makefile.PL ├── README ├── README.md ├── bin └── bel ├── ignore.txt ├── lib └── Language │ ├── Bel.pm │ └── Bel │ ├── AsyncCall.pm │ ├── AsyncEval.pm │ ├── Bytecode.pm │ ├── Compiler.pm │ ├── Compiler │ ├── Generator.pm │ ├── Gensym.pm │ ├── Pass.pm │ ├── Pass │ │ ├── AllocateRegisters.pm │ │ ├── Alpha.pm │ │ └── Flatten.pm │ └── Primitives.pm │ ├── Core.pm │ ├── Documentation.pod │ ├── Explanation.pod │ ├── Globals.pm │ ├── Globals │ ├── ByteFuncs.pm │ ├── FastFuncs.pm │ ├── FastOperatives.pm │ ├── Generator.pm │ └── Source.pm │ ├── Guides.pod │ ├── Pair │ ├── ByteFunc.pm │ ├── CharsList.pm │ ├── FastFunc.pm │ ├── FastOperative.pm │ ├── FutFunc.pm │ ├── Num.pm │ ├── RepeatList.pm │ ├── SignedRat.pm │ └── Str.pm │ ├── Primitives.pm │ ├── Printer.pm │ ├── Reader.pm │ ├── Reference.pod │ ├── Test.pm │ ├── Test │ └── DSL.pm │ └── Tutorial.pod ├── pg ├── bel.bel ├── belexamples.txt ├── bellanguage.txt ├── rees-oo.txt └── worked.txt ├── t ├── 00-consistency-unused-imports.t ├── 00-consistent-copyright-year.t ├── 00-consistent-fastfunc-exports.t ├── 00-consistent-fastoperative-exports.t ├── 00-consistent-globals.t ├── 00-consistent-version-strict-warnings.t ├── 00-consistent-version.t ├── 00-load.t ├── 00-valid-bytecode.t ├── 01-fn-readas.t ├── 02-prim-wrb.t ├── bcfn-all.t ├── bcfn-append.t ├── bcfn-atom.t ├── bcfn-caddr.t ├── bcfn-cadr.t ├── bcfn-cddr.t ├── bcfn-char.t ├── bcfn-cons.t ├── bcfn-list.t ├── bcfn-no.t ├── bcfn-pair.t ├── bcfn-proper.t ├── bcfn-reduce.t ├── bcfn-rev.t ├── bcfn-snoc.t ├── bcfn-some.t ├── bcfn-stream.t ├── bcfn-string.t ├── bcfn-symbol.t ├── board-movements.bel ├── bquote.t ├── brackets.t ├── call-mac-as-fn.t ├── comfns.t ├── compile-empty.t ├── compile-fn-atom.t ├── compile-fn-no.t ├── example-bel.t ├── example-board-movements.t ├── example-rll.t ├── example-rock-paper-scissors.t ├── fn-abs.t ├── fn-adjoin.t ├── fn-all.t ├── fn-append.t ├── fn-array.t ├── fn-atom.t ├── fn-begins.t ├── fn-bel-apply.t ├── fn-bel-applyclo.t ├── fn-bel-applycont.t ├── fn-bel-applym.t ├── fn-bel-form-after.t ├── fn-bel-form-dyn.t ├── fn-bel-form-if.t ├── fn-bel-form-quote.t ├── fn-bel-form-thread.t ├── fn-bel-form-where.t ├── fn-bel-literal.t ├── fn-bel-prim-car.t ├── fn-bel-prim-cdr.t ├── fn-bel-prim-id.t ├── fn-bel-prim-join.t ├── fn-bel-prim-nom.t ├── fn-bel-prim-type.t ├── fn-bel-sigerr.t ├── fn-bel-variable.t ├── fn-best.t ├── fn-binding.t ├── fn-breakc.t ├── fn-buildnum.t ├── fn-c-plus.t ├── fn-c-star.t ├── fn-caddr.t ├── fn-cadr.t ├── fn-cand.t ├── fn-caris.t ├── fn-cddr.t ├── fn-ceil.t ├── fn-cells.t ├── fn-char.t ├── fn-charint.t ├── fn-charn.t ├── fn-charstil.t ├── fn-clog2.t ├── fn-close.t ├── fn-combine.t ├── fn-common.t ├── fn-compose.t ├── fn-con.t ├── fn-cons.t ├── fn-consif.t ├── fn-cor.t ├── fn-cut.t ├── fn-dec.t ├── fn-dedup.t ├── fn-deq.t ├── fn-digit.t ├── fn-dock.t ├── fn-drop.t ├── fn-dups.t ├── fn-eatwhite.t ├── fn-enq.t ├── fn-eq.t ├── fn-even.t ├── fn-factor.t ├── fn-find.t ├── fn-first.t ├── fn-flip.t ├── fn-floor.t ├── fn-foldl.t ├── fn-foldr.t ├── fn-function.t ├── fn-fuse.t ├── fn-ge.t ├── fn-get.t ├── fn-gets.t ├── fn-hard-rdex.t ├── fn-hat-w.t ├── fn-hug.t ├── fn-i-hat.t ├── fn-i-lt.t ├── fn-i-minus.t ├── fn-i-plus.t ├── fn-i-slash.t ├── fn-i-star.t ├── fn-idfn.t ├── fn-in.t ├── fn-inc.t ├── fn-insert.t ├── fn-int.t ├── fn-intchar.t ├── fn-intrac.t ├── fn-inv.t ├── fn-inwhere.t ├── fn-ipart.t ├── fn-irep.t ├── fn-is.t ├── fn-isa.t ├── fn-keep.t ├── fn-last.t ├── fn-lastcdr.t ├── fn-le.t ├── fn-len.t ├── fn-list.t ├── fn-litnum.t ├── fn-lookup.t ├── fn-map.t ├── fn-match.t ├── fn-max.t ├── fn-mem.t ├── fn-min.t ├── fn-minus.t ├── fn-mod.t ├── fn-namedups.t ├── fn-newq.t ├── fn-no.t ├── fn-number.t ├── fn-numi.t ├── fn-numr.t ├── fn-odd.t ├── fn-of.t ├── fn-okenv.t ├── fn-okparms.t ├── fn-okstack.t ├── fn-only.t ├── fn-open.t ├── fn-pair.t ├── fn-pairwise.t ├── fn-parameters.t ├── fn-parsecom.t ├── fn-parsed.t ├── fn-parsei.t ├── fn-parseint.t ├── fn-parseno.t ├── fn-parsenum.t ├── fn-parseslist.t ├── fn-parsesr.t ├── fn-parset.t ├── fn-parseword.t ├── fn-part.t ├── fn-peek.t ├── fn-pint.t ├── fn-plus.t ├── fn-pos.t ├── fn-prc.t ├── fn-prelts.t ├── fn-presc.t ├── fn-print.t ├── fn-prnice.t ├── fn-prnum.t ├── fn-proper.t ├── fn-protected.t ├── fn-prpair.t ├── fn-prsimple.t ├── fn-prstring.t ├── fn-prsymbol.t ├── fn-put.t ├── fn-r-minus.t ├── fn-r-plus.t ├── fn-r-slash.t ├── fn-r-star.t ├── fn-rand.t ├── fn-randlen.t ├── fn-rdc.t ├── fn-rddelim.t ├── fn-rddot.t ├── fn-rdex.t ├── fn-rdlist.t ├── fn-rdtarget.t ├── fn-rdword.t ├── fn-rdwrap.t ├── fn-read.t ├── fn-readall.t ├── fn-real.t ├── fn-recip.t ├── fn-reduce.t ├── fn-rem.t ├── fn-rev.t ├── fn-round.t ├── fn-rpart.t ├── fn-rrep.t ├── fn-runs.t ├── fn-saferead.t ├── fn-signc.t ├── fn-simple.t ├── fn-simplify.t ├── fn-slash.t ├── fn-snap.t ├── fn-snoc.t ├── fn-some.t ├── fn-sort.t ├── fn-source.t ├── fn-split.t ├── fn-sr-lt.t ├── fn-sr-minus.t ├── fn-sr-plus.t ├── fn-sr-slash.t ├── fn-sr-star.t ├── fn-srden.t ├── fn-srinv.t ├── fn-srnum.t ├── fn-srrecip.t ├── fn-star.t ├── fn-stream.t ├── fn-string.t ├── fn-symbol.t ├── fn-table.t ├── fn-tabrem.t ├── fn-tail.t ├── fn-tokens.t ├── fn-trap.t ├── fn-udrop.t ├── fn-upon.t ├── fn-ustring.t ├── fn-uvar.t ├── fn-validd.t ├── fn-validi.t ├── fn-validr.t ├── fn-variable.t ├── fn-wait.t ├── fn-whitec.t ├── fn-whole.t ├── fn-yc.t ├── fncall.t ├── form-after.t ├── form-apply.t ├── form-ccc.t ├── form-dyn.t ├── form-extension.t ├── form-if.t ├── form-quote.t ├── form-thread.t ├── form-where.t ├── let-quine.t ├── linked-globals.t ├── mac-accum.t ├── mac-afn.t ├── mac-aif.t ├── mac-and.t ├── mac-atomic.t ├── mac-awhen.t ├── mac-bind.t ├── mac-case.t ├── mac-catch.t ├── mac-check.t ├── mac-clean.t ├── mac-def.t ├── mac-do.t ├── mac-do1.t ├── mac-drain.t ├── mac-each.t ├── mac-eif.t ├── mac-fn.t ├── mac-for.t ├── mac-from.t ├── mac-fu.t ├── mac-iflet.t ├── mac-let.t ├── mac-letu.t ├── mac-loop.t ├── mac-mac.t ├── mac-macro.t ├── mac-minus-minus.t ├── mac-nof.t ├── mac-onerr.t ├── mac-or.t ├── mac-pcase.t ├── mac-plus-plus.t ├── mac-poll.t ├── mac-pop.t ├── mac-pull.t ├── mac-push.t ├── mac-pushnew.t ├── mac-record.t ├── mac-repeat.t ├── mac-rfn.t ├── mac-safe.t ├── mac-set.t ├── mac-swap.t ├── mac-til.t ├── mac-to.t ├── mac-unless.t ├── mac-when.t ├── mac-whenlet.t ├── mac-while.t ├── mac-whilet.t ├── mac-wipe.t ├── mac-with.t ├── mac-withfile.t ├── mac-withs.t ├── mac-zap.t ├── maccall.t ├── malformed.t ├── manifest.t ├── multiple-bels.t ├── number.t ├── odd-hugs.t ├── overriding-err.t ├── param-destructure.t ├── param-optional.t ├── param-typed.t ├── pod-coverage.t ├── pod.t ├── prim-car.t ├── prim-cdr.t ├── prim-cls.t ├── prim-coin.t ├── prim-id.t ├── prim-join.t ├── prim-nom.t ├── prim-ops.t ├── prim-rdb.t ├── prim-stat.t ├── prim-type.t ├── prims.t ├── print-shared-pairs.t ├── read-shared-pairs.t ├── reader-breakc.t ├── reader-intrasymbol.t ├── reverse-linked-list.bel ├── rock-paper-scissors.bel ├── string.t ├── templates.t ├── var-scope.t ├── various-weird.t └── virfns.t ├── tools ├── generate-bel-globals └── increase-bel-version-number └── xt └── boilerplate.t /.github/workflows/perl-prove.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: CI 4 | 5 | # Controls when the action will run. 6 | on: 7 | # Triggers the workflow on push or pull request events but only for the master branch 8 | push: 9 | branches: [ master ] 10 | pull_request: 11 | branches: [ master ] 12 | 13 | # Allows you to run this workflow manually from the Actions tab 14 | workflow_dispatch: 15 | 16 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 17 | jobs: 18 | # This workflow contains a single job called "build" 19 | build: 20 | # The type of runner that the job will run on 21 | runs-on: ubuntu-latest 22 | 23 | # Steps represent a sequence of tasks that will be executed as part of the job 24 | steps: 25 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 26 | - uses: actions/checkout@v2 27 | 28 | - name: Run tests 29 | run: prove -e'perl -Ilib -T' --timer -j2 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Test-Harness-3.42/ 2 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Language-Bel 2 | 3 | 0.01 Date/time 4 | First version, released on an unsuspecting world. 5 | 6 | -------------------------------------------------------------------------------- /ignore.txt: -------------------------------------------------------------------------------- 1 | Makefile 2 | Makefile.old 3 | Build 4 | Build.bat 5 | META.* 6 | MYMETA.* 7 | .build/ 8 | _build/ 9 | cover_db/ 10 | blib/ 11 | inc/ 12 | .lwpcookies 13 | .last_cover_stats 14 | nytprof.out 15 | pod2htm*.tmp 16 | pm_to_blib 17 | Language-Bel-* 18 | Language-Bel-*.tar.gz 19 | -------------------------------------------------------------------------------- /lib/Language/Bel/AsyncCall.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::AsyncCall; 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings; 6 | 7 | use Exporter 'import'; 8 | 9 | sub new { 10 | my ($class, $fn, $args_ref, $cont_sub) = @_; 11 | 12 | my $obj = { 13 | fn => $fn, 14 | args_ref => $args_ref, 15 | cont_sub => $cont_sub, 16 | }; 17 | return bless($obj, $class); 18 | } 19 | 20 | sub fn { 21 | my ($self) = @_; 22 | 23 | return $self->{fn}; 24 | } 25 | 26 | sub args_ref { 27 | my ($self) = @_; 28 | 29 | return $self->{args_ref}; 30 | } 31 | 32 | sub invoke_cont { 33 | my ($self, $value) = @_; 34 | 35 | return $self->{cont_sub}->($value); 36 | } 37 | 38 | sub is_async_call { 39 | my ($value) = @_; 40 | 41 | if (!ref($value)) { 42 | use Carp; 43 | confess "undefined value in is_async_call: $value"; 44 | } 45 | return $value->isa(__PACKAGE__); 46 | } 47 | 48 | sub make_async_call { 49 | my ($fn, $args_ref, $cont_sub) = @_; 50 | 51 | return __PACKAGE__->new($fn, $args_ref, $cont_sub); 52 | } 53 | 54 | our @EXPORT_OK = qw( 55 | is_async_call 56 | make_async_call 57 | ); 58 | 59 | 1; 60 | -------------------------------------------------------------------------------- /lib/Language/Bel/AsyncEval.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::AsyncEval; 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings; 6 | 7 | use Exporter 'import'; 8 | 9 | sub new { 10 | my ($class, $expr, $denv, $cont_sub) = @_; 11 | 12 | my $obj = { 13 | expr => $expr, 14 | denv => $denv, 15 | cont_sub => $cont_sub, 16 | }; 17 | return bless($obj, $class); 18 | } 19 | 20 | sub expr { 21 | my ($self) = @_; 22 | 23 | return $self->{expr}; 24 | } 25 | 26 | sub denv { 27 | my ($self) = @_; 28 | 29 | return $self->{denv}; 30 | } 31 | 32 | sub invoke_cont { 33 | my ($self, $value) = @_; 34 | 35 | return defined($self->{cont_sub}) 36 | ? $self->{cont_sub}->($value) 37 | : $value; 38 | } 39 | 40 | sub is_async_eval { 41 | my ($value) = @_; 42 | 43 | return $value->isa(__PACKAGE__); 44 | } 45 | 46 | sub make_async_eval { 47 | my ($expr, $denv, $cont_sub) = @_; 48 | 49 | return __PACKAGE__->new($expr, $denv, $cont_sub); 50 | } 51 | 52 | our @EXPORT_OK = qw( 53 | is_async_eval 54 | make_async_eval 55 | ); 56 | 57 | 1; 58 | -------------------------------------------------------------------------------- /lib/Language/Bel/Compiler.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::Compiler; 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings; 6 | 7 | use Language::Bel::Compiler::Pass::AllocateRegisters; 8 | use Language::Bel::Compiler::Pass::Alpha; 9 | use Language::Bel::Compiler::Pass::Flatten; 10 | use Language::Bel::Compiler::Generator qw( 11 | generate_bytefunc 12 | ); 13 | 14 | use Exporter 'import'; 15 | 16 | sub make_pass { 17 | my ($name) = @_; 18 | 19 | return "Language::Bel::Compiler::Pass::$name"->new(); 20 | } 21 | 22 | my @PASSES = map { make_pass($_) } qw< 23 | Alpha 24 | Flatten 25 | AllocateRegisters 26 | >; 27 | 28 | sub compile { 29 | my ($source) = @_; 30 | 31 | my $program = read_whole($source); 32 | 33 | for my $nanopass (@PASSES) { 34 | $program = $nanopass->translate($program); 35 | } 36 | 37 | return generate_bytefunc($program); 38 | } 39 | 40 | our @EXPORT_OK = qw( 41 | compile 42 | ); 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/Language/Bel/Compiler/Gensym.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::Compiler::Gensym; 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings; 6 | 7 | use Language::Bel::Core qw( 8 | is_symbol 9 | symbol_name 10 | ); 11 | 12 | use Exporter 'import'; 13 | 14 | my $unique_gensym_index = 0; 15 | 16 | my $GENSYM_PREFIX = "gensym_"; 17 | 18 | sub gensym { 19 | return $GENSYM_PREFIX . sprintf("%04d", ++$unique_gensym_index); 20 | } 21 | 22 | sub is_gensym { 23 | my ($expr) = @_; 24 | 25 | return is_symbol($expr) 26 | && substr(symbol_name($expr), 0, length($GENSYM_PREFIX)) 27 | eq $GENSYM_PREFIX; 28 | } 29 | 30 | our @EXPORT_OK = qw( 31 | gensym 32 | is_gensym 33 | ); 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/Language/Bel/Compiler/Pass.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::Compiler::Pass; 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings; 6 | 7 | sub new { 8 | my ($class, $name) = @_; 9 | 10 | return bless({ 11 | name => $name, 12 | }, $class); 13 | } 14 | 15 | # abstract 16 | sub translate { 17 | my ($self) = @_; 18 | 19 | my $name = $self->{name}; 20 | 21 | die "The [$name] pass doesn't implement a 'translate' method"; 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/Language/Bel/Compiler/Primitives.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::Compiler::Primitives; 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings; 6 | 7 | use Language::Bel::Compiler::Primitives qw( 8 | car 9 | cdr 10 | ); 11 | 12 | use Exporter 'import'; 13 | 14 | my $primitives = Language::Bel::Primitives->new({ 15 | output => sub {}, 16 | read_char => sub {}, 17 | err => sub { 18 | my ($message_str) = @_; 19 | 20 | die "Error during compilation: $message_str\n"; 21 | }, 22 | }); 23 | 24 | sub car { 25 | my ($pair) = @_; 26 | 27 | return $primitives->prim_car($pair); 28 | } 29 | 30 | sub cdr { 31 | my ($pair) = @_; 32 | 33 | return $primitives->prim_cdr($pair); 34 | } 35 | 36 | our @EXPORT_OK = qw( 37 | car 38 | cdr 39 | ); 40 | 41 | 1; 42 | -------------------------------------------------------------------------------- /lib/Language/Bel/Documentation.pod: -------------------------------------------------------------------------------- 1 | # PODNAME: Language::Bel::Documentation 2 | # ABSTRACT: Bel language documentation 3 | 4 | __END__ 5 | 6 | =pod 7 | 8 | =encoding UTF-8 9 | 10 | =head1 NAME 11 | 12 | Language::Bel::Documentation - Bel language documentation 13 | 14 | =head1 VERSION 15 | 16 | version 0.35 17 | 18 | =head1 DESCRIPTION 19 | 20 | In line with L, 21 | The Bel documentation targets four possible audiences: 22 | 23 | =over 24 | 25 | =item L for learners 26 | 27 | =item L for more experienced users 28 | 29 | =item L for background and context 30 | 31 | =item L for technical description 32 | 33 | =back 34 | 35 | If you're unsure where to start, then probably 36 | L is a good place. 37 | 38 | =cut 39 | 40 | -------------------------------------------------------------------------------- /lib/Language/Bel/Guides.pod: -------------------------------------------------------------------------------- 1 | # PODNAME: Language::Bel::Guides 2 | # ABSTRACT: Bel language how-to guides 3 | 4 | __END__ 5 | 6 | =pod 7 | 8 | =encoding UTF-8 9 | 10 | =head1 NAME 11 | 12 | Language::Bel::Guides - Bel language how-to guides 13 | 14 | =head1 VERSION 15 | 16 | version 0.35 17 | 18 | =head1 DESCRIPTION 19 | 20 | Guides are supposed to be I; directions to achieve a specific 21 | end. 22 | 23 | They are written for relatively experienced users who know I they want 24 | to do, but not I. They don't much explain things; at most, they link to 25 | further explanations. 26 | 27 | Guides can show some different variants, allowing for slightly different ways 28 | to do things. However, it's more important to be practically usable than to 29 | be complete. 30 | 31 | Some possible 32 | 33 | =over 34 | 35 | =item How to deal with parameters and binding 36 | 37 | =item How to create a new special form 38 | 39 | =item How to work with files 40 | 41 | =item How to make a new literal type 42 | 43 | =item How to register your literal type as a virtual function 44 | 45 | =back 46 | 47 | These are just suggestions; I expect them to be more high-level and abstracted 48 | from language mechanisms as we all gain more experience with Bel itself. 49 | 50 | =cut 51 | 52 | -------------------------------------------------------------------------------- /lib/Language/Bel/Pair/FastOperative.pm: -------------------------------------------------------------------------------- 1 | package Language::Bel::Pair::FastOperative; 2 | use base qw(Language::Bel::Pair); 3 | 4 | use 5.006; 5 | use strict; 6 | use warnings; 7 | 8 | use Exporter 'import'; 9 | 10 | sub new { 11 | my ($class, $pair, $fn) = @_; 12 | 13 | my $obj = { 14 | pair => $pair, 15 | fn => $fn, 16 | }; 17 | return bless($obj, $class); 18 | } 19 | 20 | sub car { 21 | my ($self) = @_; 22 | 23 | return $self->{pair}->car(); 24 | } 25 | 26 | sub cdr { 27 | my ($self) = @_; 28 | 29 | return $self->{pair}->cdr(); 30 | } 31 | 32 | sub xar { 33 | my ($self, $car) = @_; 34 | 35 | return $self->{pair}->xar($car); 36 | } 37 | 38 | sub xdr { 39 | my ($self, $cdr) = @_; 40 | 41 | return $self->{pair}->xdr($cdr); 42 | } 43 | 44 | sub apply { 45 | my ($self, $bel, $denv, @args) = @_; 46 | 47 | return $self->{fn}->($bel, $denv, @args); 48 | } 49 | 50 | sub is_fastoperative { 51 | my ($object) = @_; 52 | 53 | return $object->isa(__PACKAGE__); 54 | } 55 | 56 | sub make_fastoperative { 57 | my ($pair, $fn) = @_; 58 | 59 | return __PACKAGE__->new($pair, $fn); 60 | } 61 | 62 | our @EXPORT_OK = qw( 63 | is_fastoperative 64 | make_fastoperative 65 | ); 66 | 67 | 1; 68 | -------------------------------------------------------------------------------- /lib/Language/Bel/Reference.pod: -------------------------------------------------------------------------------- 1 | # PODNAME: Language::Bel::Reference 2 | # ABSTRACT: Bel language reference 3 | 4 | __END__ 5 | 6 | =pod 7 | 8 | =encoding UTF-8 9 | 10 | =head1 NAME 11 | 12 | Language::Bel::Reference - Bel language reference 13 | 14 | =head1 VERSION 15 | 16 | version 0.35 17 | 18 | =head1 DESCRIPTION 19 | 20 | The reference goes through all the components of Bel, and describes them. 21 | 22 | We'll want to co-locate reference documentation with the things they describe. 23 | I'm fully willing to adapt the structure of the project to make this possible. 24 | 25 | Reference material should be B. 26 | 27 | Here are the things I know we'll want to document: 28 | 29 | =over 30 | 31 | =item Data types 32 | 33 | =item Axioms 34 | 35 | =item Special forms 36 | 37 | =item Built-in functions and macros 38 | 39 | =item Built-in constants 40 | 41 | =item Reader syntax 42 | 43 | =item Built-in virtual function types 44 | 45 | =back 46 | 47 | I'm fine with listing these first by some topic grouping (like "functions 48 | operating on lists"), and then all of them, alphabetically. 49 | 50 | =cut 51 | 52 | -------------------------------------------------------------------------------- /lib/Language/Bel/Tutorial.pod: -------------------------------------------------------------------------------- 1 | # PODNAME: Language::Bel::Tutorial 2 | # ABSTRACT: Bel language tutorial 3 | 4 | __END__ 5 | 6 | =pod 7 | 8 | =encoding UTF-8 9 | 10 | =head1 NAME 11 | 12 | Language::Bel::Tutorial - Bel language tutorial 13 | 14 | =head1 VERSION 15 | 16 | version 0.35 17 | 18 | =head1 DESCRIPTION 19 | 20 | This part is not written yet, but the plan is (as explained in #143) to base 21 | this off the Arc tutorial, which is written for people with no prior Lisp 22 | experience. It should be possible to adapt it to Bel and still have it feel 23 | natural and comprehensive. 24 | 25 | There doesn't have to be only one tutorial — we could have more of them, beyond 26 | the main one. 27 | 28 | =cut 29 | 30 | -------------------------------------------------------------------------------- /t/00-consistent-copyright-year.t: -------------------------------------------------------------------------------- 1 | use 5.006; 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | use Language::Bel::Test qw( 8 | for_each_line_in_file 9 | ); 10 | 11 | my @FILES = qw(README README.md lib/Language/Bel.pm); 12 | 13 | plan tests => scalar(@FILES); 14 | 15 | my $year = (localtime())[5] + 1900; 16 | 17 | for my $file (@FILES) { 18 | my $found_year = 0; 19 | for_each_line_in_file($file, sub { 20 | my ($line, $exit_loop) = @_; 21 | if ($line =~ /\b$year\b/) { 22 | $found_year = 1; 23 | $exit_loop->(); 24 | } 25 | }); 26 | 27 | ok $found_year, "found current year in $file"; 28 | } 29 | 30 | -------------------------------------------------------------------------------- /t/00-consistent-globals.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use Digest::MD5 qw(md5_hex); 7 | 8 | use Language::Bel::Test qw( 9 | slurp_file 10 | ); 11 | 12 | use Language::Bel::Globals::Generator qw(generate_globals); 13 | 14 | binmode STDOUT, ':encoding(utf-8)'; 15 | 16 | plan tests => 1; 17 | 18 | { 19 | my $actual_globals = slurp_file("lib/Language/Bel/Globals.pm"); 20 | 21 | my $bel = Language::Bel->new({ output => sub {} }); 22 | 23 | my $generated_globals; 24 | do { 25 | local *STDOUT; 26 | open(STDOUT, ">>", \$generated_globals) 27 | or die "failed to open file handle to string ($!)\n"; 28 | 29 | generate_globals($bel); # will print into $generated_globals 30 | }; 31 | 32 | is md5_hex($actual_globals), 33 | md5_hex($generated_globals), 34 | "the globals are up to date"; 35 | } 36 | -------------------------------------------------------------------------------- /t/00-load.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | plan tests => 1; 8 | 9 | BEGIN { 10 | use_ok( 'Language::Bel' ) || print "Bail out!\n"; 11 | } 12 | 13 | diag( "Testing Language::Bel $Language::Bel::VERSION, Perl $], $^X" ); 14 | -------------------------------------------------------------------------------- /t/01-fn-readas.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (tem point x 0 y 0) 10 | !IGNORE: result of template definition 11 | 12 | > (readas 'point '("(lit tab)")) 13 | (lit tab (x . 0) (y . 0)) 14 | 15 | > (readas 'point '("(lit tab (x . 1) (y . 2))")) 16 | (lit tab (x . 1) (y . 2)) 17 | 18 | > (readas 'point '("(lit tab (x . 1) (z . 1))")) 19 | (lit tab (x . 1) (y . 0)) 20 | 21 | -------------------------------------------------------------------------------- /t/02-prim-wrb.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set bang-bits "00100001") 10 | "00100001" 11 | 12 | > (do (each c bang-bits 13 | (wrb c nil)) 14 | (pr \lf) 15 | '(ignore return value)) 16 | ! 17 | (ignore return value) 18 | 19 | > (set hello-bits (append "01101000" ; h 20 | "01100101" ; e 21 | "01101100" ; l 22 | "01101100" ; l 23 | "01101111")) ; o 24 | "0110100001100101011011000110110001101111" 25 | 26 | > (set f (ops "temp9283" 'out)) 27 | 28 | 29 | > (each c hello-bits 30 | (wrb c f)) 31 | !IGNORE: result of `each` 32 | 33 | > (cls f) 34 | 35 | 36 | > (set f (ops "temp9283" 'in) 37 | read-bits '()) 38 | nil 39 | 40 | > (til b (rdb f) (= b 'eof) 41 | (push b read-bits)) 42 | nil 43 | 44 | > (cls f) 45 | 46 | 47 | > (= hello-bits (rev read-bits)) 48 | t 49 | 50 | !END: unlink("temp9283"); 51 | 52 | -------------------------------------------------------------------------------- /t/bcfn-all.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!all atom '(a b c)) 10 | t 11 | 12 | > (bcfn!all atom '(a (b c) d)) 13 | nil 14 | 15 | > (bcfn!all atom '()) 16 | t 17 | 18 | > (bcfn!all no '(nil nil nil)) 19 | t 20 | 21 | -------------------------------------------------------------------------------- /t/bcfn-append.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!append '(a b c) '(d e f)) 10 | (a b c d e f) 11 | 12 | > (bcfn!append '(a) 13 | nil 14 | '(b c) 15 | '(d e f)) 16 | (a b c d e f) 17 | 18 | > (bcfn!append) 19 | nil 20 | 21 | > (let p '(b) 22 | (id (cdr (bcfn!append '(a) p)) p)) 23 | t 24 | 25 | > (let p '(b) 26 | (id (cdr (bcfn!append '(a) p nil)) p)) 27 | nil 28 | 29 | -------------------------------------------------------------------------------- /t/bcfn-atom.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!atom \a) 10 | t 11 | 12 | > (bcfn!atom nil) 13 | t 14 | 15 | > (bcfn!atom 'a) 16 | t 17 | 18 | > (bcfn!atom '(a)) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/bcfn-caddr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!caddr nil) 10 | nil 11 | 12 | > (bcfn!caddr '(a)) 13 | nil 14 | 15 | > (bcfn!caddr '(a b)) 16 | nil 17 | 18 | > (bcfn!caddr '(a b c)) 19 | c 20 | 21 | -------------------------------------------------------------------------------- /t/bcfn-cadr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!cadr nil) 10 | nil 11 | 12 | > (bcfn!cadr '(a)) 13 | nil 14 | 15 | > (bcfn!cadr '(a b)) 16 | b 17 | 18 | > (bcfn!cadr '(a b c)) 19 | b 20 | 21 | -------------------------------------------------------------------------------- /t/bcfn-cddr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!cddr nil) 10 | nil 11 | 12 | > (bcfn!cddr '(a)) 13 | nil 14 | 15 | > (bcfn!cddr '(a b)) 16 | nil 17 | 18 | > (bcfn!cddr '(a b c)) 19 | (c) 20 | 21 | -------------------------------------------------------------------------------- /t/bcfn-char.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!char 'x) 10 | nil 11 | 12 | > (bcfn!char nil) 13 | nil 14 | 15 | > (bcfn!char '(a)) 16 | nil 17 | 18 | > (bcfn!char (join)) 19 | nil 20 | 21 | > (bcfn!char \c) 22 | t 23 | 24 | -------------------------------------------------------------------------------- /t/bcfn-cons.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!cons 'a nil) 10 | (a) 11 | 12 | > (bcfn!cons 'a) 13 | a 14 | 15 | > (bcfn!cons 'a 'b) 16 | (a . b) 17 | 18 | > (bcfn!cons) 19 | nil 20 | 21 | > (bcfn!cons 'a 'b 'c '(d e f)) 22 | (a b c d e f) 23 | 24 | -------------------------------------------------------------------------------- /t/bcfn-list.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!list) 10 | nil 11 | 12 | > (bcfn!list 'a) 13 | (a) 14 | 15 | > (bcfn!list 'a 'b) 16 | (a b) 17 | 18 | -------------------------------------------------------------------------------- /t/bcfn-no.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!no nil) 10 | t 11 | 12 | > (bcfn!no 'nil) 13 | t 14 | 15 | > (bcfn!no '()) 16 | t 17 | 18 | > (bcfn!no t) 19 | nil 20 | 21 | > (bcfn!no 'x) 22 | nil 23 | 24 | > (bcfn!no \c) 25 | nil 26 | 27 | > (bcfn!no '(nil)) 28 | nil 29 | 30 | > (bcfn!no '(a . b)) 31 | nil 32 | 33 | > (bcfn!no no) 34 | nil 35 | 36 | > (bcfn!no bcfn!no) 37 | nil 38 | 39 | > (bcfn!no (bcfn!no bcfn!no)) 40 | t 41 | 42 | -------------------------------------------------------------------------------- /t/bcfn-pair.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!pair 'x) 10 | nil 11 | 12 | > (bcfn!pair nil) 13 | nil 14 | 15 | > (bcfn!pair '(a)) 16 | t 17 | 18 | > (bcfn!pair (join)) 19 | t 20 | 21 | > (bcfn!pair \c) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/bcfn-proper.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!proper nil) 10 | t 11 | 12 | > (bcfn!proper '(a . b)) 13 | nil 14 | 15 | > (bcfn!proper '(a b)) 16 | t 17 | 18 | -------------------------------------------------------------------------------- /t/bcfn-reduce.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!reduce join '(a b c)) 10 | (a b . c) 11 | 12 | > (bcfn!reduce (fn (x y) x) '(a b c)) 13 | a 14 | 15 | > (bcfn!reduce (fn (x y) y) '(a b c)) 16 | c 17 | 18 | > (bcfn!reduce join '()) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/bcfn-rev.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!rev nil) 10 | nil 11 | 12 | > (bcfn!rev '(a b c)) 13 | (c b a) 14 | 15 | > (bcfn!rev '(a (x y) c)) 16 | (c (x y) a) 17 | 18 | -------------------------------------------------------------------------------- /t/bcfn-snoc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!snoc '(a b c) 'd 'e) 10 | (a b c d e) 11 | 12 | > (bcfn!snoc '()) 13 | nil 14 | 15 | > (bcfn!snoc) 16 | nil 17 | 18 | -------------------------------------------------------------------------------- /t/bcfn-some.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!some atom '(a b c)) 10 | (a b c) 11 | 12 | > (bcfn!some atom '()) 13 | nil 14 | 15 | > (bcfn!some is!b '(a b c)) 16 | (b c) 17 | 18 | > (bcfn!some is!q '(a b c)) 19 | nil 20 | 21 | > (bcfn!some no '(t t nil)) 22 | (nil) 23 | 24 | > (bcfn!some no '(t t)) 25 | nil 26 | 27 | -------------------------------------------------------------------------------- /t/bcfn-stream.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!stream 'x) 10 | nil 11 | 12 | > (bcfn!stream nil) 13 | nil 14 | 15 | > (bcfn!stream '(a)) 16 | nil 17 | 18 | > (bcfn!stream (join)) 19 | nil 20 | 21 | > (bcfn!stream \c) 22 | nil 23 | 24 | > (set f (ops "testfile" 'out)) 25 | 26 | 27 | > (bcfn!stream f) 28 | t 29 | 30 | !END: unlink("testfile"); 31 | 32 | -------------------------------------------------------------------------------- /t/bcfn-string.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!string nil) 10 | t 11 | 12 | > (bcfn!string "") 13 | t 14 | 15 | > (bcfn!string "hello bel") 16 | t 17 | 18 | > (bcfn!string 'c) 19 | nil 20 | 21 | > (bcfn!string \a) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/bcfn-symbol.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bcfn!symbol 'x) 10 | t 11 | 12 | > (bcfn!symbol nil) 13 | t 14 | 15 | > (bcfn!symbol '(a)) 16 | nil 17 | 18 | > (bcfn!symbol (join)) 19 | nil 20 | 21 | > (bcfn!symbol \c) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/bquote.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > `x 10 | x 11 | 12 | > `(y z) 13 | (y z) 14 | 15 | > ((fn (x) `(a ,x)) 'b) 16 | (a b) 17 | 18 | > ((fn (y) `(,y d)) 'c) 19 | (c d) 20 | 21 | > ((fn (x) `(a . ,x)) 'b) 22 | (a . b) 23 | 24 | > ((fn (y) `(,y . d)) 'c) 25 | (c . d) 26 | 27 | > ((fn (x) `(a ,@x)) '(b1 b2 b3)) 28 | (a b1 b2 b3) 29 | 30 | > ((fn (y) `(,@y d)) '(c1 c2 c3)) 31 | (c1 c2 c3 d) 32 | 33 | > ((fn (y) `(,@y . d)) '(c1 c2 c3)) 34 | (c1 c2 c3 . d) 35 | 36 | > ,x 37 | !ERROR: comma-outside-backquote 38 | 39 | > ((fn (x) ,x) 'a) 40 | !ERROR: comma-outside-backquote 41 | 42 | > (nil ,@x) 43 | !ERROR: comma-at-outside-backquote 44 | 45 | > ((fn (x) (nil ,@x)) 'a) 46 | !ERROR: comma-at-outside-backquote 47 | 48 | > `,@x 49 | !ERROR: comma-at-outside-list 50 | 51 | > ((fn (x) `,@x) 'a) 52 | !ERROR: comma-at-outside-list 53 | 54 | -------------------------------------------------------------------------------- /t/brackets.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (atom [id _ t]) 10 | nil 11 | 12 | > ([id _ 'd] 'd) 13 | t 14 | 15 | > (map [car _] '((a b) (c d) (e f))) 16 | (a c e) 17 | 18 | > ([] t) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/call-mac-as-fn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (2:or nil '(a b c)) 10 | b 11 | 12 | > ((compose 2 or) nil '(a b c)) 13 | b 14 | 15 | > (apply or nil '(a b c) nil) 16 | (a b c) 17 | 18 | -------------------------------------------------------------------------------- /t/comfns.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (< 2 4) 10 | t 11 | 12 | > (< 5 3) 13 | nil 14 | 15 | > (< \a \c) 16 | t 17 | 18 | > (< \d \b) 19 | nil 20 | 21 | > (< "aa" "ac") 22 | t 23 | 24 | > (< "bc" "ab") 25 | nil 26 | 27 | > (< 'aa 'ac) 28 | t 29 | 30 | > (< 'bc 'ab) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/compile-empty.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use Language::Bel::Test qw( 7 | test_compilation 8 | ); 9 | 10 | plan tests => 1; 11 | 12 | my $source = " 13 | (def empty (x)) 14 | "; 15 | 16 | my $target = " 17 | (bytefunc 18 | (%0 := 'nil) 19 | (return %0)) 20 | "; 21 | 22 | test_compilation($source, $target); 23 | 24 | -------------------------------------------------------------------------------- /t/compile-fn-atom.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use Language::Bel::Test qw( 7 | test_compilation 8 | ); 9 | 10 | plan tests => 1; 11 | 12 | my $source = " 13 | (def atom (x) 14 | (no (id (type x) 'pair))) 15 | "; 16 | 17 | my $target = " 18 | (bytefunc 19 | (%0 := params) 20 | (%1 := prim!cdr %0) 21 | (err!if %1 'overargs) 22 | (%0 := prim!car %0) 23 | (%0 := prim!type %0) 24 | (%0 := prim!id %0 'pair) 25 | (%0 := prim!id %0 'nil) 26 | (return %0)) 27 | "; 28 | 29 | test_compilation($source, $target); 30 | 31 | -------------------------------------------------------------------------------- /t/compile-fn-no.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use Language::Bel::Test qw( 7 | test_compilation 8 | ); 9 | 10 | plan tests => 1; 11 | 12 | my $source = " 13 | (def no (x) 14 | (id x nil)) 15 | "; 16 | 17 | my $target = " 18 | (bytefunc 19 | (%0 := params) 20 | (%1 := prim!cdr %0) 21 | (err!if %1 'overargs) 22 | (%0 := prim!car %0) 23 | (%0 := prim!id %0 'nil) 24 | (return %0)) 25 | "; 26 | 27 | test_compilation($source, $target); 28 | 29 | -------------------------------------------------------------------------------- /t/example-board-movements.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use Test::More; 8 | use Language::Bel::Test; 9 | 10 | plan tests => 4; 11 | 12 | my $output = output_of_eval_file("t/board-movements.bel"); 13 | 14 | my @lines = split(/\n/, $output); 15 | 16 | # the spaces at the end of the output are spec; they are due to `prn` 17 | is $lines[0], "(5 1) ", "a valid sequence of moves"; 18 | is $lines[1], "impossible-move ", "trying to leave the board"; 19 | is $lines[2], "illegal-command ", "issuing an unknown command"; 20 | is $lines[3], "(3 1) ", "quit command but not last"; 21 | 22 | -------------------------------------------------------------------------------- /t/example-rll.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use Test::More; 8 | use Language::Bel::Test; 9 | 10 | plan tests => 1; 11 | 12 | my $output = output_of_eval_file("t/reverse-linked-list.bel"); 13 | 14 | is $output, 15 | "\n", 16 | "reverse-linked-list example works"; 17 | 18 | -------------------------------------------------------------------------------- /t/example-rock-paper-scissors.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use Test::More; 8 | use Language::Bel::Test; 9 | 10 | plan tests => 4; 11 | 12 | my $output = output_of_eval_file("t/rock-paper-scissors.bel"); 13 | 14 | my @lines = split(/\n/, $output); 15 | 16 | is scalar(@lines), 3, "anticipated number of lines of output"; 17 | ok $lines[0] =~ /^Player 1: (rock|paper|scissors)$/, 18 | "valid player 1 move"; 19 | ok $lines[1] =~ /^Player 2: (rock|paper|scissors)$/, 20 | "valid player 2 move"; 21 | ok $lines[2] =~ /^Result: (player [12] wins|it's a tie)$/, 22 | "valid result"; 23 | 24 | -------------------------------------------------------------------------------- /t/fn-abs.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (abs (lit num (+ nil (t)) (+ nil (t)))) 10 | 0 11 | 12 | > (abs (lit num (+ nil (t)) (+ (t) (t)))) 13 | 0 14 | 15 | > (abs (lit num (+ (t) (t)) (+ nil (t)))) 16 | 1 17 | 18 | > (abs (lit num (- (t) (t)) (+ nil (t)))) 19 | 1 20 | 21 | > (abs (lit num (+ (t t) (t t t)) (- (t) (t t t t)))) 22 | 2/3 23 | 24 | > (abs (lit num (- (t t) (t t t)) (+ (t) (t t t t)))) 25 | 2/3 26 | 27 | -------------------------------------------------------------------------------- /t/fn-adjoin.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (adjoin 'a '(a b c)) 10 | (a b c) 11 | 12 | > (adjoin 'z '(a b c)) 13 | (z a b c) 14 | 15 | > (adjoin 'a '(a b c) =) 16 | (a b c) 17 | 18 | > (adjoin 'z '(a b c) =) 19 | (z a b c) 20 | 21 | > (adjoin '(a) '((a) (b) (c))) 22 | ((a) (b) (c)) 23 | 24 | > (adjoin '(a) '((a) (b) (c)) id) 25 | ((a) (a) (b) (c)) 26 | 27 | > (let p '(a) (adjoin p `(,p (b) (c)) id)) 28 | ((a) (b) (c)) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-all.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (all atom '(a b c)) 10 | t 11 | 12 | > (all atom '(a (b c) d)) 13 | nil 14 | 15 | > (all atom '()) 16 | t 17 | 18 | > (all no '(nil nil nil)) 19 | t 20 | 21 | -------------------------------------------------------------------------------- /t/fn-append.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (append '(a b c) '(d e f)) 10 | (a b c d e f) 11 | 12 | > (append '(a) 13 | nil 14 | '(b c) 15 | '(d e f)) 16 | (a b c d e f) 17 | 18 | > (append) 19 | nil 20 | 21 | > (let p '(b) 22 | (id (cdr:append '(a) p) p)) 23 | t 24 | 25 | > (let p '(b) 26 | (id (cdr:append '(a) p nil) p)) 27 | nil 28 | 29 | -------------------------------------------------------------------------------- /t/fn-array.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (array nil) 10 | nil 11 | 12 | > (array nil 0) 13 | 0 14 | 15 | > (array nil 'x) 16 | x 17 | 18 | > (array '(3) 0) 19 | (lit arr 0 0 0) 20 | 21 | > (array '(0) 'x) 22 | (lit arr) 23 | 24 | > (set L0 0 25 | L1 `(lit arr ,L0 ,L0) 26 | L2 `(lit arr ,L1 ,L1) 27 | L3 `(lit arr ,L2 ,L2)) 28 | !IGNORE: result of assignment 29 | 30 | > (= (array '(2 2) 0) L2) 31 | t 32 | 33 | > (= (array '(2 2 2) 0) L3) 34 | t 35 | 36 | -------------------------------------------------------------------------------- /t/fn-atom.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (atom \a) 10 | t 11 | 12 | > (atom nil) 13 | t 14 | 15 | > (atom 'a) 16 | t 17 | 18 | > (atom '(a)) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/fn-begins.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (begins nil nil) 10 | t 11 | 12 | > (begins '(a b c) nil) 13 | t 14 | 15 | > (begins '(a b c) '(a)) 16 | t 17 | 18 | > (begins '(a b c) '(x)) 19 | nil 20 | 21 | > (begins '(a b c) '(a b)) 22 | t 23 | 24 | > (begins '(a b c) '(a y)) 25 | nil 26 | 27 | > (begins '(a b c) '(a b c)) 28 | t 29 | 30 | > (begins '(a b c) '(a b z)) 31 | nil 32 | 33 | > (set p (join)) 34 | (nil) 35 | 36 | > (begins `(,p) `(,p)) 37 | t 38 | 39 | > (begins `(,p) `(,(join))) 40 | t 41 | 42 | > (begins `(,p) `(,p) id) 43 | t 44 | 45 | > (begins `(,p) `(,(join)) id) 46 | nil 47 | 48 | -------------------------------------------------------------------------------- /t/fn-bel-apply.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(apply idfn '(hi))) 10 | hi 11 | 12 | > (bel '(apply no '(t))) 13 | nil 14 | 15 | > (bel '(apply no '(nil))) 16 | t 17 | 18 | > (bel '(apply car '((a b)))) 19 | a 20 | 21 | -------------------------------------------------------------------------------- /t/fn-bel-applyclo.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(idfn 'hi)) 10 | hi 11 | 12 | > (bel '(no t)) 13 | nil 14 | 15 | > (bel '(no nil)) 16 | t 17 | 18 | -------------------------------------------------------------------------------- /t/fn-bel-applycont.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(join 'a (ccc (lit clo nil (c) (c 'b))))) 10 | (a . b) 11 | 12 | -------------------------------------------------------------------------------- /t/fn-bel-applym.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '((lit mac (lit clo nil (x) x)) t)) 10 | t 11 | 12 | -------------------------------------------------------------------------------- /t/fn-bel-form-after.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(after 1 2)) 10 | 1 11 | 12 | > (bel '(after 3 (car 'atom))) 13 | !ERROR: car-on-atom 14 | 15 | -------------------------------------------------------------------------------- /t/fn-bel-form-dyn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(dyn d 2 d)) 10 | 2 11 | 12 | -------------------------------------------------------------------------------- /t/fn-bel-form-if.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(if)) 10 | nil 11 | 12 | > (bel '(if 'a)) 13 | a 14 | 15 | > (bel '(if 'a 'b)) 16 | b 17 | 18 | > (bel '(if 'a 'b 'c)) 19 | b 20 | 21 | > (bel '(if nil 'b 'c)) 22 | c 23 | 24 | -------------------------------------------------------------------------------- /t/fn-bel-form-quote.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(quote a)) 10 | a 11 | 12 | -------------------------------------------------------------------------------- /t/fn-bel-form-thread.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(thread (car '(x . y)))) 10 | x 11 | 12 | -------------------------------------------------------------------------------- /t/fn-bel-form-where.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(where (car '(x . y)))) 10 | ((x . y) a) 11 | 12 | > (bel '(where (cdr '(z . w)))) 13 | ((z . w) d) 14 | 15 | The following two tests would probably work, but they are too slow. 16 | Even `(bel 'k!a)` is too slow right now. Maybe later. 17 | 18 | SKIP: > (bel '(where ((lit tab (a . 1)) 'a))) 19 | SKIP: ((a . 1) 'd) 20 | 21 | SKIP: > (bel '(where ((lit tab (a . 1)) 'b))) 22 | SKIP: ((b) 'd) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-bel-literal.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel nil) 10 | nil 11 | 12 | > (bel t) 13 | t 14 | 15 | > (bel \x) 16 | \x 17 | 18 | -------------------------------------------------------------------------------- /t/fn-bel-prim-car.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(car '(a . b))) 10 | a 11 | 12 | > (bel '(car '(a b))) 13 | a 14 | 15 | > (bel '(car nil)) 16 | nil 17 | 18 | > (bel '(car)) 19 | nil 20 | 21 | > (bel '(car 'atom)) 22 | !ERROR: car-on-atom 23 | 24 | -------------------------------------------------------------------------------- /t/fn-bel-prim-cdr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(cdr '(a . b))) 10 | b 11 | 12 | > (bel '(cdr '(a b))) 13 | (b) 14 | 15 | > (bel '(cdr nil)) 16 | nil 17 | 18 | > (bel '(cdr)) 19 | nil 20 | 21 | > (bel '(cdr 'atom)) 22 | !ERROR: cdr-on-atom 23 | 24 | -------------------------------------------------------------------------------- /t/fn-bel-prim-id.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(id 'a 'a)) 10 | t 11 | 12 | > (bel '(id 'a 'b)) 13 | nil 14 | 15 | > (bel '(id 'a \a)) 16 | nil 17 | 18 | > (bel '(id \a \a)) 19 | t 20 | 21 | > (bel '(id 't t)) 22 | t 23 | 24 | > (bel '(id nil 'nil)) 25 | t 26 | 27 | > (bel '(id id id)) 28 | t 29 | 30 | > (bel '(id id 'id)) 31 | nil 32 | 33 | > (bel '(id id nil)) 34 | nil 35 | 36 | > (bel '(id nil)) 37 | t 38 | 39 | > (bel '(id)) 40 | t 41 | 42 | -------------------------------------------------------------------------------- /t/fn-bel-prim-join.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(join 'a 'b)) 10 | (a . b) 11 | 12 | > (bel '(join 'a)) 13 | (a) 14 | 15 | > (bel '(join)) 16 | (nil) 17 | 18 | > (bel '(join nil 'b)) 19 | (nil . b) 20 | 21 | > (bel '(id (join 'a 'b) (join 'a 'b))) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-bel-prim-nom.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(nom 'a)) 10 | "a" 11 | 12 | > (bel '(nom \a)) 13 | !ERROR: mistype 14 | 15 | > (bel '(nom nil)) 16 | "nil" 17 | 18 | > (bel '(nom '(a))) 19 | !ERROR: mistype 20 | 21 | > (bel '(nom "a")) 22 | !ERROR: mistype 23 | 24 | -------------------------------------------------------------------------------- /t/fn-bel-prim-type.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(type 'a)) 10 | symbol 11 | 12 | > (bel '(type \a)) 13 | char 14 | 15 | > (bel '(type \bel)) 16 | char 17 | 18 | > (bel '(type nil)) 19 | symbol 20 | 21 | > (bel '(type '(a))) 22 | pair 23 | 24 | > (bel '(type (ops "testfile" 'out))) 25 | stream 26 | 27 | !END: unlink "testfile"; 28 | 29 | -------------------------------------------------------------------------------- /t/fn-bel-sigerr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel '(a . b)) 10 | !ERROR: malformed 11 | 12 | > (bel '(where x)) 13 | !ERROR: unbound 14 | 15 | > (bel 'x) 16 | !ERROR: (unboundb x) 17 | 18 | > (bel '(where 'a)) 19 | !ERROR: unfindable 20 | 21 | > (bel '(dyn \x 1 'hi)) 22 | !ERROR: cannot-bind 23 | 24 | > (bel '((lit . x))) 25 | !ERROR: bad-lit 26 | 27 | > (bel '(t)) 28 | !ERROR: cannot-apply 29 | 30 | > (bel '((lit clo (\x) nil t))) 31 | !ERROR: bad-clo 32 | 33 | > (bel '((lit clo nil \y t))) 34 | !ERROR: bad-clo 35 | 36 | > (bel '((lit cont (\x) nil))) 37 | !ERROR: bad-cont 38 | 39 | > (bel '((lit unp))) 40 | !ERROR: unapplyable 41 | 42 | > (bel '(car 'x 'y)) 43 | !ERROR: overargs 44 | 45 | > (bel '((lit prim unk))) 46 | !ERROR: unknown-prim 47 | 48 | > (bel '(no 'a 'b)) 49 | !ERROR: overargs 50 | 51 | > (pass t nil nil nil nil nil) 52 | !ERROR: literal-parm 53 | 54 | > (bel '(no)) 55 | !ERROR: underargs 56 | 57 | > (bel '((lit clo nil ((x y)) nil) 'd)) 58 | !ERROR: atom-arg 59 | 60 | > (bel '(join 'a (ccc (lit clo nil (c) (c))))) 61 | !ERROR: wrong-no-args 62 | 63 | > (bel '(join 'a (ccc (lit clo nil (c) (c 'x 'y))))) 64 | !ERROR: wrong-no-args 65 | 66 | -------------------------------------------------------------------------------- /t/fn-bel-variable.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (bel 'vmark) 10 | (nil) 11 | 12 | > (bel '((lit clo nil (x) x) 'g)) 13 | g 14 | 15 | > (bel '((lit clo nil (x) (where x)) 'g)) 16 | ((x . g) d) 17 | 18 | -------------------------------------------------------------------------------- /t/fn-best.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (best < '(5 1 3 2 4)) 10 | 1 11 | 12 | > (best > '(5 1 3 2 4)) 13 | 5 14 | 15 | > (best (of > len) '((a b) (c) (d e) (f))) 16 | (a b) 17 | 18 | > (best (of < len) '((a b) (c) (d e) (f))) 19 | (c) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-binding.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x1 (cons `(,smark bind (x . 1)) nil) 10 | x2 (cons `(,smark bind (x . 2)) nil) 11 | y1 (cons `(,smark bind (y . 1)) nil)) 12 | !IGNORE: result of assignment 13 | 14 | > (binding 'x nil) 15 | nil 16 | 17 | > (binding 'x (list y1)) 18 | nil 19 | 20 | > (binding 'x (list x2)) 21 | (x . 2) 22 | 23 | > (binding 'x (list y1 x2)) 24 | (x . 2) 25 | 26 | > (binding 'x (list x2 y1)) 27 | (x . 2) 28 | 29 | > (binding 'x (list x1 x2)) 30 | (x . 1) 31 | 32 | -------------------------------------------------------------------------------- /t/fn-breakc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (breakc nil) 10 | t 11 | 12 | > (breakc \0) 13 | nil 14 | 15 | > (breakc \a) 16 | nil 17 | 18 | > (if (breakc \sp) t) 19 | t 20 | 21 | > (breakc \;) 22 | t 23 | 24 | > (breakc \3) 25 | nil 26 | 27 | > (if (breakc \() t) 28 | t 29 | 30 | > (if (breakc \[) t) 31 | t 32 | 33 | > (if (breakc \)) t) 34 | t 35 | 36 | > (if (breakc \]) t) 37 | t 38 | 39 | > (breakc \D) 40 | nil 41 | 42 | -------------------------------------------------------------------------------- /t/fn-buildnum.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (buildnum '(+ (t) (t)) '(+ nil (t))) 10 | 1 11 | 12 | > (buildnum '(+ (t t) (t t)) '(+ nil (t))) 13 | 1 14 | 15 | > (set i2i2 '(+ (t t) (t t)) 16 | i4i6 '(+ (t t t t) (t t t t t t)) 17 | i0i1 '(+ nil (t))) 18 | !IGNORE: result of assignment 19 | 20 | > (srnum:numr (buildnum i2i2 i0i1)) 21 | (t) 22 | 23 | > (srnum:numr (buildnum i4i6 i0i1)) 24 | (t t) 25 | 26 | -------------------------------------------------------------------------------- /t/fn-c-plus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set c1 `((+ ,i1 ,i1) (+ ,i0 ,i1)) 10 | c2 `((- ,i1 ,i1) (+ ,i0 ,i1)) 11 | c0 `((+ ,i0 ,i1) (+ ,i0 ,i1)) 12 | c3 `((+ ,i0 ,i1) (+ ,i1 ,i1)) 13 | c4 `((+ ,i2 (t t t)) (+ ,i1 ,i1)) 14 | c5 `((+ ,i1 (t t t)) (- ,i1 ,i1))) 15 | !IGNORE: result of assignment 16 | 17 | > (c+ c1 c1) 18 | ((+ (t t) (t)) (+ nil (t))) 19 | 20 | > (c+ c1 c2) 21 | ((- nil (t)) (+ nil (t))) 22 | 23 | > (c+ c0 c0) 24 | ((+ nil (t)) (+ nil (t))) 25 | 26 | > (c+ c3 c3) 27 | ((+ nil (t)) (+ (t t) (t))) 28 | 29 | > (c+ c4 c5) 30 | ((+ (t t t t t t t t t) (t t t t t t t t t)) (- nil (t))) 31 | 32 | -------------------------------------------------------------------------------- /t/fn-c-star.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set c1 `((+ ,i1 ,i1) (+ ,i0 ,i1)) 10 | c2 `((- ,i1 ,i1) (+ ,i0 ,i1)) 11 | c3 `((+ ,i0 ,i1) (+ ,i1 ,i1)) 12 | c4 `((+ ,i0 ,i1) (- ,i1 ,i1)) 13 | c5 `((+ ,i2 (t t t)) (+ ,i1 ,i1)) 14 | c6 `((+ ,i1 (t t t)) (- ,i1 ,i1))) 15 | !IGNORE: result of assignment 16 | 17 | > (c* c1 c1) 18 | ((+ (t) (t)) (+ nil (t))) 19 | 20 | > (c* c1 c2) 21 | ((- (t) (t)) (- nil (t))) 22 | 23 | > (c* c3 c3) 24 | ((- (t) (t)) (+ nil (t))) 25 | 26 | > (c* c4 c4) 27 | ((- (t) (t)) (- nil (t))) 28 | 29 | > (= (c* c5 c6) 30 | `((+ ,(nof 11 t) ,(nof 9 t)) 31 | (- (t t t) ,(nof 9 t)))) 32 | t 33 | 34 | -------------------------------------------------------------------------------- /t/fn-caddr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (caddr nil) 10 | nil 11 | 12 | > (caddr '(a)) 13 | nil 14 | 15 | > (caddr '(a b)) 16 | nil 17 | 18 | > (caddr '(a b c)) 19 | c 20 | 21 | -------------------------------------------------------------------------------- /t/fn-cadr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (cadr nil) 10 | nil 11 | 12 | > (cadr '(a)) 13 | nil 14 | 15 | > (cadr '(a b)) 16 | b 17 | 18 | > (cadr '(a b c)) 19 | b 20 | 21 | -------------------------------------------------------------------------------- /t/fn-cand.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((cand atom no) nil) 10 | t 11 | 12 | > ((cand atom no) t) 13 | nil 14 | 15 | > ((cand atom) t) 16 | t 17 | 18 | > ((cand atom) (join)) 19 | nil 20 | 21 | > ((cand) nil) 22 | t 23 | 24 | -------------------------------------------------------------------------------- /t/fn-caris.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (caris nil nil) 10 | nil 11 | 12 | > (caris '(a b c) 'a) 13 | t 14 | 15 | > (caris '(a b c) 'b) 16 | nil 17 | 18 | > (set p '(x y z)) 19 | (x y z) 20 | 21 | > (caris '((x y z) b c) p) 22 | t 23 | 24 | > (caris '((x y z) b c) p id) 25 | nil 26 | 27 | > (caris `(,p b c) p id) 28 | t 29 | 30 | -------------------------------------------------------------------------------- /t/fn-cddr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (cddr nil) 10 | nil 11 | 12 | > (cddr '(a)) 13 | nil 14 | 15 | > (cddr '(a b)) 16 | nil 17 | 18 | > (cddr '(a b c)) 19 | (c) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-ceil.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (ceil 3.5) 10 | 4 11 | 12 | > (ceil 3) 13 | 3 14 | 15 | > (ceil -3.5) 16 | -3 17 | 18 | > (ceil -3) 19 | -3 20 | 21 | -------------------------------------------------------------------------------- /t/fn-cells.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (cells nil) 10 | nil 11 | 12 | > (cells \c) 13 | nil 14 | 15 | > (cells '()) 16 | nil 17 | 18 | > (cells '(nil)) 19 | ((nil)) 20 | 21 | > (cells '(a b c)) 22 | ((a . #1=(b . #2=(c))) #1 #2) 23 | 24 | > (cells '(a nil c)) 25 | ((a . #1=(nil . #2=(c))) #1 #2) 26 | 27 | > (let L '(a) 28 | (xar L L) 29 | (list (len (cells L)) 30 | (len (dups (cells L) id)))) 31 | (2 1) 32 | 33 | > (let L '(a) 34 | (xdr L L) 35 | (list (len (cells L)) 36 | (len (dups (cells L) id)))) 37 | (2 1) 38 | 39 | -------------------------------------------------------------------------------- /t/fn-char.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (char 'x) 10 | nil 11 | 12 | > (char nil) 13 | nil 14 | 15 | > (char '(a)) 16 | nil 17 | 18 | > (char (join)) 19 | nil 20 | 21 | > (char \c) 22 | t 23 | 24 | -------------------------------------------------------------------------------- /t/fn-charint.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (charint \3) 10 | (t t t) 11 | 12 | > (charint \7) 13 | (t t t t t t t) 14 | 15 | > (charint \f) 16 | (t t t t t t t t t t t t t t t) 17 | 18 | -------------------------------------------------------------------------------- /t/fn-charn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (charn \A) 10 | 65 11 | 12 | -------------------------------------------------------------------------------- /t/fn-charstil.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set s '("hi")) 10 | !IGNORE: result of assignment 11 | 12 | > (charstil s (is \.)) 13 | "hi" 14 | 15 | > s 16 | (nil) 17 | 18 | > (set s '("one two")) 19 | !IGNORE: result of assignment 20 | 21 | > (charstil s whitec) 22 | "one" 23 | 24 | > s 25 | (" two") 26 | 27 | -------------------------------------------------------------------------------- /t/fn-clog2.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (clog2 0) 10 | 1 11 | 12 | > (clog2 1) 13 | 1 14 | 15 | > (clog2 2) 16 | 1 17 | 18 | > (clog2 3) 19 | 2 20 | 21 | > (clog2 4) 22 | 2 23 | 24 | > (clog2 7) 25 | 3 26 | 27 | > (clog2 8) 28 | 3 29 | 30 | > (clog2 11) 31 | 4 32 | 33 | -------------------------------------------------------------------------------- /t/fn-close.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (len cbuf) 10 | 1 11 | 12 | > (set s (open "testfile" 'out)) 13 | 14 | 15 | > (len cbuf) 16 | 2 17 | 18 | > (close s) 19 | 20 | 21 | > (len cbuf) 22 | 1 23 | 24 | !END: unlink("testfile"); 25 | 26 | -------------------------------------------------------------------------------- /t/fn-combine.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (((combine and) atom no) nil) 10 | t 11 | 12 | > (((combine and) atom no) t) 13 | nil 14 | 15 | > (((combine and) atom) t) 16 | t 17 | 18 | > (((combine and) atom) (join)) 19 | nil 20 | 21 | > (((combine and)) nil) 22 | t 23 | 24 | > (((combine or) pair no) nil) 25 | t 26 | 27 | > (((combine or) pair no) t) 28 | nil 29 | 30 | > (((combine or) pair no) '(x y)) 31 | t 32 | 33 | > (((combine or) pair) (join)) 34 | t 35 | 36 | > (((combine or)) nil) 37 | nil 38 | 39 | -------------------------------------------------------------------------------- /t/fn-common.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (common '(a b c) '(d e f)) 10 | nil 11 | 12 | > (common '(a b c) '(d a f)) 13 | (a) 14 | 15 | > (common '(a b c) '(d a a)) 16 | (a) 17 | 18 | > (common '(a a c) '(d a a)) 19 | (a a) 20 | 21 | > (common '(2 2 5 5) '(2 3 5)) 22 | (2 5) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-compose.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((compose no atom) 'x) 10 | nil 11 | 12 | > ((compose no atom) nil) 13 | nil 14 | 15 | > ((compose no atom) '(a x)) 16 | t 17 | 18 | > ((compose cdr cdr cdr) '(a b c d)) 19 | (d) 20 | 21 | > ((compose) '(a b c d)) 22 | (a b c d) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-con.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((con 'a) 'b) 10 | a 11 | 12 | > ((con nil) 'c) 13 | nil 14 | 15 | > ((con '(x y)) nil) 16 | (x y) 17 | 18 | > (map (con t) '(a b c)) 19 | (t t t) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-cons.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (cons 'a nil) 10 | (a) 11 | 12 | > (cons 'a) 13 | a 14 | 15 | > (cons 'a 'b) 16 | (a . b) 17 | 18 | > (cons) 19 | nil 20 | 21 | > (cons 'a 'b 'c '(d e f)) 22 | (a b c d e f) 23 | 24 | > (let p '(b) 25 | (id (cdr:cons 'a p) p)) 26 | t 27 | 28 | -------------------------------------------------------------------------------- /t/fn-consif.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (consif 'a nil) 10 | (a) 11 | 12 | > (consif 'a '(b)) 13 | (a b) 14 | 15 | > (consif 'a '(b c)) 16 | (a b c) 17 | 18 | > (consif nil nil) 19 | nil 20 | 21 | > (consif nil '(b)) 22 | (b) 23 | 24 | > (consif nil '(b c)) 25 | (b c) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-cor.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((cor pair no) nil) 10 | t 11 | 12 | > ((cor pair no) t) 13 | nil 14 | 15 | > ((cor pair no) '(x y)) 16 | t 17 | 18 | > ((cor pair) (join)) 19 | t 20 | 21 | > ((cor) nil) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-cut.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (cut "foobar" 2 4) 10 | "oob" 11 | 12 | > (cut "foobar" 2 -1) 13 | "ooba" 14 | 15 | > (cut "foobar" 2) 16 | "oobar" 17 | 18 | > (cut "foobar") 19 | "foobar" 20 | 21 | -------------------------------------------------------------------------------- /t/fn-dec.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (dec 0) 10 | -1 11 | 12 | > (dec 1) 13 | 0 14 | 15 | > (dec 3) 16 | 2 17 | 18 | > (dec -1) 19 | -2 20 | 21 | > (dec -4.5) 22 | -11/2 23 | 24 | > (dec .5) 25 | -1/2 26 | 27 | -------------------------------------------------------------------------------- /t/fn-dedup.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (dedup "abracadabra") 10 | "abrcd" 11 | 12 | > (dedup '(1 2 2 2 3 1 4 2)) 13 | (1 2 3 4) 14 | 15 | > (dedup '((a) (b) (a))) 16 | ((a) (b)) 17 | 18 | > (dedup '((a) (b) (a)) id) 19 | ((a) (b) (a)) 20 | 21 | > (let p '(a) 22 | (dedup `(,p (b) ,p) id)) 23 | ((a) (b)) 24 | 25 | > (dedup '(7 3 0 9 2 4 1) >=) 26 | (7 9) 27 | 28 | -------------------------------------------------------------------------------- /t/fn-deq.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set q '((a b c d))) 10 | ((a b c d)) 11 | 12 | > (deq q) 13 | a 14 | 15 | > (deq q) 16 | b 17 | 18 | `deq` also affects the nested list, removing elements. 19 | 20 | > q 21 | ((c d)) 22 | 23 | > (deq q) 24 | c 25 | 26 | > (deq q) 27 | d 28 | 29 | > (deq q) 30 | nil 31 | 32 | -------------------------------------------------------------------------------- /t/fn-digit.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (~~digit \0) 10 | t 11 | 12 | > (~~digit \7) 13 | t 14 | 15 | > (~~digit \9) 16 | t 17 | 18 | > (~~digit \0 i10) 19 | t 20 | 21 | > (~~digit \7 i10) 22 | t 23 | 24 | > (~~digit \9 i10) 25 | t 26 | 27 | > (digit \a) 28 | nil 29 | 30 | > (~~digit \a i16) 31 | t 32 | 33 | > (digit \b) 34 | nil 35 | 36 | > (~~digit \b i16) 37 | t 38 | 39 | > (digit \f) 40 | nil 41 | 42 | > (~~digit \f i16) 43 | t 44 | 45 | > (digit \g) 46 | nil 47 | 48 | > (digit \g i16) 49 | nil 50 | 51 | > (set i8 '(t t t t t t t t)) 52 | (t t t t t t t t) 53 | 54 | > (~~digit \0 i8) 55 | t 56 | 57 | > (~~digit \7 i8) 58 | t 59 | 60 | > (digit \9 i8) 61 | nil 62 | 63 | -------------------------------------------------------------------------------- /t/fn-dock.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (dock nil) 10 | nil 11 | 12 | > (dock '(a)) 13 | nil 14 | 15 | > (dock '(a b)) 16 | (a) 17 | 18 | > (dock '(a b c)) 19 | (a b) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-drop.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (drop 2 '(a b c)) 10 | (c) 11 | 12 | > (drop 0 '(a b c)) 13 | (a b c) 14 | 15 | If you drop more from the list than is available, you get `nil`. 16 | 17 | > (drop 5 '(a b c)) 18 | nil 19 | 20 | > (drop 2 nil) 21 | nil 22 | 23 | -------------------------------------------------------------------------------- /t/fn-dups.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (dups nil) 10 | nil 11 | 12 | > (dups '(a b c)) 13 | nil 14 | 15 | > (dups '(a b b c)) 16 | (b) 17 | 18 | > (dups '(a nil b c nil)) 19 | (nil) 20 | 21 | > (dups '(1 2 3 4 3 2)) 22 | (2 3) 23 | 24 | > (dups "abracadabra") 25 | "abr" 26 | 27 | > (dups '(1 2 2 2 3 1 4 2)) 28 | (1 2) 29 | 30 | > (dups '((a) (b) (a))) 31 | ((a)) 32 | 33 | > (dups '((a) (b) (a)) id) 34 | nil 35 | 36 | > (dups '(7 3 0 9 2 4 1) >=) 37 | (7 3 0) 38 | 39 | -------------------------------------------------------------------------------- /t/fn-eatwhite.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set s '(" foo")) 10 | !IGNORE: result of assignment 11 | 12 | > (eatwhite s) 13 | nil 14 | 15 | > s 16 | ("foo") 17 | 18 | > (set s (list (append " ; comment" (list \lf) "hi"))) 19 | !IGNORE: result of assignment 20 | 21 | > (eatwhite s) 22 | nil 23 | 24 | > s 25 | ("hi") 26 | 27 | > (eatwhite nil) 28 | nil 29 | 30 | -------------------------------------------------------------------------------- /t/fn-enq.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set q (newq)) 10 | (nil) 11 | 12 | > (enq 'a q) 13 | ((a)) 14 | 15 | > (enq 'b q) 16 | ((a b)) 17 | 18 | > (enq 'c q) 19 | ((a b c)) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-eq.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (= '() '()) 10 | t 11 | 12 | > (= 'x 'x) 13 | t 14 | 15 | > (= 'x 'y) 16 | nil 17 | 18 | > (= 'x '(x)) 19 | nil 20 | 21 | > (= '(a b c) '(a b c)) 22 | t 23 | 24 | > (= '(a b d) '(a b c)) 25 | nil 26 | 27 | > (= '(a b) '(a b c)) 28 | nil 29 | 30 | > (= '(a b c) '(a b)) 31 | nil 32 | 33 | > (= '(a b (x y)) '(a b (x y))) 34 | t 35 | 36 | > (= '(a b (x y)) '(a b (x z))) 37 | nil 38 | 39 | -------------------------------------------------------------------------------- /t/fn-even.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (even 0) 10 | t 11 | 12 | > (even -1) 13 | nil 14 | 15 | > (even 1/2) 16 | nil 17 | 18 | > (even 4/2) 19 | t 20 | 21 | > (even 3) 22 | nil 23 | 24 | > (even 4) 25 | t 26 | 27 | Arguably, it is a bug that `even` produces an error on non-numeric 28 | values. But it is according to spec -- so if it's a bug, it's a bug 29 | in the spec. 30 | 31 | > (even \x) 32 | !ERROR: cdr-on-atom 33 | 34 | > (even \0) 35 | !ERROR: cdr-on-atom 36 | 37 | -------------------------------------------------------------------------------- /t/fn-factor.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set i2 '(t t) 10 | i3 '(t t t) 11 | i4 '(t t t t) 12 | i5 '(t t t t t) 13 | i6 '(t t t t t t) 14 | i7 '(t t t t t t t)) 15 | !IGNORE: result of assignment 16 | 17 | > (= (factor i2) (list i2)) 18 | t 19 | 20 | > (= (factor i3) (list i3)) 21 | t 22 | 23 | > (= (factor i4) (list i2 i2)) 24 | t 25 | 26 | > (= (factor i5) (list i5)) 27 | t 28 | 29 | > (= (factor i6) (list i2 i3)) 30 | t 31 | 32 | > (= (factor i7) (list i7)) 33 | t 34 | 35 | -------------------------------------------------------------------------------- /t/fn-find.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (find atom '(a b c)) 10 | a 11 | 12 | > (find atom '()) 13 | nil 14 | 15 | > (find (fn (x) (id x 'b)) '(a b c)) 16 | b 17 | 18 | > (find (fn (x) (id x 'q)) '(a b c)) 19 | nil 20 | 21 | > (find no '(t t nil)) 22 | nil 23 | 24 | > (find no '(t t)) 25 | nil 26 | 27 | -------------------------------------------------------------------------------- /t/fn-first.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (first 1 '(a b c)) 10 | (a) 11 | 12 | If the number exceeds the length of the list, the full 13 | list is returned. 14 | 15 | > (first 4 '(a b c)) 16 | (a b c) 17 | 18 | > (first 2 nil) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/fn-flip.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((flip -) 1 10) 10 | 9 11 | 12 | > ((flip list) 5 4 3 2 1) 13 | (1 2 3 4 5) 14 | 15 | > ((flip all) '(nil nil nil) no) 16 | t 17 | 18 | -------------------------------------------------------------------------------- /t/fn-floor.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (floor 3.5) 10 | 3 11 | 12 | > (floor 3) 13 | 3 14 | 15 | > (floor -3.5) 16 | -4 17 | 18 | > (floor -3) 19 | -3 20 | 21 | -------------------------------------------------------------------------------- /t/fn-foldl.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (foldl cons nil '(a b)) 10 | (b a) 11 | 12 | > (foldl cons (cons 'a nil) '(b)) 13 | (b a) 14 | 15 | > (foldl cons (cons 'b (cons 'a nil)) nil) 16 | (b a) 17 | 18 | > (foldl put nil '(a b c) '(x y z)) 19 | ((c . z) (b . y) (a . x)) 20 | 21 | > (foldl err nil) 22 | nil 23 | 24 | > (foldl cons nil '(1 2 3 4 5)) 25 | (5 4 3 2 1) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-foldr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (foldr cons nil '(a b)) 10 | (a b) 11 | 12 | > (cons 'a (foldr cons nil '(b))) 13 | (a b) 14 | 15 | > (cons 'a (cons 'b (foldr cons nil nil))) 16 | (a b) 17 | 18 | > (foldr put nil '(a b c) '(x y z)) 19 | ((a . x) (b . y) (c . z)) 20 | 21 | > (foldr err nil) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-function.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (function (fn (x) x)) 10 | clo 11 | 12 | > (function [_]) 13 | clo 14 | 15 | > (function idfn) 16 | clo 17 | 18 | > (function car) 19 | prim 20 | 21 | > (function nil) 22 | nil 23 | 24 | > (function 'c) 25 | nil 26 | 27 | > (function '(a b c)) 28 | nil 29 | 30 | > (function def) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/fn-fuse.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (fuse idfn '((a b) (c d) (e f))) 10 | (a b c d e f) 11 | 12 | > (fuse list '(a b c) '(1 2 3)) 13 | (a 1 b 2 c 3) 14 | 15 | > (fuse list '(a b c) '(1 2)) 16 | (a 1 b 2) 17 | 18 | > (fuse join) 19 | nil 20 | 21 | > (fuse car '(a b c) '(1 2 3)) 22 | !ERROR: car-on-atom 23 | 24 | -------------------------------------------------------------------------------- /t/fn-ge.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (>= 1 1 1) 10 | t 11 | 12 | > (>= 3 2 0) 13 | t 14 | 15 | > (>= 1 2 3) 16 | nil 17 | 18 | > (>= 1 2 1) 19 | nil 20 | 21 | > (>= 1) 22 | t 23 | 24 | > (>=) 25 | t 26 | 27 | -------------------------------------------------------------------------------- /t/fn-get.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L '((a . 1) (b . 2) (c . 3))) 10 | !IGNORE: result of assignment 11 | 12 | > (get 'b L) 13 | (b . 2) 14 | 15 | > (get 'd L) 16 | nil 17 | 18 | > (get 'x nil) 19 | nil 20 | 21 | > (set q '(b)) 22 | (b) 23 | 24 | > (set L `(((a) . 1) (,q . two) ((c) . 3))) 25 | !IGNORE: result of assignment 26 | 27 | > (get '(b) L) 28 | ((b) . two) 29 | 30 | > (get '(b) L id) 31 | nil 32 | 33 | > (get q L id) 34 | ((b) . two) 35 | 36 | -------------------------------------------------------------------------------- /t/fn-gets.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let L '((a . 1) (b . 2) (c . 3)) 10 | (gets 2 L)) 11 | (b . 2) 12 | 13 | > (let L '((a . 1) (b . 2) (c . 3)) 14 | (gets 4 L)) 15 | nil 16 | 17 | > (let L nil 18 | (gets 5 L)) 19 | nil 20 | 21 | > (let L '((1 . (a)) 22 | (2 . (b)) 23 | (3 . (c))) 24 | (gets '(b) L)) 25 | (2 b) 26 | 27 | > (let L '((1 . (a)) 28 | (2 . (b)) 29 | (3 . (c))) 30 | (gets '(b) L id)) 31 | nil 32 | 33 | > (withs (q '(b) 34 | L `((1 . (a)) 35 | (two . ,q) 36 | (3 . (c)))) 37 | (gets q L id)) 38 | (two b) 39 | 40 | -------------------------------------------------------------------------------- /t/fn-hard-rdex.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (hard-rdex '("foo") i10 nil 'no-message) 10 | (foo nil) 11 | 12 | > (hard-rdex '("") i10 nil 'unterminated-list) 13 | !ERROR: unterminated-list 14 | 15 | -------------------------------------------------------------------------------- /t/fn-hat-w.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (^w 5 1) 10 | 5 11 | 12 | > (^w 5 0) 13 | 1 14 | 15 | > (^w 3 2) 16 | 9 17 | 18 | > (^w 2 3) 19 | 8 20 | 21 | > (^w 1.5 1) 22 | 3/2 23 | 24 | > (^w 1.5 0) 25 | 1 26 | 27 | > (^w 1.5 2) 28 | 9/4 29 | 30 | > (^w 5 -1) 31 | !ERROR: mistype 32 | 33 | -------------------------------------------------------------------------------- /t/fn-hug.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (hug '(a b c d)) 10 | ((a b) (c d)) 11 | 12 | > (hug '(a b c d e)) 13 | ((a b) (c d) (e)) 14 | 15 | > (hug '(a b c d) cons) 16 | ((a . b) (c . d)) 17 | 18 | > (hug '(a b c d e) cons) 19 | ((a . b) (c . d) e) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-i-hat.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (i^ i0 i0) 10 | (t) 11 | 12 | > (i^ i0 i1) 13 | nil 14 | 15 | > (i^ i1 i0) 16 | (t) 17 | 18 | > (i^ i1 i2) 19 | (t) 20 | 21 | > (i^ i10 i1) 22 | (t t t t t t t t t t) 23 | 24 | > (i^ i2 '(t t t)) 25 | (t t t t t t t t) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-i-lt.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (i< i0 i0) 10 | nil 11 | 12 | > (i< i0 i1) 13 | (t) 14 | 15 | > (i< i1 i2) 16 | (t) 17 | 18 | > (i< i10 i16) 19 | (t t t t t t) 20 | 21 | > (i< i16 i10) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-i-minus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (i- i0 i0) 10 | (- nil) 11 | 12 | > (i- i0 i1) 13 | (- (t)) 14 | 15 | > (i- i1 i0) 16 | (+ (t)) 17 | 18 | > (i- i1 i2) 19 | (- (t)) 20 | 21 | > (i- i10 i1) 22 | (+ (t t t t t t t t t)) 23 | 24 | > (i- i2 i10) 25 | (- (t t t t t t t t)) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-i-plus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (i+ i0 i0) 10 | nil 11 | 12 | > (i+ i0 i1) 13 | (t) 14 | 15 | > (i+ i1 i2) 16 | (t t t) 17 | 18 | > (i+ i10 i1) 19 | (t t t t t t t t t t t) 20 | 21 | > (i+ i2 i10) 22 | (t t t t t t t t t t t t) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-i-slash.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (i/ i0 i1) 10 | (nil nil) 11 | 12 | > (i/ i1 i2) 13 | (nil (t)) 14 | 15 | > (i/ i10 i1) 16 | ((t t t t t t t t t t) nil) 17 | 18 | > (i/ i2 i10) 19 | (nil (t t)) 20 | 21 | > (i/ i16 '(t t t)) 22 | ((t t t t t) (t)) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-i-star.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (i* i0 i0) 10 | nil 11 | 12 | > (i* i0 i1) 13 | nil 14 | 15 | > (i* i1 i0) 16 | nil 17 | 18 | > (i* i1 i2) 19 | (t t) 20 | 21 | > (i* i10 i1) 22 | (t t t t t t t t t t) 23 | 24 | > (i* i2 i10) 25 | (t t t t t t t t t t t t t t t t t t t t) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-idfn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (idfn nil) 10 | nil 11 | 12 | > (idfn '(a b c)) 13 | (a b c) 14 | 15 | > (idfn \bel) 16 | \bel 17 | 18 | > (idfn 'x) 19 | x 20 | 21 | -------------------------------------------------------------------------------- /t/fn-in.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (in 'e 'x 'y 'z) 10 | nil 11 | 12 | > (in 'b 'a 'b 'c) 13 | (b c) 14 | 15 | > (in nil 'a nil 'c) 16 | (nil c) 17 | 18 | -------------------------------------------------------------------------------- /t/fn-inc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (inc 0) 10 | 1 11 | 12 | > (inc 1) 13 | 2 14 | 15 | > (inc 3) 16 | 4 17 | 18 | > (inc -1) 19 | 0 20 | 21 | > (inc -4.5) 22 | -7/2 23 | 24 | > (inc .5) 25 | 3/2 26 | 27 | -------------------------------------------------------------------------------- /t/fn-insert.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (insert < 3 nil) 10 | (3) 11 | 12 | > (insert < 3 '(1 2 4 5)) 13 | (1 2 3 4 5) 14 | 15 | -------------------------------------------------------------------------------- /t/fn-int.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (int 0) 10 | t 11 | 12 | > (int \x) 13 | nil 14 | 15 | > (int -1) 16 | t 17 | 18 | > (int \0) 19 | nil 20 | 21 | > (int 1/2) 22 | nil 23 | 24 | > (int 4/2) 25 | t 26 | 27 | -------------------------------------------------------------------------------- /t/fn-intchar.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (intchar nil) 10 | \0 11 | 12 | > (set n7 '(t t t t t t t)) 13 | !IGNORE: output of set 14 | 15 | > (intchar n7) 16 | \7 17 | 18 | > (set n10 '(t t t t t t t t t t)) 19 | !IGNORE: output of set 20 | 21 | > (intchar n10) 22 | \a 23 | 24 | > (set n14 '(t t t t t t t t t t t t t t)) 25 | !IGNORE: output of set 26 | 27 | > (intchar n14) 28 | \e 29 | 30 | > (set n16 '(t t t t t t t t t t t t t t t t)) 31 | !IGNORE: output of set 32 | 33 | > (intchar n16) 34 | nil 35 | 36 | -------------------------------------------------------------------------------- /t/fn-intrac.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (intrac nil) 10 | nil 11 | 12 | > (intrac \0) 13 | nil 14 | 15 | > (intrac \a) 16 | nil 17 | 18 | > (~~intrac \.) 19 | t 20 | 21 | > (~~intrac \!) 22 | t 23 | 24 | > (intrac \+) 25 | nil 26 | 27 | > (intrac \-) 28 | nil 29 | 30 | > (intrac \D) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/fn-inv.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (inv (lit num (+ nil (t)) (+ nil (t)))) 10 | 0 11 | 12 | > (inv (lit num (+ nil (t)) (+ (t) (t)))) 13 | -i 14 | 15 | > (inv (lit num (+ (t) (t)) (+ nil (t)))) 16 | -1 17 | 18 | > (inv (lit num (+ (t t) (t t t)) (+ (t) (t t t t)))) 19 | -2/3-1/4i 20 | 21 | -------------------------------------------------------------------------------- /t/fn-inwhere.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > smark 10 | (nil) 11 | 12 | > (id vmark smark) 13 | nil 14 | 15 | > (inwhere nil) 16 | nil 17 | 18 | > (inwhere `(((,smark)))) 19 | nil 20 | 21 | > (inwhere `(((,smark nope)))) 22 | nil 23 | 24 | > (inwhere `(((,smark loc t)))) 25 | (t) 26 | 27 | > (inwhere `(((,smark loc nil)))) 28 | (nil) 29 | 30 | > (inwhere `(((,smark loc foo)))) 31 | (foo) 32 | 33 | > (inwhere `(((,smark loc)))) 34 | nil 35 | 36 | -------------------------------------------------------------------------------- /t/fn-ipart.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (ipart (lit num (+ nil (t)) (+ nil (t)))) 10 | 0 11 | 12 | > (ipart (lit num (+ nil (t)) (+ (t) (t)))) 13 | 1 14 | 15 | > (ipart (lit num (+ (t) (t)) (+ nil (t)))) 16 | 0 17 | 18 | > (ipart (lit num (+ (t t) (t t t)) (+ (t) (t t t t)))) 19 | 1/4 20 | 21 | -------------------------------------------------------------------------------- /t/fn-irep.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set n10 '(t t t t t t t t t t)) 10 | !IGNORE: output of set 11 | 12 | > (irep nil n10) 13 | "0" 14 | 15 | > (set n7 '(t t t t t t t)) 16 | !IGNORE: output of set 17 | 18 | > (irep n7 n10) 19 | "7" 20 | 21 | > (irep n10 n10) 22 | "10" 23 | 24 | > (set n14 '(t t t t t t t t t t t t t t)) 25 | !IGNORE: output of set 26 | 27 | > (irep n14 n10) 28 | "14" 29 | 30 | > (set n16 '(t t t t t t t t t t t t t t t t)) 31 | !IGNORE: output of set 32 | 33 | > (irep n16 n10) 34 | "16" 35 | 36 | > (irep n14 n16) 37 | "e" 38 | 39 | -------------------------------------------------------------------------------- /t/fn-is.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((is car) car) 10 | t 11 | 12 | > ((is car) cdr) 13 | nil 14 | 15 | > ((is 'x) 'x) 16 | t 17 | 18 | > ((is 'x) 'y) 19 | nil 20 | 21 | > ((is 'x) \x) 22 | nil 23 | 24 | > ((is (join)) (join)) 25 | t 26 | 27 | -------------------------------------------------------------------------------- /t/fn-isa.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (isa!clo (fn (x) x)) 10 | t 11 | 12 | > (isa!clo [_]) 13 | t 14 | 15 | > (isa!clo idfn) 16 | t 17 | 18 | > (isa!prim car) 19 | t 20 | 21 | > (isa!clo nil) 22 | nil 23 | 24 | > (isa!clo 'c) 25 | nil 26 | 27 | > (isa!clo '(a b c)) 28 | nil 29 | 30 | > (isa!mac def) 31 | t 32 | 33 | -------------------------------------------------------------------------------- /t/fn-keep.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (keep [id _ \a] "abracadabra") 10 | "aaaaa" 11 | 12 | > (keep is!b '(a b c b a b)) 13 | (b b b) 14 | 15 | > (keep is!b '(a c a)) 16 | nil 17 | 18 | > (keep is!x nil) 19 | nil 20 | 21 | > (keep [] '(a b c b a b)) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-last.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (last nil) 10 | nil 11 | 12 | > (last '(a)) 13 | a 14 | 15 | > (last '(a b)) 16 | b 17 | 18 | > (last '(a b c)) 19 | c 20 | 21 | > (last '(a b nil)) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-lastcdr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (lastcdr nil) 10 | nil 11 | 12 | > (lastcdr '(a)) 13 | (a) 14 | 15 | > (lastcdr '(a b)) 16 | (b) 17 | 18 | > (lastcdr '(a b c)) 19 | (c) 20 | 21 | > (let p '(c) 22 | (id (lastcdr (cons 'a 'b 23 | p)) 24 | p)) 25 | t 26 | 27 | -------------------------------------------------------------------------------- /t/fn-le.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (<= 1 1 1) 10 | t 11 | 12 | > (<= 3 2 0) 13 | nil 14 | 15 | > (<= 1 2 3) 16 | t 17 | 18 | > (<= 1 2 1) 19 | nil 20 | 21 | > (<= 1) 22 | t 23 | 24 | > (<=) 25 | t 26 | 27 | -------------------------------------------------------------------------------- /t/fn-len.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (len nil) 10 | 0 11 | 12 | > (len '(t)) 13 | 1 14 | 15 | > (len '(t t)) 16 | 2 17 | 18 | > (len '(t t t)) 19 | 3 20 | 21 | > (len '(t t t t)) 22 | 4 23 | 24 | -------------------------------------------------------------------------------- /t/fn-list.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (list) 10 | nil 11 | 12 | > (list 'a) 13 | (a) 14 | 15 | > (list 'a 'b) 16 | (a b) 17 | 18 | > (let p '(a b c) 19 | (id (apply list p) p)) 20 | nil 21 | 22 | -------------------------------------------------------------------------------- /t/fn-litnum.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (litnum '(+ nil (t))) 10 | 0 11 | 12 | > (litnum '(+ (t) (t))) 13 | 1 14 | 15 | > (litnum '(+ nil (t)) '(+ (t) (t))) 16 | +i 17 | 18 | -------------------------------------------------------------------------------- /t/fn-lookup.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (lookup 'foo nil nil nil) 10 | nil 11 | 12 | `scope`, `globe` 13 | 14 | > (lookup 'scope '((a . 1)) nil nil) 15 | (scope (a . 1)) 16 | 17 | > (lookup 'globe nil nil '((b . 2))) 18 | (globe (b . 2)) 19 | 20 | Global lookup (trumps `scope` and `globe`). 21 | 22 | > (lookup 'foo nil nil '((foo . 0))) 23 | (foo . 0) 24 | 25 | > (lookup 'scope nil nil '((scope . 1))) 26 | (scope . 1) 27 | 28 | > (lookup 'globe nil nil '((globe . 2))) 29 | (globe . 2) 30 | 31 | Lexical lookup (trumps global lookup). 32 | 33 | > (lookup 'foo '((foo . 0)) nil nil) 34 | (foo . 0) 35 | 36 | > (lookup 'foo '((foo . 1)) nil '((foo . 2))) 37 | (foo . 1) 38 | 39 | Dynamic lookup (trumps lexical lookup). 40 | 41 | > (lookup 'foo nil (list (cons (list smark 'bind '(foo . 0)) nil)) nil) 42 | (foo . 0) 43 | 44 | > (lookup 'foo '((foo . 2)) (list (cons (list smark 'bind '(foo . 1)) nil)) nil) 45 | (foo . 1) 46 | 47 | > (lookup 'foo nil (list (cons (list smark 'bind '(foo . 1)) '((foo . 3)))) nil) 48 | (foo . 1) 49 | 50 | -------------------------------------------------------------------------------- /t/fn-map.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (map car '((a b) (c d) (e f))) 10 | (a c e) 11 | 12 | > (map cons '(a b c) '(1 2 3)) 13 | ((a . 1) (b . 2) (c . 3)) 14 | 15 | If lists of differing lengths are passed to `map`, the result will have 16 | the length of the shortest list. 17 | 18 | > (map cons '(a b c) '(1 2)) 19 | ((a . 1) (b . 2)) 20 | 21 | > (map join) 22 | nil 23 | 24 | > (map list '(1 2) '(a b . c)) 25 | ((1 a) (2 b)) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-match.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (match '(a b c) '(a b c)) 10 | t 11 | 12 | > (match '(a b c) '(a D c)) 13 | nil 14 | 15 | > (match '(a b c) '(a t c)) 16 | t 17 | 18 | > (match '(a b c) '(t t t)) 19 | t 20 | 21 | > (match '(a b c) '(t t)) 22 | nil 23 | 24 | > (match '(a b c) '(t t t t)) 25 | nil 26 | 27 | > (match '(a b c) `(a ,symbol c)) 28 | t 29 | 30 | > (match '(a b c) `(,symbol ,symbol ,symbol)) 31 | t 32 | 33 | > (match '(a b c) `(,symbol ,pair ,symbol)) 34 | nil 35 | 36 | > (match '(a (b) c) `(,symbol ,pair ,symbol)) 37 | t 38 | 39 | -------------------------------------------------------------------------------- /t/fn-max.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (max 5 1 3 2 4) 10 | 5 11 | 12 | > (max 3 1 -2 4 0) 13 | 4 14 | 15 | -------------------------------------------------------------------------------- /t/fn-mem.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (mem 'b '(a b c)) 10 | (b c) 11 | 12 | > (mem 'e '(a b c)) 13 | nil 14 | 15 | > (mem \a "foobar") 16 | "ar" 17 | 18 | > (mem '(x) '((a) b x)) 19 | nil 20 | 21 | > (mem '(x) '((a) b (x))) 22 | ((x)) 23 | 24 | > (mem '(x) '((a) b (x)) id) 25 | nil 26 | 27 | > (let q '(x) (mem q `((a) b ,q))) 28 | ((x)) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-min.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (min 5 1 3 2 4) 10 | 1 11 | 12 | > (min 3 1 -2 4 0) 13 | -2 14 | 15 | -------------------------------------------------------------------------------- /t/fn-minus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set n1 (lit num (+ (t) (t)) (+ nil (t))) 10 | n2 (lit num (- (t) (t)) (+ nil (t))) 11 | n3 (lit num (+ nil (t)) (+ (t t t) (t))) 12 | n4 (lit num (- (t) (t t)) (+ nil (t))) 13 | n5 (lit num (+ nil (t)) (- (t t) (t t t))) 14 | n6 (lit num (+ (t) (t t)) (- (t t) (t t t))) 15 | n7 (lit num (- (t) (t t)) (+ (t t) (t t t)))) 16 | !IGNORE: result of assignment 17 | 18 | > (-) 19 | 0 20 | 21 | > (- n1 n1) 22 | 0 23 | 24 | > (- n1 n2) 25 | 2 26 | 27 | > (- n1 (lit num (+ nil (t)) (+ (t t t) (t)))) 28 | 1-3i 29 | 30 | > (- n4 n5) 31 | -1/2+2/3i 32 | 33 | > (- n6 n7) 34 | 1-4/3i 35 | 36 | > (- 1 1) 37 | 0 38 | 39 | > (- 1 -1) 40 | 2 41 | 42 | > (- 1 +3i) 43 | 1-3i 44 | 45 | > (- -1/2 -2/3i) 46 | -1/2+2/3i 47 | 48 | > (- 1/2-2/3i -1/2+2/3i) 49 | 1-4/3i 50 | 51 | > (- 4 3 2 1) 52 | -2 53 | 54 | -------------------------------------------------------------------------------- /t/fn-mod.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (mod 10 2) 10 | 0 11 | 12 | > (mod 10 3) 13 | 1 14 | 15 | > (mod 5 4) 16 | 1 17 | 18 | > (mod 6 4) 19 | 2 20 | 21 | > (mod 7 3.5) 22 | 0 23 | 24 | > (mod 8 3.5) 25 | 1 26 | 27 | -------------------------------------------------------------------------------- /t/fn-namedups.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (len (namedups '(a))) 10 | 0 11 | 12 | > (len (namedups '(a b c))) 13 | 0 14 | 15 | > (let L '(a) 16 | (xar L L) 17 | (namedups L)) 18 | ((#1=(#1) . 1)) 19 | 20 | > (let L '(a) 21 | (xar L L) 22 | L) 23 | #1=(#1) 24 | 25 | > (let L '(a) 26 | (xdr L L) 27 | (namedups L)) 28 | ((#1=(a . #1) . 1)) 29 | 30 | > (let L '(a) 31 | (xdr L L) 32 | L) 33 | #1=(a . #1) 34 | 35 | -------------------------------------------------------------------------------- /t/fn-newq.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (newq) 10 | (nil) 11 | 12 | > (id (newq) (newq)) 13 | nil 14 | 15 | -------------------------------------------------------------------------------- /t/fn-no.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (no nil) 10 | t 11 | 12 | > (no 'nil) 13 | t 14 | 15 | > (no '()) 16 | t 17 | 18 | > (no t) 19 | nil 20 | 21 | > (no 'x) 22 | nil 23 | 24 | > (no \c) 25 | nil 26 | 27 | > (no '(nil)) 28 | nil 29 | 30 | > (no '(a . b)) 31 | nil 32 | 33 | > (no no) 34 | nil 35 | 36 | > (no (no no)) 37 | t 38 | 39 | -------------------------------------------------------------------------------- /t/fn-number.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (number '()) 10 | nil 11 | 12 | > (number (lit)) 13 | nil 14 | 15 | > (number (lit num)) 16 | nil 17 | 18 | > (number (lit num (+ nil (t)))) 19 | nil 20 | 21 | > (number (lit num (+ nil (t)) (+ nil))) 22 | nil 23 | 24 | > (number (lit num (+ nil (t)) (+ nil (t)))) 25 | t 26 | 27 | > (number (lit num (+ (t) (t)) (+ nil (t)))) 28 | t 29 | 30 | > (number (lit num (+ (t t) (t t t)) (+ (t t t) (t)))) 31 | t 32 | 33 | -------------------------------------------------------------------------------- /t/fn-numi.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (numi (lit num (+ nil (t)) (+ nil (t)))) 10 | (+ nil (t)) 11 | 12 | > (numi (lit num (+ nil (t)) (+ (t) (t)))) 13 | (+ (t) (t)) 14 | 15 | > (numi (lit num (+ (t) (t)) (+ nil (t)))) 16 | (+ nil (t)) 17 | 18 | > (numi (lit num (+ (t t) (t t t)) (+ (t) (t t t t)))) 19 | (+ (t) (t t t t)) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-numr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (numr (lit num (+ nil (t)) (+ nil (t)))) 10 | (+ nil (t)) 11 | 12 | > (numr (lit num (+ nil (t)) (+ (t) (t)))) 13 | (+ nil (t)) 14 | 15 | > (numr (lit num (+ (t) (t)) (+ nil (t)))) 16 | (+ (t) (t)) 17 | 18 | > (numr (lit num (+ (t t) (t t t)) (+ (t) (t t t t)))) 19 | (+ (t t) (t t t)) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-odd.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (odd 0) 10 | nil 11 | 12 | > (odd \x) 13 | nil 14 | 15 | > (odd -1) 16 | t 17 | 18 | > (odd \0) 19 | nil 20 | 21 | > (odd 1/2) 22 | nil 23 | 24 | > (odd 4/2) 25 | nil 26 | 27 | > (odd 6/2) 28 | t 29 | 30 | > (odd 3) 31 | t 32 | 33 | > (odd 4) 34 | nil 35 | 36 | -------------------------------------------------------------------------------- /t/fn-of.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (list (car '(a b)) (car '(c d)) (car '(e f))) 10 | (a c e) 11 | 12 | > ((of list car) '(a b) '(c d) '(e f)) 13 | (a c e) 14 | 15 | > (def double (x) 16 | (list x x)) 17 | !IGNORE: result of definition 18 | 19 | > ((of list double) 'a 'b) 20 | ((a a) (b b)) 21 | 22 | > ((of append double) 'a 'b 'c) 23 | (a a b b c c) 24 | 25 | > ((of join con.t) 'a 'b) 26 | (t . t) 27 | 28 | -------------------------------------------------------------------------------- /t/fn-okenv.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (okenv nil) 10 | t 11 | 12 | > (okenv '(a . b)) 13 | nil 14 | 15 | > (okenv '(a)) 16 | nil 17 | 18 | > (okenv '((a . b))) 19 | t 20 | 21 | > (okenv '((a . b) (c . d))) 22 | t 23 | 24 | > (okenv '((a . b) nil (c . d))) 25 | nil 26 | 27 | > (okenv '((a . b) (nil) (c . d))) 28 | t 29 | 30 | -------------------------------------------------------------------------------- /t/fn-okparms.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (okparms nil) 10 | t 11 | 12 | > (okparms 'args) 13 | t 14 | 15 | > (okparms 't) 16 | nil 17 | 18 | > (okparms 'o) 19 | nil 20 | 21 | > (okparms 'apply) 22 | nil 23 | 24 | > (okparms (uvar)) 25 | t 26 | 27 | > (okparms '(t x int)) 28 | t 29 | 30 | > (okparms '(t x int y)) 31 | nil 32 | 33 | > (okparms '(t x int)) 34 | t 35 | 36 | > (okparms '(t x int y)) 37 | nil 38 | 39 | > (okparms '(o y 0)) 40 | nil 41 | 42 | > (okparms '(o y)) 43 | nil 44 | 45 | > (okparms '(o y (+ 2 2))) 46 | nil 47 | 48 | > (okparms '((o y 0))) 49 | t 50 | 51 | > (okparms '((o y 0 x))) 52 | nil 53 | 54 | > (okparms '((o y))) 55 | t 56 | 57 | > (okparms '((o y (+ 2 2)))) 58 | t 59 | 60 | > (okparms '(a b)) 61 | t 62 | 63 | > (okparms '(a (o b))) 64 | t 65 | 66 | > (okparms '(a (o b) c)) 67 | t 68 | 69 | > (okparms '(a (o b 0) c)) 70 | t 71 | 72 | > (okparms '(a (o b 0 1) c)) 73 | nil 74 | 75 | > (okparms '(a . rest)) 76 | t 77 | 78 | > (okparms '(a b . rest)) 79 | t 80 | 81 | > (okparms '(a (b c) d)) 82 | t 83 | 84 | > (okparms '(a (b . rest) d)) 85 | t 86 | 87 | -------------------------------------------------------------------------------- /t/fn-okstack.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (okstack nil) 10 | t 11 | 12 | > (okstack '(a)) 13 | nil 14 | 15 | > (okstack '((b))) 16 | nil 17 | 18 | > (okstack '((c ((x . y))))) 19 | t 20 | 21 | > (okstack '((d ((x . y) (z . w))))) 22 | t 23 | 24 | > (okstack '((e nil) (f ((m . n))))) 25 | t 26 | 27 | -------------------------------------------------------------------------------- /t/fn-only.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((only cons) nil 'a 'b 'c) 10 | nil 11 | 12 | > ((only cons) 'a 'b 'c) 13 | (a b . c) 14 | 15 | > ((compose (only car) some) is!b '(a b c)) 16 | b 17 | 18 | > ((compose (only car) some) is!z '(a b c)) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/fn-open.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (len cbuf) 10 | 1 11 | 12 | > (set f (open "fn-open-testfile" 'out)) 13 | 14 | 15 | > (type f) 16 | stream 17 | 18 | > (len cbuf) 19 | 2 20 | 21 | > (close f) 22 | 23 | 24 | > (len cbuf) 25 | 1 26 | 27 | > (type (open "fn-open-testfile" 'in)) 28 | stream 29 | 30 | > (len cbuf) 31 | 2 32 | 33 | !END: unlink("fn-open-testfile"); 34 | 35 | -------------------------------------------------------------------------------- /t/fn-pair.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (pair 'x) 10 | nil 11 | 12 | > (pair nil) 13 | nil 14 | 15 | > (pair '(a)) 16 | t 17 | 18 | > (pair (join)) 19 | t 20 | 21 | > (pair \c) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-pairwise.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (pairwise id nil) 10 | t 11 | 12 | > (pairwise id '(a)) 13 | t 14 | 15 | > (pairwise id '(a a)) 16 | t 17 | 18 | > (pairwise id '(a b)) 19 | nil 20 | 21 | > (set L (nof 3 (join))) 22 | ((nil) (nil) (nil)) 23 | 24 | > (pairwise id L) 25 | nil 26 | 27 | > (pairwise = L) 28 | t 29 | 30 | > (let p (join) 31 | (pairwise id `(,p ,p ,p))) 32 | t 33 | 34 | -------------------------------------------------------------------------------- /t/fn-parameters.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parameters nil) 10 | nil 11 | 12 | > (parameters 'foo) 13 | (foo) 14 | 15 | > (parameters 'bar) 16 | (bar) 17 | 18 | > (parameters \c) 19 | !ERROR: bad-parm 20 | 21 | > (parameters '(t one)) 22 | (one) 23 | 24 | > (parameters '(o two)) 25 | (two) 26 | 27 | > (parameters '(one two three)) 28 | (one two three) 29 | 30 | > (parameters '((((one))))) 31 | (one) 32 | 33 | > (parameters '((((one)) two) three)) 34 | (one two three) 35 | 36 | > (parameters '((((one)) (o two)) three)) 37 | (one two three) 38 | 39 | -------------------------------------------------------------------------------- /t/fn-parsecom.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parsecom "~car" i10) 10 | (compose no car) 11 | 12 | > (parsecom "~" i10) 13 | no 14 | 15 | > (parsecom "~5" i10) 16 | (compose no 5) 17 | 18 | > (parsecom "1+3i" i10) 19 | 1+3i 20 | 21 | > (parsecom "a-symbol" i10) 22 | a-symbol 23 | 24 | > (type (parsecom "a-symbol" i10)) 25 | symbol 26 | 27 | > (parsecom "car:cdr" i10) 28 | (compose car cdr) 29 | 30 | > (parsecom "car:cdr:cdr" i10) 31 | (compose car cdr cdr) 32 | 33 | > (parsecom ":" i10) 34 | (compose) 35 | 36 | -------------------------------------------------------------------------------- /t/fn-parsed.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parsed "1" i10) 10 | ((t) (t)) 11 | 12 | > (parsed "1." i10) 13 | ((t) (t)) 14 | 15 | > (parsed "1.0" i10) 16 | ((t t t t t t t t t t) (t t t t t t t t t t)) 17 | 18 | > (parsed "1.2" i10) 19 | ((t t t t t t t t t t t t) (t t t t t t t t t t)) 20 | 21 | > (parsed ".1" i10) 22 | ((t) (t t t t t t t t t t)) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-parsei.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parsei "+i" i10) 10 | (+ (t) (t)) 11 | 12 | > (parsei "-i" i10) 13 | (- (t) (t)) 14 | 15 | > (parsei "+1/2i" i10) 16 | (+ #1=(t) (t . #1)) 17 | 18 | > (parsei "-2i" i10) 19 | (- (t . #1=(t)) #1) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-parseint.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parseint "" i10) 10 | nil 11 | 12 | > (parseint "" i0) 13 | nil 14 | 15 | > (parseint "3" i10) 16 | (t t t) 17 | 18 | > (parseint "7" i10) 19 | (t t t t t t t) 20 | 21 | > (parseint "f" i16) 22 | (t t t t t t t t t t t t t t t) 23 | 24 | > (parseint "11" i10) 25 | (t t t t t t t t t t t) 26 | 27 | > (parseint "11" i16) 28 | (t t t t t t t t t t t t t t t t t) 29 | 30 | > (parseint "00" i10) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/fn-parseno.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parseno "~car" i10) 10 | (compose no car) 11 | 12 | > (parseno "~" i10) 13 | no 14 | 15 | > (parseno "~5" i10) 16 | (compose no 5) 17 | 18 | > (parseno "1+3i" i10) 19 | 1+3i 20 | 21 | > (parseno "a-symbol" i10) 22 | a-symbol 23 | 24 | > (type (parseno "a-symbol" i10)) 25 | symbol 26 | 27 | -------------------------------------------------------------------------------- /t/fn-parsenum.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parsenum "+i" i10) 10 | +i 11 | 12 | > (parsenum "-i" i10) 13 | -i 14 | 15 | > (parsenum "2" i10) 16 | 2 17 | 18 | > (parsenum "+2" i10) 19 | 2 20 | 21 | > (parsenum "-2" i10) 22 | -2 23 | 24 | > (parsenum "2+3i" i10) 25 | 2+3i 26 | 27 | > (parsenum "+2+3i" i10) 28 | 2+3i 29 | 30 | > (parsenum "-2+3i" i10) 31 | -2+3i 32 | 33 | -------------------------------------------------------------------------------- /t/fn-parseslist.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parseslist '("hi" ".") i10) 10 | !ERROR: final-intrasymbol 11 | 12 | > (parseslist '("hello" "!") i10) 13 | !ERROR: final-intrasymbol 14 | 15 | > (parseslist '("one" "!." "two") i10) 16 | !ERROR: double-intrasymbol 17 | 18 | > (parseslist '("one" "!" "two:three") i10) 19 | (one (quote (compose two three))) 20 | 21 | > (parseslist '("one:two" "." "three") i10) 22 | ((compose one two) three) 23 | 24 | > (parseslist '("one" "." "two" "." "three") i10) 25 | (one two three) 26 | 27 | > (parseslist '("one" "!" "two" "!" "three") i10) 28 | (one (quote two) (quote three)) 29 | 30 | > (parseslist '("." "car") i10) 31 | (upon car) 32 | 33 | -------------------------------------------------------------------------------- /t/fn-parsesr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parsesr "+1/2" i10) 10 | (+ #1=(t) (t . #1)) 11 | 12 | > (parsesr "1/2" i10) 13 | (+ #1=(t) (t . #1)) 14 | 15 | > (parsesr "-1/2" i10) 16 | (- #1=(t) (t . #1)) 17 | 18 | > (parsesr "-1.0/3.0" i10) 19 | (- #1=(t) (t t . #1)) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-parset.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parset "foo|bar" i10) 10 | (t foo bar) 11 | 12 | > (parset "foo|bar|baz" i10) 13 | !ERROR: multiple-bars 14 | 15 | > (parset "a:b|c.d" i10) 16 | (t (compose a b) (c d)) 17 | 18 | > (parset "foo|" i10) 19 | !ERROR: bad-tspec 20 | 21 | > (parset "|bar" i10) 22 | !ERROR: bad-tspec 23 | 24 | -------------------------------------------------------------------------------- /t/fn-parseword.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (parseword "2+3i" i10) 10 | 2+3i 11 | 12 | > (parseword "." i10) 13 | !ERROR: unexpected-dot 14 | 15 | > (parseword "x|int" i10) 16 | (t x int) 17 | 18 | > (parseword "one.two" i10) 19 | (one two) 20 | 21 | > (parseword "one!two" i10) 22 | (one (quote two)) 23 | 24 | > (parseword ".car" i10) 25 | (upon car) 26 | 27 | > (parseword "~car" i10) 28 | (compose no car) 29 | 30 | > (parseword "~" i10) 31 | no 32 | 33 | > (parseword "a-symbol" i10) 34 | a-symbol 35 | 36 | > (parseword "car:cdr" i10) 37 | (compose car cdr) 38 | 39 | > (parseword "car:cdr:cdr" i10) 40 | (compose car cdr cdr) 41 | 42 | > (parseword ":" i10) 43 | (compose) 44 | 45 | -------------------------------------------------------------------------------- /t/fn-part.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((part cons 'a) 'b) 10 | (a . b) 11 | 12 | > ((part list 1 2 3) 4 5) 13 | (1 2 3 4 5) 14 | 15 | > ((part no) t) 16 | nil 17 | 18 | > ((part no) nil) 19 | t 20 | 21 | -------------------------------------------------------------------------------- /t/fn-peek.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (peek '("hello")) 10 | \h 11 | 12 | > (peek '(nil)) 13 | nil 14 | 15 | > (peek nil) 16 | \B 17 | 18 | -------------------------------------------------------------------------------- /t/fn-pint.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (pint 0) 10 | nil 11 | 12 | > (pint \x) 13 | nil 14 | 15 | > (pint -1) 16 | nil 17 | 18 | > (pint 1) 19 | t 20 | 21 | > (pint 1/2) 22 | nil 23 | 24 | > (pint 4/2) 25 | t 26 | 27 | > (pint -4/2) 28 | nil 29 | 30 | -------------------------------------------------------------------------------- /t/fn-plus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set n1 (lit num (+ (t) (t)) (+ nil (t))) 10 | n2 (lit num (- (t) (t)) (+ nil (t))) 11 | n3 (lit num (+ nil (t)) (+ (t t t) (t))) 12 | n4 (lit num (- (t) (t t)) (+ nil (t))) 13 | n5 (lit num (+ nil (t)) (- (t t) (t t t))) 14 | n6 (lit num (+ (t) (t t)) (- (t t) (t t t))) 15 | n7 (lit num (- (t) (t t)) (+ (t t) (t t t)))) 16 | !IGNORE: result of assignment 17 | 18 | > (+ n1 n1) 19 | 2 20 | 21 | > (+ n1 n2) 22 | 0 23 | 24 | > (+ n1 n3) 25 | 1+3i 26 | 27 | > (+ n4 n5) 28 | -1/2-2/3i 29 | 30 | > (+ n6 n7) 31 | 0 32 | 33 | > (+ 1 1) 34 | 2 35 | 36 | > (+ 1 -1) 37 | 0 38 | 39 | > (+ 1 +3i) 40 | 1+3i 41 | 42 | > (+ -1/2 -2/3i) 43 | -1/2-2/3i 44 | 45 | > (+ 1/2-2/3i -1/2+2/3i) 46 | 0 47 | 48 | > (+ 1 2 3) 49 | 6 50 | 51 | -------------------------------------------------------------------------------- /t/fn-pos.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (pos 'b '(a b c)) 10 | 2 11 | 12 | > (pos 'x '(w y z)) 13 | nil 14 | 15 | > (pos 'b '(a b c b b)) 16 | 2 17 | 18 | > (pos '() '(n n () n)) 19 | 3 20 | 21 | > (set p '(x)) 22 | (x) 23 | 24 | > (pos p '(n n (x) n)) 25 | 3 26 | 27 | > (pos p '(n n (x) n) id) 28 | nil 29 | 30 | > (pos p `(n n ,p n) id) 31 | 3 32 | 33 | -------------------------------------------------------------------------------- /t/fn-prc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prc \c) 11 | (prc \lf) 12 | nil) 13 | c 14 | nil 15 | 16 | > (do 17 | (prc \B) 18 | (prc \lf) 19 | nil) 20 | B 21 | nil 22 | 23 | > (withfile f "temp3827" 'out 24 | (each c "abc" 25 | (prc c f))) 26 | !IGNORE: result of each 27 | 28 | > (withfile f "temp3827" 'in 29 | (nof 4 (rdc f))) 30 | (\a \b \c nil) 31 | 32 | > (set s '("ab")) 33 | !IGNORE: result of assignment 34 | 35 | > (prc \c s) 36 | \c 37 | 38 | > s 39 | ("abc") 40 | 41 | !END: unlink("temp3827"); 42 | -------------------------------------------------------------------------------- /t/fn-prelts.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prelts '(1 2 3) outs nil nil) 11 | (prc \lf) 12 | nil) 13 | 1 2 3 14 | nil 15 | 16 | > (do 17 | (prelts '(a b . c) outs nil nil) 18 | (prc \lf) 19 | nil) 20 | a b . c 21 | nil 22 | 23 | -------------------------------------------------------------------------------- /t/fn-presc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (presc "B\\o\"b" \" outs) 11 | (prc \lf) 12 | nil) 13 | B\\o\"b 14 | nil 15 | 16 | > (withfile f "temp2923" 'out 17 | (presc "1\\2\"3" \" f)) 18 | !IGNORE: return value of presc 19 | 20 | > (withfile f "temp2923" 'in 21 | (nof 8 (rdc f))) 22 | (\1 \\ \\ \2 \\ \" \3 nil) 23 | 24 | > (set s '("?")) 25 | !IGNORE: result of assignment 26 | 27 | > (presc "a!b" \! s) 28 | !IGNORE: return value of presc 29 | 30 | > s 31 | ("?a\\!b") 32 | 33 | !END: unlink("temp2923"); 34 | 35 | -------------------------------------------------------------------------------- /t/fn-prnice.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prnice 'foo) 11 | (prc \lf) 12 | nil) 13 | foo 14 | nil 15 | 16 | > (do 17 | (prnice \T) 18 | (prc \lf) 19 | nil) 20 | T 21 | nil 22 | 23 | > (withfile f "testfile" 'out 24 | (prnice f) 25 | (prc \lf) 26 | nil) 27 | 28 | nil 29 | 30 | > (do 31 | (prnice 1+i) 32 | (prc \lf) 33 | nil) 34 | 1+i 35 | nil 36 | 37 | > (do 38 | (prnice "foo") 39 | (prc \lf) 40 | nil) 41 | foo 42 | nil 43 | 44 | > (do 45 | (prnice (list "abx" "dex")) 46 | (prc \lf) 47 | nil) 48 | ("abx" "dex") 49 | nil 50 | 51 | !END: unlink("testfile"); 52 | 53 | -------------------------------------------------------------------------------- /t/fn-prnum.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (with (r (numr 2+3i) 10 | i (numi 2+3i)) 11 | (prnum r i outs) 12 | (prc \lf) 13 | nil) 14 | 2+3i 15 | nil 16 | 17 | > (with (r (numr -1-2i) 18 | i (numi -1-2i)) 19 | (prnum r i outs) 20 | (prc \lf) 21 | nil) 22 | -1-2i 23 | nil 24 | 25 | -------------------------------------------------------------------------------- /t/fn-proper.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (proper nil) 10 | t 11 | 12 | > (proper '(a . b)) 13 | nil 14 | 15 | > (proper '(a b)) 16 | t 17 | 18 | -------------------------------------------------------------------------------- /t/fn-protected.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L1 (list (list smark 'foo))) 10 | !IGNORE: result of assignment 11 | 12 | > (protected L1) 13 | nil 14 | 15 | > (set L2 (list (list smark 'bind))) 16 | !IGNORE: result of assignment 17 | 18 | > (~~protected L2) 19 | t 20 | 21 | > (set L3 (list (list smark 'prot))) 22 | !IGNORE: result of assignment 23 | 24 | > (~~protected L3) 25 | t 26 | 27 | > (set L4 (list (list (join)))) 28 | !IGNORE: result of assignment 29 | 30 | > (protected L4) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/fn-prpair.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prpair '(1 2 3) outs nil nil) 11 | (prc \lf) 12 | nil) 13 | (1 2 3) 14 | nil 15 | 16 | > (do 17 | (prpair '(a b . c) outs nil nil) 18 | (prc \lf) 19 | nil) 20 | (a b . c) 21 | nil 22 | 23 | -------------------------------------------------------------------------------- /t/fn-prsimple.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prsimple 'foo outs) 11 | (prc \lf) 12 | nil) 13 | foo 14 | nil 15 | 16 | > (do 17 | (prsimple \T outs) 18 | (prc \lf) 19 | nil) 20 | \T 21 | nil 22 | 23 | > (withfile f "testfile" 'out 24 | (prsimple f outs) 25 | (prc \lf) 26 | nil) 27 | 28 | nil 29 | 30 | > (do 31 | (prsimple 1+i outs) 32 | (prc \lf) 33 | nil) 34 | 1+i 35 | nil 36 | 37 | !END: unlink("testfile"); 38 | 39 | -------------------------------------------------------------------------------- /t/fn-prstring.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prstring "Bob" outs nil nil) 11 | (prc \lf) 12 | nil) 13 | "Bob" 14 | nil 15 | 16 | > (withfile f "temp8237" 'out 17 | (prstring "123" f nil nil)) 18 | nil 19 | 20 | > (withfile f "temp8237" 'in 21 | (nof 6 (rdc f))) 22 | (\" \1 \2 \3 \" nil) 23 | 24 | > (set s '("!")) 25 | !IGNORE: result of assignment 26 | 27 | > (prstring "hi" s nil nil) 28 | nil 29 | 30 | > s 31 | ("!\"hi\"") 32 | 33 | !END: unlink("temp8237"); 34 | -------------------------------------------------------------------------------- /t/fn-prsymbol.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (prsymbol 'hello outs) 11 | (prc \lf) 12 | nil) 13 | hello 14 | nil 15 | 16 | -------------------------------------------------------------------------------- /t/fn-put.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (put 'a 'x nil) 10 | ((a . x)) 11 | 12 | > (put 'a 'x '((b . y) (c . z))) 13 | ((a . x) (b . y) (c . z)) 14 | 15 | > (put 'a 'x '((b . y) (a . w))) 16 | ((a . x) (b . y)) 17 | 18 | > (put (join) 'x (list '(b . y) (cons (join) 'w))) 19 | (((nil) . x) (b . y)) 20 | 21 | > (put (join) 'x (list '(b . y) (cons (join) 'w)) id) 22 | (((nil) . x) (b . y) ((nil) . w)) 23 | 24 | > (set p (join)) 25 | (nil) 26 | 27 | > (put p 'x (list '(b . y) (cons p 'w)) id) 28 | (((nil) . x) (b . y)) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-r-minus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (r- (list i1 i1) (list i1 i1)) 10 | (- nil (t)) 11 | 12 | > (r- (list i0 i1) (list i0 i1)) 13 | (- nil (t)) 14 | 15 | > (r- (list i2 i1) (list i2 i1)) 16 | (- nil (t)) 17 | 18 | > (r- (list i1 i2) (list i1 i2)) 19 | (- nil (t t t t)) 20 | 21 | > (r- (list i1 i2) (list i1 i1)) 22 | (- (t) (t t)) 23 | 24 | > (r- (list i2 '(t t t)) (list '(t t t) i2)) 25 | (- (t t t t t) (t t t t t t)) 26 | 27 | > (r- (list i2 i0) (list '(t t t) i2)) 28 | (+ (t t t t) nil) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-r-plus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (r+ (list i1 i1) (list i1 i1)) 10 | ((t t) (t)) 11 | 12 | > (r+ (list i0 i1) (list i0 i1)) 13 | (nil (t)) 14 | 15 | > (r+ (list i2 i1) (list i2 i1)) 16 | ((t t t t) (t)) 17 | 18 | > (r+ (list i1 i2) (list i1 i2)) 19 | ((t t t t) (t t t t)) 20 | 21 | > (r+ (list i2 '(t t t)) (list '(t t t) i2)) 22 | ((t t t t t t t t t t t t t) (t t t t t t)) 23 | 24 | > (r+ (list i2 i0) (list '(t t t) i2)) 25 | ((t t t t) nil) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-r-slash.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (r/ (list i1 i1) (list i1 i1)) 10 | ((t) (t)) 11 | 12 | > (r/ (list i0 i1) (list i0 i1)) 13 | (nil nil) 14 | 15 | > (r/ (list i2 i1) (list i2 i1)) 16 | ((t t) (t t)) 17 | 18 | > (r/ (list i1 i2) (list i1 i2)) 19 | ((t t) (t t)) 20 | 21 | > (r/ (list i2 '(t t t)) (list '(t t t) i2)) 22 | ((t t t t) (t t t t t t t t t)) 23 | 24 | > (r/ (list i2 i0) (list '(t t t) i2)) 25 | ((t t t t) nil) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-r-star.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (r* `(,i1 ,i1) `(,i1 ,i1)) 10 | ((t) (t)) 11 | 12 | > (r* `(,i0 ,i1) `(,i0 ,i1)) 13 | (nil (t)) 14 | 15 | > (r* `(,i2 ,i1) `(,i2 ,i1)) 16 | ((t t t t) (t)) 17 | 18 | > (r* `(,i1 ,i2) `(,i1 ,i2)) 19 | ((t) (t t t t)) 20 | 21 | > (r* `(,i2 (t t t)) `((t t t) ,i2)) 22 | ((t t t t t t) (t t t t t t)) 23 | 24 | > (r* `(,i2 ,i0) `((t t t) ,i2)) 25 | ((t t t t t t) nil) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-rand.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (<= 0 (rand 2) 1) 10 | t 11 | 12 | > (<= 0 (rand 6) 5) 13 | t 14 | 15 | > (<= 0 (rand 11) 10) 16 | t 17 | 18 | > (rand 0) 19 | !ERROR: mistype 20 | 21 | -------------------------------------------------------------------------------- /t/fn-randlen.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (= (randlen 0) nil) 10 | t 11 | 12 | > (<= 0 (randlen 2) 3) 13 | t 14 | 15 | > (<= 0 (randlen 3) 7) 16 | t 17 | 18 | > (<= 0 (randlen 4) 15) 19 | t 20 | 21 | -------------------------------------------------------------------------------- /t/fn-rdc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set s '("hi")) 10 | !IGNORE: result of assignment 11 | 12 | > (rdc s) 13 | \h 14 | 15 | > (rdc s) 16 | \i 17 | 18 | > (rdc s) 19 | nil 20 | 21 | > (rdc nil) 22 | \B 23 | 24 | -------------------------------------------------------------------------------- /t/fn-rddelim.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rddelim '("") \") 10 | !ERROR: missing-delimiter 11 | 12 | > (rddelim '("\\") \") 13 | !ERROR: missing-delimiter 14 | 15 | > (rddelim '("\"") \") 16 | nil 17 | 18 | > (rddelim '("\\x\"") \") 19 | "x" 20 | 21 | -------------------------------------------------------------------------------- /t/fn-rddot.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rddot '("") \) i10 nil nil) 10 | !ERROR: unterminated-list 11 | 12 | > (rddot '(" ") \) i10 nil nil) 13 | !ERROR: missing-car 14 | 15 | > (rddot '(" foo)") \) i10 nil '(bar)) 16 | ((bar . foo) nil) 17 | 18 | > (rddot '(" foo bar)") \) i10 nil '(bar)) 19 | !ERROR: duplicate-cdr 20 | 21 | > (rddot '("2)") \) i10 nil nil) 22 | ((1/5) nil) 23 | 24 | > (rddot '("2)") \) i10 nil '(bar)) 25 | ((bar 1/5) nil) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-rdex.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rdex '("")) 10 | (nil nil) 11 | 12 | > (rdex '(" ")) 13 | (nil nil) 14 | 15 | > (rdex '("") i10 'eof) 16 | (eof nil) 17 | 18 | > (rdex '(" ") i10 'eof) 19 | (eof nil) 20 | 21 | > (rdex '("(foo bar baz)")) 22 | ((foo bar baz) nil) 23 | 24 | > (rdex '("\\")) 25 | !ERROR: escape-without-char 26 | 27 | > (rdex '("\\dufeqbef")) 28 | !ERROR: unknown-named-char 29 | 30 | > (rdex '("\\bel")) 31 | (\bel nil) 32 | 33 | > (rdex '("'foo")) 34 | ((quote foo) nil) 35 | 36 | > (rdex '("`foo")) 37 | ((bquote foo) nil) 38 | 39 | > (rdex '(",foo")) 40 | ((comma foo) nil) 41 | 42 | > (rdex '(",@foo")) 43 | ((comma-at foo) nil) 44 | 45 | > (def wrap (s c) 46 | `(,c ,@s ,c)) 47 | !IGNORE: result of definition 48 | 49 | > (rdex (list (wrap "hi" \"))) 50 | ("hi" nil) 51 | 52 | > (rdex (list (wrap "hi" \¦))) 53 | (hi nil) 54 | 55 | !TODO: currently the printer doesn't handle "special" symbols 56 | > (rdex (list (wrap "hi there" \¦))) 57 | (¦hi there¦ nil) 58 | 59 | -------------------------------------------------------------------------------- /t/fn-rdlist.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rdlist '(" ") \) i10 nil) 10 | !ERROR: unterminated-list 11 | 12 | > (rdlist '("a . b)") \) i10 nil) 13 | ((a . b) nil) 14 | 15 | > (rdlist '("a b c)") \) i10 nil) 16 | ((a b c) nil) 17 | 18 | > (rdlist '(")") \) i10 nil) 19 | (nil nil) 20 | 21 | -------------------------------------------------------------------------------- /t/fn-rdtarget.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rdtarget '("") i10 "1" (join) nil) 10 | !ERROR: missing-target 11 | 12 | > (rdtarget '("x") i10 "1" (join) nil) 13 | !ERROR: bad-target 14 | 15 | > (set c (join)) 16 | (nil) 17 | 18 | > (rdtarget '("(foo bar)") i10 "1" c nil) 19 | (#1=(foo bar) (("1" . #1))) 20 | 21 | > (rdtarget '("(quux)") i10 "2" (join) '(("1" foo bar))) 22 | (#1=(quux) (("2" . #1) ("1" foo bar))) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-rdword.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set s '("2+3i and some other stuff")) 10 | !IGNORE: result of assignment 11 | 12 | > (rdword s (rdc s) i10) 13 | 2+3i 14 | 15 | > s 16 | (" and some other stuff") 17 | 18 | > (rdword nil \a i10) 19 | aBel 20 | 21 | -------------------------------------------------------------------------------- /t/fn-rdwrap.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rdwrap '("") 'quote i10 nil) 10 | !ERROR: missing-expression 11 | 12 | > (rdwrap '("foo") 'quote i10 nil) 13 | ((quote foo) nil) 14 | 15 | > (rdwrap '("foo") 'quote i10 '(bar)) 16 | ((quote foo) (bar)) 17 | 18 | -------------------------------------------------------------------------------- /t/fn-read.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (read '("")) 10 | nil 11 | 12 | > (read '(" ")) 13 | nil 14 | 15 | > (read '("") 10 'eof) 16 | eof 17 | 18 | > (read '(" ") 10 'eof) 19 | eof 20 | 21 | > (read '("12") 10) 22 | 12 23 | 24 | > (read '("12") 3) 25 | 5 26 | 27 | > (read '("(foo bar baz)")) 28 | (foo bar baz) 29 | 30 | > (read '("\\")) 31 | !ERROR: escape-without-char 32 | 33 | > (read '("\\dufeqbef")) 34 | !ERROR: unknown-named-char 35 | 36 | > (read '("\\bel")) 37 | \bel 38 | 39 | > (read '("'foo")) 40 | (quote foo) 41 | 42 | > (read '("`foo")) 43 | (bquote foo) 44 | 45 | > (read '(",foo")) 46 | (comma foo) 47 | 48 | > (read '(",@foo")) 49 | (comma-at foo) 50 | 51 | > (def wrap (s c) 52 | `(,c ,@s ,c)) 53 | !IGNORE: result of definition 54 | 55 | > (read (list (wrap "hi" \"))) 56 | "hi" 57 | 58 | > (read (list (wrap "hi" \¦))) 59 | hi 60 | 61 | !TODO: currently the printer doesn't handle "special" symbols 62 | > (read (list (wrap "hi there" \¦))) 63 | ¦hi there¦ 64 | 65 | -------------------------------------------------------------------------------- /t/fn-readall.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (readall '("")) 10 | nil 11 | 12 | > (readall '(" 1 2 3 ")) 13 | (1 2 3) 14 | 15 | > (readall '("(foo bar) (baz)")) 16 | ((foo bar) (baz)) 17 | 18 | > (readall '("10 12 3")) 19 | (10 12 3) 20 | 21 | > (readall '("10 12 3") 10) 22 | (10 12 3) 23 | 24 | > (readall '("10 12 3") 4) 25 | (4 6 3) 26 | 27 | -------------------------------------------------------------------------------- /t/fn-real.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (real (lit num (+ nil (t)) (+ nil (t)))) 10 | t 11 | 12 | > (real (lit num (+ nil (t)) (+ (t) (t)))) 13 | nil 14 | 15 | > (real (lit num (+ (t) (t)) (+ nil (t)))) 16 | t 17 | 18 | > (real (lit num (+ (t t) (t t t)) (+ (t) (t t t t)))) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/fn-recip.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (recip (lit num (+ (t) (t)) (+ nil (t)))) 10 | 1 11 | 12 | > (recip (lit num (- (t) (t)) (+ nil (t)))) 13 | -1 14 | 15 | > (recip (lit num (+ (t t) (t)) (+ nil (t)))) 16 | 1/2 17 | 18 | > (recip (lit num (- (t t t) (t)) (+ nil (t)))) 19 | -1/3 20 | 21 | > (recip (lit num (+ nil (t)) (+ (t) (t)))) 22 | -i 23 | 24 | > (recip (lit num (+ nil (t)) (- (t) (t)))) 25 | +i 26 | 27 | > (recip (lit num (+ (t t t) (t)) (+ (t t t t) (t)))) 28 | 3/25-4/25i 29 | 30 | > (recip 0) 31 | !ERROR: mistype 32 | 33 | -------------------------------------------------------------------------------- /t/fn-reduce.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (reduce join '(a b c)) 10 | (a b . c) 11 | 12 | > (reduce (fn (x y) x) '(a b c)) 13 | a 14 | 15 | > (reduce (fn (x y) y) '(a b c)) 16 | c 17 | 18 | > (reduce join '()) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/fn-rem.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rem \a "abracadabra") 10 | "brcdbr" 11 | 12 | > (rem 'b '(a b c b a b)) 13 | (a c a) 14 | 15 | > (rem 'b '(a c a)) 16 | (a c a) 17 | 18 | > (rem 'x nil) 19 | nil 20 | 21 | > (rem '() '(a () c () a ())) 22 | (a c a) 23 | 24 | > (rem '(z) '(a (z) c) id) 25 | (a (z) c) 26 | 27 | > (rem 'x '((a) (x y) (b) (x)) caris) 28 | ((a) (b)) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-rev.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rev nil) 10 | nil 11 | 12 | > (rev '(a b c)) 13 | (c b a) 14 | 15 | > (rev '(a (x y) c)) 16 | (c (x y) a) 17 | 18 | -------------------------------------------------------------------------------- /t/fn-round.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (round -2.5) 10 | -2 11 | 12 | > (round -1.5) 13 | -2 14 | 15 | > (round -1.4) 16 | -1 17 | 18 | > (round 1.4) 19 | 1 20 | 21 | > (round 1.5) 22 | 2 23 | 24 | > (round 2.5) 25 | 2 26 | 27 | -------------------------------------------------------------------------------- /t/fn-rpart.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (rpart (lit num (+ nil (t)) (+ nil (t)))) 10 | 0 11 | 12 | > (rpart (lit num (+ nil (t)) (+ (t) (t)))) 13 | 0 14 | 15 | > (rpart (lit num (+ (t) (t)) (+ nil (t)))) 16 | 1 17 | 18 | > (rpart (lit num (+ (t t) (t t t)) (+ (t) (t t t t)))) 19 | 2/3 20 | 21 | -------------------------------------------------------------------------------- /t/fn-rrep.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set n10 '(t t t t t t t t t t)) 10 | !IGNORE: output of set 11 | 12 | > (rrep (list nil nil) n10) 13 | "0/0" 14 | 15 | > (set n1 '(t)) 16 | !IGNORE: output of set 17 | 18 | > (set n7 '(t t t t t t t)) 19 | !IGNORE: output of set 20 | 21 | > (rrep (list n7 n1) n10) 22 | "7" 23 | 24 | > (rrep (list n10 n7) n10) 25 | "10/7" 26 | 27 | > (set n14 '(t t t t t t t t t t t t t t)) 28 | !IGNORE: output of set 29 | 30 | > (rrep (list n14 n1) n10) 31 | "14" 32 | 33 | > (rrep (list n14 n7) n10) 34 | "14/7" 35 | 36 | > (set n16 '(t t t t t t t t t t t t t t t t)) 37 | !IGNORE: output of set 38 | 39 | > (rrep (list n14 n7) n16) 40 | "e/7" 41 | 42 | -------------------------------------------------------------------------------- /t/fn-runs.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (runs is.1 '(1 1 0 0 0 1 1 1 0)) 10 | ((1 1) (0 0 0) (1 1 1) (0)) 11 | 12 | > (runs is.1 '()) 13 | nil 14 | 15 | > (runs is.1 '(1)) 16 | ((1)) 17 | 18 | > (runs is.1 '(0)) 19 | ((0)) 20 | 21 | > (runs is.1 '(1 0)) 22 | ((1) (0)) 23 | 24 | > (runs is.1 '(0 1)) 25 | ((0) (1)) 26 | 27 | > (runs is.1 '(1) nil) 28 | (nil (1)) 29 | 30 | > (runs is.1 '(1) t) 31 | ((1)) 32 | 33 | > (runs is.1 '(0) nil) 34 | ((0)) 35 | 36 | > (runs is.1 '(0) t) 37 | (nil (0)) 38 | 39 | > (runs is.1 '(1 0) nil) 40 | (nil (1) (0)) 41 | 42 | > (runs is.1 '(1 0) t) 43 | ((1) (0)) 44 | 45 | > (runs is.1 '(0 1) nil) 46 | ((0) (1)) 47 | 48 | > (runs is.1 '(0 1) t) 49 | (nil (0) (1)) 50 | 51 | -------------------------------------------------------------------------------- /t/fn-saferead.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (saferead '("12") nil 10) 10 | 12 11 | 12 | > (saferead '("12") nil 3) 13 | 5 14 | 15 | > (saferead '("(foo bar baz)")) 16 | (foo bar baz) 17 | 18 | > (saferead '("\\")) 19 | nil 20 | 21 | > (saferead '("\\") 'alt) 22 | alt 23 | 24 | -------------------------------------------------------------------------------- /t/fn-signc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (signc nil) 10 | nil 11 | 12 | > (signc \0) 13 | nil 14 | 15 | > (signc \a) 16 | nil 17 | 18 | > (~~signc \+) 19 | t 20 | 21 | > (~~signc \-) 22 | t 23 | 24 | > (signc \;) 25 | nil 26 | 27 | > (signc \3) 28 | nil 29 | 30 | > (signc \D) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/fn-simple.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (simple 'x) 10 | t 11 | 12 | > (simple \c) 13 | t 14 | 15 | > (simple nil) 16 | t 17 | 18 | > (simple '(a b)) 19 | nil 20 | 21 | > (simple 3) 22 | t 23 | 24 | > (simple "ab") 25 | nil 26 | 27 | -------------------------------------------------------------------------------- /t/fn-simplify.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (simplify '(+ nil (t t t))) 10 | (+ nil (t)) 11 | 12 | > (simplify '(+ nil (t))) 13 | (+ nil (t)) 14 | 15 | > (simplify '(+ nil nil)) 16 | (+ nil (t)) 17 | 18 | > (simplify '(+ (t t t t t t) (t t t t))) 19 | (+ (t t . #1=(t)) (t . #1)) 20 | 21 | > (simplify '(+ (t t t t t t) (t t t))) 22 | (+ (t . #1=(t)) #1) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-slash.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (/) 10 | 1 11 | 12 | > (/ 5) 13 | 5 14 | 15 | > (set n1 (lit num (+ (t) (t)) (+ nil (t))) 16 | m1 (lit num (- (t) (t)) (+ nil (t))) 17 | z1 (lit num (+ nil (t)) (+ (t t t) (t))) 18 | z2 (lit num (- (t) (t t)) (+ nil (t))) 19 | z3 (lit num (+ nil (t)) (- (t t) (t t t)))) 20 | !IGNORE: result of assignment 21 | 22 | > (/ n1 n1) 23 | 1 24 | 25 | > (/ n1 m1) 26 | -1 27 | 28 | > (/ n1 z1) 29 | -1/3i 30 | 31 | > (/ z2 z3) 32 | -3/4i 33 | 34 | > (/ 1 1) 35 | 1 36 | 37 | > (/ 1 -1) 38 | -1 39 | 40 | > (/ 1 +3i) 41 | -1/3i 42 | 43 | > (/ -1/2 -2/3i) 44 | -3/4i 45 | 46 | > (/ 1 0) 47 | !ERROR: mistype 48 | 49 | -------------------------------------------------------------------------------- /t/fn-snap.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (snap nil nil) 10 | (nil nil) 11 | 12 | > (snap nil '(a b c)) 13 | (nil (a b c)) 14 | 15 | > (snap '(x) '(a b c)) 16 | ((a) (b c)) 17 | 18 | > (snap '(x y z w) '(a b c)) 19 | ((a b c nil) nil) 20 | 21 | > (snap '(x) '(a b c) '(d e)) 22 | ((d e a) (b c)) 23 | 24 | -------------------------------------------------------------------------------- /t/fn-snoc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (snoc '(a b c) 'd 'e) 10 | (a b c d e) 11 | 12 | > (snoc '()) 13 | nil 14 | 15 | > (snoc) 16 | nil 17 | 18 | -------------------------------------------------------------------------------- /t/fn-some.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (some atom '(a b c)) 10 | (a b c) 11 | 12 | > (some atom '()) 13 | nil 14 | 15 | > (some is!b '(a b c)) 16 | (b c) 17 | 18 | > (some is!q '(a b c)) 19 | nil 20 | 21 | > (some no '(t t nil)) 22 | (nil) 23 | 24 | > (some no '(t t)) 25 | nil 26 | 27 | -------------------------------------------------------------------------------- /t/fn-sort.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (sort < '(5 1 3 2 4)) 10 | (1 2 3 4 5) 11 | 12 | > (sort (of > len) 13 | '((a b) (c) (d e) (f))) 14 | ((a b) (d e) (c) (f)) 15 | 16 | -------------------------------------------------------------------------------- /t/fn-source.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use Language::Bel::Test::DSL; 7 | 8 | __DATA__ 9 | 10 | > (source 'x) 11 | nil 12 | 13 | > (source (open "testfile" 'out)) 14 | t 15 | 16 | > (source '(x)) 17 | nil 18 | 19 | > (source (list "")) 20 | t 21 | > (source (list "abc")) 22 | t 23 | > (source (list \c)) 24 | nil 25 | 26 | !END: unlink("testfile"); 27 | 28 | -------------------------------------------------------------------------------- /t/fn-split.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (split (is \a) "frantic") 10 | ("fr" "antic") 11 | 12 | > (split no '(a b nil)) 13 | ((a b) (nil)) 14 | 15 | > (split no '(a b c)) 16 | ((a b c) nil) 17 | 18 | > (split (is \i) "frantic" "quo") 19 | ("quofrant" "ic") 20 | 21 | -------------------------------------------------------------------------------- /t/fn-sr-lt.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set sr1 (list '+ i1 i1) 10 | sr2 (list '- i1 i1) 11 | sr3 (list '+ i0 i1) 12 | sr4 (list '+ i2 i1) 13 | sr5 (list '- i2 i1) 14 | sr6 (list '+ i1 i2)) 15 | !IGNORE: result of assignment 16 | 17 | > (sr< sr1 sr1) 18 | nil 19 | 20 | > (sr< sr1 sr2) 21 | nil 22 | 23 | > (sr< sr3 sr3) 24 | nil 25 | 26 | > (sr< sr4 sr4) 27 | nil 28 | 29 | > (sr< sr1 sr5) 30 | nil 31 | 32 | > (sr< sr5 sr1) 33 | t 34 | 35 | > (sr< sr5 sr2) 36 | (t) 37 | 38 | > (sr< sr6 sr1) 39 | (t) 40 | 41 | > (sr< (list '+ i2 '(t t t)) (list '+ '(t t t) i2)) 42 | (t t t t t) 43 | 44 | > (sr< (list '- i2 '(t t t)) (list '+ '(t t t) i2)) 45 | t 46 | 47 | > (sr< (list '+ i2 i0) (list '+ i2 i2)) 48 | nil 49 | 50 | -------------------------------------------------------------------------------- /t/fn-sr-minus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set sr1 (list '+ i1 i1) 10 | sr2 (list '- i1 i1) 11 | sr3 (list '+ i0 i1) 12 | sr4 (list '+ i2 i1) 13 | sr5 (list '- i2 i1) 14 | sr6 (list '+ i1 i2) 15 | sr7 (list '+ '(t t t) i2)) 16 | !IGNORE: result of assignment 17 | 18 | > (sr- sr1 sr1) 19 | (- nil (t)) 20 | 21 | > (sr- sr1 sr2) 22 | (+ (t t) (t)) 23 | 24 | > (sr- sr3 sr3) 25 | (+ nil (t)) 26 | 27 | > (sr- sr4 sr4) 28 | (- nil (t)) 29 | 30 | > (sr- sr1 sr5) 31 | (+ (t t t) (t)) 32 | 33 | > (sr- sr6 sr6) 34 | (- nil (t t t t)) 35 | 36 | > (sr- (list '+ i2 '(t t t)) sr7) 37 | (- (t t t t t) (t t t t t t)) 38 | 39 | > (sr- (list '- i2 '(t t t)) sr7) 40 | (- (t t t t t t t t t t t t t) (t t t t t t)) 41 | 42 | > (sr- (list '+ i2 i0) sr7) 43 | (+ (t t t t) nil) 44 | 45 | -------------------------------------------------------------------------------- /t/fn-sr-plus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set sr1 (list '+ i1 i1) 10 | sr2 (list '- i1 i1) 11 | sr3 (list '+ i0 i1) 12 | sr4 (list '+ i2 i1) 13 | sr5 (list '- i2 i1) 14 | sr6 (list '+ i1 i2) 15 | sr7 (list '+ '(t t t) i2)) 16 | !IGNORE: result of assignment 17 | 18 | > (sr+ sr1 sr1) 19 | (+ (t t) (t)) 20 | 21 | > (sr+ sr1 sr2) 22 | (- nil (t)) 23 | 24 | > (sr+ sr3 sr3) 25 | (+ nil (t)) 26 | 27 | > (sr+ sr4 sr4) 28 | (+ (t t t t) (t)) 29 | 30 | > (sr+ sr1 sr5) 31 | (- (t) (t)) 32 | 33 | > (sr+ sr6 sr6) 34 | (+ (t t t t) (t t t t)) 35 | 36 | > (sr+ (list '+ i2 '(t t t)) sr7) 37 | (+ (t t t t t t t t t t t t t) (t t t t t t)) 38 | 39 | > (sr+ (list '- i2 '(t t t)) sr7) 40 | (+ (t t t t t) (t t t t t t)) 41 | 42 | > (sr+ (list '+ i2 i0) sr7) 43 | (+ (t t t t) nil) 44 | 45 | -------------------------------------------------------------------------------- /t/fn-sr-slash.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set sr1 (list '+ i1 i1) 10 | sr2 (list '- i1 i1) 11 | sr3 (list '+ i0 i1) 12 | sr4 (list '+ i2 i1) 13 | sr5 (list '- i2 i1) 14 | sr6 (list '+ i1 i2) 15 | sr7 (list '+ '(t t t) i2)) 16 | !IGNORE: result of assignment 17 | 18 | > (sr/ sr1 sr1) 19 | (+ (t) (t)) 20 | 21 | > (sr/ sr1 sr2) 22 | (- (t) (t)) 23 | 24 | > (sr/ sr3 sr4) 25 | (+ nil (t t)) 26 | 27 | > (sr/ sr4 sr4) 28 | (+ (t t) (t t)) 29 | 30 | > (sr/ sr1 sr5) 31 | (- (t) (t t)) 32 | 33 | > (sr/ sr6 sr6) 34 | (+ (t t) (t t)) 35 | 36 | > (sr/ (list '+ i2 '(t t t)) sr7) 37 | (+ (t t t t) (t t t t t t t t t)) 38 | 39 | > (sr/ (list '- i2 i2) sr6) 40 | (- (t t t t) (t t)) 41 | 42 | > (sr/ (list '+ i2 i0) sr7) 43 | (+ (t t t t) nil) 44 | 45 | -------------------------------------------------------------------------------- /t/fn-sr-star.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set sr1 (list '+ i1 i1) 10 | sr2 (list '- i1 i1) 11 | sr3 (list '+ i0 i1) 12 | sr4 (list '+ i2 i1) 13 | sr5 (list '- i2 i1) 14 | sr6 (list '+ i1 i2) 15 | sr7 (list '+ '(t t t) i2)) 16 | !IGNORE: result of assignment 17 | 18 | > (sr* sr1 sr1) 19 | (+ (t) (t)) 20 | 21 | > (sr* sr1 sr2) 22 | (- (t) (t)) 23 | 24 | > (sr* sr3 sr4) 25 | (+ nil (t)) 26 | 27 | > (sr* sr4 sr4) 28 | (+ (t t t t) (t)) 29 | 30 | > (sr* sr1 sr5) 31 | (- (t t) (t)) 32 | 33 | > (sr* sr6 sr6) 34 | (+ (t) (t t t t)) 35 | 36 | > (sr* (list '+ i2 '(t t t)) sr7) 37 | (+ (t t t t t t) (t t t t t t)) 38 | 39 | > (sr* (list '- i2 i2) sr6) 40 | (- (t t) (t t t t)) 41 | 42 | > (sr* (list '+ i2 i0) sr7) 43 | (+ (t t t t t t) nil) 44 | 45 | -------------------------------------------------------------------------------- /t/fn-srden.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (srden (list '+ i1 i1)) 10 | (t) 11 | 12 | > (srden (list '- i1 i1)) 13 | (t) 14 | 15 | > (srden (list '+ i0 i1)) 16 | (t) 17 | 18 | > (srden (list '+ i2 i1)) 19 | (t) 20 | 21 | > (srden (list '+ '(t t t) i1)) 22 | (t) 23 | 24 | > (srden (list '- i2 '(t t t))) 25 | (t t t) 26 | 27 | > (srden (list '+ i16 i0)) 28 | nil 29 | 30 | -------------------------------------------------------------------------------- /t/fn-srinv.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (srinv (list '+ i1 i1)) 10 | (- #1=(t) #1) 11 | 12 | > (srinv (list '+ i0 i1)) 13 | (+ nil (t)) 14 | 15 | > (srinv (list '- i0 i1)) 16 | (+ nil (t)) 17 | 18 | > (srinv (list '+ i2 i1)) 19 | (- (t t) (t)) 20 | 21 | > (srinv (list '+ i1 i2)) 22 | (- (t) (t t)) 23 | 24 | > (srinv (list '- i1 i2)) 25 | (+ (t) (t t)) 26 | 27 | > (srinv (list '+ i2 '(t t t))) 28 | (- (t t) (t t t)) 29 | 30 | > (srinv (list '- '(t t t) i2)) 31 | (+ (t t t) (t t)) 32 | 33 | > (srinv (list '+ i2 i10)) 34 | (- (t t) (t t t t t t t t t t)) 35 | 36 | -------------------------------------------------------------------------------- /t/fn-srnum.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (srnum (list '+ i1 i1)) 10 | (t) 11 | 12 | > (srnum (list '- i1 i1)) 13 | (t) 14 | 15 | > (srnum (list '+ i0 i1)) 16 | nil 17 | 18 | > (srnum (list '+ i2 i1)) 19 | (t t) 20 | 21 | > (srnum (list '+ '(t t t) i1)) 22 | (t t t) 23 | 24 | > (srnum (list '- i2 '(t t t))) 25 | (t t) 26 | 27 | > (srnum (list '+ i16 i0)) 28 | (t t t t t t t t t t t t t t t t) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-srrecip.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (srrecip (list '+ i1 i1)) 10 | (+ #1=(t) #1) 11 | 12 | > (srrecip (list '+ (list t) (list t))) 13 | (+ (t) (t)) 14 | 15 | > (srrecip (list '- i1 i1)) 16 | (- #1=(t) #1) 17 | 18 | > (srrecip (list '- (list t) (list t))) 19 | (- (t) (t)) 20 | 21 | > (srrecip (list '+ i0 i1)) 22 | !ERROR: mistype 23 | 24 | > (srrecip (list '+ i2 i1)) 25 | (+ (t) (t t)) 26 | 27 | > (srrecip (list '- i2 i1)) 28 | (- (t) (t t)) 29 | 30 | > (srrecip (list '+ i1 i2)) 31 | (+ (t t) (t)) 32 | 33 | > (srrecip (list '+ i2 '(t t t))) 34 | (+ (t t t) (t t)) 35 | 36 | > (srrecip (list '- i2 i2)) 37 | (- #1=(t t) #1) 38 | 39 | > (srrecip (list '- (list t t) (list t t))) 40 | (- (t t) (t t)) 41 | 42 | > (srrecip (list '+ i2 i0)) 43 | (+ nil (t t)) 44 | 45 | -------------------------------------------------------------------------------- /t/fn-star.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set n1 (lit num (+ (t) (t)) (+ nil (t))) 10 | n2 (lit num (- (t) (t)) (+ nil (t))) 11 | n3 (lit num (+ nil (t)) (+ (t t t) (t))) 12 | n4 (lit num (- (t) (t t)) (+ nil (t))) 13 | n5 (lit num (+ nil (t)) (- (t t) (t t t))) 14 | n6 (lit num (+ (t) (t t)) (- (t t) (t t t))) 15 | n7 (lit num (- (t) (t t)) (+ (t t) (t t t)))) 16 | !IGNORE: result of assignment 17 | 18 | > (*) 19 | 1 20 | 21 | > (* n1 n1) 22 | 1 23 | 24 | > (* n1 n2) 25 | -1 26 | 27 | > (* n1 n3) 28 | +3i 29 | 30 | > (* n4 n5) 31 | +1/3i 32 | 33 | > (* n6 n7) 34 | 7/36+2/3i 35 | 36 | > (* 1 1) 37 | 1 38 | 39 | > (* 1 -1) 40 | -1 41 | 42 | > (* 1 +3i) 43 | +3i 44 | 45 | > (* -1/2 -2/3i) 46 | +1/3i 47 | 48 | > (* 1/2-2/3i -1/2+2/3i) 49 | 7/36+2/3i 50 | 51 | > (* 1 2 3 4) 52 | 24 53 | 54 | -------------------------------------------------------------------------------- /t/fn-stream.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (stream 'x) 10 | nil 11 | 12 | > (stream nil) 13 | nil 14 | 15 | > (stream '(a)) 16 | nil 17 | 18 | > (stream (join)) 19 | nil 20 | 21 | > (stream \c) 22 | nil 23 | 24 | > (set f (ops "testfile" 'out)) 25 | 26 | 27 | > (stream f) 28 | t 29 | 30 | !END: unlink("testfile"); 31 | 32 | -------------------------------------------------------------------------------- /t/fn-string.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (string nil) 10 | t 11 | 12 | > (string "") 13 | t 14 | 15 | > (string "hello bel") 16 | t 17 | 18 | > (string 'c) 19 | nil 20 | 21 | > (string \a) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-symbol.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (symbol 'x) 10 | t 11 | 12 | > (symbol nil) 13 | t 14 | 15 | > (symbol '(a)) 16 | nil 17 | 18 | > (symbol (join)) 19 | nil 20 | 21 | > (symbol \c) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-table.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (table) 10 | (lit tab) 11 | 12 | > (table nil) 13 | (lit tab) 14 | 15 | > (table '((a . b))) 16 | (lit tab (a . b)) 17 | 18 | > (table '((a . b) (c . nil))) 19 | (lit tab (a . b) (c)) 20 | 21 | > (table '((a . b) (c . d))) 22 | (lit tab (a . b) (c . d)) 23 | 24 | > (table '((a . b) (a . d))) 25 | (lit tab (a . b) (a . d)) 26 | 27 | > (table '((a . 1) (b . 2))) 28 | (lit tab (a . 1) (b . 2)) 29 | 30 | -------------------------------------------------------------------------------- /t/fn-tabrem.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set k (table '((z . 2) 10 | (a . 1) 11 | (c . d)))) 12 | !IGNORE: result of definition 13 | 14 | > (tabrem k 'z) 15 | ((a . 1) (c . d)) 16 | 17 | > k 18 | (lit tab (a . 1) (c . d)) 19 | 20 | > (set k (table '((x . 1) 21 | (y . 2) 22 | (x . 3)))) 23 | !IGNORE: result of definition 24 | 25 | > (tabrem k 'x) 26 | ((y . 2)) 27 | 28 | > k 29 | (lit tab (y . 2)) 30 | 31 | -------------------------------------------------------------------------------- /t/fn-tail.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (tail idfn nil) 10 | nil 11 | 12 | > (tail car '(a b c)) 13 | (a b c) 14 | 15 | > (tail car '(nil b c)) 16 | (b c) 17 | 18 | > (tail no:cdr '(a b c)) 19 | (c) 20 | 21 | > (tail [caris _ \-] "non-nil") 22 | "-nil" 23 | 24 | -------------------------------------------------------------------------------- /t/fn-tokens.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (tokens "the age of the essay") 10 | ("the" "age" "of" "the" "essay") 11 | 12 | > (tokens "A|B|C") 13 | ("A|B|C") 14 | 15 | > (tokens "A|B|C" \|) 16 | ("A" "B" "C") 17 | 18 | > (tokens "A.B:C.D!E:F" 19 | (cor (is \.) (is \:))) 20 | ("A" "B" "C" "D!E" "F") 21 | 22 | -------------------------------------------------------------------------------- /t/fn-trap.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((trap cons 'a) 'b) 10 | (b . a) 11 | 12 | > ((trap list 1 2 3) 4 5) 13 | (4 5 1 2 3) 14 | 15 | > ((trap no) t) 16 | nil 17 | 18 | > ((trap no) nil) 19 | t 20 | 21 | -------------------------------------------------------------------------------- /t/fn-udrop.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (udrop nil nil) 10 | nil 11 | 12 | > (udrop nil '(a b c)) 13 | (a b c) 14 | 15 | > (udrop '(x) '(a b c)) 16 | (b c) 17 | 18 | If the first list is as long as or longer than the second list, you 19 | get `nil` back. 20 | 21 | > (udrop '(x y z w) '(a b c)) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-upon.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (function (upon '(a b c))) 10 | clo 11 | 12 | > ((upon '(a b c)) cdr) 13 | (b c) 14 | 15 | > (map (upon '(a b c)) (list car cadr cdr)) 16 | (a b (b c)) 17 | 18 | -------------------------------------------------------------------------------- /t/fn-ustring.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set s "tail") 10 | "tail" 11 | 12 | > (len (set names (namedups (list (append "head1" s) 13 | (append "head2" s))))) 14 | 1 15 | 16 | > (ustring "" names) 17 | nil 18 | 19 | > (ustring "foo" names) 20 | t 21 | 22 | > (ustring \bel names) 23 | nil 24 | 25 | > (ustring "bel" names) 26 | t 27 | 28 | > (ustring s names) 29 | nil 30 | 31 | > (ustring "head3tail" names) 32 | t 33 | 34 | > (ustring (append "head4" s) names) 35 | nil 36 | 37 | -------------------------------------------------------------------------------- /t/fn-uvar.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > vmark 10 | (nil) 11 | 12 | > (id vmark vmark) 13 | t 14 | 15 | > (id vmark (join)) 16 | nil 17 | 18 | > (id vmark '(nil)) 19 | nil 20 | 21 | > (uvar) 22 | ((nil)) 23 | 24 | > (id (uvar) (uvar)) 25 | nil 26 | 27 | > (id (car (uvar)) vmark) 28 | t 29 | 30 | -------------------------------------------------------------------------------- /t/fn-validd.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (validd "" i10) 10 | nil 11 | 12 | > (validd "0" i10) 13 | t 14 | 15 | > (validd "1" i10) 16 | t 17 | 18 | > (validd "9" i10) 19 | t 20 | 21 | > (validd "f" i10) 22 | nil 23 | 24 | > (validd "f" i16) 25 | t 26 | 27 | > (validd "10" i10) 28 | t 29 | 30 | > (validd "1.0" i10) 31 | t 32 | 33 | > (validd "1..0" i10) 34 | nil 35 | 36 | > (validd "10." i10) 37 | t 38 | 39 | > (validd ".10" i10) 40 | t 41 | 42 | > (validd ".1f" i10) 43 | nil 44 | 45 | > (validd ".1f" i16) 46 | t 47 | 48 | > (validd "." i10) 49 | nil 50 | 51 | > (validd "1.0." i10) 52 | nil 53 | 54 | > (validd ".1.0" i10) 55 | nil 56 | 57 | > (validd ".10." i10) 58 | nil 59 | 60 | -------------------------------------------------------------------------------- /t/fn-validi.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (validi "+i" i10) 10 | t 11 | 12 | > (validi "+i" i0) 13 | t 14 | 15 | > (validi "-i" i10) 16 | t 17 | 18 | > (validi "+0i" i10) 19 | t 20 | 21 | > (validi "+0" i10) 22 | nil 23 | 24 | > (validi "+0j" i10) 25 | nil 26 | 27 | > (validi "-fi" i10) 28 | nil 29 | 30 | > (validi "-fi" i16) 31 | t 32 | 33 | > (validi "+1.0i" i10) 34 | t 35 | 36 | > (validi "-.1fi" i10) 37 | nil 38 | 39 | > (validi "-.1fi" i16) 40 | t 41 | 42 | > (validi "+.i" i10) 43 | nil 44 | 45 | > (validi "-1/2.i" i10) 46 | t 47 | 48 | > (validi "+1/.2i" i10) 49 | t 50 | 51 | > (validi "-1/.i" i10) 52 | nil 53 | 54 | > (validi "-1.0/2.0i" i10) 55 | t 56 | 57 | > -1.0/2.0i 58 | -1/2i 59 | 60 | -------------------------------------------------------------------------------- /t/fn-validr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (validr "" i10) 10 | nil 11 | 12 | > (validr "0" i10) 13 | t 14 | 15 | > (validr "1" i10) 16 | t 17 | 18 | > (validr "9" i10) 19 | t 20 | 21 | > (validr "f" i10) 22 | nil 23 | 24 | > (validr "f" i16) 25 | t 26 | 27 | > (validr "10" i10) 28 | t 29 | 30 | > (validr "1.0" i10) 31 | t 32 | 33 | > (validr "1..0" i10) 34 | nil 35 | 36 | > (validr "10." i10) 37 | t 38 | 39 | > (validr ".10" i10) 40 | t 41 | 42 | > (validr ".1f" i10) 43 | nil 44 | 45 | > (validr ".1f" i16) 46 | t 47 | 48 | > (validr "." i10) 49 | nil 50 | 51 | > (validr "1.0." i10) 52 | nil 53 | 54 | > (validr ".1.0" i10) 55 | nil 56 | 57 | > (validr ".10." i10) 58 | nil 59 | 60 | > (validr "1/2" i10) 61 | t 62 | 63 | > (validr "1/" i10) 64 | nil 65 | 66 | > (validr "/2" i10) 67 | nil 68 | 69 | > (validr "1/2/3" i10) 70 | nil 71 | 72 | > (validr "1./2" i10) 73 | t 74 | 75 | > (validr "1/2." i10) 76 | t 77 | 78 | > (validr "1/.2" i10) 79 | t 80 | 81 | > (validr "1/." i10) 82 | nil 83 | 84 | > (validr "1.0/2.0" i10) 85 | t 86 | 87 | -------------------------------------------------------------------------------- /t/fn-variable.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (variable 'foo) 10 | t 11 | 12 | > (variable nil) 13 | nil 14 | 15 | > (variable t) 16 | nil 17 | 18 | > (variable (uvar)) 19 | t 20 | 21 | > (variable \c) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/fn-wait.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (def popx () 10 | (let (xa . xd) x 11 | (set x xd) 12 | xa)) 13 | !IGNORE: result of definition 14 | 15 | > (set x '(nil nil a b c)) 16 | (nil nil a b c) 17 | 18 | > (len x) 19 | 5 20 | 21 | > (wait popx) 22 | a 23 | 24 | > (len x) 25 | 2 26 | 27 | -------------------------------------------------------------------------------- /t/fn-whitec.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (~~whitec \sp) 10 | t 11 | 12 | > (~~whitec \lf) 13 | t 14 | 15 | > (~~whitec \tab) 16 | t 17 | 18 | > (~~whitec \cr) 19 | t 20 | 21 | > (~~whitec \a) 22 | nil 23 | 24 | > (~~whitec \b) 25 | nil 26 | 27 | > (~~whitec \x) 28 | nil 29 | 30 | > (~~whitec \1) 31 | nil 32 | 33 | -------------------------------------------------------------------------------- /t/fn-whole.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (whole 0) 10 | t 11 | 12 | > (whole \x) 13 | nil 14 | 15 | > (whole -1) 16 | nil 17 | 18 | > (whole 1) 19 | t 20 | 21 | > (whole 1/2) 22 | nil 23 | 24 | > (whole 4/2) 25 | t 26 | 27 | > (whole -4/2) 28 | nil 29 | 30 | -------------------------------------------------------------------------------- /t/fn-yc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (def popx () 10 | (let (xa . xd) x 11 | (set x xd) 12 | xa)) 13 | !IGNORE: result of definition 14 | 15 | > (set x '(nil nil a b c)) 16 | (nil nil a b c) 17 | 18 | > (len x) 19 | 5 20 | 21 | > ((yc (fn (self) (fn (v) (if v v (self (popx)))))) (popx)) 22 | a 23 | 24 | > (len x) 25 | 2 26 | 27 | -------------------------------------------------------------------------------- /t/fncall.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((lit clo nil (x) (id x nil)) nil) 10 | t 11 | 12 | > ((lit clo nil (x) (id x nil)) t) 13 | nil 14 | 15 | > ('y 'z) 16 | !ERROR: cannot-apply 17 | 18 | > ((fn (x) 'one-param-zero-args)) 19 | !ERROR: underargs 20 | 21 | > ((fn (x) 'one-param-two-args) t t) 22 | !ERROR: overargs 23 | 24 | -------------------------------------------------------------------------------- /t/form-after.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (after 1 2) 10 | 1 11 | 12 | > (after 3 (car 'atom)) 13 | !ERROR: car-on-atom 14 | 15 | > (do (after (set x 1) 16 | (set x 2)) 17 | x) 18 | 2 19 | 20 | > (after) 21 | !ERROR: bad-form 22 | 23 | > (after a) 24 | !ERROR: bad-form 25 | 26 | > (after a b c) 27 | !ERROR: bad-form 28 | 29 | -------------------------------------------------------------------------------- /t/form-apply.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (apply join '(a b)) 10 | (a . b) 11 | 12 | > (apply join 'a '(b)) 13 | (a . b) 14 | 15 | > (apply no '(nil)) 16 | t 17 | 18 | > (apply no '(t)) 19 | nil 20 | 21 | > (apply cons '(a b c (d e f))) 22 | (a b c d e f) 23 | 24 | > (apply cons '()) 25 | nil 26 | 27 | > (map apply (list (fn () 'x) (fn () 'y))) 28 | (x y) 29 | 30 | -------------------------------------------------------------------------------- /t/form-ccc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (list 'a (ccc (fn (c) (set cont c) 'b))) 10 | (a b) 11 | 12 | > (cont 'z) 13 | (a z) 14 | 15 | > (cont 'w) 16 | (a w) 17 | 18 | There are spaces at the end of the `prn`'d lines. 19 | Becuase that's how `prn` works according to spec. 20 | 21 | > (do (ccc (fn (c) 22 | (set cont c))) 23 | (prn 1) 24 | 3) 25 | 1 26 | 3 27 | 28 | > (after (cont 'ignore) (prn 2)) 29 | 1 30 | 2 31 | 3 32 | 33 | > (bind dvar "two" 34 | (after (cont 'ignore) (prn dvar))) 35 | 1 36 | "two" 37 | 3 38 | 39 | > (ccc) 40 | !ERROR: bad-form 41 | 42 | > (ccc a b) 43 | !ERROR: bad-form 44 | 45 | -------------------------------------------------------------------------------- /t/form-dyn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let f (fn () d) (f)) 10 | !ERROR: ('unboundb d) 11 | 12 | > (let f (fn () d) 13 | (dyn d 'hai (f))) 14 | hai 15 | 16 | > (dyn d 'yes d) 17 | yes 18 | 19 | Dynamic bindings can shadow each other on the value stack; as an 20 | inner one goes out of scope, the next-outer one becomes visible again. 21 | 22 | > (dyn d 'one 23 | (cons (dyn d 'two d) d)) 24 | (two . one) 25 | 26 | Dynamic bindings trump lexical ones, regardless of how they nest. 27 | 28 | > (let v 'lexical (dyn v 'dynamic v)) 29 | dynamic 30 | 31 | > (dyn v 'dynamic (let v 'lexical v)) 32 | dynamic 33 | 34 | > (dyn) 35 | !ERROR: bad-form 36 | 37 | > (dyn v) 38 | !ERROR: bad-form 39 | 40 | > (dyn v 'a) 41 | !ERROR: bad-form 42 | 43 | > (dyn v 'a 'b 'c) 44 | !ERROR: bad-form 45 | 46 | -------------------------------------------------------------------------------- /t/form-extension.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (form hello ((e) a s r m) 10 | (mev s (cons (append "Hello " e "!") r) m)) 11 | !IGNORE: output of form definition 12 | 13 | > (bel '(hello "world")) 14 | "Hello world!" 15 | 16 | -------------------------------------------------------------------------------- /t/form-if.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (if) 10 | nil 11 | 12 | > (if 'a) 13 | a 14 | 15 | > (if 'a 'b) 16 | b 17 | 18 | > (if 'a 'b 'c) 19 | b 20 | 21 | > (if nil 'b 'c) 22 | c 23 | 24 | -------------------------------------------------------------------------------- /t/form-quote.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (quote) 10 | !ERROR: bad-form 11 | 12 | > (quote a) 13 | a 14 | 15 | > (quote 'a) 16 | (quote a) 17 | 18 | > (quote a b) 19 | !ERROR: bad-form 20 | 21 | > (quote a b nil) 22 | !ERROR: bad-form 23 | 24 | -------------------------------------------------------------------------------- /t/form-thread.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (thread (+ 2 2)) 10 | 4 11 | 12 | > (do (thread 1) 13 | (thread (+ 2 2))) 14 | 4 15 | 16 | > (set n 0) 17 | 0 18 | 19 | > (do (thread 20 | (for i 1 10 21 | (++ n))) 22 | (thread 23 | (for i 1 10 24 | (-- n)))) 25 | !IGNORE: result of racing the two threads 26 | 27 | > n 28 | 0 29 | 30 | > (thread) 31 | !ERROR: bad-form 32 | 33 | > (thread a b) 34 | !ERROR: bad-form 35 | 36 | -------------------------------------------------------------------------------- /t/let-quine.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let let '`(let let ',let ,let) `(let let ',let ,let)) 10 | (let let (quote #1=(bquote (let let (quote (comma let)) (comma let)))) #1) 11 | 12 | > (= (let let '`(let let ',let ,let) `(let let ',let ,let)) '(let let (quote #1=(bquote (let let (quote (comma let)) (comma let)))) #1)) 13 | t 14 | 15 | -------------------------------------------------------------------------------- /t/linked-globals.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (id i< udrop) 10 | t 11 | 12 | > (id srnum cadr) 13 | t 14 | 15 | > (id srden caddr) 16 | t 17 | 18 | -------------------------------------------------------------------------------- /t/mac-accum.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (accum a 10 | (map (cand odd a) '(1 2 3 4 5))) 11 | (1 3 5) 12 | 13 | > (accum a 14 | (map [if (odd _) (a _)] '(1 2 3 4 5))) 15 | (1 3 5) 16 | 17 | > (accum a 18 | (map [when (odd _) (a _) (a _)] '(1 2 3 4 5))) 19 | (1 1 3 3 5 5) 20 | 21 | -------------------------------------------------------------------------------- /t/mac-afn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (def popx () 10 | (let (xa . xd) x 11 | (set x xd) 12 | xa)) 13 | !IGNORE: result of definition 14 | 15 | > (set x '(nil nil a b c)) 16 | (nil nil a b c) 17 | 18 | > (len x) 19 | 5 20 | 21 | > ((afn (v) (if v v (self (popx)))) 22 | (popx)) 23 | a 24 | 25 | > (len x) 26 | 2 27 | 28 | -------------------------------------------------------------------------------- /t/mac-aif.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (aif) 10 | nil 11 | 12 | > (aif 'a (list it 'b)) 13 | (a b) 14 | 15 | > (aif 'a (list 'b it) 'c) 16 | (b a) 17 | 18 | -------------------------------------------------------------------------------- /t/mac-and.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (and) 10 | t 11 | 12 | > (and nil) 13 | nil 14 | 15 | > (and t) 16 | t 17 | 18 | > (and 'a) 19 | a 20 | 21 | > (and 'b nil 'c) 22 | nil 23 | 24 | Later side effects don't run if the conjunction has already 25 | been falsified. 26 | 27 | > (set x "original") 28 | "original" 29 | 30 | > (and nil (set x "changed")) 31 | nil 32 | 33 | > x 34 | "original" 35 | 36 | -------------------------------------------------------------------------------- /t/mac-atomic.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > lock 10 | !ERROR: ('unboundb lock) 11 | 12 | > (let f (fn () lock) (f)) 13 | !ERROR: ('unboundb lock) 14 | 15 | > (let f (fn () lock) (atomic (f))) 16 | t 17 | 18 | > (atomic 'hi) 19 | hi 20 | 21 | > (atomic lock) 22 | t 23 | 24 | > (atomic 'no 'but lock) 25 | t 26 | 27 | > (atomic (cons (atomic lock) lock)) 28 | (t . t) 29 | 30 | `atomic` creates a dynamic binding of `lock`, which trumps any lexical 31 | binding, whether inside or outside the `atomic` expression. 32 | 33 | > (let lock 'lexical (atomic lock)) 34 | t 35 | 36 | > (atomic (let lock 'lexical lock)) 37 | t 38 | 39 | -------------------------------------------------------------------------------- /t/mac-awhen.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (awhen nil) 10 | nil 11 | 12 | > (awhen 'a 13 | (list it 'b)) 14 | (a b) 15 | 16 | > (awhen 'a 17 | (list 'b it) 18 | 'c) 19 | c 20 | 21 | > (awhen nil 22 | (list 'b it) 23 | 'c) 24 | nil 25 | 26 | -------------------------------------------------------------------------------- /t/mac-bind.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let f (fn () d) (f)) 10 | !ERROR: ('unboundb d) 11 | 12 | > (let f (fn () d) (bind d 'hai (f))) 13 | hai 14 | 15 | > (bind d 'yes 16 | d) 17 | yes 18 | 19 | > (bind d 'yes 20 | 'no 21 | 'but 22 | d) 23 | yes 24 | 25 | > (bind d 'one 26 | (cons (bind d 'two d) d)) 27 | (two . one) 28 | 29 | Dynamic variables trump lexical variables, no matter how they nest. 30 | 31 | > (let v 'lexical 32 | (bind v 'dynamic v)) 33 | dynamic 34 | 35 | > (bind v 'dynamic 36 | (let v 'lexical v)) 37 | dynamic 38 | 39 | -------------------------------------------------------------------------------- /t/mac-catch.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (catch 10 | (throw 'a) 11 | (/ 1 0)) 12 | a 13 | 14 | -------------------------------------------------------------------------------- /t/mac-check.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (check t idfn) 10 | t 11 | 12 | > (check nil idfn) 13 | nil 14 | 15 | > (check 2 is.2) 16 | 2 17 | 18 | > (check 1 is.2) 19 | nil 20 | 21 | > (check 2 is.2 0) 22 | 2 23 | 24 | > (check 1 is.2 0) 25 | 0 26 | 27 | > (set x 1) 28 | 1 29 | 30 | > (check (++ x) is.2)) 31 | 2 32 | 33 | > x 34 | 2 35 | 36 | -------------------------------------------------------------------------------- /t/mac-clean.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x '(1 2 3 4 5)) 10 | (1 2 3 4 5) 11 | 12 | > (clean odd x) 13 | (2 4) 14 | 15 | > x 16 | (2 4) 17 | 18 | -------------------------------------------------------------------------------- /t/mac-def.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 10 | (def foo (x) x) 11 | (foo 'a)) 12 | a 13 | 14 | > (do 15 | (def bar (x) (cons x x)) 16 | (bar 'a)) 17 | (a . a) 18 | 19 | -------------------------------------------------------------------------------- /t/mac-do.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (do 'a 10 | 'b 11 | 'c 12 | (list 'hello 'world)) 13 | (hello world) 14 | 15 | > (do) 16 | nil 17 | 18 | > (do 'x 19 | 'y) 20 | y 21 | 22 | -------------------------------------------------------------------------------- /t/mac-do1.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | The `do1` macro returns the value of the _first_ expression 10 | it evaluates. 11 | 12 | > (do1 1 13 | 2) 14 | 1 15 | 16 | It doesn't matter if the variable the value was originally 17 | from subsequently changes. 18 | 19 | > (let x 'hi 20 | (do1 x 21 | (set x 'hey))) 22 | hi 23 | 24 | However, the subsequent expressions are still evaluated, and 25 | so any side effects from them are still visible. 26 | 27 | > (let x 'hi 28 | (do1 x 29 | (set y 'hey)) 30 | y) 31 | hey 32 | 33 | A (rare) edge case which nevertheless works is that of an empty 34 | sequence of `do1` expressions. 35 | 36 | > (do1) 37 | nil 38 | 39 | -------------------------------------------------------------------------------- /t/mac-drain.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x '(a b c d e)) 10 | (a b c d e) 11 | 12 | > (drain (pop x)) 13 | (a b c d e) 14 | 15 | > x 16 | nil 17 | 18 | > (set x '(a b c d e)) 19 | (a b c d e) 20 | 21 | > (drain (pop x) (is 'd)) 22 | (a b c) 23 | 24 | > x 25 | (e) 26 | 27 | -------------------------------------------------------------------------------- /t/mac-each.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L '()) 10 | nil 11 | 12 | > (each n '(1 2 3) 13 | (push (inc n) L)) 14 | (#1=(2) #2=(3 . #1) (4 . #2)) 15 | 16 | > L 17 | (4 3 2) 18 | 19 | > (set L '()) 20 | nil 21 | 22 | > (each n '(1 2 3) 23 | (set L (append (list inc.n) L nil))) 24 | ((2) (3 2) (4 3 2)) 25 | 26 | > L 27 | (4 3 2) 28 | 29 | > (set L '()) 30 | nil 31 | 32 | > (each n '() 33 | (push (inc n) L)) 34 | nil 35 | 36 | > L 37 | nil 38 | 39 | > (set L '((a) (b) (c))) 40 | ((a) (b) (c)) 41 | 42 | > (each e L 43 | (xar e 'z)) 44 | (z z z) 45 | 46 | > L 47 | ((z) (z) (z)) 48 | 49 | > (set L nil) 50 | nil 51 | 52 | > (each e '(a b c) 53 | (push e L)) 54 | (#1=(a) #2=(b . #1) (c . #2)) 55 | 56 | > L 57 | (c b a) 58 | 59 | > (set L nil) 60 | nil 61 | 62 | > (each e '(a b c) 63 | (set L (append (list e) L nil))) 64 | ((a) (b a) (c b a)) 65 | 66 | > L 67 | (c b a) 68 | 69 | -------------------------------------------------------------------------------- /t/mac-eif.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (eif v (car 'atom) 10 | 'no 11 | 'yes) 12 | no 13 | 14 | > (eif v (car '(1 2)) 15 | 'no 16 | 'yes) 17 | yes 18 | 19 | > (eif v (car 'atom) 20 | v 21 | v) 22 | car-on-atom 23 | 24 | > (eif v (car '(1 2)) 25 | v 26 | v) 27 | 1 28 | 29 | -------------------------------------------------------------------------------- /t/mac-fn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((fn (x) (list x x)) 'a) 10 | (a a) 11 | 12 | > ((fn (x y) (list x y)) 'a 'b) 13 | (a b) 14 | 15 | > ((fn () (list 'a 'b 'c))) 16 | (a b c) 17 | 18 | > ((fn (x) ((fn (y) (list x y)) 'g)) 'f) 19 | (f g) 20 | 21 | If there are several expressions in a function, the result of the whole 22 | function call is the value of the last expression. 23 | 24 | > ((fn () 'irrelevant 'relevant)) 25 | relevant 26 | 27 | Side effects of the expressions prior to the last still run, in order. 28 | 29 | > ((fn () (car 'atom) 'never)) 30 | !ERROR: car-on-atom 31 | 32 | -------------------------------------------------------------------------------- /t/mac-for.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let L nil 10 | (for n 1 5 11 | (push n L)) 12 | L) 13 | (5 4 3 2 1) 14 | 15 | > (let L nil 16 | (for n 3 3 17 | (push n L)) 18 | L) 19 | (3) 20 | 21 | > (let L nil 22 | (for n 4 1 23 | (push n L)) 24 | L) 25 | nil 26 | 27 | -------------------------------------------------------------------------------- /t/mac-from.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (from "README.md" 10 | 'foo) 11 | foo 12 | 13 | -------------------------------------------------------------------------------- /t/mac-fu.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (type (fu (s r m) s)) 10 | pair 11 | 12 | > (= (fu (s r m) s) `((,smark fut (lit clo nil (s r m) s)) nil)) 13 | t 14 | 15 | > (= (fu (s r m) r) `((,smark fut (lit clo nil (s r m) r)) nil)) 16 | t 17 | 18 | > (id (car:car (fu (s r m) (cdr s))) smark) 19 | t 20 | 21 | -------------------------------------------------------------------------------- /t/mac-iflet.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (iflet x) 10 | nil 11 | 12 | > (iflet y 'a 13 | (list y 'b)) 14 | (a b) 15 | 16 | > (iflet z 'a 17 | (list 'b z) 18 | 'c) 19 | (b a) 20 | 21 | > (iflet w nil 22 | (list 'd w) 23 | 'e) 24 | e 25 | 26 | > (iflet (a b . c) '(1 2 3 4 5) 27 | (list a b c) 28 | 'flurken) 29 | (1 2 (3 4 5)) 30 | 31 | > (iflet (a b . c) nil 32 | (list a b c) 33 | 'gherkin) 34 | gherkin 35 | 36 | -------------------------------------------------------------------------------- /t/mac-let.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let x 'a 10 | (cons x 'b)) 11 | (a . b) 12 | 13 | `let` declarations can shadow one another, creating a lexically 14 | nested structure of definitions. 15 | 16 | > (let x 'a 17 | (cons (let x 'b 18 | x) 19 | x)) 20 | (b . a) 21 | 22 | > (let x 'a 23 | (let y 'b 24 | (list x y))) 25 | (a b) 26 | 27 | > (let x 1 28 | (let x (+ x 1) 29 | x)) 30 | 2 31 | 32 | -------------------------------------------------------------------------------- /t/mac-letu.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (letu va 10 | (variable va)) 11 | t 12 | 13 | > (letu va 14 | ([= _ (uvar)] va)) 15 | t 16 | 17 | > (letu va 18 | (id vmark (car va))) 19 | t 20 | 21 | > (letu (vb vc) 22 | (and (variable vb) 23 | (variable vc))) 24 | t 25 | 26 | > (letu (vb vc) 27 | (and ([= _ (uvar)] vb) 28 | ([= _ (uvar)] vc))) 29 | t 30 | 31 | > (letu (vb vc) 32 | (and (id vmark (car vb)) 33 | (id vmark (car vc)))) 34 | t 35 | 36 | -------------------------------------------------------------------------------- /t/mac-loop.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L nil) 10 | nil 11 | 12 | > (loop x 1 (+ x 1) (< x 5) 13 | (push x L)) 14 | nil 15 | 16 | > L 17 | (4 3 2 1) 18 | 19 | > (set L nil) 20 | nil 21 | 22 | > (loop x 1 (+ x 1) (< x 1) 23 | (push x L)) 24 | nil 25 | 26 | > L 27 | nil 28 | 29 | -------------------------------------------------------------------------------- /t/mac-mac.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (mac foo (x) 10 | ''b) 11 | !IGNORE: output of definition 12 | 13 | > (foo 'a) 14 | b 15 | 16 | > (mac bar (x) 17 | `(cons ,x ,x)) 18 | !IGNORE: output of definition 19 | 20 | > (bar 'a) 21 | (a . a) 22 | 23 | -------------------------------------------------------------------------------- /t/mac-macro.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((macro (v) v) 'b) 10 | b 11 | 12 | > ((macro (v) `(cons ,v 'a)) 'b) 13 | (b . a) 14 | 15 | > ((fn (x) 16 | ((macro (v) `(cons ,v 'a)) x)) 'b) 17 | (b . a) 18 | 19 | -------------------------------------------------------------------------------- /t/mac-minus-minus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let x 1 10 | (-- x)) 11 | 0 12 | 13 | > (let x 1.5 14 | (-- x)) 15 | 1/2 16 | 17 | > (let x -3+i 18 | (-- x)) 19 | -4+i 20 | 21 | > (set x 1) 22 | 1 23 | 24 | > (-- x) 25 | 0 26 | 27 | > x 28 | 0 29 | 30 | > (-- x 3) 31 | -3 32 | 33 | > x 34 | -3 35 | 36 | > (set L '(1 1 1)) 37 | (1 1 1) 38 | 39 | > (-- (cadr L)) 40 | 0 41 | 42 | > L 43 | (1 0 1) 44 | 45 | > (bind f6ac4d 2 46 | (-- f6ac4d) 47 | f6ac4d) 48 | 1 49 | 50 | > (bind f6ac4d 3 51 | (-- f6ac4d 3) 52 | f6ac4d) 53 | 0 54 | 55 | > (let L '(1 2 3) 56 | (-- (find is.2 L)) 57 | L) 58 | (1 1 3) 59 | 60 | > (-- (find [= _ 0] '(1 2 3))) 61 | !ERROR: unfindable 62 | 63 | > (let kvs '((a . 1) 64 | (b . 2) 65 | (c . 3)) 66 | (-- (cdr:get 'b kvs)) 67 | kvs) 68 | ((a . 1) (b . 1) (c . 3)) 69 | 70 | > (let kvs '(((a) . 1) 71 | ((b) . 2) 72 | ((c) . 3)) 73 | (-- (cdr:get '(b) kvs)) 74 | kvs) 75 | (((a) . 1) ((b) . 1) ((c) . 3)) 76 | 77 | -------------------------------------------------------------------------------- /t/mac-nof.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (nof 5 'hi) 10 | (hi hi hi hi hi) 11 | 12 | > (nof 3 '(s)) 13 | (#1=(s) #1 #1) 14 | 15 | > (nof 3 (list 's)) 16 | ((s) (s) (s)) 17 | 18 | > (nof 0 '(s)) 19 | nil 20 | 21 | > (let L (nof 3 '(s)) 22 | (= (1 L) (2 L))) 23 | t 24 | 25 | > (let L (nof 3 '(s)) 26 | (id (1 L) (2 L))) 27 | t 28 | 29 | > (let n 0 30 | (nof 4 (++ n))) 31 | (1 2 3 4) 32 | 33 | -------------------------------------------------------------------------------- /t/mac-onerr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (onerr 'oops (car 'a)) 10 | oops 11 | 12 | > (onerr 'no-oops (car '(1 2))) 13 | 1 14 | 15 | -------------------------------------------------------------------------------- /t/mac-or.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (or) 10 | nil 11 | 12 | > (or nil) 13 | nil 14 | 15 | > (or nil t) 16 | t 17 | 18 | > (or nil 'a) 19 | a 20 | 21 | > (or nil 'b 'c) 22 | b 23 | 24 | Later side effects don't run if the disjunction has already been 25 | satisfied by an earlier expression. 26 | 27 | > (set x "original") 28 | "original" 29 | 30 | > (or t (set x "changed")) 31 | t 32 | 33 | > x 34 | "original" 35 | 36 | -------------------------------------------------------------------------------- /t/mac-plus-plus.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let x 1 10 | (++ x)) 11 | 2 12 | 13 | > (let x 1.5 14 | (++ x)) 15 | 5/2 16 | 17 | > (let x -3+i 18 | (++ x)) 19 | -2+i 20 | 21 | > (set x 1) 22 | 1 23 | 24 | > (++ x) 25 | 2 26 | 27 | > x 28 | 2 29 | 30 | > (++ x 3) 31 | 5 32 | 33 | > x 34 | 5 35 | 36 | > (set L '(1 1 1)) 37 | (1 1 1) 38 | 39 | > (++ (cadr L)) 40 | 2 41 | 42 | > L 43 | (1 2 1) 44 | 45 | > (bind f6ac4d 2 46 | (++ f6ac4d) 47 | f6ac4d) 48 | 3 49 | 50 | > (bind f6ac4d 3 51 | (++ f6ac4d 3) 52 | f6ac4d) 53 | 6 54 | 55 | > (let L '(1 2 3) 56 | (++ (find is.2 L)) 57 | L) 58 | (1 3 3) 59 | 60 | > (++ (find [= _ 0] '(1 2 3))) 61 | !ERROR: unfindable 62 | 63 | > (let kvs '((a . 1) 64 | (b . 2) 65 | (c . 3)) 66 | (++ (cdr:get 'b kvs)) 67 | kvs) 68 | ((a . 1) (b . 3) (c . 3)) 69 | 70 | > (let kvs '(((a) . 1) 71 | ((b) . 2) 72 | ((c) . 3)) 73 | (++ (cdr:get '(b) kvs)) 74 | kvs) 75 | (((a) . 1) ((b) . 3) ((c) . 3)) 76 | 77 | -------------------------------------------------------------------------------- /t/mac-poll.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let x '(a b c d e) 10 | (poll (pop x) (is 'c)) 11 | x) 12 | (d e) 13 | 14 | > (let x '(c) 15 | (poll (pop x) (is 'c)) 16 | x) 17 | nil 18 | 19 | -------------------------------------------------------------------------------- /t/mac-pop.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L '(a b c)) 10 | (a b c) 11 | 12 | > (pop L) 13 | a 14 | 15 | > L 16 | (b c) 17 | 18 | > (set L '(d e f)) 19 | (d e f) 20 | 21 | > (pop (cddr L)) 22 | f 23 | 24 | > L 25 | (d e) 26 | 27 | > (pop L) 28 | d 29 | 30 | > (pop L) 31 | e 32 | 33 | > L 34 | nil 35 | 36 | > (def f () 37 | (pop L)) 38 | !IGNORE: result of definition 39 | 40 | > (bind L '(g h i) 41 | (f) 42 | L) 43 | (h i) 44 | 45 | -------------------------------------------------------------------------------- /t/mac-pull.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let L '(a b c b d) 10 | (pull 'b L)) 11 | (a c d) 12 | 13 | You can `pull` from the inside of a list! 14 | 15 | > (set L '(a b a c a a d)) 16 | (a b a c a a d) 17 | 18 | > (pull 'a (cdr L)) 19 | (b c d) 20 | 21 | > L 22 | (a b c d) 23 | 24 | > (pull 'z L) 25 | (a b c d) 26 | 27 | > (set L '(a)) 28 | (a) 29 | 30 | > (pull 'a L) 31 | nil 32 | 33 | > (bind L '(g h g i g) 34 | (pull 'g L)) 35 | (h i) 36 | 37 | > (def f () 38 | (pull 'h L)) 39 | !IGNORE: result of definition 40 | 41 | > (bind L '(g h h h i) 42 | (f)) 43 | (g i) 44 | 45 | > (set q '(b)) 46 | (b) 47 | 48 | > (let L `((a) ,q) 49 | (pull q L)) 50 | ((a)) 51 | 52 | > (let L `((a) ,q) 53 | (pull '(b) L id)) 54 | ((a) (b)) 55 | 56 | > (let L `((a) ,q) 57 | (pull q L id)) 58 | ((a)) 59 | 60 | -------------------------------------------------------------------------------- /t/mac-push.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | Push is destructive, in the sense that it actually changes its second 10 | argument. 11 | 12 | > (let L '(b c) 13 | (push 'a L) 14 | L) 15 | (a b c) 16 | 17 | You can push to the `cdr` of a list! 18 | 19 | > (let L '(b c) 20 | (push 'a (cdr L)) 21 | L) 22 | (b a c) 23 | 24 | > (let L nil 25 | (push 'a L) 26 | L) 27 | (a) 28 | 29 | > (bind L '(h i) 30 | (push 'g L) 31 | L) 32 | (g h i) 33 | 34 | > (def f (v) (push 'g L)) 35 | !IGNORE: result of definition 36 | 37 | > (bind L '(h i) 38 | (f 'g) 39 | L) 40 | (g h i) 41 | 42 | -------------------------------------------------------------------------------- /t/mac-pushnew.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x '(a b c)) 10 | (a b c) 11 | 12 | > (pushnew 'a x) 13 | (a b c) 14 | 15 | > x 16 | (a b c) 17 | 18 | > (pushnew 'z x) 19 | (z a b c) 20 | 21 | > x 22 | (z a b c) 23 | 24 | > (set y '(a b c)) 25 | (a b c) 26 | 27 | > (pushnew 'a y =) 28 | (a b c) 29 | 30 | > (pushnew 'z y =) 31 | (z a b c) 32 | 33 | > (pushnew 'z y =) 34 | (z a b c) 35 | 36 | > (set p '(a) 37 | L `(,p (b) (c))) 38 | ((a) (b) (c)) 39 | 40 | > (pushnew p L) 41 | ((a) (b) (c)) 42 | 43 | > (pushnew '(a) L id) 44 | ((a) (a) (b) (c)) 45 | 46 | > (set L `(,p (b) (c))) 47 | !IGNORE: result of assignment, same as before 48 | 49 | > (pushnew p L id) 50 | ((a) (b) (c)) 51 | 52 | -------------------------------------------------------------------------------- /t/mac-record.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (record (enq \a outs) (enq \b outs) (enq \c outs)) 10 | "abc" 11 | 12 | > (record (map [enq _ outs] '(\x \y \z))) 13 | "xyz" 14 | 15 | > (record) 16 | nil 17 | 18 | !TODO: The `pr` function does not yet respect `outs` 19 | > (record (pr (append "hello" '(\lf)))) 20 | "hello\lf" 21 | 22 | -------------------------------------------------------------------------------- /t/mac-repeat.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L1 nil) 10 | nil 11 | 12 | > (repeat 5 13 | (push 'hi L1)) 14 | nil 15 | 16 | > L1 17 | (hi hi hi hi hi) 18 | 19 | > (set L2 nil) 20 | nil 21 | 22 | > (repeat 1 23 | (push 'hi L2)) 24 | nil 25 | 26 | > L2 27 | (hi) 28 | 29 | > (set L3 nil) 30 | nil 31 | 32 | > (repeat 0 33 | (push 'hi L3)) 34 | nil 35 | 36 | > L3 37 | nil 38 | 39 | > (set L4 nil) 40 | nil 41 | 42 | > (repeat -2 43 | (push 'hi L4)) 44 | nil 45 | 46 | > L4 47 | nil 48 | 49 | -------------------------------------------------------------------------------- /t/mac-rfn.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (def popx () 10 | (let (xa . xd) x 11 | (set x xd) 12 | xa)) 13 | !IGNORE: result of definition 14 | 15 | > (set x '(nil nil a b c)) 16 | (nil nil a b c) 17 | 18 | > (len x) 19 | 5 20 | 21 | > ((rfn self (v) (if v v (self (popx)))) (popx)) 22 | a 23 | 24 | > (len x) 25 | 2 26 | 27 | -------------------------------------------------------------------------------- /t/mac-safe.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (safe (car 'a)) 10 | nil 11 | 12 | > (safe (car '(1 2))) 13 | 1 14 | 15 | -------------------------------------------------------------------------------- /t/mac-set.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x 'foo) 10 | foo 11 | 12 | > x 13 | foo 14 | 15 | > (set y) 16 | t 17 | 18 | > y 19 | t 20 | 21 | > (set x 'foo 22 | x 'bar)) 23 | bar 24 | 25 | > x 26 | bar 27 | 28 | > (set x 'foo y 'bar) 29 | bar 30 | 31 | > x 32 | foo 33 | 34 | > (let x 'hi 35 | (set x 'bye) 36 | x) 37 | bye 38 | 39 | > x 40 | foo 41 | 42 | > (bind f6ac4d 'hi 43 | (set f6ac4d 'bye) 44 | f6ac4d) 45 | bye 46 | 47 | > (let L '(a b (c d) e) 48 | (set (find pair L) 'cd) 49 | L) 50 | (a b cd e) 51 | 52 | > (set (find pair '(a b e)) 'z) 53 | !ERROR: unfindable 54 | 55 | > (let kvs '((a . 1) 56 | (b . 2) 57 | (c . 3)) 58 | (set (cdr:get 'b kvs) 5) 59 | kvs) 60 | ((a . 1) (b . 5) (c . 3)) 61 | 62 | > (let kvs '((a . 1) 63 | (b . 2) 64 | (c . 3)) 65 | (set (get 'd kvs) 5)) 66 | !ERROR: unfindable 67 | 68 | > (let kvs '(((a) . 1) 69 | ((b) . 2) 70 | ((c) . 3)) 71 | (set (cdr:get '(b) kvs) 5) 72 | kvs) 73 | (((a) . 1) ((b) . 5) ((c) . 3)) 74 | 75 | > (let kvs '(((a) . 1) 76 | ((b) . 2) 77 | ((c) . 3)) 78 | (set (get '(b) kvs id) 5)) 79 | !ERROR: unfindable 80 | 81 | -------------------------------------------------------------------------------- /t/mac-swap.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let (x y z) '(a b c) 10 | (swap x y z) 11 | (list x y z)) 12 | (b c a) 13 | 14 | > (let x '(a b c d e) 15 | (swap 2.x 4.x) 16 | x) 17 | (a d c b e) 18 | 19 | -------------------------------------------------------------------------------- /t/mac-til.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set L '() 10 | x '(a b c d e)) 11 | (a b c d e) 12 | 13 | > (til y (pop x) (= y 'c) 14 | (push y L)) 15 | nil 16 | 17 | > L 18 | (b a) 19 | 20 | > x 21 | (d e) 22 | 23 | > (set L '() 24 | x '(c)) 25 | (c) 26 | 27 | > (til y (pop x) (= y 'c) 28 | (push y L)) 29 | nil 30 | 31 | > x 32 | nil 33 | 34 | -------------------------------------------------------------------------------- /t/mac-to.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (to "alsieu" 'choo) 10 | choo 11 | 12 | !END: unlink("alsieu"); 13 | 14 | -------------------------------------------------------------------------------- /t/mac-unless.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (unless t 10 | "OH" 11 | " " 12 | "HAI") 13 | nil 14 | 15 | > (unless t 16 | "OH") 17 | nil 18 | 19 | > (unless t) 20 | nil 21 | 22 | > (unless nil 23 | "OH" 24 | " " 25 | "HAI") 26 | "HAI" 27 | 28 | > (unless nil 29 | "OH") 30 | "OH" 31 | 32 | > (unless nil) 33 | nil 34 | 35 | -------------------------------------------------------------------------------- /t/mac-when.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (when t 10 | "OH" 11 | " " 12 | "HAI") 13 | "HAI" 14 | 15 | > (when t 16 | "OH") 17 | "OH" 18 | 19 | > (when t) 20 | nil 21 | 22 | > (when nil 23 | "OH" 24 | " " 25 | "HAI") 26 | nil 27 | 28 | > (when nil 29 | "OH") 30 | nil 31 | 32 | > (when nil) 33 | nil 34 | 35 | -------------------------------------------------------------------------------- /t/mac-whenlet.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (whenlet x nil) 10 | nil 11 | 12 | > (whenlet y 'a 13 | (list y 'b)) 14 | (a b) 15 | 16 | > (whenlet z 'a 17 | (list 'b z) 18 | 'c) 19 | c 20 | 21 | > (whenlet z nil 22 | (list 'b z) 23 | 'c) 24 | nil 25 | 26 | If the condition is not true, side effects do not run. 27 | 28 | > (set x "original") 29 | "original" 30 | 31 | > (whenlet w nil 32 | (set x "changed")) 33 | nil 34 | 35 | > x 36 | "original" 37 | 38 | > (whenlet (a b . c) '(1 2 3 4 5) 39 | (list a b c) 40 | b) 41 | 2 42 | 43 | > (whenlet (a b . c) nil 44 | (list a b c) 45 | c) 46 | nil 47 | 48 | -------------------------------------------------------------------------------- /t/mac-while.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (with (x '(a b c) 10 | L '()) 11 | (while (pop x) 12 | (push x L)) 13 | L) 14 | (nil #1=(c) (b . #1)) 15 | 16 | > (with (x '() 17 | L '()) 18 | (while (pop x) 19 | (push x L)) 20 | L) 21 | nil 22 | 23 | -------------------------------------------------------------------------------- /t/mac-whilet.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x '(a b c) 10 | y '()) 11 | nil 12 | 13 | > (whilet e (pop x) 14 | (push e y)) 15 | nil 16 | 17 | > y 18 | (c b a) 19 | 20 | > (set x '() 21 | y '()) 22 | nil 23 | 24 | > (whilet e (pop x) 25 | (push e y)) 26 | nil 27 | 28 | > y 29 | nil 30 | 31 | > (mac moo () 32 | (letu vx `(whilet ,vx (pop L) 33 | (push ,vx K)))) 34 | !IGNORE: result of definition 35 | 36 | > (set L '(a b c d) 37 | K '()) 38 | nil 39 | 40 | > (moo) 41 | nil 42 | 43 | > K 44 | (d c b a) 45 | 46 | > (set x '((a b) (c d) (e f)) 47 | y '()) 48 | nil 49 | 50 | > (whilet (e1 e2) (pop x) 51 | (push e2 y)) 52 | nil 53 | 54 | > y 55 | (f d b) 56 | 57 | -------------------------------------------------------------------------------- /t/mac-wipe.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (let x 'hi 10 | (wipe x) 11 | x) 12 | nil 13 | 14 | > (let x '(a b c d e) 15 | (wipe 2.x 4.x) 16 | x) 17 | (a nil c nil e) 18 | 19 | -------------------------------------------------------------------------------- /t/mac-with.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (with (x 'a y 'b) (cons x y)) 10 | (a . b) 11 | 12 | > (let x 'a (with (x 'b y x) y)) 13 | a 14 | 15 | > (with (x 'a y) y) 16 | nil 17 | 18 | > (let x 1 19 | (with (x (+ x 1) 20 | x (+ x 1)) 21 | x)) 22 | 2 23 | 24 | -------------------------------------------------------------------------------- /t/mac-withfile.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (withfile f "testfile" 'out 10 | (set ff f) 11 | (stat f)) 12 | out 13 | 14 | > (stat ff) 15 | closed 16 | 17 | !END: unlink("testfile"); 18 | 19 | -------------------------------------------------------------------------------- /t/mac-withs.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (withs () 10 | (cons 'b 'a)) 11 | (b . a) 12 | 13 | > (withs (x 'a 14 | y 'b) 15 | (cons x y)) 16 | (a . b) 17 | 18 | > (withs (x 'a y x) 19 | (cons x y)) 20 | (a . a) 21 | 22 | The outer binding of a variable that's about to be bound is visible 23 | when evaluating the expression to be bound. 24 | 25 | > (let x 'a 26 | (withs (x x 27 | y x) 28 | y)) 29 | a 30 | 31 | > (withs (x 'a y) 32 | (cons x y)) 33 | (a) 34 | 35 | > (let x 1 36 | (withs (x (+ x 1) 37 | x (+ x 1)) 38 | x)) 39 | 3 40 | 41 | -------------------------------------------------------------------------------- /t/mac-zap.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set x 1) 10 | 1 11 | 12 | > (zap + x 1) 13 | 2 14 | 15 | > x 16 | 2 17 | 18 | > (set y "Be") 19 | "Be" 20 | 21 | > (zap append y "l") 22 | "Bel" 23 | 24 | > y 25 | "Bel" 26 | 27 | > (set L '(a b c)) 28 | (a b c) 29 | 30 | > (zap (con 'z) (cadr L)) 31 | z 32 | 33 | > L 34 | (a z c) 35 | 36 | > (set L '(a (b c) d)) 37 | (a (b c) d) 38 | 39 | > (zap cdr (find pair L)) 40 | (c) 41 | 42 | > L 43 | (a (c) d) 44 | 45 | > (bind f6ac4d 'hi 46 | (zap (con 'bye) f6ac4d) 47 | f6ac4d) 48 | bye 49 | 50 | > (set L '(a b e)) 51 | (a b e) 52 | 53 | > (zap idfn (find pair '(a b e))) 54 | !ERROR: unfindable 55 | 56 | > (set kvs '((a . 1) 57 | (b . 2) 58 | (c . 3))) 59 | ((a . 1) (b . 2) (c . 3)) 60 | 61 | > (zap (con 5) (cdr:get 'b kvs)) 62 | 5 63 | 64 | > kvs 65 | ((a . 1) (b . 5) (c . 3)) 66 | 67 | > (zap idfn (get 'd kvs)) 68 | !ERROR: unfindable 69 | 70 | > (set kvs '(((a) . 1) 71 | ((b) . 2) 72 | ((c) . 3))) 73 | (((a) . 1) ((b) . 2) ((c) . 3)) 74 | 75 | > (zap (con 5) (cdr:get '(b) kvs)) 76 | 5 77 | 78 | > kvs 79 | (((a) . 1) ((b) . 5) ((c) . 3)) 80 | 81 | > (zap (con 5) (get '(b) kvs id)) 82 | !ERROR: unfindable 83 | 84 | -------------------------------------------------------------------------------- /t/maccall.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((lit mac (lit clo nil (x) (list 'cons nil x))) 'a) 10 | (nil . a) 11 | 12 | > ((lit mac (lit clo nil (x) (list 'cons nil x))) 'b) 13 | (nil . b) 14 | 15 | -------------------------------------------------------------------------------- /t/malformed.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (list "hello be" . \l) 10 | !ERROR: malformed 11 | 12 | > (cons \e . \l) 13 | !ERROR: malformed 14 | 15 | > (\e . \l) 16 | !ERROR: malformed 17 | 18 | > ((lit clo nil nil)) 19 | nil 20 | 21 | -------------------------------------------------------------------------------- /t/manifest.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | unless ( $ENV{RELEASE_TESTING} ) { 8 | plan( skip_all => "Author tests not required for installation" ); 9 | } 10 | 11 | my $min_tcm = 0.9; 12 | eval "use Test::CheckManifest $min_tcm"; 13 | plan skip_all => "Test::CheckManifest $min_tcm required" if $@; 14 | 15 | ok_manifest(); 16 | -------------------------------------------------------------------------------- /t/multiple-bels.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | use Language::Bel; 8 | 9 | plan tests => 1; 10 | 11 | my $actual_output = ""; 12 | my $b1 = Language::Bel->new({ output => sub { 13 | my ($string) = @_; 14 | $actual_output = "$actual_output$string"; 15 | } }); 16 | my $b2 = Language::Bel->new({ output => sub {} }); 17 | 18 | $b1->read_eval_print("(set xyzzy 'right)"); 19 | $b2->read_eval_print("(set xyzzy 'wrong)"); 20 | 21 | $actual_output = ""; 22 | $b1->read_eval_print("xyzzy"); 23 | 24 | is($actual_output, 25 | "right\n", 26 | "two Bel instances have distinct globals and don't interfere"); 27 | -------------------------------------------------------------------------------- /t/odd-hugs.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (hug '(a b c d e)) 10 | ((a b) (c d) (e)) 11 | 12 | > (with (a 1 b) (list a b)) 13 | (1 nil) 14 | 15 | > (set x 1 16 | y) 17 | t 18 | 19 | > x 20 | 1 21 | 22 | > y 23 | t 24 | 25 | > (tem t1 f1 nil f2) 26 | !ERROR: underargs 27 | 28 | > (tem t2 f1 nil) 29 | !IGNORE: result of template declaration 30 | 31 | > (make t2 f1 1 f2) 32 | !ERROR: underargs 33 | 34 | -------------------------------------------------------------------------------- /t/param-destructure.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # -T 3 | use 5.006; 4 | use strict; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((lit clo nil ((a b c)) c) '(a b c)) 10 | c 11 | 12 | > ((lit clo nil ((a b c)) c) 'not-a-list) 13 | !ERROR: atom-arg 14 | 15 | > ((fn ((a b c)) c) '(a b c)) 16 | c 17 | 18 | > ((fn ((a b c)) c) 'not-a-list) 19 | !ERROR: atom-arg 20 | 21 | -------------------------------------------------------------------------------- /t/param-optional.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((lit clo nil ((o x)) x) 'a) 10 | a 11 | 12 | > ((lit clo nil ((o x)) x)) 13 | nil 14 | 15 | > ((lit clo nil ((o x 'b)) x) 'a) 16 | a 17 | 18 | > ((lit clo nil ((o x 'b)) x)) 19 | b 20 | 21 | > ((lit clo nil ((o x) (o y)) (list x y)) 'a 'b) 22 | (a b) 23 | 24 | > ((lit clo nil ((o x) (o y)) (list x y)) 'a) 25 | (a nil) 26 | 27 | > ((lit clo nil ((o x) (o y)) (list x y))) 28 | (nil nil) 29 | 30 | > ((lit clo nil ((o x) (o y x)) (list x y)) 'c) 31 | (c c) 32 | 33 | > ((fn ((o x)) x) 'a) 34 | a 35 | 36 | > ((fn ((o x)) x)) 37 | nil 38 | 39 | > ((fn ((o x 'b)) x) 'a) 40 | a 41 | 42 | > ((fn ((o x 'b)) x)) 43 | b 44 | 45 | > ((fn ((o x) (o y)) (list x y)) 'a 'b) 46 | (a b) 47 | 48 | > ((fn ((o x) (o y)) (list x y)) 'a) 49 | (a nil) 50 | 51 | > ((fn ((o x) (o y)) (list x y))) 52 | (nil nil) 53 | 54 | > ((fn ((o x) (o y x)) (list x y)) 'c) 55 | (c c) 56 | 57 | > (let ((o x)) '(a) x) 58 | a 59 | 60 | > (let ((o x)) '() x) 61 | nil 62 | 63 | > (let ((o x 'b)) '(a) x) 64 | a 65 | 66 | > (let ((o x 'b)) '() x) 67 | b 68 | 69 | -------------------------------------------------------------------------------- /t/param-typed.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # -T 3 | use 5.006; 4 | use strict; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > ((lit clo nil ((t xs pair)) xs) (join)) 10 | (nil) 11 | 12 | > ((lit clo nil ((t xs pair)) xs) 'a) 13 | !ERROR: mistype 14 | 15 | > (def f1 ((t xs pair)) 16 | xs) 17 | !IGNORE: result of definition 18 | 19 | > (f1 (join)) 20 | (nil) 21 | 22 | > (f1 'a) 23 | !ERROR: mistype 24 | 25 | > (def f2 ((o (t (x . y) [caris _ 'a]) '(a . b))) 26 | x) 27 | !IGNORE: result of definition 28 | 29 | > (f2 '(b b)) 30 | !ERROR: mistype 31 | 32 | > (f2) 33 | a 34 | 35 | > (def f3 (s (t n [~= _ nil]) d) 36 | (list s d n)) 37 | !IGNORE: result of definition 38 | 39 | > (f3 '+ '(t t) '(t t t)) 40 | (+ (t t t) (t t)) 41 | 42 | > (f3 '+ nil '(t t t)) 43 | !ERROR: mistype 44 | 45 | -------------------------------------------------------------------------------- /t/pod-coverage.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | unless ( $ENV{RELEASE_TESTING} ) { 8 | plan( skip_all => "Author tests not required for installation" ); 9 | } 10 | 11 | # Ensure a recent version of Test::Pod::Coverage 12 | my $min_tpc = 1.08; 13 | eval "use Test::Pod::Coverage $min_tpc"; 14 | plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" 15 | if $@; 16 | 17 | # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, 18 | # but older versions don't recognize some common documentation styles 19 | my $min_pc = 0.18; 20 | eval "use Pod::Coverage $min_pc"; 21 | plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" 22 | if $@; 23 | 24 | all_pod_coverage_ok(); 25 | -------------------------------------------------------------------------------- /t/pod.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | unless ( $ENV{RELEASE_TESTING} ) { 8 | plan( skip_all => "Author tests not required for installation" ); 9 | } 10 | 11 | # Ensure a recent version of Test::Pod 12 | my $min_tp = 1.22; 13 | eval "use Test::Pod $min_tp"; 14 | plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; 15 | 16 | all_pod_files_ok(); 17 | -------------------------------------------------------------------------------- /t/prim-car.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (car '(a . b)) 10 | a 11 | 12 | > (car '(a b)) 13 | a 14 | 15 | > (car nil) 16 | nil 17 | 18 | > (car) 19 | nil 20 | 21 | > (car 'atom) 22 | !ERROR: car-on-atom 23 | 24 | -------------------------------------------------------------------------------- /t/prim-cdr.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (cdr '(a . b)) 10 | b 11 | 12 | > (cdr '(a b)) 13 | (b) 14 | 15 | > (cdr nil) 16 | nil 17 | 18 | > (cdr) 19 | nil 20 | 21 | > (cdr 'atom) 22 | !ERROR: cdr-on-atom 23 | 24 | -------------------------------------------------------------------------------- /t/prim-cls.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set f (ops "testfile" 'out)) 10 | 11 | 12 | > (cls f) 13 | 14 | 15 | > (stat f) 16 | closed 17 | 18 | > (cls f) 19 | !ERROR: already-closed 20 | 21 | > (cls 'not-a-stream) 22 | !ERROR: mistype 23 | 24 | !END: unlink("testfile"); 25 | 26 | -------------------------------------------------------------------------------- /t/prim-coin.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (~~mem (coin) '(t nil)) 10 | t 11 | 12 | > (whilet _ (coin)) 13 | nil 14 | 15 | > (til _ (coin) no) 16 | nil 17 | 18 | -------------------------------------------------------------------------------- /t/prim-id.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (id 'a 'a) 10 | t 11 | 12 | > (id 'a 'b) 13 | nil 14 | 15 | > (id 'a \a) 16 | nil 17 | 18 | > (id \a \a) 19 | t 20 | 21 | > (id 't t) 22 | t 23 | 24 | > (id nil 'nil) 25 | t 26 | 27 | > (id id id) 28 | t 29 | 30 | > (id id 'id) 31 | nil 32 | 33 | > (id id nil) 34 | nil 35 | 36 | > (id nil) 37 | t 38 | 39 | > (id) 40 | t 41 | 42 | -------------------------------------------------------------------------------- /t/prim-join.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (join 'a 'b) 10 | (a . b) 11 | 12 | > (join 'a) 13 | (a) 14 | 15 | > (join) 16 | (nil) 17 | 18 | > (join nil 'b) 19 | (nil . b) 20 | 21 | > (id (join 'a 'b) (join 'a 'b)) 22 | nil 23 | 24 | -------------------------------------------------------------------------------- /t/prim-nom.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (nom 'a) 10 | "a" 11 | 12 | > (nom \a) 13 | !ERROR: mistype 14 | 15 | > (nom nil) 16 | "nil" 17 | 18 | > (nom '(a)) 19 | !ERROR: mistype 20 | 21 | > (nom "a") 22 | !ERROR: mistype 23 | 24 | -------------------------------------------------------------------------------- /t/prim-ops.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set f (ops "prim-ops-testfile" 'out)) 10 | 11 | 12 | > (type f) 13 | stream 14 | 15 | > (cls f) 16 | 17 | 18 | > (set f (ops "prim-ops-testfile" 'in)) 19 | 20 | 21 | > (type f) 22 | stream 23 | 24 | > (ops "rukyerw" 'in) 25 | !ERROR: notexist 26 | 27 | !END: unlink("prim-ops-testfile"); 28 | 29 | -------------------------------------------------------------------------------- /t/prim-rdb.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | 6 | BEGIN { 7 | { 8 | open(my $OUT, ">", "temp3627") 9 | or die "Could not open 'temp3627' for writing: $!"; 10 | 11 | print {$OUT} "zoo"; 12 | 13 | close($OUT); 14 | } 15 | } 16 | 17 | use Language::Bel::Test::DSL; 18 | 19 | __DATA__ 20 | 21 | > (nof 8 (rdb nil)) 22 | "01000010" 23 | 24 | > (set s (ops "temp3627" 'in)) 25 | 26 | 27 | > (nof 8 (rdb s)) 28 | "01111010" 29 | 30 | > (nof 8 (rdb s)) 31 | "01101111" 32 | 33 | > (nof 8 (rdb s)) 34 | "01101111" 35 | 36 | > (rdb s) 37 | eof 38 | 39 | > (let s (ops "temp3627" 'out) 40 | (rdb s)) 41 | !ERROR: badmode 42 | 43 | !END: unlink("temp3627"); 44 | 45 | -------------------------------------------------------------------------------- /t/prim-stat.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set f (ops "testfile" 'out)) 10 | 11 | 12 | > (stat f) 13 | out 14 | 15 | > (cls f) 16 | 17 | 18 | > (stat f) 19 | closed 20 | 21 | !END: unlink("testfile"); 22 | 23 | -------------------------------------------------------------------------------- /t/prim-type.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (type 'a) 10 | symbol 11 | 12 | > (type \a) 13 | char 14 | 15 | > (type \bel) 16 | char 17 | 18 | > (type nil) 19 | symbol 20 | 21 | > (type '(a)) 22 | pair 23 | 24 | > (set f (ops "testfile" 'out)) 25 | 26 | 27 | > (type f) 28 | stream 29 | 30 | !END: unlink("testfile"); 31 | 32 | -------------------------------------------------------------------------------- /t/prims.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (type prims) 10 | pair 11 | 12 | > (all pair prims) 13 | t 14 | 15 | > (if (mem 'coin (1 (rev prims))) t) 16 | t 17 | 18 | > (~~mem 'car (2 (rev prims))) 19 | t 20 | 21 | > (~~mem 'cdr (2 (rev prims))) 22 | t 23 | 24 | > (~~mem 'type (2 (rev prims))) 25 | t 26 | 27 | > (~~mem 'sym (2 (rev prims))) 28 | t 29 | 30 | > (~~mem 'nom (2 (rev prims))) 31 | t 32 | 33 | > (~~mem 'rdb (2 (rev prims))) 34 | t 35 | 36 | > (~~mem 'cls (2 (rev prims))) 37 | t 38 | 39 | > (~~mem 'stat (2 (rev prims))) 40 | t 41 | 42 | > (~~mem 'sys (2 (rev prims))) 43 | t 44 | 45 | > (~~mem 'id (3 (rev prims))) 46 | t 47 | 48 | > (~~mem 'join (3 (rev prims))) 49 | t 50 | 51 | > (~~mem 'xar (3 (rev prims))) 52 | t 53 | 54 | > (~~mem 'xdr (3 (rev prims))) 55 | t 56 | 57 | > (~~mem 'wrb (3 (rev prims))) 58 | t 59 | 60 | > (~~mem 'ops (3 (rev prims))) 61 | t 62 | 63 | -------------------------------------------------------------------------------- /t/print-shared-pairs.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (set d '(nil)) 10 | (nil) 11 | 12 | > (set dd (list d d)) 13 | (#1=(nil) #1) 14 | 15 | > (set e '(nil)) 16 | (nil) 17 | 18 | > (set (cdr e) e) 19 | #1=(nil . #1) 20 | 21 | > e 22 | #1=(nil . #1) 23 | 24 | > (set L '(1 2 3)) 25 | (1 2 3) 26 | 27 | > (set K '(4 5 6)) 28 | (4 5 6) 29 | 30 | > (set (cdr (cddr K)) K) 31 | #1=(4 5 6 . #1) 32 | 33 | > (set (cdr (cddr L)) K) 34 | #1=(4 5 6 . #1) 35 | 36 | > L 37 | (1 2 3 . #1=(4 5 6 . #1)) 38 | 39 | > (set A1 '(hi there)) 40 | (hi there) 41 | 42 | > (set A2 '(there hi)) 43 | (there hi) 44 | 45 | > (set (cdr A1) A2) 46 | (there hi) 47 | 48 | > (set (cdr A2) A1) 49 | #1=(hi there . #1) 50 | 51 | > A2 52 | #1=(there hi . #1) 53 | 54 | > (set R '(x)) 55 | (x) 56 | 57 | > (set (car R) R) 58 | #1=(#1) 59 | 60 | > R 61 | #1=(#1) 62 | 63 | -------------------------------------------------------------------------------- /t/read-shared-pairs.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > '(#1=(nil) #1) 10 | (#1=(nil) #1) 11 | 12 | > '#1=(nil . #1) 13 | #1=(nil . #1) 14 | 15 | > '#2=(nil . #2) 16 | #1=(nil . #1) 17 | 18 | > #1 19 | !ERROR: unknown-label 20 | 21 | > '(a #1) 22 | !ERROR: unknown-label 23 | 24 | > '#1=(4 5 6 . #1) 25 | #1=(4 5 6 . #1) 26 | 27 | > '#1=(hi there . #1) 28 | #1=(hi there . #1) 29 | 30 | -------------------------------------------------------------------------------- /t/reader-breakc.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | Just checking that we properly roundtrip some characters via 10 | the reader and the printer. 11 | 12 | > \) 13 | \) 14 | 15 | > \] 16 | \] 17 | 18 | Note that there's a space (0x20) after the backslash. 19 | 20 | > \ ; backslash space 21 | \sp 22 | 23 | -------------------------------------------------------------------------------- /t/reader-intrasymbol.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > 'a:b:c 10 | (compose a b c) 11 | 12 | > ':bar 13 | (compose bar) 14 | 15 | > ': 16 | (compose) 17 | 18 | > 'foo:0:bar 19 | (compose foo 0 bar) 20 | 21 | > '~n 22 | (compose no n) 23 | 24 | > 'a:~b:c 25 | (compose a (compose no b) c) 26 | 27 | > '~= 28 | (compose no =) 29 | 30 | > '~~z 31 | (compose no (compose no z)) 32 | 33 | > '~< 34 | (compose no <) 35 | 36 | > '~ 37 | no 38 | 39 | > '~~ 40 | (compose no no) 41 | 42 | > 'for|2 43 | (t for 2) 44 | 45 | > 'a.b 46 | (a b) 47 | 48 | > 'a!b 49 | (a (quote b)) 50 | 51 | > 'c|isa!cont 52 | (t c (isa (quote cont))) 53 | 54 | > '(id 2.x 3.x) 55 | (id (2 x) (3 x)) 56 | 57 | > 'a!b.c 58 | (a (quote b) c) 59 | 60 | > '!a 61 | (upon (quote a)) 62 | 63 | > (let x '(a . b) (map .x (list car cdr))) 64 | (a b) 65 | 66 | > 'x|~f:g!a 67 | (t x ((compose (compose no f) g) (quote a))) 68 | 69 | > inc.10 70 | 11 71 | 72 | > (is.0 0) 73 | t 74 | 75 | -------------------------------------------------------------------------------- /t/reverse-linked-list.bel: -------------------------------------------------------------------------------- 1 | (tem linked-list contents nil) 2 | 3 | (def prs-linked-list (lst) 4 | (prs "")) 5 | 6 | (def rev-linked-list (lst) 7 | (let last (rev-linked-node lst!contents nil) 8 | (set lst!contents last))) 9 | 10 | (def rev-linked-node (node prev) 11 | (if (no node) 12 | prev 13 | (let next (cdr node) ; remember next node 14 | (set (cdr node) prev) ; point backwards along list 15 | (rev-linked-node next node)))) ; recursively handle remainder 16 | 17 | (set lst (make linked-list contents '(1 2 3 4 5))) 18 | (rev-linked-list lst) 19 | (pr (prs-linked-list lst) \lf) 20 | -------------------------------------------------------------------------------- /t/rock-paper-scissors.bel: -------------------------------------------------------------------------------- 1 | (set moves '(rock paper scissors)) 2 | 3 | (def random-move () 4 | ((inc:rand:len moves) moves)) 5 | 6 | (def wins c 7 | (mem c '((rock scissors) (scissors paper) (paper rock)))) 8 | 9 | (set p1 (random-move) 10 | p2 (random-move)) 11 | 12 | (pr "Player 1: " p1 \lf 13 | "Player 2: " p2 \lf) 14 | 15 | (set result (if (wins p1 p2) "player 1 wins" 16 | (wins p2 p1) "player 2 wins" 17 | "it's a tie")) 18 | 19 | (pr "Result: " result \lf) 20 | 21 | -------------------------------------------------------------------------------- /t/string.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > "Bel" 10 | "Bel" 11 | 12 | > "" 13 | nil 14 | 15 | > (cons \s "tring") 16 | "string" 17 | 18 | > (cons \s \t \r \i \n \g nil) 19 | "string" 20 | 21 | > (cdr "max") 22 | "ax" 23 | 24 | > (cdr "\\") 25 | nil 26 | 27 | > (car "\"") 28 | \" 29 | 30 | > "\\" 31 | "\\" 32 | 33 | > "\"" 34 | "\"" 35 | 36 | -------------------------------------------------------------------------------- /t/templates.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > templates 10 | (lit tab) 11 | 12 | > (tem point x 0 y 0) 13 | ((x lit clo nil nil 0) (y lit clo nil nil 0)) 14 | 15 | > (make point) 16 | (lit tab (x . 0) (y . 0)) 17 | 18 | > (set p (make point x 1 y 5)) 19 | (lit tab (x . 1) (y . 5)) 20 | 21 | > p!x 22 | 1 23 | 24 | > (++ p!x) 25 | 2 26 | 27 | > p!x 28 | 2 29 | 30 | > (swap p!x p!y) 31 | !IGNORE: whatever it is `swap` returns 32 | 33 | > p 34 | (lit tab (x . 5) (y . 2)) 35 | 36 | > (set above (of > !y)) 37 | !IGNORE: result of assignment 38 | 39 | This example is from bellanguage.txt. 40 | 41 | > (with (p (make point y 1) 42 | q (make point x 1 y 5)) 43 | (above q p (make point))) 44 | t 45 | 46 | -------------------------------------------------------------------------------- /t/var-scope.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > scope 10 | nil 11 | 12 | > ((lit clo nil (x) scope) 'a) 13 | ((x . a)) 14 | 15 | -------------------------------------------------------------------------------- /t/virfns.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Language::Bel::Test::DSL; 6 | 7 | __DATA__ 8 | 9 | > (2 '(a b c)) 10 | b 11 | 12 | > (let arr (array '(3) 0) 13 | (arr 2)) 14 | 0 15 | 16 | > (let arr (array '(3) 'x) 17 | (arr 3)) 18 | x 19 | 20 | > (let arr (array '(2 2) 0) 21 | (arr 2 1)) 22 | 0 23 | 24 | > (let arr (array '(2 2) 'x) 25 | (arr 1 2)) 26 | x 27 | 28 | > (set tab (table '((a . 1) 29 | (b . 2)))) 30 | !IGNORE: result of assignment 31 | 32 | > (tab 'a) 33 | 1 34 | 35 | > (tab 'b) 36 | 2 37 | 38 | > (tab 'c) 39 | nil 40 | 41 | > (tab 'c 3) 42 | 3 43 | 44 | > (let tab (table '((x . 1) 45 | (x . 2))) 46 | (tab 'x)) 47 | 1 48 | 49 | > (push `(num . ,(fn (f args) ''haha)) 50 | virfns) 51 | !IGNORE: result of `push` 52 | 53 | > (2 '(a b c)) 54 | haha 55 | 56 | > (pop virfns) 57 | !IGNORE: result of `pop` 58 | 59 | > (2 '(a b c)) 60 | b 61 | 62 | --------------------------------------------------------------------------------