From 096670f0a7176abed88c2fabe824dd17f1a66b8a Mon Sep 17 00:00:00 2001 From: Tom Browder Date: Tue, 28 Aug 2018 15:55:20 -0500 Subject: [PATCH] add some more nqp examples --- examples/sub-lines2words.nqp | 27 +++++++++ examples/test-ws.nqp | 22 ++++++++ examples/use-classes.nqp | 103 +++++++++++++++++++++++++++++++++++ examples/use-hashes.nqp | 31 +++++++++++ 4 files changed, 183 insertions(+) create mode 100755 examples/sub-lines2words.nqp create mode 100755 examples/test-ws.nqp create mode 100755 examples/use-classes.nqp create mode 100755 examples/use-hashes.nqp diff --git a/examples/sub-lines2words.nqp b/examples/sub-lines2words.nqp new file mode 100755 index 0000000000..101b4bc329 --- /dev/null +++ b/examples/sub-lines2words.nqp @@ -0,0 +1,27 @@ +#!/usr/bin/env nqp + +# create a line => words splitting function +my $line := ' # one two '; + +say("\$line: '$line'"); + +my @w := words($line); + +say("'$line' => words"); +for @w { + say(" word: $_"); +} + +sub words($line) { + my @arr := nqp::split(' ', $line); + my @words := []; + for @arr { + my $s := $_; + # remove any whitespace + $s := subst($s, /\s+/, '', :global); + next if !$s; + @words.push($s); + } + + return @words; +} diff --git a/examples/test-ws.nqp b/examples/test-ws.nqp new file mode 100755 index 0000000000..55f24e49a3 --- /dev/null +++ b/examples/test-ws.nqp @@ -0,0 +1,22 @@ +#!/usr/bin/env nqp + +# test regexes for deleting and normalizing whitespace in text +# interspersed with comments +my $txt := 'blah # comment + # comment + + blah'; + +my $rx := / + + \h* + [ + | [\h* '#' \N* \n] + | [\h* \n] + ]* + \h* + /; + +my $s := subst($txt, $rx, ' '); +say("original text = '$txt'"); +say("new text = '$s'"); diff --git a/examples/use-classes.nqp b/examples/use-classes.nqp new file mode 100755 index 0000000000..3633a04ed1 --- /dev/null +++ b/examples/use-classes.nqp @@ -0,0 +1,103 @@ +#!/usr/bin/env nqp + +# based on blog post by Andrew Shitov: +# +# https://perl6.online/2018/01/09/what-does-nqpgetattr-do/ +# +# class C { +# has $.attr is rw; +# } +# +# my $o := nqp::create(C); +# $o.attr = 'other value'; +# nqp::say(nqp::getattr($o, C, '$!attr')); # other value + +class Foo { + has $!line; + has @!contents; + + method set-line($value) { + $!line := $value; + } + + method set-contents(@value) { + @!contents := @value; + } + + method add2contents($value) { + @!contents.push($value); + } + + method empty-contents() { + @!contents := []; + } + + # note the empty parens are required in the declaration + method show-line() { + say(" \$!line: '$!line'"); + } + + # note the empty parens are required in the declaration + method show-contents() { + say(" \@!contents:"); + if !nqp::elems(@!contents) { + say(" [empty]"); + return; + } + for @!contents { + say(" $_"); + } + } +} + +my $line1 := ' # text '; +my $line2 := ' text '; + +my $o1 := nqp::create(Foo); +$o1.set-line($line1); +my $o2 := nqp::create(Foo); +$o2.set-line($line2); + +my $L1 := nqp::getattr($o1, Foo, '$!line'); +my $L2 := nqp::getattr($o2, Foo, '$!line'); +say("\$o1.line: '$L1'"); +say("\$o2.line: '$L2'"); + +my @arr := nqp::list( + 'elem 0', + 'elem 1', +); + +$o1.set-contents(@arr); + +my @list := nqp::getattr($o1, Foo, '@!contents'); +say("\$o1's contents:"); +for @list { + say(" $_"); +} + +$o1.add2contents('another elem'); +@list := nqp::getattr($o1, Foo, '@!contents'); +say("\n\$o1's contents after an update:"); +for @list { + say(" $_"); +} + +$o1.empty-contents; +@list := nqp::getattr($o1, Foo, '@!contents'); +say("\n\$o1's contents after emptying:"); +if !nqp::elems(@list) { + say(" \$o1's \@contents are empty"); +} +else { + for @list { + say(" $_"); + } +} + +my $o3:= nqp::create(Foo); +$o3.set-contents(@arr); +$o3.set-line('line 3'); + +$o3.show-contents; +$o3.show-line; diff --git a/examples/use-hashes.nqp b/examples/use-hashes.nqp new file mode 100755 index 0000000000..b60eb2a8cc --- /dev/null +++ b/examples/use-hashes.nqp @@ -0,0 +1,31 @@ +#!/usr/bin/env nqp + +# create a hash +my %h := nqp::hash( + 'k1', 0, + 'k2', 1, +); + +# iterate over the hash +for %h { + my $k := nqp::iterkey_s($_); + my $v := nqp::iterval($_); + say("key $k => val $v"); +} + +my $k1 := 'k1'; +my $k2 := 'k2'; + +# return value of a key +my $v := nqp::atkey(%h, $k1); +say("value of key $k1 is $v"); + +# check existence of a key + +if nqp::existskey(%h, $k2) { + say("key $k2 exists"); +} + + + +