Updates Blackjack example, adds extra type support.

10 files changed, 223 insertions, 62 deletions

diff --git a/data/examples/blackjack/cards.fate b/data/examples/blackjack/cards.fate
index e85bff6..6868650 100644
--- a/data/examples/blackjack/cards.fate
+++ b/data/examples/blackjack/cards.fate
@@ -8,7 +8,7 @@
 
 (local (lambda (list card) (string)) card_generator)
 
-(set card_generator
+(set! card_generator
    (lambda ( (string family) )
       (map
          (lambda
@@ -50,20 +50,20 @@
    (local int aces_count)
    (local int maybe_better_score)
 
-   (set (at result) 0)
+   (set! (at result) 0)
 
    (foreach (at deck) card
-      (set (at result) (+ card.score (at result)))
+      (set! (at result) (+ card.score (at result)))
       (if (= (var card.number) 1)
-         (set aces_count (+ aces_count 1))
+         (set! aces_count (+ aces_count 1))
       )
    )
 
    (while (> aces_count 0)
-      (set maybe_better_score (+ (at result) 10))
+      (set! maybe_better_score (+ (at result) 10))
       (if (=< maybe_better_score 21)
-         (set (at result) (var maybe_better_score))
+         (set! (at result) (var maybe_better_score))
       )
-      (set aces_count (- aces_count 1))
+      (set! aces_count (- aces_count 1))
    )
 )
diff --git a/data/examples/blackjack/global.fate b/data/examples/blackjack/global.fate
index a20704e..d08706b 100644
--- a/data/examples/blackjack/global.fate
+++ b/data/examples/blackjack/global.fate
@@ -6,7 +6,7 @@
 
 (global (lambda text (int)) coins_word)
 
-(set coins_word
+(set! coins_word
    (lambda ((int i))
       (if_else (= (var i) 1)
          (text a single coin)
@@ -18,7 +18,7 @@
 (declare_text_effect action_description)
 
 (define_sequence money_acquisition ((int amount))
-   (set player.money (+ player.money amount))
+   (set! player.money (+ player.money amount))
    (if (> amount 0)
       (text_effect action_description
          You acquired (eval coins_word (var amount))!
@@ -27,7 +27,7 @@
 )
 
 (define_sequence money_loss ((int amount))
-   (set player.money (- player.money amount))
+   (set! player.money (- player.money amount))
    (if (> amount 0)
       (text_effect action_description
          You lost (eval coins_word (var amount)).
diff --git a/data/examples/blackjack/main.fate b/data/examples/blackjack/main.fate
index 67b70b1..170ef29 100644
--- a/data/examples/blackjack/main.fate
+++ b/data/examples/blackjack/main.fate
@@ -8,38 +8,38 @@
 
 (local int original_amount)
 
-(set player.money 0)
+(set! player.money 0)
 
 Welcome to Tonkadur's wonderful and totally original blackjack!
 Say, I don't think I've seen you before...
 No, no, I am sure I haven't, actually.
-(prompt_string (ptr player.name) 1 64 What's your name, then?)
+(prompt_string! (ptr player.name) 1 64 What's your name, then?)
 Alright, (var player.name), well, since it's your first time here, let me give
 you some coins.
 Just between you and me, someone left those laying around, they aren't mine.
 
-(visit money_acquisition (+ 100 (rand 0 100)))
-(set original_amount (var player.money))
+(visit! money_acquisition (+ 100 (rand 0 100)))
+(set! original_amount (var player.money))
 
 Now, you're all set to go... unless you don't know how to play?
 
-(player_choice
+(player_choice!
    (option ( As it happens, I do not. )
-      (visit rules_of_blackjack)
+      (visit! rules_of_blackjack)
       (text_effect action_description
          You leave the counter and approach one of the tables.
       )
-      (visit play_a_game)
+      (visit! play_a_game)
    )
    (event (escape)
       You suddenly disappear.
-      (end)
+      (end!)
    )
    (option ( I am familiar with BlackJack. )
       (text_effect action_description
          You leave the counter and approach one of the tables.
       )
-      (visit play_a_game)
+      (visit! play_a_game)
    )
 )
 (text_effect action_description
@@ -76,4 +76,4 @@ Now, you're all set to go... unless you don't know how to play?
    (eval coins_word (var player.money)).
 )
 
-(end)
+(end!)
diff --git a/data/examples/blackjack/play.fate b/data/examples/blackjack/play.fate
index 81c7c58..c914b8f 100644
--- a/data/examples/blackjack/play.fate
+++ b/data/examples/blackjack/play.fate
@@ -10,7 +10,7 @@
 (global int bet)
 (global bool has_doubled)
 
-(set has_played (false))
+(set! has_played (false))
 
 (define_sequence play_a_game ()
    (local card new_card)
@@ -20,13 +20,13 @@
          Sitting yourself at a table, you see someone rushing to set up the
          cards and manage the game.
       )
-      (set has_played (true))
+      (set! has_played (true))
    )
    (if (= (var player.money) 0)
       I am sorry, (var player.name), but you appear to have ran out of coins.
-      (done)
+      (done!)
    )
-   (prompt_integer
+   (prompt_integer!
       (ptr bet)
       1
       (var player.money)
@@ -38,7 +38,7 @@
 
    (newline)
 
-   (set current_deck (shuffle deck_template))
+   (set! current_deck (shuffle deck_template))
 
    (pop_left! current_deck (ptr new_card))
    (add! (var new_card) player.hand)
@@ -74,26 +74,26 @@
       (newline)
    )
 
-   (visit initial_draw)
+   (visit! initial_draw)
 
-   (clear dealer_hand)
-   (clear player.hand)
+   (clear! dealer_hand)
+   (clear! player.hand)
 
    (newline)
    Interesting. Would you like to go again?
 
-   (player_choice
+   (player_choice!
       (option
          ( Yes, please. )
          Very well.
          (newline)
-         (jump_to play_a_game)
+         (jump_to! play_a_game)
       )
       (option
          ( No, thank you. )
          It was a pleasure to play with you. Farewell.
          (newline)
-         (done)
+         (done!)
       )
    )
 )
@@ -102,8 +102,8 @@
    (local int dealer_score)
    (local int player_score)
 
-   (visit compute_score (ptr dealer_hand) (ptr dealer_score))
-   (visit compute_score (ptr player.hand) (ptr player_score))
+   (visit! compute_score (ptr dealer_hand) (ptr dealer_score))
+   (visit! compute_score (ptr player.hand) (ptr player_score))
 
    (if (= (var dealer_score) 21)
       (text_effect action_description
@@ -127,7 +127,7 @@
             )
             (newline)
             Double Blackjack! A tie, then.
-            (done)
+            (done!)
          )
          (
             (text_effect action_description
@@ -135,8 +135,8 @@
             )
             (newline)
             Blackjack! Looks like I win, this time.
-            (visit money_loss (var bet))
-            (done)
+            (visit! money_loss (var bet))
+            (done!)
          )
       )
    )
@@ -148,26 +148,26 @@
       (newline)
       Blackjack! Looks like you win, this time.
       (newline)
-      (visit money_acquisition (cast int (* (cast float (var bet)) 1.5)))
-      (done)
+      (visit! money_acquisition (cast int (* (cast float (var bet)) 1.5)))
+      (done!)
    )
 
-   (player_choice
+   (player_choice!
       (option
          ( Another card, please. )
-         (set has_doubled (false))
-         (jump_to acquire_card)
+         (set! has_doubled (false))
+         (jump_to! acquire_card)
       )
       (option
          ( I will stand. )
-         (jump_to resolve_dealer)
+         (jump_to! resolve_dealer)
       )
       (if (and (>= player_score 9) (<= player_score 11))
          (option
             ( Double my bet, I'll only take one card. )
-            (set bet (* bet 2))
-            (set has_doubled (true))
-            (jump_to acquire_card)
+            (set! bet (* bet 2))
+            (set! has_doubled (true))
+            (jump_to! acquire_card)
          )
       )
    )
@@ -180,7 +180,7 @@
    (pop_left! current_deck (ptr new_card))
    (add! (var new_card) player.hand)
 
-   (visit compute_score (ptr player.hand) (ptr player_score))
+   (visit! compute_score (ptr player.hand) (ptr player_score))
 
    (text_effect action_description
       You have been dealt the (var new_card.name).
@@ -206,22 +206,22 @@
       (newline)
       A bust! What a shame...
       (newline)
-      (visit money_loss (var bet))
+      (visit! money_loss (var bet))
       (done)
    )
 
    (if (var has_doubled)
-      (jump_to resolve_dealer)
+      (jump_to! resolve_dealer)
    )
 
-   (player_choice
+   (player_choice!
       (option
          ( Another card, please. )
-         (jump_to acquire_card)
+         (jump_to! acquire_card)
       )
       (option
          ( This will do. I stand. )
-         (jump_to resolve_dealer)
+         (jump_to! resolve_dealer)
       )
    )
 )
@@ -229,7 +229,7 @@
 (define_sequence resolve_dealer ()
    (local int dealer_score)
    (local int player_score)
-   (visit compute_score (ptr dealer_hand) (ptr dealer_score))
+   (visit! compute_score (ptr dealer_hand) (ptr dealer_score))
 
    Very well. I shall now play my turn.
    (newline)
@@ -261,7 +261,7 @@
          (newline)
       )
 
-      (visit compute_score (ptr dealer_hand) (ptr dealer_score))
+      (visit! compute_score (ptr dealer_hand) (ptr dealer_score))
    )
 
    (if (> dealer_score 21)
@@ -271,11 +271,11 @@
       (newline)
       Ah. It would appear I have gone above the limit.
       (newline)
-      (visit money_acquisition (var bet))
-      (done)
+      (visit! money_acquisition (var bet))
+      (done!)
    )
 
-   (visit compute_score (ptr player.hand) (ptr player_score))
+   (visit! compute_score (ptr player.hand) (ptr player_score))
 
    (var player_score) for you, against (var dealer_score) for me.
 
@@ -283,21 +283,21 @@
 
    (if (= (var player_score) (var dealer_score))
       A tie, then.
-      (done)
+      (done!)
    )
 
    (if_else (> player_score dealer_score)
       (
          Congratulation, you won.
          (newline)
-         (visit money_acquisition (var bet))
-         (done)
+         (visit! money_acquisition (var bet))
+         (done!)
       )
       (
          It would appear I have won this game.
          (newline)
-         (visit money_loss (var bet))
-         (done)
+         (visit! money_loss (var bet))
+         (done!)
       )
    )
 )
diff --git a/src/core/src/tonkadur/fate/v1/lang/type/ExtraType.java b/src/core/src/tonkadur/fate/v1/lang/type/ExtraType.java
new file mode 100644
index 0000000..8c48380
--- /dev/null
+++ b/src/core/src/tonkadur/fate/v1/lang/type/ExtraType.java
@@ -0,0 +1,92 @@
+package tonkadur.fate.v1.lang.type;
+
+import tonkadur.parser.Origin;
+
+import tonkadur.fate.v1.lang.meta.DeclaredEntity;
+
+public class ExtraType extends Type
+{
+   /***************************************************************************/
+   /**** MEMBERS **************************************************************/
+   /***************************************************************************/
+
+   /***************************************************************************/
+   /**** PUBLIC ***************************************************************/
+   /***************************************************************************/
+
+   /**** Constructors *********************************************************/
+   public ExtraType
+   (
+      final Origin origin,
+      final String name
+   )
+   {
+      super(origin, null, name);
+   }
+
+   public ExtraType
+   (
+      final Origin origin,
+      final ExtraType parent,
+      final String name
+   )
+   {
+      super(origin, parent, name);
+   }
+
+   /**** Accessors ************************************************************/
+
+   /**** Compatibility ********************************************************/
+   @Override
+   public boolean can_be_used_as (final Type t)
+   {
+      if (t instanceof ExtraType)
+      {
+         final ExtraType e;
+
+         e = (ExtraType) t;
+
+         return get_base_type().get_name().equals(e.get_base_type().get_name());
+
+      }
+
+      return false;
+   }
+
+   /*
+    * This is for the very special case where a type is used despite not being
+    * even a sub-type of the expected one. Using this rather expensive function,
+    * the most restrictive shared type will be returned. If no such type exists,
+    * the ANY time is returned.
+    */
+   @Override
+   public DeclaredEntity generate_comparable_to (final DeclaredEntity de)
+   {
+      return Type.ANY;
+   }
+
+   @Override
+   public Type get_act_as_type ()
+   {
+      return get_base_type();
+   }
+
+   /**** Misc. ****************************************************************/
+
+   @Override
+   public Type generate_alias (final Origin origin, final String name)
+   {
+      return new ExtraType(origin, this, name);
+   }
+
+   @Override
+   public String toString ()
+   {
+      final StringBuilder sb = new StringBuilder();
+
+      sb.append("ExtraType::");
+      sb.append(name);
+
+      return sb.toString();
+   }
+}
diff --git a/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4 b/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4
index 7accac5..9c1cdb7 100644
--- a/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4
+++ b/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4
@@ -41,6 +41,7 @@ DECLARE_DICT_TYPE_KW: L_PAREN
    ('declare'|'define'|'def')US('dict'|('struct''ure'?))(US'type')? SEP+;
 DECLARE_EXTRA_INSTRUCTION_KW: L_PAREN ('declare'|'define'|'def')US'extra'US'instruction' SEP+;
 DECLARE_EXTRA_COMPUTATION_KW: L_PAREN ('declare'|'define'|'def')US'extra'US'computation' SEP+;
+DECLARE_EXTRA_TYPE_KW: L_PAREN ('declare'|'define'|'def')US'extra'US'type' SEP+;
 DECLARE_EVENT_TYPE_KW: L_PAREN ('declare'|'define'|'def')(US'input')?US'event'(US'type')? SEP+;
 DECLARE_TEXT_EFFECT_KW: L_PAREN ('declare'|'define'|'def')US'text'US'effect' SEP+;
 DECLARE_VARIABLE_KW: L_PAREN 'global' SEP+;
@@ -126,7 +127,7 @@ PUSH_LEFT_KW: L_PAREN 'push'US'left' SEP+;
 IMP_PUSH_LEFT_KW: L_PAREN 'push'US'left!' SEP+;
 PUSH_RIGHT_KW: L_PAREN 'push'US'right' SEP+;
 IMP_PUSH_RIGHT_KW: L_PAREN 'push'US'right!' SEP+;
-PLAYER_CHOICE_KW: L_PAREN ('choice'|'user'US'choice'|'player'US'choice') SEP+;
+PLAYER_CHOICE_KW: L_PAREN ('choice'|'user'US'choice'|'player'US'choice')'!' SEP+;
 TEXT_OPTION_KW: L_PAREN ('option'|'user'US'option'|'player'US'option') SEP+;
 EVENT_OPTION_KW: L_PAREN ('event'|'user'US'event'|'player'US'event') SEP+;
 PLUS_KW: L_PAREN ('plus'|'+') SEP+;
diff --git a/src/core/src/tonkadur/fate/v1/parser/FateParser.g4 b/src/core/src/tonkadur/fate/v1/parser/FateParser.g4
index 43b970c..1596104 100644
--- a/src/core/src/tonkadur/fate/v1/parser/FateParser.g4
+++ b/src/core/src/tonkadur/fate/v1/parser/FateParser.g4
@@ -357,6 +357,27 @@ first_level_fate_instr:
       WORLD.types().add(new_type);
    }
 
+   | DECLARE_EXTRA_TYPE_KW new_reference_name WS* R_PAREN
+   {
+      final Origin start_origin;
+
+      start_origin =
+         CONTEXT.get_origin_at
+         (
+            ($DECLARE_EXTRA_TYPE_KW.getLine()),
+            ($DECLARE_EXTRA_TYPE_KW.getCharPositionInLine())
+         );
+
+      WORLD.types().add
+      (
+         new ExtraType
+         (
+            start_origin,
+            ($new_reference_name.result)
+         )
+      );
+   }
+
    | DECLARE_EXTRA_INSTRUCTION_KW new_reference_name WS* R_PAREN
    {
       final Origin start_origin;
diff --git a/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/TypeCompiler.java b/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/TypeCompiler.java
index 572fa19..8dcd70d 100644
--- a/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/TypeCompiler.java
+++ b/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/TypeCompiler.java
@@ -73,6 +73,17 @@ public class TypeCompiler
          return Type.INT;
       }
 
+      if (fate_type instanceof tonkadur.fate.v1.lang.type.ExtraType)
+      {
+         final ExtraType result;
+
+         result = new ExtraType(fate_type.get_base_type().get_name());
+
+         compiler.world().add_extra_type(result);
+
+         return result;
+      }
+
       fate_type = fate_type.get_base_type();
 
       if (fate_type.equals(tonkadur.fate.v1.lang.type.Type.BOOL))
diff --git a/src/core/src/tonkadur/wyrd/v1/lang/World.java b/src/core/src/tonkadur/wyrd/v1/lang/World.java
index cd4bf70..e1316c6 100644
--- a/src/core/src/tonkadur/wyrd/v1/lang/World.java
+++ b/src/core/src/tonkadur/wyrd/v1/lang/World.java
@@ -11,6 +11,7 @@ import java.util.Set;
 import tonkadur.wyrd.v1.lang.Register;
 
 import tonkadur.wyrd.v1.lang.type.DictType;
+import tonkadur.wyrd.v1.lang.type.ExtraType;
 
 import tonkadur.wyrd.v1.lang.meta.Instruction;
 
@@ -24,6 +25,7 @@ public class World
 
    /* This solves the issue of using other yet undefined dict types. */
    protected final List<DictType> dict_types_in_order;
+   protected final Set<String> extra_types;
 
    protected final List<Instruction> code;
 
@@ -35,6 +37,7 @@ public class World
       sequence_labels = new HashMap<String, Integer>();
       dict_types = new HashMap<String, DictType>();
       dict_types_in_order = new ArrayList<DictType>();
+      extra_types = new HashSet<String>();
 
       code = new ArrayList<Instruction>();
    }
@@ -59,12 +62,22 @@ public class World
       return dict_types_in_order;
    }
 
+   public Set<String> get_extra_types ()
+   {
+      return extra_types;
+   }
+
    public void add_dict_type (final DictType dict_type)
    {
       dict_types.put(dict_type.get_name(), dict_type);
       dict_types_in_order.add(dict_type);
    }
 
+   public void add_extra_type (final ExtraType type)
+   {
+      extra_types.add(type.get_name());
+   }
+
    public Collection<Register> get_registers ()
    {
       return registers;
diff --git a/src/core/src/tonkadur/wyrd/v1/lang/type/ExtraType.java b/src/core/src/tonkadur/wyrd/v1/lang/type/ExtraType.java
new file mode 100644
index 0000000..58ce8b3
--- /dev/null
+++ b/src/core/src/tonkadur/wyrd/v1/lang/type/ExtraType.java
@@ -0,0 +1,23 @@
+package tonkadur.wyrd.v1.lang.type;
+
+public class ExtraType extends Type
+{
+   public ExtraType (final String name)
+   {
+      super(name);
+   }
+
+   @Override
+   public String toString ()
+   {
+      final StringBuilder sb;
+
+      sb = new StringBuilder();
+
+      sb.append("(ExtraType ");
+      sb.append(name);
+      sb.append(")");
+
+      return sb.toString();
+   }
+}