Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

[Shrdlu] de-bitrotted

- Can't assign to a variable that contains *
- Some rules really wanted to be tokens
- Nowadays (as per spec), >>~~<< needs parens around lhs and rhs
  • Loading branch information...
commit ad72e6fe90a6567e7d4c32023ce1b63b0eb0c471 1 parent 41e9df3
Carl Mäsak authored November 13, 2010

Showing 1 changed file with 18 additions and 23 deletions. Show diff stats Hide diff stats

  1. 41  lib/Shrdlu.pm
41  lib/Shrdlu.pm 100644 → 100755
... ...
@@ -1,30 +1,25 @@
1 1
 use v6;
2 2
 
3 3
 grammar Shrdlu::Language {
4  
-    rule TOP { ^ <order> $ }
  4
+    token TOP { ^ <order> $ }
5 5
 
6 6
     rule order { <pick_up> <noun_phrase> '.'? }
7 7
 
8  
-    rule pick_up { pick up | grasp }
  8
+    token pick_up { 'pick up' | grasp }
9 9
 
10  
-    rule noun_phrase { <article> <attribute>* <noun> }
  10
+    rule noun_phrase { <article> [<attribute> \h*]* <noun> }
11 11
 
12  
-    rule article { a | the }
13  
-    rule attribute { <color> | <size> }
14  
-    rule color { red }
15  
-    rule size { big }
16  
-    rule noun { block | pyramid }
  12
+    token article { a | the }
  13
+    token attribute { <color> | <size> }
  14
+    token color { red }
  15
+    token size { big }
  16
+    token noun { block | pyramid }
17 17
 }
18 18
 
19 19
 class Shrdlu::Object {
20 20
     has $.size;
21 21
     has $.shape;
22 22
     has $.color;
23  
-
24  
-    # RAKUDO: Possibly do this one better
25  
-    method new($size, $shape, $color) {
26  
-        self.bless(*, :$size, :$shape, :$color);
27  
-    }
28 23
 }
29 24
 
30 25
 class Shrdlu {
@@ -32,19 +27,17 @@ class Shrdlu {
32 27
     has @.reply;
33 28
 
34 29
     submethod BUILD() {
35  
-        given Shrdlu::Object {
36  
-            @!blocks =
37  
-                .new( |<big red block> ),
38  
-                .new( |<big red pyramid> ),
39  
-                .new( |<small green pyramid> ),
40  
-            ;
41  
-        }
  30
+        @!blocks =
  31
+            .new( :size<big>, :color<red>, :shape<block> ),
  32
+            .new( :size<big>, :color<red>, :shape<pyramid> ),
  33
+            .new( :size<small>, :color<green>, :shape<pyramid> )
  34
+                given Shrdlu::Object;
42 35
     }
43 36
 
44 37
     method tell(Str $sentence) {
45 38
         if Shrdlu::Language.parse($sentence.lc) {
46 39
             my @possible-objects;
47  
-            my ($desired-shape, $desired-size, $desired-color) = *, *, *;
  40
+            my ($desired-shape, $desired-size, $desired-color);
48 41
             given $<order><noun_phrase> {
49 42
                 $desired-shape = ~.<noun>;
50 43
                 if .<attribute> {
@@ -61,9 +54,11 @@ class Shrdlu {
61 54
                     }
62 55
                 }
63 56
             }
  57
+            $desired-color //= *;
  58
+            $desired-size  //= *;
64 59
             @possible-objects = grep {
65  
-                all(                .shape,         .size,         .color
66  
-                     >>~~<< $desired-shape, $desired-size, $desired-color )
  60
+                all(        (        .shape,         .size,         .color)
  61
+                     >>~~<< ($desired-shape, $desired-size, $desired-color) )
67 62
             }, @!blocks;
68 63
             @!reply = @possible-objects == 1
69 64
                         ?? 'OK.'

0 notes on commit ad72e6f

Please sign in to comment.
Something went wrong with that request. Please try again.