summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--data/unit-testing/merge.fate244
-rw-r--r--src/core/src/tonkadur/fate/v1/parser/FateLexer.g46
-rw-r--r--src/core/src/tonkadur/fate/v1/parser/FateParser.g436
-rw-r--r--src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/ComputationCompiler.java2
-rw-r--r--src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/InstructionCompiler.java14
5 files changed, 182 insertions, 120 deletions
diff --git a/data/unit-testing/merge.fate b/data/unit-testing/merge.fate
index 0bf7bca..13bdf83 100644
--- a/data/unit-testing/merge.fate
+++ b/data/unit-testing/merge.fate
@@ -4,15 +4,14 @@
(set test_name ( MERGE ))
+(local int i)
+(local int j)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; BASIC TEST 0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(global (list int) li0)
(global (list int) li1)
-(global (list int) li2)
-(global (list int) li3)
-
-(global (set int) si0)
-(global (set int) si1)
-(global (set int) si2)
-(global (set int) si3)
(set li0
(merge_to_list
@@ -42,127 +41,174 @@
(range 0 60 2)
)
-(set li2
- (map
- (lambda ((int i) (int mod)) (* i mod))
- (range 0 10 1)
- 2
- )
-)
-
-(set li3 (range 0 10 1))
-
-(map!
- (lambda ((int i) (int mod)) (* i mod))
- li3
- 2
-)
-
(assert
- (= (var li1) (var li0) (var li2) (var li3))
+ (= (var li1) (var li0))
[FAILED] (var test_name) Equality test 0.
)
-(assert
- (= 0 (var li1.0) (var li0.0))
- [FAILED] (var test_name) Test for 0: (var li1.0), (var li0.0).
+(for (set i 0) (=< i 30) (set i (+ i 1))
+ (assert
+ (= (access li1 i) (access li0 i) (- (+ 10 i) (* 2 i)))
+ [FAILED] (var test_name) Basic test 0, index (var i), values:
+ li0: (access li0 i);
+ li1: (access li1 i);
+ Expected: (- (+ 10 i) (* 2 i))
+ )
)
-(assert
- (= 2 (var li1.1) (var li0.1))
- [FAILED] (var test_name) Test for 2: (var li1.1), (var li0.1).
-)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; BASIC TEST 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(global (set int) si0)
+(global (set int) si1)
-(assert
- (= 4 (var li1.2) (var li0.2))
- [FAILED] (var test_name) Test for 4: (var li1.2), (var li0.2).
-)
-(assert
- (= 6 (var li1.3) (var li0.3))
- [FAILED] (var test_name) Test for 6: (var li1.3), (var li0.3).
-)
-(assert
- (= 8 (var li1.4) (var li0.4))
- [FAILED] (var test_name) Test for 8: (var li1.4), (var li0.4).
-)
-(assert
- (= 10 (var li1.5) (var li0.5))
- [FAILED] (var test_name) Test for 10: (var li1.5), (var li0.5).
-)
-(assert
- (= 12 (var li1.6) (var li0.6))
- [FAILED] (var test_name) Test for 12: (var li1.6), (var li0.6).
-)
-(assert
- (= 14 (var li1.7) (var li0.7))
- [FAILED] (var test_name) Test for 14: (var li1.7), (var li0.7).
-)
-(assert
- (= 16 (var li1.8) (var li0.8))
- [FAILED] (var test_name) Test for 16: (var li1.8), (var li0.8).
-)
-(assert
- (= 18 (var li1.9) (var li0.9))
- [FAILED] (var test_name) Test for 18: (var li1.9), (var li0.9).
-)
-(assert
- (= 20 (var li1.10) (var li0.10))
- [FAILED] (var test_name) Test for 20: (var li1.10), (var li0.10).
+(set si0
+ (merge_to_set
+ (lambda
+ (
+ (int a)
+ (int b)
+ )
+ (- a b)
+ )
+ (range 10 40 1)
+ (range 0 60 2)
+ )
)
-(clear li0)
-(clear li1)
-(clear li2)
-(clear li3)
+(add_all! (range 10 40 1) si1)
-(set li0
- (indexed_map
- (lambda ((int ix) (int i)) (+ (* i ix) 1000))
- (range 10 20 1)
+(merge!
+ (lambda
+ (
+ (int a)
+ (int b)
+ )
+ (- a b)
)
+ si1
+ (range 0 60 2)
)
-(set li1 (range 10 20 1))
+(assert
+ (= (var si1) (var si0))
+ [FAILED] (var test_name) Equality test 1.
+)
-(indexed_map!
- (lambda ((int ix) (int i)) (+ (* i ix) 1000))
- li1
+(for
+ (
+ (set i 0)
+ (set j 30)
+ )
+ (=< i 30)
+ (
+ (set i (+ i 1))
+ (set j (- j 1))
+ )
+ (assert
+ (= (access si1 i) (access si0 i) (- (+ 10 j) (* 2 j)))
+ [FAILED] (var test_name) Basic test 1, index (var i), values:
+ si0: (access si0 i);
+ si1: (access si1 i);
+ Expected: (- (+ 10 j) (* 2 j))
+ )
)
-(set li2
- (indexed_map
- (lambda ((int ix) (int i) (int mod)) (+ (* i ix) mod))
- (range 10 20 1)
- 1000
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; BASIC TEST 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(global (set int) si2)
+(global (set int) si3)
+
+(set si2
+ (merge_to_set
+ (lambda
+ (
+ (int a)
+ (int b)
+ (int mod)
+ )
+ (* (- a b) mod)
+ )
+ (range 10 40 1)
+ (range 0 60 2)
+ -1
)
)
-(set li3 (range 10 20 1))
+(add_all! (range 10 40 1) si3)
-(indexed_map!
- (lambda ((int ix) (int i) (int mod)) (+ (* i ix) mod))
- li3
- 1000
+(merge!
+ (lambda
+ (
+ (int a)
+ (int b)
+ (int mod)
+ )
+ (* (- a b) mod)
+ )
+ si3
+ (range 0 60 2)
+ -1
)
(assert
- (= (var li1) (var li0) (var li2) (var li3))
- [FAILED] (var test_name) Equality test 1.
+ (= (var si3) (var si2))
+ [FAILED] (var test_name) Equality test 0.
)
-(global int i)
-
-(for (set i 0) (=< i 10) (set i (+ i 1))
+(for
+ (
+ (set i 0)
+ (set j 30)
+ )
+ (=< i 30)
+ (
+ (set i (+ i 1))
+ (set j (- j 1))
+ )
(assert
- (=
- (access li1 i) (access li0 i) (access li2 i) (access li3 i)
- (+ (* i (+ 10 i)) 1000)
- )
- [FAILED] (var test_name) Indexed map at (var i):
- (access li1 i), (access li0 i), (access li2 i), (access li3 i)
+ (= (access si3 i) (access si2 i) (* (- (+ 10 i) (* 2 i)) -1))
+ [FAILED] (var test_name) Basic test 2, index (var i), values:
+ si2: (access si2 i);
+ si3: (access si3 i);
+ Expected: (* (- (+ 10 i) (* 2 i)) -1)
)
)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; BASIC TEST 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;(clear li0)
+;;(clear li1)
+;;
+;;(set li0
+;; (indexed_map
+;; (lambda ((int ix) (int i)) (+ (* i ix) 1000))
+;; (range 10 20 1)
+;; )
+;;)
+;;
+;;(set li1 (range 10 20 1))
+;;
+;;(indexed_map!
+;; (lambda ((int ix) (int i)) (+ (* i ix) 1000))
+;; li1
+;;)
+;;
+;;(for (set i 0) (=< i 10) (set i (+ i 1))
+;; (assert
+;; (=
+;; (access li1 i) (access li0 i) (access li2 i) (access li3 i)
+;; (+ (* i (+ 10 i)) 1000)
+;; )
+;; [FAILED] (var test_name) Indexed map at (var i):
+;; (access li1 i), (access li0 i), (access li2 i), (access li3 i)
+;; )
+;;)
+
[COMPLETED] (var test_name)
(end)
diff --git a/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4 b/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4
index c2ed078..10bb692 100644
--- a/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4
+++ b/src/core/src/tonkadur/fate/v1/parser/FateLexer.g4
@@ -98,6 +98,12 @@ INDEXED_MERGE_TO_LIST_KW : L_PAREN 'indexed'US'merge'US'to'US'list' SEP+;
INDEXED_MERGE_TO_SET_KW : L_PAREN 'indexed'US'merge'US'to'US'set' SEP+;
IMP_MERGE_KW : L_PAREN 'merge!' SEP+;
IMP_INDEXED_MERGE_KW : L_PAREN 'indexed'US'merge!' SEP+;
+SAFE_MERGE_TO_LIST_KW : L_PAREN 'safe'US'merge'US'to'US'list' SEP+;
+SAFE_MERGE_TO_SET_KW : L_PAREN 'safe'US'merge'US'to'US'set' SEP+;
+SAFE_INDEXED_MERGE_TO_LIST_KW : L_PAREN (('safe'US'indexed')|('indexed'US'safe'))US'merge'US'to'US'list' SEP+;
+SAFE_INDEXED_MERGE_TO_SET_KW : L_PAREN (('safe'US'indexed')|('indexed'US'safe'))US'merge'US'to'US'set' SEP+;
+SAFE_IMP_MERGE_KW : L_PAREN 'safe'US'merge!' SEP+;
+SAFE_IMP_INDEXED_MERGE_KW : L_PAREN (('indexed'US'safe')|('safe'US'indexed'))US'merge!' SEP+;
NEWLINE_KW: L_PAREN 'newline)';
NEW_KW: L_PAREN ('new'|'reserve'|'create') SEP+;
NOT_KW: L_PAREN ('not'|'~'|'!') SEP+;
diff --git a/src/core/src/tonkadur/fate/v1/parser/FateParser.g4 b/src/core/src/tonkadur/fate/v1/parser/FateParser.g4
index 2ea8bc4..4d791e3 100644
--- a/src/core/src/tonkadur/fate/v1/parser/FateParser.g4
+++ b/src/core/src/tonkadur/fate/v1/parser/FateParser.g4
@@ -1044,7 +1044,7 @@ returns [Instruction result]
);
}
- | IMP_MERGE_KW
+ | SAFE_IMP_MERGE_KW
fun=non_text_value WS+
def0=value WS+
value_reference WS+
@@ -1057,8 +1057,8 @@ returns [Instruction result]
(
CONTEXT.get_origin_at
(
- ($IMP_MERGE_KW.getLine()),
- ($IMP_MERGE_KW.getCharPositionInLine())
+ ($SAFE_IMP_MERGE_KW.getLine()),
+ ($SAFE_IMP_MERGE_KW.getCharPositionInLine())
),
($fun.result),
($value_reference.result),
@@ -1069,7 +1069,7 @@ returns [Instruction result]
);
}
- | IMP_MERGE_KW
+ | SAFE_IMP_MERGE_KW
fun=non_text_value WS+
def0=value WS+
value_reference WS+
@@ -1083,8 +1083,8 @@ returns [Instruction result]
(
CONTEXT.get_origin_at
(
- ($IMP_MERGE_KW.getLine()),
- ($IMP_MERGE_KW.getCharPositionInLine())
+ ($SAFE_IMP_MERGE_KW.getLine()),
+ ($SAFE_IMP_MERGE_KW.getCharPositionInLine())
),
($fun.result),
($value_reference.result),
@@ -4392,7 +4392,7 @@ returns [Computation result]
);
}
- | MERGE_TO_LIST_KW
+ | SAFE_MERGE_TO_LIST_KW
fun=non_text_value WS+
def0=value WS+
inv0=non_text_value WS+
@@ -4405,8 +4405,8 @@ returns [Computation result]
(
CONTEXT.get_origin_at
(
- ($MERGE_TO_LIST_KW.getLine()),
- ($MERGE_TO_LIST_KW.getCharPositionInLine())
+ ($SAFE_MERGE_TO_LIST_KW.getLine()),
+ ($SAFE_MERGE_TO_LIST_KW.getCharPositionInLine())
),
($fun.result),
($inv0.result),
@@ -4418,7 +4418,7 @@ returns [Computation result]
);
}
- | MERGE_TO_LIST_KW
+ | SAFE_MERGE_TO_LIST_KW
fun=non_text_value WS+
def0=value WS+
inv0=non_text_value WS+
@@ -4432,8 +4432,8 @@ returns [Computation result]
(
CONTEXT.get_origin_at
(
- ($MERGE_TO_LIST_KW.getLine()),
- ($MERGE_TO_LIST_KW.getCharPositionInLine())
+ ($SAFE_MERGE_TO_LIST_KW.getLine()),
+ ($SAFE_MERGE_TO_LIST_KW.getCharPositionInLine())
),
($fun.result),
($inv0.result),
@@ -4539,7 +4539,7 @@ returns [Computation result]
);
}
- | MERGE_TO_SET_KW
+ | SAFE_MERGE_TO_SET_KW
fun=non_text_value WS+
def0=value WS+
inv0=non_text_value WS+
@@ -4552,8 +4552,8 @@ returns [Computation result]
(
CONTEXT.get_origin_at
(
- ($MERGE_TO_SET_KW.getLine()),
- ($MERGE_TO_SET_KW.getCharPositionInLine())
+ ($SAFE_MERGE_TO_SET_KW.getLine()),
+ ($SAFE_MERGE_TO_SET_KW.getCharPositionInLine())
),
($fun.result),
($inv0.result),
@@ -4565,7 +4565,7 @@ returns [Computation result]
);
}
- | MERGE_TO_SET_KW
+ | SAFE_MERGE_TO_SET_KW
fun=non_text_value WS+
def0=value WS+
inv0=non_text_value WS+
@@ -4579,8 +4579,8 @@ returns [Computation result]
(
CONTEXT.get_origin_at
(
- ($MERGE_TO_SET_KW.getLine()),
- ($MERGE_TO_SET_KW.getCharPositionInLine())
+ ($SAFE_MERGE_TO_SET_KW.getLine()),
+ ($SAFE_MERGE_TO_SET_KW.getCharPositionInLine())
),
($fun.result),
($inv0.result),
diff --git a/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/ComputationCompiler.java b/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/ComputationCompiler.java
index 2587769..9fb288d 100644
--- a/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/ComputationCompiler.java
+++ b/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/ComputationCompiler.java
@@ -2951,7 +2951,7 @@ implements tonkadur.fate.v1.lang.meta.ComputationVisitor
)
throws Throwable
{
- if (n.get_default_a() == null)
+ if (n.get_default_a() != null)
{
visit_merge_with_defaults(n);
diff --git a/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/InstructionCompiler.java b/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/InstructionCompiler.java
index 147f2f1..2f82d3c 100644
--- a/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/InstructionCompiler.java
+++ b/src/core/src/tonkadur/wyrd/v1/compiler/fate/v1/InstructionCompiler.java
@@ -890,10 +890,9 @@ implements tonkadur.fate.v1.lang.meta.InstructionVisitor
)
throws Throwable
{
- /* TODO: handle default values. */
/* This is one dangerous operation to do in-place, so we don't. */
- if (n.get_default_a() == null)
+ if (n.get_default_a() != null)
{
visit_merge_with_defaults(n);
return;
@@ -938,6 +937,17 @@ implements tonkadur.fate.v1.lang.meta.InstructionVisitor
new SetValue(holder.get_address(), collection_cc.get_computation())
);
+ result.add
+ (
+ Clear.generate
+ (
+ compiler.registers(),
+ compiler.assembler(),
+ collection_cc.get_address()
+ )
+ );
+
+
in_collection_b_cc = new ComputationCompiler(compiler);
n.get_collection_in_b().get_visited_by(in_collection_b_cc);