# New Ticket Created by Stephen Roe
# Please include the string: [perl #131997]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=131997 >
This is Rakudo version 2017.04.3 built on MoarVM version 2017.04-53-g66c6dda
implementing Perl 6.c.
As mentioned on IRC #perl6 today 16:50.
Apologies if this is down to newbie error - please do let me know if (& where)
I messed up!
This main
#!/usr/bin/env perl6
2 #main.p6
3 #SYNOPSIS WIP
4
5 use v6;
6 use lib 'lib';
7 use Physics::Measure;
8
9 my Distance $d .=new(value => 1e4, units => 'm');
10 my Distance $e .=new(value => 42, units => 'm');
11 my Distance $f .=new();
12
13 $f = $d + '42 m';
14 say $f.perl;
15 $f = $d + $e;
16 say $f.perl;
This module
#lib/Physics/Measure.pm
unit module Physics::Measure:ver<0.0.1>:auth<Steve Roe (s...@furnival.net)>;
our $debug = True;
class Measure is Real is export {
#Parent type for objects that each represent a physical scalar quantity
with value, units and error
#Builds a list of child types such as Distance, Mass, Power that can be
used directly in calculations
#(not to be confused with perl6 built-in Scalar type)
has Real $.value is rw;
has Str $.units is rw = 'm';
multi method new (Str:D $s) {
my ($v, $u) = self!extract($s);
self.bless(value => $v, units => $u);
}
multi method new (Real:D $r) {
self.bless(value => $r);
}
multi method new (Measure:D $m) {
self.bless(value => $m.value, units => $m.units);
}
method !extract (Str:D $string) { #baby Grammar to Unit class
$string ~~ /(^<[\+\-\.\_\deE]>+) \s+ (\D+)$/;
my Real $v = +($0); #cast to Real
my Str $u = $1.Str;
return( $v, $u );
}
method Str {
return $.value.Str ~ ' ' ~ $.units;
}
multi method assign (Str:D $right) {
my ($v, $u) = self!extract($right);
$.value = $v; $.units = $u;
}
multi method assign (Real:D $right) {
$.value = $right;
#.units not altered
}
multi method assign (Measure:D $right) {
$.value = $right.value;
$.units = $right.units;
}
method add (Measure:D $right) {
if ( $right.units eq $.units ) {
$.value += $right.value;
}
return self;
}
method subtract (Measure:D $right) {
my $diff = Measure.new();
if ( $right.units eq $.units ) {
$diff.units = $.units;
$diff.value = $.value - $right.value;
}
return $diff;
}
method multiply (Measure:D $right) {
my $prod = Measure.new();
if ( $right.units eq $.units ) {
$prod.units = $.units ~ $right.units;
$prod.value = $.value * $right.value;
}
return $prod;
}
method divide (Measure:D $right) {
my $frac = Measure.new();
if ( $right.units eq $.units ) {
$frac.units = $.units ~ '/' ~ $right.units;
$frac.value = $.value / $right.value;
}
return $frac;
}
}
class Distance is Measure is export {}
#assignment
multi sub infix:<⫶=> (Measure:D $left, $right) is equiv( &infix:<=> ) is export
{
$left.assign($right);
}
#declaration with default
multi sub infix:<⫶=> (Measure:U $left is rw, $right) is equiv( &infix:<=> ) {
$left .=new($right);
}
#`[[
#addition FIXME MM variant only needed due to suspected perl6 bug
multi sub infix:<+> (Measure:D $left, Measure:D $right) is equiv( &infix:<+> )
is export {
say "entering infix:<+> MM" if $debug;
my Measure $temp .=new($right);
$left.add($temp);
}
]]
multi sub infix:<+> (Measure:D $left, Any:D $right where Measure|Real|Str) is
equiv( &infix:<+> ) is export {
say "entering infix:<+> MA" if $debug;
my Measure $temp .=new($right);
$left.add($temp);
}
multi sub infix:<-> (Measure:D $left, Any:D $right where Measure|Real|Str) is
equiv( &infix:<-> ) is export {
my Distance $temp .= new: $right;
$left.subtract($temp);
}
~steve
s...@furnival.net
