on master help sign in
Merge branch 'master' into YuMingLiao-feature/arbitrary_tupleset

# Conflicts: # src/lib/ProjectM36/Attribute.hs # src/lib/ProjectM36/Base.hs

commit53bab2806412c99a722b0dd71287aa68a70c2706 authorAgentM <agentm@themactionfaction.com> dateFri 25 May 2018, 17:47 (8 years ago) parent8285a588827c0f
18 files changed+366−227
docs/tutd_tutorial.markdown+171−168 project-m36.cabal+1 src/bin/TutorialD/Interpreter/Base.hs+1−1 src/bin/TutorialD/Interpreter/RelationalExpr.hs−12 src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs+2−1 src/bin/TutorialD/Interpreter/Types.hs+21 src/lib/ProjectM36/AtomFunctionError.hs+1 src/lib/ProjectM36/AtomFunctions/Primitive.hs+9−1 src/lib/ProjectM36/AtomType.hs+46−16 src/lib/ProjectM36/Attribute.hs+3 src/lib/ProjectM36/AttributeExpr.hs+7 src/lib/ProjectM36/Base.hs+45−4 src/lib/ProjectM36/Client.hs+1−1 src/lib/ProjectM36/DataConstructorDef.hs+2−3 src/lib/ProjectM36/DataTypes/Day.hs+2−2 src/lib/ProjectM36/RelationalExpression.hs+16−9 src/lib/ProjectM36/TypeConstructor.hs+4−6 test/TutorialD/Interpreter.hs+34−3
docs/tutd_tutorial.markdown+171−168
@@ -20,14 +20,15 @@ TutorialD is strongly-typed. The basic built-in types are:
2020
2121|Type Name|Explanation|Example|
2222|---------|-----------|-------|
23−|text|arbitrary text|"The Old Man and the Sea"|
24−|int|any integer|-4|
25−|datetime|timestamp UTC|dateTimeFromEpochSeconds(1502304846)|
26−|date|calendar date|fromGregorian(2017,05,30)|
27−|double|floating point number|3.1459|
28−|bool|boolean value|t|
29−|bytestring|arbitrary-length string of bytes- input is base64-encoded|bytestring("dGVzdGRhdGE=")|
30−|interval x|interval/range type for ints, doubles, datetimes, and dates|interval(3,5,f,f)|
23+|Text|arbitrary text|"The Old Man and the Sea"|
24+|Integer|arbitarily-sized integer|-4|
25+|Int|machine word integer|int(10)|
26+|DateTime|timestamp UTC|dateTimeFromEpochSeconds(1502304846)|
27+|Date|calendar date|fromGregorian(2017,05,30)|
28+|Double|floating point number|3.1459|
29+|Bool|boolean value|t|
30+|Bytestring|arbitrary-length string of bytes- input is base64-encoded|bytestring("dGVzdGRhdGE=")|
31+|Interval x|interval/range type for ints, doubles, datetimes, and dates|interval(3,5,f,f)|
3132
3233With regards to boolean values, be sure not to conflate ```t``` or ```f``` as a boolean value with ```true``` and ```false``` which are relation variables.
3334
@@ -48,7 +49,7 @@ Relation Variables are named cells which reference relations within a transactio
4849
4950Definition of a relation variable:
5051```
51−products :: {name char, age int}
52+products :: {name Text, age Integer}
5253```
5354This expression creates a new relation variable in the current context which can refer to any relation with the header of "name" of type "char" and "age" of type int.
5455
@@ -151,15 +152,15 @@ The unary rename operator outputs a new relation with chosen attributes renamed.
151152
152153```
153154TutorialD (master/main): :showexpr s rename {city as town}
154−┌──┬─────┬──────┬──────┐
155−│s#│sname│status│town │
156−├──┼─────┼──────┼──────┤
157−│S3│Blake│30 │Paris │
158−│S4│Clark│20 │London│
159−│S5│Adams│30 │Athens│
160−│S1│Smith│20 │London│
161−│S2│Jones│10 │Paris │
162−└──┴─────┴──────┴──────┘
155+┌────────┬───────────┬───────────────┬──────────┐
156+│s#::Text│sname::Text│status::Integer│town::Text│
157+├────────┼───────────┼───────────────┼──────────┤
158+│"S3" │"Blake" │30 │"Paris" │
159+│"S4" │"Clark" │20 │"London" │
160+│"S5" │"Adams" │30 │"Athens" │
161+│"S1" │"Smith" │20 │"London" │
162+│"S2" │"Jones" │10 │"Paris" │
163+└────────┴───────────┴───────────────┴──────────┘
163164```
164165
165166#### Projection
@@ -170,14 +171,15 @@ For example:
170171
171172```
172173TutorialD (master/main): :showexpr p{color,city}
173−┌──────┬─────┐
174−│city │color│
175−├──────┼─────┤
176−│London│Red │
177−│Paris │Blue │
178−│Oslo │Blue │
179−│Paris │Green│
180−└──────┴─────┘
174+┌──────────┬───────────┐
175+│city::Text│color::Text│
176+├──────────┼───────────┤
177+│"London" │"Red" │
178+│"Paris" │"Green" │
179+│"Oslo" │"Blue" │
180+│"Paris" │"Blue" │
181+└──────────┴───────────┘
182+
181183```
182184
183185Projection attributes can also be inverted using `all but`:
@@ -217,22 +219,22 @@ Restriction is applied using a "where" clause, much like in SQL.
217219
218220```
219221TutorialD (master/main): :showexpr p where color="Blue" and city="Paris"
220−┌─────┬─────┬──┬─────┬──────┐
221−│city │color│p#│pname│weight│
222−├─────┼─────┼──┼─────┼──────┤
223−│Paris│Blue │P5│Cam │12 │
224−└─────┴─────┴──┴─────┴──────┘
222+┌──────────┬───────────┬────────┬───────────┬───────────────┐
223+│city::Text│color::Text│p#::Text│pname::Text│weight::Integer│
224+├──────────┼───────────┼────────┼───────────┼───────────────┤
225+│"Paris" │"Blue" │"P5" │"Cam" │12 │
226+└──────────┴───────────┴────────┴───────────┴───────────────┘
225227```
226228
227229The restriction predicate can be built from "and", "not", and "or". Boolean atom functions can also appear in a restriction as long as they are preceded by "^". For example:
228230
229231```
230232TutorialD (master/main): :showexpr s where ^lt(@status,20)
231−┌─────┬──┬─────┬──────┐
232−│city │s#│sname│status│
233−├─────┼──┼─────┼──────┤
234−│Paris│S2│Jones│10 │
235−└─────┴──┴─────┴──────┘
233+┌──────────┬────────┬───────────┬───────────────┐
234+│city::Text│s#::Text│sname::Text│status::Integer│
235+├──────────┼────────┼───────────┼───────────────┤
236+│"Paris" │"S2" │"Jones" │10 │
237+└──────────┴────────┴───────────┴───────────────┘
236238```
237239
238240#### Join
@@ -241,21 +243,22 @@ Joins are binary operators and are applied with the "join" keyword. The equivale
241243
242244```
243245TutorialD (master/main): :showexpr s join sp
244−┌──────┬──┬───┬──┬─────┬──────┐
245−│city │p#│QTY│s#│sname│status│
246−├──────┼──┼───┼──┼─────┼──────┤
247−│London│P6│100│S1│Smith│20 │
248−│London│P3│400│S1│Smith│20 │
249−│London│P5│400│S4│Clark│20 │
250−│London│P1│300│S1│Smith│20 │
251−│Paris │P2│200│S3│Blake│30 │
252−│Paris │P1│300│S2│Jones│10 │
253−│London│P5│100│S1│Smith│20 │
254−│London│P4│300│S4│Clark│20 │
255−│Paris │P2│400│S2│Jones│10 │
256−│London│P2│200│S1│Smith│20 │
257−│London│P4│200│S1│Smith│20 │
258−└──────┴──┴───┴──┴─────┴──────┘
246+┌──────────┬────────┬────────────┬────────┬───────────┬───────────────┐
247+│city::Text│p#::Text│qty::Integer│s#::Text│sname::Text│status::Integer│
248+├──────────┼────────┼────────────┼────────┼───────────┼───────────────┤
249+│"London" │"P2" │200 │"S1" │"Smith" │20 │
250+│"London" │"P6" │100 │"S1" │"Smith" │20 │
251+│"London" │"P3" │400 │"S1" │"Smith" │20 │
252+│"Paris" │"P2" │400 │"S2" │"Jones" │10 │
253+│"London" │"P5" │400 │"S4" │"Clark" │20 │
254+│"Paris" │"P1" │300 │"S2" │"Jones" │10 │
255+│"London" │"P1" │300 │"S1" │"Smith" │20 │
256+│"Paris" │"P2" │200 │"S3" │"Blake" │30 │
257+│"London" │"P4" │300 │"S4" │"Clark" │20 │
258+│"London" │"P2" │200 │"S4" │"Clark" │20 │
259+│"London" │"P4" │200 │"S1" │"Smith" │20 │
260+│"London" │"P5" │100 │"S1" │"Smith" │20 │
261+└──────────┴────────┴────────────┴────────┴───────────┴───────────────┘
259262```
260263
261264As a convenience, `tutd` also supports semijoin (`matching`) and antijoin (`not matching`) syntax.
@@ -269,16 +272,16 @@ As a convenience, `tutd` also supports semijoin (`matching`) and antijoin (`not
269272The binary union operator merges tuples from both relations if-and-only-if the attributes of both relations are identical. The SQL equivalent is the "UNION" operator. Unlike SQL, however, duplicate tuples are not tolerated, so there is no "UNION ALL" equivalent in the relational algebra.
270273
271274```
272−TutorialD (master/main): :showexpr S union S
273−┌──────┬──┬─────┬──────┐
274−│city │s#│sname│status│
275−├──────┼──┼─────┼──────┤
276−│Paris │S3│Blake│30 │
277−│London│S4│Clark│20 │
278−│Athens│S5│Adams│30 │
279−│London│S1│Smith│20 │
280−│Paris │S2│Jones│10 │
281−└──────┴──┴─────┴──────┘
275+TutorialD (master/main): :showexpr s union s
276+┌──────────┬────────┬───────────┬───────────────┐
277+│city::Text│s#::Text│sname::Text│status::Integer│
278+├──────────┼────────┼───────────┼───────────────┤
279+│"Paris" │"S3" │"Blake" │30 │
280+│"Athens" │"S5" │"Adams" │30 │
281+│"London" │"S1" │"Smith" │20 │
282+│"Paris" │"S2" │"Jones" │10 │
283+│"London" │"S4" │"Clark" │20 │
284+└──────────┴────────┴───────────┴───────────────┘
282285```
283286
284287The union of any relation with itself is itself.
@@ -289,15 +292,15 @@ The extend unary operator adds an attribute to a relation's header and body and
289292
290293```
291294TutorialD (master/main): :showexpr s:{status2:=add(10,@status)}
292−┌──────┬──┬─────┬──────┬───────┐
293−│city │s#│sname│status│status2│
294−├──────┼──┼─────┼──────┼───────┤
295−│Paris │S2│Jones│10 │20 │
296−│Athens│S5│Adams│30 │40 │
297−│Paris │S3│Blake│30 │40 │
298−│London│S1│Smith│20 │30 │
299−│London│S4│Clark│20 │30 │
300−└──────┴──┴─────┴──────┴───────┘
295+┌──────────┬────────┬───────────┬───────────────┬────────────────┐
296+│city::Text│s#::Text│sname::Text│status::Integer│status2::Integer│
297+├──────────┼────────┼───────────┼───────────────┼────────────────┤
298+│"Paris" │"S2" │"Jones" │10 │20 │
299+│"Athens" │"S5" │"Adams" │30 │40 │
300+│"London" │"S4" │"Clark" │20 │30 │
301+│"Paris" │"S3" │"Blake" │30 │40 │
302+│"London" │"S1" │"Smith" │20 │30 │
303+└──────────┴────────┴───────────┴───────────────┴────────────────┘
301304```
302305
303306The "@" is required in the above query in order to distinguish the attribute's name from a relation's name.
@@ -323,27 +326,27 @@ The group operator can also be used to emulate functionality similar to SQL's OU
323326
324327```
325328TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)
326−┌──────┬─────────────────┐
327−│city │subrel │
328−├──────┼─────────────────┤
329−│Athens│┌──┬─────┬──────┐│
330−│ ││s#│sname│status││
331−│ │├──┼─────┼──────┤│
332−│ ││S5│Adams│30 ││
333−│ │└──┴─────┴──────┘│
334−│London│┌──┬─────┬──────┐│
335−│ ││s#│sname│status││
336−│ │├──┼─────┼──────┤│
337−│ ││S1│Smith│20 ││
338−│ ││S4│Clark│20 ││
339−│ │└──┴─────┴──────┘│
340−│Paris │┌──┬─────┬──────┐│
341−│ ││s#│sname│status││
342−│ │├──┼─────┼──────┤│
343−│ ││S3│Blake│30 ││
344−│ ││S2│Jones│10 ││
345−│ │└──┴─────┴──────┘│
346−└──────┴─────────────────┘
329+┌──────────┬───────────────────────────────────────────────────────┐
330+│city::Text│subrel::relation {s#::Text,sname::Text,status::Integer}│
331+├──────────┼───────────────────────────────────────────────────────┤
332+│"Athens" │┌────────┬───────────┬───────────────┐ │
333+│ ││s#::Text│sname::Text│status::Integer│ │
334+│ │├────────┼───────────┼───────────────┤ │
335+│ ││"S5" │"Adams" │30 │ │
336+│ │└────────┴───────────┴───────────────┘ │
337+│"Paris" │┌────────┬───────────┬───────────────┐ │
338+│ ││s#::Text│sname::Text│status::Integer│ │
339+│ │├────────┼───────────┼───────────────┤ │
340+│ ││"S2" │"Jones" │10 │ │
341+│ ││"S3" │"Blake" │30 │ │
342+│ │└────────┴───────────┴───────────────┘ │
343+│"London" │┌────────┬───────────┬───────────────┐ │
344+│ ││s#::Text│sname::Text│status::Integer│ │
345+│ │├────────┼───────────┼───────────────┤ │
346+│ ││"S4" │"Clark" │20 │ │
347+│ ││"S1" │"Smith" │20 │ │
348+│ │└────────┴───────────┴───────────────┘ │
349+└──────────┴───────────────────────────────────────────────────────┘
347350```
348351
349352#### Ungroup
@@ -352,15 +355,15 @@ The unary ungroup operator "unwraps" subrelations in a relation-valued attribute
352355
353356```
354357TutorialD (master/main): :showexpr (s group ({sname,status,s#} as subrel)) ungroup subrel
355−┌──────┬──┬─────┬──────┐
356−│city │s#│sname│status│
357−├──────┼──┼─────┼──────┤
358−│Paris │S3│Blake│30 │
359−│London│S4│Clark│20 │
360−│Athens│S5│Adams│30 │
361−│London│S1│Smith│20 │
362−│Paris │S2│Jones│10 │
363−└──────┴──┴─────┴──────┘
358+┌──────────┬────────┬───────────┬───────────────┐
359+│city::Text│s#::Text│sname::Text│status::Integer│
360+├──────────┼────────┼───────────┼───────────────┤
361+│"Paris" │"S2" │"Jones" │10 │
362+│"Paris" │"S3" │"Blake" │30 │
363+│"London" │"S4" │"Clark" │20 │
364+│"London" │"S1" │"Smith" │20 │
365+│"Athens" │"S5" │"Adams" │30 │
366+└──────────┴────────┴───────────┴───────────────┘
364367```
365368
366369#### Minus
@@ -393,11 +396,11 @@ The relation variable assignment mentioned above certainly changes the state of
393396```
394397TutorialD (master/main): newrelvar:=relation{tuple{age 3}}
395398TutorialD (master/main): :showexpr newrelvar
396−┌───┐
397−│age│
398−├───┤
399−│3 │
400−└───┘
399+┌────────────┐
400+│age::Integer│
401+├────────────┤
402+│3 │
403+└────────────┘
401404```
402405
403406All further operators are convenience operators and could be implemented with simple assignment. SQL has no equivalent to relational assignment; instead, one must issue "CREATE TABLE" commands and insert rows into the resultant tables.
@@ -419,16 +422,16 @@ The insert operators accepts a relation variable and a relation of the same type
419422```
420423TutorialD (master/main): insert s relation{tuple{city "Boston",s# "S10",sname "Gonzalez",status 10}}
421424TutorialD (master/main): :showexpr s
422−┌──────┬───┬────────┬──────┐
423−│city │s# │sname │status│
424−├──────┼───┼────────┼──────┤
425−│Paris │S3 │Blake │30 │
426−│London│S4 │Clark │20 │
427−│Athens│S5 │Adams │30 │
428−│London│S1 │Smith │20 │
429−│Paris │S2 │Jones │10 │
430−│Boston│S10│Gonzalez│10 │
431−└──────┴───┴────────┴──────┘
425+┌──────────┬────────┬───────────┬───────────────┐
426+│city::Text│s#::Text│sname::Text│status::Integer│
427+├──────────┼────────┼───────────┼───────────────┤
428+│"Athens" │"S5" │"Adams" │30 │
429+│"Paris" │"S2" │"Jones" │10 │
430+│"Boston" │"S10" │"Gonzalez" │10 │
431+│"London" │"S4" │"Clark" │20 │
432+│"London" │"S1" │"Smith" │20 │
433+│"Paris" │"S3" │"Blake" │30 │
434+└──────────┴────────┴───────────┴───────────────┘
432435```
433436
434437This insertion operation is equivalent to:
@@ -443,15 +446,15 @@ The update operator accepts a relation argument and a predicate, optionally filt
443446```
444447TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")
445448TutorialD (master/main): :showexpr s
446−┌──────┬──┬──────────┬──────┐
447−│city │s#│sname │status│
448−├──────┼──┼──────────┼──────┤
449−│Paris │S3│Blake │30 │
450−│London│S1│Mr. Twenty│20 │
451−│Athens│S5│Adams │30 │
452−│Paris │S2│Jones │10 │
453−│London│S4│Mr. Twenty│20 │
454−└──────┴──┴──────────┴──────┘
449+┌──────────┬────────┬────────────┬───────────────┐
450+│city::Text│s#::Text│sname::Text │status::Integer│
451+├──────────┼────────┼────────────┼───────────────┤
452+│"Paris" │"S2" │"Jones" │10 │
453+│"London" │"S1" │"Mr. Twenty"│20 │
454+│"Paris" │"S3" │"Blake" │30 │
455+│"London" │"S4" │"Mr. Twenty"│20 │
456+│"Athens" │"S5" │"Adams" │30 │
457+└──────────┴────────┴────────────┴───────────────┘
455458```
456459
457460This is logically equivalent to:
@@ -459,15 +462,15 @@ This is logically equivalent to:
459462```
460463TutorialD (master/main): s:=(((s where status=20){city,s#,status}):{sname:="Mr. Twenty"}) union (s where not status=20)
461464TutorialD (master/main): :showexpr s
462−┌──────┬──┬──────────┬──────┐
463−│city │s#│sname │status│
464−├──────┼──┼──────────┼──────┤
465−│Paris │S3│Blake │30 │
466−│London│S1│Mr. Twenty│20 │
467−│Athens│S5│Adams │30 │
468−│Paris │S2│Jones │10 │
469−│London│S4│Mr. Twenty│20 │
470−└──────┴──┴──────────┴──────┘
465+┌──────────┬────────┬────────────┬───────────────┐
466+│city::Text│s#::Text│sname::Text │status::Integer│
467+├──────────┼────────┼────────────┼───────────────┤
468+│"Paris" │"S2" │"Jones" │10 │
469+│"London" │"S1" │"Mr. Twenty"│20 │
470+│"Paris" │"S3" │"Blake" │30 │
471+│"London" │"S4" │"Mr. Twenty"│20 │
472+│"Athens" │"S5" │"Adams" │30 │
473+└──────────┴────────┴────────────┴───────────────┘
471474```
472475
473476This query means: "Drop the sname attribute from S filtered where status equals 20, extend the resultant relation by sname with value 'Mr. Twenty', then union the resultant relation with S filtered by status not equaling 20, and assign that to S."
@@ -479,19 +482,19 @@ The delete operator accepts a relation argument and a filtering predicate, creat
479482```
480483TutorialD (master/main): delete sp where s#="S4"
481484TutorialD (master/main): :showexpr sp
482−┌──┬───┬──┐
483−│p#│QTY│s#│
484−├──┼───┼──┤
485−│P3│400│S1│
486−│P4│200│S1│
487−│P2│400│S2│
488−│P2│200│S1│
489−│P6│100│S1│
490−│P1│300│S1│
491−│P2│200│S3│
492−│P1│300│S2│
493−│P5│100│S1│
494−└──┴───┴──┘
485+┌────────┬────────────┬────────┐
486+│p#::Text│qty::Integer│s#::Text│
487+├────────┼────────────┼────────┤
488+│"P2" │200 │"S3" │
489+│"P2" │400 │"S2" │
490+│"P1" │300 │"S1" │
491+│"P5" │100 │"S1" │
492+│"P4" │200 │"S1" │
493+│"P1" │300 │"S2" │
494+│"P3" │400 │"S1" │
495+│"P2" │200 │"S1" │
496+│"P6" │100 │"S1" │
497+└────────┴────────────┴────────┘
495498```
496499
497500This is logically equivalent to:
@@ -526,7 +529,7 @@ Foreign keys are constraints which require that certain values appearing in one
526529TutorialD (master/main): foreign key s#_in_sp sp{s#} in s{s#}
527530```
528531
529−This expression ensure that any sp{s#} must also appear as a value in s{s#}. Note that the sub-expression (on the left of "in") and the super-expression (on the right) must be of the same relation type- the generated relation values' attribute names and types must be equal. Use `rename` to make attribute names identical.
532+This expression ensure that any sp{s#} must also appear as a value in s{s#}. Note that the sub-expression (on the left of "in") and the super-expression (on the right) must be of the same relation type- the generated relation values' attribute names and types must be equal. Use `rename` to make attribute names identical.
530533
531534#### Functional dependencies
532535
@@ -560,27 +563,27 @@ SQL supports aggregate queries using aggregate functions (SUM(), COUNT(), AVERAG
560563
561564```
562565TutorialD (master/main): :showexpr s group ({s#,sname,status} as subrel):{citycount:=count(@subrel)}
563−┌──────┬─────────┬─────────────────┐
564−│city │citycount│subrel │
565−├──────┼─────────┼─────────────────┤
566−│Paris │2 │┌──┬─────┬──────┐│
567−│ │ ││s#│sname│status││
568−│ │ │├──┼─────┼──────┤│
569−│ │ ││S3│Blake│30 ││
570−│ │ ││S2│Jones│10 ││
571−│ │ │└──┴─────┴──────┘│
572−│London│2 │┌──┬─────┬──────┐│
573−│ │ ││s#│sname│status││
574−│ │ │├──┼─────┼──────┤│
575−│ │ ││S1│Smith│20 ││
576−│ │ ││S4│Clark│20 ││
577−│ │ │└──┴─────┴──────┘│
578−│Athens│1 │┌──┬─────┬──────┐│
579−│ │ ││s#│sname│status││
580−│ │ │├──┼─────┼──────┤│
581−│ │ ││S5│Adams│30 ││
582−│ │ │└──┴─────┴──────┘│
583−└──────┴─────────┴─────────────────┘
566+┌──────────┬──────────────────┬───────────────────────────────────────────────────────┐
567+│city::Text│citycount::Integer│subrel::relation {s#::Text,sname::Text,status::Integer}│
568+├──────────┼──────────────────┼───────────────────────────────────────────────────────┤
569+│"Athens" │1 │┌────────┬───────────┬───────────────┐ │
570+│ │ ││s#::Text│sname::Text│status::Integer│ │
571+│ │ │├────────┼───────────┼───────────────┤ │
572+│ │ ││"S5" │"Adams" │30 │ │
573+│ │ │└────────┴───────────┴───────────────┘ │
574+│"Paris" │2 │┌────────┬───────────┬───────────────┐ │
575+│ │ ││s#::Text│sname::Text│status::Integer│ │
576+│ │ │├────────┼───────────┼───────────────┤ │
577+│ │ ││"S2" │"Jones" │10 │ │
578+│ │ ││"S3" │"Blake" │30 │ │
579+│ │ │└────────┴───────────┴───────────────┘ │
580+│"London" │2 │┌────────┬───────────┬───────────────┐ │
581+│ │ ││s#::Text│sname::Text│status::Integer│ │
582+│ │ │├────────┼───────────┼───────────────┤ │
583+│ │ ││"S4" │"Clark" │20 │ │
584+│ │ ││"S1" │"Smith" │20 │ │
585+│ │ │└────────┴───────────┴───────────────┘ │
586+└──────────┴──────────────────┴───────────────────────────────────────────────────────┘
584587```
585588
586589In this query result, we can simultaneously answer how many suppliers are located in each city and which suppliers they are. The expression is constructed by first grouping to isolate the city, then extending the query to add a attribute containing the tuple count for each subrelation.
project-m36.cabal+1
@@ -126,6 +126,7 @@ Library
126126 ProjectM36.Client.Simple,
127127 ProjectM36.Persist,
128128 ProjectM36.AtomType,
129+ ProjectM36.AttributeExpr,
129130 ProjectM36.AtomFunctions.Basic,
130131 ProjectM36.AtomFunctions.Primitive,
131132 ProjectM36.Atomable,
src/bin/TutorialD/Interpreter/Base.hs+1−1
@@ -94,7 +94,7 @@ whiteSpace = Token.whiteSpace lexer
9494-}
9595
9696integer :: Parser Integer
97−integer = Lex.integer
97+integer = Lex.signed spaceConsumer Lex.integer
9898
9999float :: Parser Double
100100float = Lex.float
src/bin/TutorialD/Interpreter/RelationalExpr.hs−12
@@ -11,12 +11,6 @@ import qualified Data.Map as M
1111import Data.List (sort)
1212import ProjectM36.MiscUtils
1313
14−class RelationalMarkerExpr a where
15− parseMarkerP :: Parser a
16−
17−instance RelationalMarkerExpr () where
18− parseMarkerP = pure ()
19−
2014--used in projection
2115attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)
2216attributeListP =
@@ -33,12 +27,6 @@ makeRelationP = do
3327 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []
3428 pure $ MakeRelationFromExprs attrExprs tupleExprs
3529
36−--used in relation creation
37−makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]
38−makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)
39−
40−attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)
41−attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP
4230
4331--abstract data type parser- in this context, the type constructor must not include any type arguments
4432--Either Text Int
src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs+2−1
@@ -3,6 +3,7 @@
33module TutorialD.Interpreter.TransGraphRelationalOperator where
44import ProjectM36.TransGraphRelationalExpression
55import ProjectM36.TransactionGraph
6+import TutorialD.Interpreter.Types
67import qualified ProjectM36.Client as C
78
89import TutorialD.Interpreter.Base
@@ -15,7 +16,7 @@ import qualified Data.Text as T
1516
1617instance RelationalMarkerExpr TransactionIdLookup where
1718 parseMarkerP = string "@" *> transactionIdLookupP
18−
19+
1920newtype TransGraphRelationalOperator = ShowTransGraphRelation TransGraphRelationalExpr
2021 deriving Show
2122
src/bin/TutorialD/Interpreter/Types.hs+21
@@ -7,6 +7,12 @@ import TutorialD.Interpreter.Base
77import ProjectM36.DataTypes.Primitive
88import qualified Data.Text as T
99
10+class RelationalMarkerExpr a where
11+ parseMarkerP :: Parser a
12+
13+instance RelationalMarkerExpr () where
14+ parseMarkerP = pure ()
15+
1016-- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments.
1117-- data *Either a b* = Left a | Right b
1218typeConstructorDefP :: Parser TypeConstructorDef
@@ -33,9 +39,24 @@ primitiveTypeConstructorP = choice (map (\(PrimitiveTypeConstructorDef name typ,
3339 pure $ PrimitiveTypeConstructor tName typ)
3440 primitiveTypeConstructorMapping)
3541
42+-- relation{a Int} in type construction (no tuples parsed)
43+relationTypeConstructorP :: Parser TypeConstructor
44+relationTypeConstructorP = do
45+ reserved "relation"
46+ RelationAtomTypeConstructor <$> makeAttributeExprsP
47+
48+--used in relation creation
49+makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]
50+makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)
51+
52+attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)
53+attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP
54+
55+
3656-- *Either Int Text*, *Int*
3757typeConstructorP :: Parser TypeConstructor
3858typeConstructorP = primitiveTypeConstructorP <|>
59+ relationTypeConstructorP <|>
3960 TypeVariable <$> uncapitalizedIdentifier <|>
4061 ADTypeConstructor <$> capitalizedIdentifier <*> many (parens typeConstructorP <|>
4162 monoTypeConstructorP)
src/lib/ProjectM36/AtomFunctionError.hs+1
@@ -9,6 +9,7 @@ data AtomFunctionError = AtomFunctionUserError String |
99 AtomFunctionTypeMismatchError |
1010 InvalidIntervalOrderingError |
1111 InvalidIntervalBoundariesError |
12+ InvalidIntBoundError |
1213 AtomFunctionEmptyRelationError |
1314 AtomTypeDoesNotSupportOrderingError Text |
1415 AtomTypeDoesNotSupportIntervalError Text |
src/lib/ProjectM36/AtomFunctions/Primitive.hs+9−1
@@ -43,7 +43,15 @@ primitiveAtomFunctions = HS.fromList [
4343 atomFuncBody = body $ integerAtomFuncLessThan True >=> boolAtomNot},
4444 AtomFunction { atomFuncName = "not",
4545 atomFuncType = [BoolAtomType, BoolAtomType],
46− atomFuncBody = body $ \(b:_) -> boolAtomNot b }
46+ atomFuncBody = body $ \(b:_) -> boolAtomNot b },
47+ AtomFunction { atomFuncName = "int",
48+ atomFuncType = [IntegerAtomType, IntAtomType],
49+ atomFuncBody = body $ \(IntegerAtom v:_) -> if v < fromIntegral (maxBound :: Int) then
50+ pure (IntAtom (fromIntegral v))
51+ else
52+ Left InvalidIntBoundError
53+ }
54+
4755 ]
4856 where
4957 body = AtomFunctionBody Nothing
src/lib/ProjectM36/AtomType.hs+46−16
@@ -6,6 +6,7 @@ import qualified ProjectM36.DataConstructorDef as DCD
66import ProjectM36.MiscUtils
77import ProjectM36.Error
88import ProjectM36.DataTypes.Primitive
9+import ProjectM36.AttributeExpr as AE
910import qualified ProjectM36.Attribute as A
1011import qualified Data.Vector as V
1112import qualified Data.Set as S
@@ -41,22 +42,12 @@ atomTypeForDataConstructorName dConsName atomTypesIn tConsList =
4142 ConstructedAtomType (TCD.name tCons) <$> resolveDataConstructorTypeVars dCons atomTypesIn tConsList
4243
4344atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType
44−atomTypeForDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) aType tConss =
45− case isValidAtomTypeForTypeConstructor aType tCons tConss of
46− Just err -> Left err
47− Nothing -> Right aType
45+atomTypeForDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) aType tConss = do
46+ isValidAtomTypeForTypeConstructor aType tCons tConss
47+ pure aType
4848
4949atomTypeForDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) aType _ = Right aType --any type is OK
5050
51−--reconcile the atom-in types with the type constructors
52−isValidAtomTypeForTypeConstructor :: AtomType -> TypeConstructor -> TypeConstructorMapping -> Maybe RelationalError
53−isValidAtomTypeForTypeConstructor aType (PrimitiveTypeConstructor _ expectedAType) _ = if expectedAType /= aType then Just (AtomTypeMismatchError expectedAType aType) else Nothing
54−
55−--lookup constructor name and check if the incoming atom types are valid
56−isValidAtomTypeForTypeConstructor (ConstructedAtomType tConsName _) (ADTypeConstructor expectedTConsName _) _ = if tConsName /= expectedTConsName then Just (TypeConstructorNameMismatch expectedTConsName tConsName) else Nothing
57−
58−isValidAtomTypeForTypeConstructor aType tCons _ = Just (AtomTypeTypeConstructorReconciliationError aType (TC.name tCons))
59−
6051-- | Used to determine if the atom arguments can be used with the data constructor.
6152-- | This is the entry point for type-checking from RelationalExpression.hs.
6253atomTypeForDataConstructor :: TypeConstructorMapping -> DataConstructorName -> [AtomType] -> Either RelationalError AtomType
@@ -116,6 +107,17 @@ resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) (ConstructedAtomT
116107 Left (TypeConstructorTypeVarsMismatch expectedPVarNames (M.keysSet pVarMap'))
117108resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = Right (M.singleton tvName typ)
118109resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) typ _ = Left (TypeConstructorAtomTypeMismatch tConsName typ)
110+resolveTypeConstructorTypeVars (RelationAtomTypeConstructor attrExprs) typ tConsMap =
111+ case typ of
112+ RelationAtomType attrs ->
113+ --resolve any typevars in the attrExprs
114+ M.unions <$> mapM (\(expectedAtomType, attrExpr) -> resolveAttributeExprTypeVars attrExpr expectedAtomType tConsMap) (zip (A.atomTypesList attrs) attrExprs)
115+ otherType -> Left (AtomTypeMismatchError typ otherType)
116+
117+--used when recursing down sub-relation type definition
118+resolveAttributeExprTypeVars :: AttributeExprBase a -> AtomType -> TypeConstructorMapping -> Either RelationalError TypeVarMap
119+resolveAttributeExprTypeVars (NakedAttributeExpr attr) aType _ = pure $ resolveTypeVariable (A.atomType attr) aType
120+resolveAttributeExprTypeVars (AttributeAndTypeNameExpr _ tCons _) aType tConsMap = resolveTypeConstructorTypeVars tCons aType tConsMap
119121
120122-- check that type vars on the right also appear on the left
121123-- check that the data constructor names are unique
@@ -137,6 +139,10 @@ atomTypeForTypeConstructor (PrimitiveTypeConstructor _ aType) _ _ = Right aType
137139atomTypeForTypeConstructor (TypeVariable tvname) _ tvMap = case M.lookup tvname tvMap of
138140 Nothing -> Right (TypeVariableType tvname)
139141 Just typ -> Right typ
142+atomTypeForTypeConstructor (RelationAtomTypeConstructor attrExprs) tConsMap tvMap = do
143+ resolvedAtomTypes <- mapM (\expr -> atomTypeForAttributeExpr expr tConsMap tvMap) attrExprs
144+ let attrs = zipWith Attribute (map AE.attributeName attrExprs) resolvedAtomTypes
145+ pure (RelationAtomType (A.attributesFromList attrs))
140146atomTypeForTypeConstructor tCons tConss tvMap = case findTypeConstructor (TC.name tCons) tConss of
141147 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))
142148 Just (tConsDef, _) -> do
@@ -144,6 +150,23 @@ atomTypeForTypeConstructor tCons tConss tvMap = case findTypeConstructor (TC.nam
144150 let pVarNames = TCD.typeVars tConsDef
145151 tConsArgs = M.fromList (zip pVarNames tConsArgTypes)
146152 Right (ConstructedAtomType (TC.name tCons) tConsArgs)
153+
154+atomTypeForAttributeExpr :: AttributeExprBase a -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType
155+atomTypeForAttributeExpr (NakedAttributeExpr attr) _ _ = pure (A.atomType attr)
156+atomTypeForAttributeExpr (AttributeAndTypeNameExpr _ tCons _) tConsMap tvMap = atomTypeForTypeConstructor tCons tConsMap tvMap
157+
158+--reconcile the atom-in types with the type constructors
159+isValidAtomTypeForTypeConstructor :: AtomType -> TypeConstructor -> TypeConstructorMapping -> Either RelationalError ()
160+isValidAtomTypeForTypeConstructor aType (PrimitiveTypeConstructor _ expectedAType) _ = if expectedAType /= aType then Left (AtomTypeMismatchError expectedAType aType) else pure ()
161+
162+--lookup constructor name and check if the incoming atom types are valid
163+isValidAtomTypeForTypeConstructor (ConstructedAtomType tConsName _) (ADTypeConstructor expectedTConsName _) _ = if tConsName /= expectedTConsName then Left (TypeConstructorNameMismatch expectedTConsName tConsName) else pure ()
164+
165+isValidAtomTypeForTypeConstructor (RelationAtomType attrs) (RelationAtomTypeConstructor attrExprs) tConsMap = do
166+ evaldAtomTypes <- mapM (\expr -> atomTypeForAttributeExpr expr tConsMap M.empty) attrExprs
167+ mapM_ (uncurry resolveAtomType) (zip (map A.atomType (V.toList attrs)) evaldAtomTypes)
168+ pure ()
169+isValidAtomTypeForTypeConstructor aType tCons _ = Left (AtomTypeTypeConstructorReconciliationError aType (TC.name tCons))
147170
148171findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])
149172findTypeConstructor name = foldr tConsFolder Nothing
@@ -161,7 +184,7 @@ resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresol
161184 else
162185 Left (AtomTypeMismatchError typeFromRelation unresolvedType)
163186
164−-- this could be optimized to reduce new tuple creation- if anyatomtype does not appear, just return the original typevarmap
187+-- this could be optimized to reduce new tuple creation
165188resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap
166189resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do
167190 {-
@@ -215,8 +238,13 @@ validateAtomType typ@(ConstructedAtomType tConsName tVarMap) tConss =
215238 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames
216239 else
217240 Right ()
218− _ -> Right ()
219−validateAtomType _ _ = Right ()
241+ _ -> Right ()
242+validateAtomType (RelationAtomType attrs) tConss = do
243+ mapM_ (\attr ->
244+ validateAtomType (A.atomType attr) tConss) (V.toList attrs)
245+ pure ()
246+validateAtomType (TypeVariableType x) _ = Left (TypeConstructorTypeVarMissing x)
247+validateAtomType _ _ = pure ()
220248
221249validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()
222250validateTuple (RelationTuple _ atoms) tConss = mapM_ (\a -> validateAtomType (atomTypeForAtom a) tConss) atoms
@@ -307,3 +335,5 @@ resolvedAtomTypeForDataConstructorDefArg tConsMap tvMap (DataConstructorDefTypeC
307335resolvedAtomTypeForDataConstructorDefArg _ tvMap (DataConstructorDefTypeVarNameArg tvName) = case M.lookup tvName tvMap of
308336 Nothing -> Left (DataConstructorUsesUndeclaredTypeVariable tvName)
309337 Just typ -> Right typ
338+
339+
src/lib/ProjectM36/Attribute.hs+3
@@ -29,6 +29,9 @@ atomType (Attribute _ atype) = atype
2929atomTypes :: Attributes -> V.Vector AtomType
3030atomTypes = V.map atomType
3131
32+atomTypesList :: Attributes -> [AtomType]
33+atomTypesList = V.toList . atomTypes
34+
3235--hm- no error-checking here
3336addAttribute :: Attribute -> Attributes -> Attributes
3437addAttribute attr attrs = attrs `V.snoc` attr
src/lib/ProjectM36/AttributeExpr.hsnew file+7
@@ -0,0 +1,7 @@
1+module ProjectM36.AttributeExpr where
2+import ProjectM36.Base
3+import ProjectM36.Attribute as A
4+
5+attributeName :: AttributeExprBase a -> AttributeName
6+attributeName (AttributeAndTypeNameExpr nam _ _) = nam
7+attributeName (NakedAttributeExpr attr) = A.attributeName attr
src/lib/ProjectM36/Base.hs+45−4
@@ -248,9 +248,11 @@ data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName]
248248 deriving (Show, Generic, Binary, Eq, NFData)
249249
250250-- | Found in data constructors and type declarations: Left (Either Int Text) | Right Int
251−data TypeConstructor = ADTypeConstructor TypeConstructorName [TypeConstructor] |
252− PrimitiveTypeConstructor TypeConstructorName AtomType |
253− TypeVariable TypeVarName
251+type TypeConstructor = TypeConstructorBase ()
252+data TypeConstructorBase a = ADTypeConstructor TypeConstructorName [TypeConstructor] |
253+ PrimitiveTypeConstructor TypeConstructorName AtomType |
254+ RelationAtomTypeConstructor [AttributeExprBase a] |
255+ TypeVariable TypeVarName
254256 deriving (Show, Generic, Binary, Eq, NFData)
255257
256258type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]
@@ -539,7 +541,6 @@ instance Hashable DatabaseContextFunction where
539541instance Eq DatabaseContextFunction where
540542 f1 == f2 = dbcFuncName f1 == dbcFuncName f2
541543
542−
543544-- for creating arbitrary tuples
544545instance Arbitrary Text where
545546 arbitrary = pack <$> elements ["Mary", "Johnny", "Sunny", "Ted"]
@@ -610,3 +611,43 @@ arbitrary' _ = undefined
610611
611612getAtomType :: Attribute -> AtomType
612613getAtomType (Attribute _ atomType) = atomType
614+
615+attrTypeVars :: Attribute -> S.Set TypeVarName
616+attrTypeVars (Attribute _ aType) = case aType of
617+ IntAtomType -> S.empty
618+ IntegerAtomType -> S.empty
619+ DoubleAtomType -> S.empty
620+ TextAtomType -> S.empty
621+ DayAtomType -> S.empty
622+ DateTimeAtomType -> S.empty
623+ ByteStringAtomType -> S.empty
624+ BoolAtomType -> S.empty
625+ (IntervalAtomType atomtyp) -> atomTypeVars atomtyp
626+ (RelationAtomType attrs) -> S.unions (map attrTypeVars (V.toList attrs))
627+ (ConstructedAtomType _ tvMap) -> M.keysSet tvMap
628+ (TypeVariableType nam) -> S.singleton nam
629+
630+typeVars :: TypeConstructor -> S.Set TypeVarName
631+typeVars (PrimitiveTypeConstructor _ _) = S.empty
632+typeVars (ADTypeConstructor _ args) = S.unions (map typeVars args)
633+typeVars (TypeVariable v) = S.singleton v
634+typeVars (RelationAtomTypeConstructor attrExprs) = S.unions (map attrExprTypeVars attrExprs)
635+
636+attrExprTypeVars :: AttributeExprBase a -> S.Set TypeVarName
637+attrExprTypeVars (AttributeAndTypeNameExpr _ tCons _) = typeVars tCons
638+attrExprTypeVars (NakedAttributeExpr attr) = attrTypeVars attr
639+
640+atomTypeVars :: AtomType -> S.Set TypeVarName
641+atomTypeVars IntAtomType = S.empty
642+atomTypeVars IntegerAtomType = S.empty
643+atomTypeVars DoubleAtomType = S.empty
644+atomTypeVars TextAtomType = S.empty
645+atomTypeVars DayAtomType = S.empty
646+atomTypeVars DateTimeAtomType = S.empty
647+atomTypeVars ByteStringAtomType = S.empty
648+atomTypeVars BoolAtomType = S.empty
649+atomTypeVars (IntervalAtomType aType) = atomTypeVars aType
650+atomTypeVars (RelationAtomType attrs) = S.unions (map attrTypeVars (V.toList attrs))
651+atomTypeVars (ConstructedAtomType _ tvMap) = M.keysSet tvMap
652+atomTypeVars (TypeVariableType nam) = S.singleton nam
653+
src/lib/ProjectM36/Client.hs+1−1
@@ -78,7 +78,7 @@ module ProjectM36.Client
7878 databaseContextExprForForeignKey,
7979 createScriptedAtomFunction,
8080 AttributeExprBase(..),
81− TypeConstructor(..),
81+ TypeConstructorBase(..),
8282 TypeConstructorDef(..),
8383 DataConstructorDef(..),
8484 AttributeNamesBase(..),
src/lib/ProjectM36/DataConstructorDef.hs+2−3
@@ -1,6 +1,5 @@
11module ProjectM36.DataConstructorDef where
2−import ProjectM36.Base
3−import qualified ProjectM36.TypeConstructor as TC
2+import ProjectM36.Base as B
43import qualified Data.Set as S
54
65emptyDataConstructor :: DataConstructorName -> DataConstructorDef
@@ -16,6 +15,6 @@ typeVars :: DataConstructorDef -> S.Set TypeVarName
1615typeVars (DataConstructorDef _ tConsArgs) = S.unions $ map typeVarsInDefArg tConsArgs
1716
1817typeVarsInDefArg :: DataConstructorDefArg -> S.Set TypeVarName
19−typeVarsInDefArg (DataConstructorDefTypeConstructorArg tCons) = TC.typeVars tCons
18+typeVarsInDefArg (DataConstructorDefTypeConstructorArg tCons) = B.typeVars tCons
2019typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName
2120
src/lib/ProjectM36/DataTypes/Day.hs+2−2
@@ -7,8 +7,8 @@ import Data.Time.Calendar
77dayAtomFunctions :: AtomFunctions
88dayAtomFunctions = HS.fromList [
99 AtomFunction { atomFuncName = "fromGregorian",
10− atomFuncType = [IntAtomType, IntAtomType, IntAtomType, DayAtomType],
11− atomFuncBody = compiledAtomFunctionBody $ \(IntAtom year:IntAtom month:IntAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))
10+ atomFuncType = [IntegerAtomType, IntegerAtomType, IntegerAtomType, DayAtomType],
11+ atomFuncBody = compiledAtomFunctionBody $ \(IntegerAtom year:IntegerAtom month:IntegerAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))
1212 },
1313 AtomFunction { atomFuncName = "dayEarlierThan",
1414 atomFuncType = [DayAtomType, DayAtomType, BoolAtomType],
src/lib/ProjectM36/RelationalExpression.hs+16−9
@@ -268,14 +268,21 @@ evalDatabaseContextExpr (Define relVarName attrExprs) = do
268268 relvars <- fmap relationVariables getStateContext
269269 tConss <- fmap typeConstructorMapping getStateContext
270270 let eAttrs = map (evalAttrExpr tConss) attrExprs
271− case lefts eAttrs of
272− err:_ -> pure (Left err)
273− [] -> case M.member relVarName relvars of
274− True -> pure (Left (RelVarAlreadyDefinedError relVarName))
275− False -> setRelVar relVarName emptyRelation >> pure (Right ())
276− where
277− attrs = A.attributesFromList (rights eAttrs)
278− emptyRelation = Relation attrs emptyTupleSet
271+ attrErrs = lefts eAttrs
272+ attrsList = rights eAttrs
273+ if not (null attrErrs) then
274+ pure (Left (someErrors attrErrs))
275+ else do
276+ let atomTypeErrs = lefts $ map ((`validateAtomType` tConss) . A.atomType) attrsList
277+ if not (null atomTypeErrs) then
278+ pure (Left (someErrors atomTypeErrs))
279+ else
280+ case M.member relVarName relvars of
281+ True -> pure (Left (RelVarAlreadyDefinedError relVarName))
282+ False -> setRelVar relVarName emptyRelation >> pure (Right ())
283+ where
284+ attrs = A.attributesFromList attrsList
285+ emptyRelation = Relation attrs emptyTupleSet
279286
280287evalDatabaseContextExpr (Undefine relVarName) = deleteRelVar relVarName
281288
@@ -884,6 +891,7 @@ verifyAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = runExceptT $ d
884891evalAttrExpr :: TypeConstructorMapping -> AttributeExpr -> Either RelationalError Attribute
885892evalAttrExpr aTypes (AttributeAndTypeNameExpr attrName tCons ()) = do
886893 aType <- atomTypeForTypeConstructor tCons aTypes M.empty
894+ validateAtomType aType aTypes
887895 Right (Attribute attrName aType)
888896
889897evalAttrExpr _ (NakedAttributeExpr attr) = Right attr
@@ -958,4 +966,3 @@ evalAttributeNames attrNames expr = do
958966 Left err -> pure (Left err)
959967 Right attrExprType -> pure (Right (A.attributeNameSet (attributes attrExprType)))
960968
961−
src/lib/ProjectM36/TypeConstructor.hs+4−6
@@ -1,19 +1,17 @@
11module ProjectM36.TypeConstructor where
22import ProjectM36.Base
3−import qualified Data.Set as S
43
54name :: TypeConstructor -> TypeConstructorName
65name (ADTypeConstructor name' _) = name'
76name (PrimitiveTypeConstructor name' _) = name'
8−name (TypeVariable _) = error "spam" --v --not really the name, but this is used for display only
7+name (RelationAtomTypeConstructor _) = error "name called on RelationAtomTypeConstructor"
8+name (TypeVariable _) = error "name called on TypeVariable" --v --not really the name, but this is used for display only
99
1010arguments :: TypeConstructor -> [TypeConstructor]
1111arguments (ADTypeConstructor _ args) = args
1212arguments (PrimitiveTypeConstructor _ _) = []
13+arguments (RelationAtomTypeConstructor _) = []
1314arguments (TypeVariable _) = []
1415
15−typeVars :: TypeConstructor -> S.Set TypeVarName
16−typeVars (PrimitiveTypeConstructor _ _) = S.empty
17−typeVars (ADTypeConstructor _ args) = S.unions (map typeVars args)
18−typeVars (TypeVariable v) = S.singleton v
16+
1917
test/TutorialD/Interpreter.hs+34−3
@@ -29,6 +29,7 @@ import Data.Text hiding (map)
2929import qualified Data.Text as T
3030import Data.Time.Clock.POSIX hiding (getCurrentTime)
3131import Data.Time.Clock (getCurrentTime)
32+import Data.Time.Calendar (fromGregorian)
3233
3334main :: IO ()
3435main = do
@@ -59,7 +60,10 @@ main = do
5960 testRestrictionPredicateExprs,
6061 testRelationalAttributeNames,
6162 testSemijoin,
62− testAntijoin
63+ testAntijoin,
64+ testRelationAttributeDefinition,
65+ testAssignWithTypeVar,
66+ testDefineWithTypeVar
6367 ]
6468 simpleRelTests = [("x:=true", Right relationTrue),
6569 ("x:=false", Right relationFalse),
@@ -86,7 +90,7 @@ main = do
8690 ("x:=true=true", Right relationTrue),
8791 ("x:=true=false", Right relationFalse),
8892 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),
89− ("x:=relation {b Integer, a Text}{}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList [TextAtom "spam", IntegerAtom 5]]),
93+ ("x:=relation {b Integer, a Text}{}; insert x relation{tuple{b -5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList [TextAtom "spam", IntegerAtom (-5)]]),
9094 -- test nested relation constructor
9195 ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ RelationTupleSet [RelationTuple nestedRelationAttributes (V.fromList [IntegerAtom 5, RelationAtom (Relation simpleAAttributes $ RelationTupleSet [RelationTuple simpleAAttributes $ V.fromList [IntegerAtom 6]])])]),
9296 ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [TextAtom "spam", IntegerAtom 5])]),
@@ -155,7 +159,9 @@ main = do
155159 ("x:=relation{tuple{a Left 3}}", Left (TypeConstructorTypeVarsMismatch (S.fromList ["a","b"]) (S.fromList ["a"]))), -- Left 3, alone is not enough information to imply the type
156160 ("x:=relation{a Either Integer Text}{tuple{a Left 3}}", mkRelationFromList simpleEitherIntTextAttributes [[ConstructedAtom "Left" (eitherAtomType IntegerAtomType TextAtomType) [IntegerAtom 3]]]),
157161 --test datetime constructor
158− ("x:=relation{tuple{a dateTimeFromEpochSeconds(1495199790)}}", mkRelationFromList (A.attributesFromList [Attribute "a" DateTimeAtomType]) [[DateTimeAtom (posixSecondsToUTCTime(realToFrac (1495199790 :: Int)))]])
162+ ("x:=relation{tuple{a dateTimeFromEpochSeconds(1495199790)}}", mkRelationFromList (A.attributesFromList [Attribute "a" DateTimeAtomType]) [[DateTimeAtom (posixSecondsToUTCTime(realToFrac (1495199790 :: Int)))]]),
163+ --test Day constructor
164+ ("x:=relation{tuple{a fromGregorian(2017,05,30)}}", mkRelationFromList (A.attributesFromList [Attribute "a" DayAtomType]) [[DayAtom (fromGregorian 2017 05 30)]])
159165 ]
160166
161167assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> Text -> Assertion
@@ -537,3 +543,28 @@ testAntijoin = TestCase $ do
537543 eY <- executeRelationalExpr sessionId dbconn (RelationVariable "y" ())
538544 assertEqual "antijoin only Adams" eX eY
539545
546+testRelationAttributeDefinition :: Test
547+testRelationAttributeDefinition = TestCase $ do
548+ -- test normal subrelation construction
549+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback
550+ executeTutorialD sessionId dbconn "x:=relation{a relation{b Integer}}{tuple{a relation{tuple{b 4}}}}"
551+ eX <- executeRelationalExpr sessionId dbconn (RelationVariable "x" ())
552+ let expected = mkRelationFromList attrs [[RelationAtom subRel]]
553+ attrs = attributesFromList [Attribute "a" (RelationAtomType subRelAttrs)]
554+ subRelAttrs = attributesFromList [Attribute "b" IntegerAtomType]
555+ Right subRel = mkRelationFromList subRelAttrs [[IntegerAtom 4]]
556+ assertEqual "relation attribute construction" expected eX
557+ -- test rejected subrelation construction due to floating type variables
558+ expectTutorialDErr sessionId dbconn (T.isPrefixOf "TypeConstructorTypeVarMissing") "y:=relation{a relation{b x}}"
559+
560+testAssignWithTypeVar :: Test
561+testAssignWithTypeVar = TestCase $ do
562+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback
563+ let err1 = "TypeConstructorTypeVarMissing"
564+ expectTutorialDErr sessionId dbconn (T.isPrefixOf err1) "y:=relation{a int, b invalidtype}"
565+
566+testDefineWithTypeVar :: Test
567+testDefineWithTypeVar = TestCase $ do
568+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback
569+ let err1 = "TypeConstructorTypeVarMissing"
570+ expectTutorialDErr sessionId dbconn (T.isInfixOf err1) "y::{a int, b invalidtype}"