Elm 0.6.0.3 → 0.7
raw patch · 22 files changed
+1137/−738 lines, 22 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Elm.cabal +4/−2
- elm-runtime-0.6.0.3.js +0/−134
- elm-runtime-0.7.js +135/−0
- src/Ast.hs +71/−54
- src/Context.hs +43/−0
- src/Gen/Cases.hs +16/−13
- src/Gen/CompileToJS.hs +108/−52
- src/Gen/ExtractNoscript.hs +11/−7
- src/Optimize.hs +81/−62
- src/Parse/Binops.hs +55/−36
- src/Parse/Expr.hs +94/−46
- src/Parse/Library.hs +31/−9
- src/Parse/Patterns.hs +64/−25
- src/Parse/Types.hs +10/−1
- src/Rename.hs +19/−11
- src/Substitute.hs +8/−8
- src/Types/Constrain.hs +175/−115
- src/Types/Hints.hs +14/−12
- src/Types/Solver.hs +148/−106
- src/Types/Substitutions.hs +24/−30
- src/Types/Types.hs +24/−14
- src/Types/Unify.hs +2/−1
Elm.cabal view
@@ -1,6 +1,6 @@ Name: Elm-Version: 0.6.0.3+Version: 0.7 Synopsis: The Elm language module. Description: Elm aims to make client-side web-development more pleasant. It is a statically/strongly typed, functional reactive@@ -22,7 +22,7 @@ Build-type: Simple Extra-source-files: changelog.txt-Data-files: elm-runtime-0.6.0.3.js+Data-files: elm-runtime-0.7.js Cabal-version: >=1.8 source-repository head@@ -34,6 +34,7 @@ Language.Elm.Quasi Hs-Source-Dirs: src, src/Gen other-modules: Ast,+ Context, CompileToJS, Cases, Substitute,@@ -80,6 +81,7 @@ Main-is: Compiler.hs Hs-Source-Dirs: src, src/Gen other-modules: Ast,+ Context, CompileToJS, Cases, Substitute,
− elm-runtime-0.6.0.3.js
@@ -1,134 +0,0 @@-Elm={};var Guid=function(){var e=0;return{guid:function(){return e+=1}}}();-Elm.JavaScript=function(){function e(a){for(var b=["Nil"],l=a.length;l--;)b=["Cons",a[l],b];return b}function j(a){for(var b=[];"Cons"===a[0];)b.push(a[1]),a=a[2];return b}function a(a){return a.slice(1)}function d(a){return["Tuple"+a.length].concat(a)}return{castJSBoolToBool:function(a){return a},castBoolToJSBool:function(a){return a},castJSNumberToFloat:function(a){return a},castFloatToJSNumber:function(a){return a},castJSNumberToInt:function(a){return~~a},castIntToJSNumber:function(a){return a},-Experimental:{castJSElementToElement:function(a){return function(b){return function(l){return["Element",Guid.guid(),["EExternalHtml",l],a,b,1,Nothing,Nothing]}}},castElementToJSElement:function(a){return Render.render(a)}},castJSArrayToList:e,castListToJSArray:j,castJSStringToString:e,castStringToJSString:function(a){return"string"===typeof a?a:j(a).join("")},castTupleToJSTuple2:a,castTupleToJSTuple3:a,castTupleToJSTuple4:a,castTupleToJSTuple5:a,castJSTupleToTuple2:d,castJSTupleToTuple3:d,castJSTupleToTuple4:d,-castJSTupleToTuple5:d}}();var JSjson=window.JSON;-Elm.JSON=function(){function e(b,a){return function(h){return function(k){var f=d.castStringToJSString(h);return k[1].hasOwnProperty(f)&&(k=k[1][f],k[0]===b)?k[1]:a}}}function j(b){return function(a){function h(b){switch(b[0]){case "JsonNull":return null;case "JsonString":return d.castStringToJSString(b[1]);case "JsonObject":var f={},b=b[1][1],c;for(c in b)f[c]=h(b[c]);return f;case "JsonArray":f=d.castListToJSArray(b[1]);for(c=f.length;c--;)f[c]=h(f[c]);return f;default:return b[1]}}return JSjson.stringify(h(["JsonObject",-a]),null,d.castStringToJSString(b))}}function a(b){function a(b){switch(typeof b){case "string":return["JsonString",d.castJSStringToString(b)];case "number":return["JsonNumber",d.castJSNumberToFloat(b)];case "boolean":return["JsonBool",d.castJSBoolToBool(b)];case "object":if(null===b)return["JsonNull"];for(var f in b)b[f]=a(b[f]);return b instanceof Array?["JsonArray",d.castJSArrayToList(b)]:["JsonObject",["JSON",b]]}}var b=JSjson.parse(b),h;for(h in b)b[h]=a(b[h]);return["JSON",b]}var d=Elm.JavaScript,-i=["JSON",{}];return{empty:i,singleton:function(b){return function(a){var h={};h[d.castStringToJSString(b)]=a;return["JSON",h]}},insert:function(b){return function(a){return function(h){var h=h[1],k={},f;for(f in h)k[f]=h[f];k[d.castStringToJSString(b)]=a;return["JSON",k]}}},lookup:function(b){return function(a){var h=d.castStringToJSString(b);return a[1].hasOwnProperty(h)?["Just",a[1][h]]:["Nothing"]}},findString:e("JsonString",["Nil"]),findObject:e("JsonObject",i),findArray:e("JsonArray",["Nil"]),-findWithDefault:function(b){return function(a){return function(h){var k=d.castStringToJSString(a);return h[1].hasOwnProperty(k)?h[1][k]:b}}},remove:function(b){return function(a){var a=a[1],h={},k;for(k in a)h[k]=a[k];delete h[d.castStringToJSString(b)];return["JSON",h]}},toPrettyJSString:j,toJSString:j(""),fromJSString:a,toPrettyString:function(b){return function(a){return d.castJSStringToString(j(b)(a))}},toString:function(b){return d.castJSStringToString(j("")(b))},fromString:function(b){return a(d.castStringToJSString(b))},-toList:function(b){var b=b[1],a=[],h;for(h in b)a.push(Value.Tuple(d.castJSStringToString(h),b[h]));return d.castJSArrayToList(a)},fromList:function(b){for(var b=d.castListToJSArray(b),a={},h=b.length;h--;)a[d.castStringToJSString(b[h][1])]=b[h][2];return["JSON",a]},JsonString:function(b){return["JsonString",b]},JsonNumber:function(b){return["JsonNumber",b]},JsonBool:function(b){return["JsonBool",b]},JsonNull:["JsonNull"],JsonArray:function(b){return["JsonArray",b]},JsonObject:function(b){return["JsonObject",-b]}}}();-var Value=function(){function e(b){if(0==b.length)return b;for(var b=b.replace(/"/g,""").replace(/'/g,"'").replace(/</g,"<").replace(/>/g,">").replace(/\n/g,"<br/>"),b=b.split("<br/>"),a=b.length;a--;){var h=b,d=a,f;f=b[a];if(0!=f.length){f=f.split("");" "==f[0]&&(f[0]=" ");for(var c=f.length;--c;)" "==f[c][0]&&" "==f[c-1]&&(f[c-1]+=f[c],f[c]="");for(c=f.length;c--;)if(1<f[c].length&&" "==f[c][0]){for(var g=f[c].split(""),r=g.length-2;0<=r;r-=2)g[r]=" ";f[c]=g.join("")}f=f.join("");-f=" "===f[f.length-1]?f.slice(0,-1)+" ":f}h[d]=f}return b.join("<br/>")}var j=function(b,a){if("object"===typeof b){if(b===a)return!0;if(b.length!==a.length)return!1;for(var h=b.length;h--;)if(!j(b[h],a[h]))return!1;return!0}return b===a},a=function(b){if("boolean"===typeof b)return b?"True":"False";if("number"!==typeof b){if("string"===typeof b&&2>b.length)return"'"+b+"'";if(b[0]){if("Tuple"===b[0].substring(0,5)){for(var d="",h=b.length;--h;)d=","+a(b[h])+d;","===d[0]&&(d=d.substring(1));return"("+-d+")"}if("Cons"===b[0])for(var h="string"===typeof b[1]?'"':"]",k="string"===typeof b[1]?"":",",f="string"===typeof b[1]?function(b){return b}:a,d=("string"===typeof b[1]?'"':"[")+f(b[1]),b=b[2];;)if("Cons"===b[0])d+=k+f(b[1]),b=b[2];else return d+h;else{if("Nil"===b[0])return"[]";if("JSON"===b[0])return"(JSON.fromList "+a(Elm.JSON.toList(b))+")";if("RBNode"===b[0]||"RBEmpty"===b[0])return b=Elm.Dict.foldr(function(b){return function(a){return function(f){return["Cons",["Tuple2",b,a],f]}}})(["Nil"])(b),-d="Dict","Cons"===b[0]&&"Tuple0"===b[1][2][0]&&(d="Set",b=Elm.List.map(function(b){return b[1]})(b)),"("+d+".fromList "+a(b)+")";d="";for(h=b.length;--h;)d=" "+a(b[h])+d;d=b[0]+d;return 1<b.length?"("+d+")":d}}}return b+""},d=function(b){for(var a=["Nil"],d=b.length;d--;)a=["Cons",b[d],a];return a},i;i=document.addEventListener?function(b,a,d){b.addEventListener(a,d,!1)}:function(b,a,d){b.attachEvent("on"+a,d)};return{eq:j,str:d,show:function(b){return d(a(b))},Tuple:function(){var b=arguments.length,-a=Array(b+1);for(a[0]="Tuple"+arguments.length;b--;)a[b+1]=arguments[b];return a},append:function(b,a){if("string"===typeof b&&"string"===typeof a)return b.concat(a);if("Nil"===b[0])return a;for(var d=["Cons",b[1],["Nil"]],k=d,b=b[2];"Cons"===b[0];)k[2]=["Cons",b[1],["Nil"]],b=b[2],k=k[2];k[2]=a;return d},listToArray:function(b){for(var a=[];"Cons"===b[0];)a.push(b[1]),b=b[2];return a},toText:function(a){if("string"===typeof a)return e(a);for(var d=[];"Cons"===a[0];)d.push(a[1]),a=a[2];return e(d.join(""))},-properEscape:e,getTextSize:function(a,d,h){var k=document.createElement("div");k.innerHTML=h;k.style.textAlign="left";0<a&&(k.style.width=a+"px");k.style.visibility="hidden";k.style.styleFloat="left";k.style.cssFloat="left";document.body.appendChild(k);h=window.getComputedStyle(k,null);a=h.getPropertyValue("width").slice(0,-2)-0;h=h.getPropertyValue("height").slice(0,-2)-0;document.body.removeChild(k);return[Math.ceil(a),Math.ceil(Math.max(d,h))]},getSize:function(a){a=a.cloneNode(!0);a.style.visibility=-"hidden";a.style.styleFloat="left";a.style.cssFloat="left";document.body.appendChild(a);var d=a.offsetWidth,h=a.offsetHeight;document.body.removeChild(a);return[d,h]},getExcess:function(a){a=a.cloneNode(!0);a.style.visibility="hidden";a.style.styleFloat="left";a.style.cssFloat="left";document.body.appendChild(a);var d=a.offsetWidth,h=a.offsetHeight,k=window.getComputedStyle(a,null),f=k.getPropertyValue("width").slice(0,-2)-0,k=k.getPropertyValue("height").slice(0,-2)-0;document.body.removeChild(a);-return[d-f,h-k]},groupForms:function(a){for(var a=Elm.JavaScript.castListToJSArray(a),d=[],h=[],k=a.length;k--;){var f=a[k];switch(f[4][0]){case "FElement":0<h.length&&(d.push(h),h=[]);d.push(f);break;default:h.push(f)}}0<h.length&&d.push(h);return d},wrap:function(a){var d=Value.getSize(a);return["Element",Guid.guid(),["EHtml",a],d[0],d[1],1,["Nothing"],["Nothing"]]},addListener:i}}();-Elm.List=function(){function e(a){return function(b){if("Nil"===b[0])return b;"Cons"!==b[0]&&f("map");for(var c=["Cons",a(b[1]),["Nil"]],g=c,b=b[2];"Cons"===b[0];)g[2]=["Cons",a(b[1]),["Nil"]],b=b[2],g=g[2];return c}}function j(a){return function(b){return function(c){var g=b;if("Nil"===c[0])return g;for("Cons"!==c[0]&&f("foldl");"Cons"===c[0];)g=a(c[1])(g),c=c[2];return g}}}function a(a){return function(b){return function(c){var g=b;if("Nil"===c[0])return g;"Cons"!==c[0]&&f("foldr");for(var d=[];"Cons"===-c[0];)d.push(c[1]),c=c[2];for(c=d.length;c--;)g=a(d[c])(g);return g}}}function d(a){return function(f){var b;"Cons"!==f[0]?b=void 0:(b=f[1],f=f[2],b=j(a)(b)(f));return b}}function i(a){return function(b){return function(c){if("Nil"===c[0])return["Cons",b,["Nil"]];"Cons"!==c[0]&&f("scanl");for(var g=[b];"Cons"===c[0];)b=a(c[1])(b),g.push(b),c=c[2];for(var c=["Nil"],d=g.length;d--;)c=["Cons",g[d],c];return c}}}function b(a){return function(f){a:{for(var c=[function(a){return"Nil"!==a[0]?void 0:["Tuple2",-["Nil"],["Nil"]]},function(f){if("Cons"===f[0]){var c=f[1],f=f[2];var g=b(a)(f);"Tuple2"!==g[0]?c=void 0:(f=g[1],g=g[2],c=a(c)?["Tuple2",["Cons",c,f],g]:["Tuple2",f,["Cons",c,g]]);return c}}],g=c.length;g--;){var d=c[g](f);if(void 0!==d){f=d;break a}}f=void 0}return f}}function l(a){a:{for(var f=[function(a){return"Nil"!==a[0]?void 0:["Tuple2",["Nil"],["Nil"]]},function(a){if("Cons"!==a[0])a=void 0;else if(a=["Tuple2",a[1],l(a[2])],"Tuple2"!==a[0]||"Tuple2"!==a[1][0])a=void 0;else var f=a[1][1],b=-a[1][2],a="Tuple2"!==a[2][0]?void 0:["Tuple2",["Cons",f,a[2][1]],["Cons",b,a[2][2]]];return a}],b=f.length;b--;){var c=f[b](a);if(void 0!==c){a=c;break a}}a=void 0}return a}function h(a){return function(f){a:{for(var b=[function(a){return"Nil"!==a[0]?void 0:["Nil"]},function(a){if("Cons"===a[0]){var f=a[1];return"Nil"!==a[2][0]?void 0:["Cons",f,["Nil"]]}},function(f){if("Cons"===f[0]){var b=f[1];if("Cons"===f[2][0]){var c=f[2][1],f=f[2][2];return["Cons",b,["Cons",a,h(a)(["Cons",c,f])]]}}}],c=b.length;c--;){var g=-b[c](f);if(void 0!==g){f=g;break a}}f=void 0}return f}}function k(a){return function(f){a:{for(var b=[function(a){return"Nil"!==a[0]?void 0:["Nil"]},function(a){if("Cons"===a[0]){var f=a[1];return"Nil"!==a[2][0]?void 0:f}},function(f){if("Cons"===f[0]){var b=f[1];if("Cons"===f[2][0]){var c=f[2][1],f=f[2][2];return Value.append(b,Value.append(a,k(a)(["Cons",c,f])))}}}],c=b.length;c--;){var g=b[c](f);if(void 0!==g){f=g;break a}}f=void 0}return f}}var f=function(a){throw"Function '"+a+"' expecting a list!";-},c=j(function(a){return function(f){return["Cons",a,f]}})(["Nil"]),g=a(function(a){return function(f){return Value.append(a,f)}})(["Nil"]),r=j(function(a){return function(f){return a&&f}})(!0),m=j(function(a){return function(f){return a||f}})(!1),n=j(function(a){return function(f){return a+f}})(0),u=j(function(a){return function(f){return a*f}})(1),x=d(function(a){return function(f){return Math.max(a,f)}}),q=d(function(a){return function(f){return Math.min(a,f)}});return{head:function(a){if("Cons"!==-a[0])throw"Error: 'head' only accepts lists of length greater than one.";return a[1]},tail:function(a){if("Cons"!==a[0])throw"Error: 'tail' only accepts lists of length greater than one.";return a[2]},last:function(a){if("Cons"!==a[0])throw"Error: 'last' only accepts lists of length greater than one.";for(var f=a[1];"Cons"===a[0];)f=a[1],a=a[2];return f},map:e,foldl:j,foldr:a,foldl1:d,foldr1:function(a){return function(b){if("Nil"===b[0])throw"'foldr1' requires an non-empty list.";"Cons"!==b[0]&&-f("foldr1");for(var c=[];"Cons"===b[0];)c.push(b[1]),b=b[2];for(var b=c.pop(),g=c.length;g--;)b=a(c[g])(b);return b}},scanl:i,scanl1:function(a){return function(f){if("Cons"!==f[0])throw"Error: 'scanl1' requires a list of at least length 1.";return i(a)(f[1])(f[2])}},filter:function(a){return function(b){if("Nil"===b[0])return b;"Cons"!==b[0]&&f("filter");for(var c=[];"Cons"===b[0];)a(b[1])&&c.push(b[1]),b=b[2];for(var b=["Nil"],g=c.length;g--;)b=["Cons",c[g],b];return b}},length:function(a){for(var f=-0;"Cons"===a[0];)f+=1,a=a[2];return f},reverse:c,concat:g,concatMap:function(a){return function(f){return g(e(a)(f))}},and:r,or:m,all:function(a){return j(function(f){return function(b){return b&&a(f)}})(!0)},any:function(a){return j(function(f){return function(b){return b||a(f)}})(!1)},sum:n,product:u,maximum:x,minimum:q,partition:b,zipWith:function(a){return function(b){return function(c){if("Nil"===b[0]||"Nil"===c[0])return["Nil"];("Cons"!==b[0]||"Cons"!==c[0])&&f("zipWith");for(var g=[];"Cons"===-b[0]&&"Cons"===c[0];)g.push(a(b[1])(c[1])),b=b[2],c=c[2];for(var c=["Nil"],d=g.length;d--;)c=["Cons",g[d],c];return c}}},zip:function(a){return function(b){if("Nil"===a[0]||"Nil"===b[0])return["Nil"];("Cons"!==a[0]||"Cons"!==b[0])&&f("zip");for(var c=[];"Cons"===a[0]&&"Cons"===b[0];)c.push(["Tuple2",a[1],b[1]]),a=a[2],b=b[2];for(var b=["Nil"],g=c.length;g--;)b=["Cons",c[g],b];return b}},unzip:l,intersperse:h,intercalate:k,sort:function(a){if("Nil"===a[0])return a;"Cons"!==a[0]&&f("sort");for(var b=-[];"Cons"===a[0];)b.push(a[1]),a=a[2];b.sort(function(a,f){return a-f});for(var a=["Nil"],c=b.length;c--;)a=["Cons",b[c],a];return a},take:function(a){return function(b){if(0>=a)return["Nil"];if("Nil"===b[0])return b;"Cons"!==b[0]&&f("take");var c=["Cons",b[1],["Nil"]],g=c,b=b[2];for(--a;"Cons"===b[0]&&0<a;)g[2]=["Cons",b[1],["Nil"]],g=g[2],b=b[2],--a;return c}},drop:function(a){return function(b){if("Nil"===b[0])return b;for("Cons"!==b[0]&&f("drop");"Cons"===b[0]&&0<a;)b=b[2],--a;return b}}}}();-Elm.Maybe=function(){function e(a){return function(d){return"Just"===a[0]?["Cons",a[1],d]:d}}function j(a){return function(d){return function(i){var b=a(d);return"Just"===b[0]?["Cons",b[1],i]:i}}}return{Just:function(a){return["Just",a]},Nothing:["Nothing"],catMaybes:Elm.List.foldr(e)(["Nil"]),isJust:function(a){return"Just"===a[0]},isNothing:function(a){return"Nothing"===a[0]},fromMaybe:function(a){return function(d){return"Just"===d[0]?d[1]:a}},consMaybe:e,mapMaybe:function(a){return Elm.List.foldr(j(a))(["Nil"])},-maybe:function(a){return function(d){return function(i){return"Just"===i[0]?d(i[1]):a}}}}}();-Elm.Char=function(){function e(a,b){return function(d){d=d.charCodeAt(0);return a<=d&&d<=b}}var j=e(48,57),a=e(97,102),d=e(65,70);return{fromCode:function(a){return String.fromCharCode(a)},toCode:function(a){return a.charCodeAt(0)},toUpper:function(a){return a.toUpperCase()},toLower:function(a){return a.toLowerCase()},toLocaleUpper:function(a){return a.toLocaleUpperCase()},toLocaleLower:function(a){return a.toLocaleLowerCase()},isLower:e(97,122),isUpper:e(65,90),isDigit:j,isOctDigit:e(48,55),isHexDigit:function(e){return j(e)||-a(e)||d(e)}}}();-Elm.Color=function(){function e(e){var a=e.value*e.saturation,d=e.hue/60,i=a*(1-Math.abs(d%2-1)),b=0,l=0,h=0;0<=d&&1>d?(b=a,l=i,h=0):1<=d&&2>d?(b=i,l=a,h=0):2<=d&&3>d?(b=0,l=a,h=i):3<=d&&4>d?(b=0,l=i,h=a):4<=d&&5>d?(b=i,l=0,h=a):5<=d&&6>d&&(b=a,l=0,h=i);e=e.value-a;return["Color",Math.round(255*(b+e)),Math.round(255*(l+e)),Math.round(255*(h+e)),1]}return{rgba:function(e){return function(a){return function(d){return function(i){return["Color",e,a,d,i]}}}},rgb:function(e){return function(a){return function(d){return["Color",e,-a,d,1]}}},hsva:function(j){return function(a){return function(d){return function(i){var b=e({hue:j,saturation:a,value:d});b[4]=i;return b}}}},hsv:function(j){return function(a){return function(d){return e({hue:j,saturation:a,value:d})}}},red:["Color",255,0,0,1],green:["Color",0,255,0,1],blue:["Color",0,0,255,1],yellow:["Color",255,255,0,1],cyan:["Color",0,255,255,1],magenta:["Color",255,0,255,1],black:["Color",0,0,0,1],white:["Color",255,255,255,1],gray:["Color",128,128,128,1],grey:["Color",128,128,-128,1],complement:function(j){var a;a=j[1]/255;var d=j[2]/255,j=j[3]/255,i=Math.max(a,d,j),b=Math.min(a,d,j),b=i-b,l=0;0===b?l=0:i===a?l=(d-j)/b%6:i===d?l=(j-a)/b+2:i===j&&(l=(a-d)/b+4);a={value:i,hue:60*l,saturation:0===i?0:b/i};a.hue=(a.hue+180)%360;return e(a)},extract:function(e){return 1===e[4]?"rgb("+e[1]+","+e[2]+","+e[3]+")":"rgba("+e[1]+","+e[2]+","+e[3]+","+e[4]+")"}}}();-var Collage=function(){function e(a,b){var c=b.length-1;if(!(0>=c))for(a.moveTo(b[c][1],b[c][2]);c--;)a.lineTo(b[c][1],b[c][2])}function j(a,b,c,g){0===a.length&&(a=[8,4]);var d=g.length-1;if(!(0>=d)){var m=g[d][1],h=g[d][2],e=0,i=0,j=0,l=0,p=0,s=0,v=a.length,z=!0,w=a[0];for(b.moveTo(m,h);d--;){e=g[d][1];i=g[d][2];j=e-m;l=i-h;for(p=Math.sqrt(j*j+l*l);w<=p;)m+=j*w/p,h+=l*w/p,b[z?"lineTo":"moveTo"](m,h),j=e-m,l=i-h,p=Math.sqrt(j*j+l*l),z=!z,s=(s+1)%v,w=a[s];0<p&&(b[z?"lineTo":"moveTo"](e,i),w-=p);m=-e;h=i}}b.strokeStyle=Elm.Color.extract(c);b.stroke()}function a(a,b,c,g,d){b.clearRect(0,0,c,g);for(c=d.length;c--;){var m=d[c],n=a,g=b,i=m[1],l=m[2],q=m[3][1],t=m[3][2],m=m[4];g.save();(0!==q||0!==t)&&g.translate(q,t);i!==~~i&&g.rotate(2*Math.PI*i);1!==l&&g.scale(l,l);g.beginPath();switch(m[0]){case "FLine":a:switch(n=g,i=m,m=i[3][1],i[1][0]){case "Solid":i=i[2];e(n,m);n.strokeStyle=Elm.Color.extract(i);n.stroke();break;case "Dotted":j([3,3],n,i[2],m);break a;case "Dashed":j([8,4],n,i[2],m);break a;-case "Custom":j(i[1][1],n,i[2],m)}break;case "FShape":a:switch(q=n,l=g,n=m[1],i=m[2],m=m[3][1],n[0]){case "Filled":n=l;e(n,m);n.fillStyle=Elm.Color.extract(i);n.fill();break a;case "Outlined":n=l;e(n,m);n.strokeStyle=Elm.Color.extract(i);n.stroke();break a;case "Textured":i=q;n=n[1];q=new Image;q.src=h.castStringToJSString(n);q.onload=i;e(l,m);l.fillStyle=l.createPattern(q,"repeat");l.fill();break a;case "CustomOutline":j(n[1],l,i,m)}break;case "FImage":i=g,l=m[1],q=m[2],m=m[3],t=new Image,t.onload=-n,t.src=h.castStringToJSString(m),i.drawImage(t,-l/2,-q/2,l,q)}g.restore()}}function d(b,f,c){var g=Render.newElement("canvas"),b=~~b,f=~~f;g.style.width=b+"px";g.style.height=f+"px";g.style.display="block";g.width=b;g.height=f;if(g.getContext){var d=g.getContext("2d");a(function(){a(this,d,b,f,c)},d,b,f,c);return g}g.innerHTML="Your browser does not support the canvas element.";return g}function i(a,b,c,g,d,h,e){var i=Render.render(e),c="translate("+(d-e[3]/2)+"px,"+(h-e[4]/2)+"px) "+(1===g?"":"scale("+-g+","+g+")")+" "+(c===~~c?"":"rotate("+360*c+"deg)");i.style.transform=c;i.style.msTransform=c;i.style.MozTransform=c;i.style.webkitTransform=c;i.style.OTransform=c;c=Render.newElement("div");Render.addTo(c,i);c.style.width=~~a+"px";c.style.height=~~b+"px";c.style.overflow="hidden";return c}function b(b,f,c){if(!Value.eq(c,f)){var g=b.style.width.slice(0,-2)-0,h=b.style.height.slice(0,-2)-0;if("object"===typeof c[0]){if("object"===typeof f[0]&&b.getContext){var m=b.getContext("2d");return a(function(){a(this,-m,g,h,c)},m,g,h,c)}f=d(g,h,c);f.style.position="absolute";return b.parentNode.replaceChild(f,b)}f=i(g,h,c[1],c[2],c[3][1],c[3][2],c[4][1]);f.style.position="absolute";return b.parentNode.replaceChild(f,b)}}function l(a,b,c,g,d){var h=0,e,i=(a[1]-g[1])/c,a=(a[2]-g[2])/c;0!==b&&(b*=-2*Math.PI,c=i*Math.cos(b)-a*Math.sin(b),a=i*Math.sin(b)+a*Math.cos(b),i=c);if(0===d.length)return!1;e=d[0];for(c=d.length-1;c--;){b=d[c];g=e[1];e=e[2];var j=b[1],l=b[2];if(e<l)var t=e,p=l;else t=l,p=e;if(g<j)var s=g,v=j;-else s=j,v=g;t<a&&a<=p&&i<=v&&(i<=s||i<=(a-e)*(j-g)/(l-e)+g)&&++h;e=b}return 1===h%2}var h=Elm.JavaScript;return{collage:function(a,b,c){if(0===c.length)return d(a,b,[]);for(var g=Array(c.length),h=c.length;h--;){var e=c[h];g[h]="string"===typeof e[0]?i(a,b,e[1],e[2],e[3][1],e[3][2],e[4][1]):d(a,b,e)}return 1===c.length?g[0]:Render.flowWith(Render.goIn,function(a){return a},g)},updateCollage:function(a,f,c){if(1===c.length)return b(a,f[0],c[0]);for(var a=a.childNodes,g=a.length,d=g;d--;)b(a[g-d-1],-f[d],c[d])},insideForm:function(a){return function(b){var c=a[1],g=a[2];if(6>b.length){var d=b[3][1],e=b[3][2],h=0,i=b[2];switch(b[4][0]){case "FShape":for(var j=b[4][3][1],q=j.length;--q;)var t=j[q],h=Math.max(h,t[1]*t[1]+t[2]*t[2]);h*=i*i;break;case "FImage":j=i*b[4][1]/2;i=i*b[4][2]/2;h=j*j+i*i;break;case "FElement":j=i*b[4][1][3]/2,i=i*b[4][1][4]/2,h=j*j+i*i}b.push(function(a,b){var c=a-d,f=b-e;return c*c+f*f<h+1})}if(!b[5](c,g))return!1;var p,s;switch(b[4][0]){case "FShape":return l(a,b[1],b[2],-b[3],b[4][3][1]);case "FLine":return!1;case "FImage":p=b[4][1]/2;s=b[4][2]/2;break;case "FElement":p=b[4][1][3]/2,s=b[4][1][4]/2}return l(a,b[1],b[2],b[3],[[null,p,s],[null,-p,s],[null,-p,-s],[null,p,-s],[null,p,s]])}}}}();-Elm.Graphics=function(){function e(a){return function(b){return["Position",a,b]}}function j(a){return function(b){return["EText",a,b]}}function a(a){return function(b){return["EFlow",a,u.castListToJSArray(b)]}}function d(a){return["Line",u.castListToJSArray(a)]}function i(a){return function(b){var c=u.castListToJSArray(a);0<c.length&&c.push(c[0]);return["Shape",c,b]}}function b(a){return function(b){return function(c){return function(f){return["Form",a,b,c,f]}}}}function l(a){return function(b){return function(c){return["FLine",-a,b,c]}}}function h(a){return function(b){return function(c){return["FShape",a,b,c]}}}function k(a,b,c,f,g,d){return["Element",Guid.guid(),a,b,c,f,g,d]}function f(a,b,c){return["Element",Guid.guid(),a,b,c,1,["Nothing"],["Nothing"]]}function c(a){return~~a[3]}function g(a){return~~a[4]}function r(a){return function(b){return function(c){return f(["EImage",u.castStringToJSString(c)],a,b)}}}function m(a){return function(b){return f(z,a,b)}}function n(a){return function(b){return function(c){var f=map(function(c){return["Tuple2",-a/2*Math.cos(2*(Math.PI/50)*c),b/2*Math.sin(2*(Math.PI/50)*c)]}),g=49,d=["Nil"];if(0<=g){do d=["Cons",g,d];while(0<g--)}return i(f(d))(c)}}}for(this.i in Elm.List)eval("var "+this.i+" = Elm.List[this.i];");var u=Elm.JavaScript,x=["DRight"],q=["DDown"],t=["DOut"],p=["Near"],s=["Mid"],v=["Far"],z=["EEmpty"],w=["Solid"],C=["Dotted"],E=["Dashed"],A=["Filled"],D=["Outlined"],y=e(p)(p),B=e(v)(p),F=e(p)(v),G=e(v)(v),H=e(p)(s),I=e(v)(s),p=e(s)(p),v=e(s)(v),s=e(s)(s);return{left:["DLeft"],right:x,down:q,up:["DUp"],-inward:["DIn"],outward:t,topLeft:y,topRight:B,bottomLeft:F,bottomRight:G,midLeft:H,midRight:I,midTop:p,midBottom:v,middle:s,middleAt:function(a){return function(b){return["PositionAt",a,b]}},topLeftAt:function(a){return function(b){return["PositionTL",a,b]}},topRightAt:function(a){return function(b){return["PositionTR",a,b]}},bottomLeftAt:function(a){return function(b){return["PositionBL",a,b]}},bottomRightAt:function(a){return function(b){return["PositionBR",a,b]}},absolute:function(a){return["Absolute",-a]},relative:function(a){return["Relative",a]},width:function(a){return function(b){var c=b[2];switch(c[0]){case "EImage":case "EVideo":return k(b[2],a,b[4]*a/b[3],b[5],b[6],b[7]);case "EText":return c=Value.getTextSize(a,b[4],c[2]),k(b[2],a,c[1],b[5],b[6],b[7])}return k(b[2],a,b[4],b[5],b[6],b[7])}},height:function(a){return function(b){switch(b[2][0]){case "EImage":case "EVideo":return k(b[2],b[3]*a/b[4],a,b[5],b[6],b[7])}return k(b[2],b[3],a,b[5],b[6],b[7])}},size:function(a){return function(b){return function(c){return k(c[2],-a,b,c[5],c[6],c[7])}}},opacity:function(a){return function(b){return k(b[2],b[3],b[4],a,b[6],b[7])}},color:function(a){return function(b){return k(b[2],b[3],b[4],b[5],["Just",a],b[7])}},link:function(a){return function(b){return k(b[2],b[3],b[4],b[5],b[6],["Just",u.castStringToJSString(a)])}},widthOf:c,heightOf:g,sizeOf:function(a){return["Tuple2",~~a[3],~~a[4]]},text:function(a){var b=Value.getTextSize(0,0,a);return f(j("left")(a),b[0],b[1])},asText:function(a){var a=Elm.Text.monospace(Value.toText(Value.show(a))),-b=Value.getTextSize(0,0,a);return f(j("left")(a),b[0],b[1])},plainText:function(a){var a=Value.toText(a),b=Value.getTextSize(0,0,a);return f(j("left")(a),b[0],b[1])},centeredText:function(a){var b=Value.getTextSize(0,0,a);return f(j("center")(a),b[0],b[1])},justifiedText:function(a){var b=Value.getTextSize(0,0,a);return f(j("justify")(a),b[0],b[1])},rightedText:function(a){var b=Value.getTextSize(0,0,a);return f(j("right")(a),b[0],b[1])},image:r,images:function(a){var b=Elm.Signal.constant(m(0)(0)),-a=Elm.Signal.lift(function(a){var a=u.castStringToJSString(a),c=new Image;c.onload=function(){Dispatcher.notify(b.id,r(this.width)(this.height)(a))};c.src=a})(a);return Elm.Signal.lift2(function(a){return function(){return a}})(b)(a)},video:function(a){return function(b){return function(c){return f(["EVideo",u.castStringToJSString(c)],a,b)}}},fittedImage:function(a){return function(b){return function(c){return f(["EFittedImage",u.castStringToJSString(c)],a,b)}}},flow:function(b){return function(d){var h;-h=map(c)(d);a:{switch(b[0]){case "DLeft":h=sum(h);break a;case "DRight":h=sum(h);break a}h=maximum(h)}var e;e=map(g)(d);a:{switch(b[0]){case "DDown":e=sum(e);break a;case "DUp":e=sum(e);break a}e=maximum(e)}return f(a(b)(d),h,e)}},above:function(b){return function(c){return f(a(q)(["Cons",b,["Cons",c,["Nil"]]]),Math.max(~~b[3],~~c[3]),~~b[4]+~~c[4])}},below:function(b){return function(c){return f(a(q)(["Cons",c,["Cons",b,["Nil"]]]),Math.max(~~b[3],~~c[3]),~~b[4]+~~c[4])}},beside:function(b){return function(c){return f(a(x)(["Cons",-b,["Cons",c,["Nil"]]]),~~b[3]+~~c[3],Math.max(~~b[4],~~c[4]))}},layers:function(b){return f(a(t)(b),maximum(map(c)(b)),maximum(map(g)(b)))},collage:function(a){return function(b){return function(c){return f(["ECollage",a,b,Value.groupForms(c)],a,b)}}},spacer:m,container:function(a){return function(b){return function(c){return function(g){return f(["EContainer",c,g],a,b)}}}},line:d,segment:function(a){return function(b){return d(["Cons",a,["Cons",b,["Nil"]]])}},polygon:i,rect:function(a){return function(b){return function(c){return i(["Cons",-["Tuple2",0-a/2,0-b/2],["Cons",["Tuple2",0-a/2,b/2],["Cons",["Tuple2",a/2,b/2],["Cons",["Tuple2",a/2,0-b/2],["Nil"]]]]])(c)}}},oval:n,circle:function(a){return n(2*a)(2*a)},ngon:function(a){return function(b){return function(c){var f=map(function(c){return["Tuple2",b*Math.cos(2*(Math.PI/a)*c),b*Math.sin(2*(Math.PI/a)*c)]}),g=a-1,d=["Nil"];if(0<=g){do d=["Cons",g,d];while(0<g--)}return i(f(d))(c)}}},solid:function(a){return function(c){return b(0)(1)(["Tuple2",0,0])(l(w)(a)(c))}},dotted:function(a){return function(c){return b(0)(1)(["Tuple2",-0,0])(l(C)(a)(c))}},dashed:function(a){return function(c){return b(0)(1)(["Tuple2",0,0])(l(E)(a)(c))}},customLine:function(a){return function(c){return function(f){return b(0)(1)(["Tuple2",0,0])(l(["Custom",u.castListToJSArray(a)])(c)(f))}}},filled:function(a){return function(c){return b(0)(1)(c[2])(h(A)(a)(c))}},outlined:function(a){return function(c){return b(0)(1)(c[2])(h(D)(a)(c))}},customOutline:function(a){return function(c){return function(f){return b(0)(1)(f[2])(h(["CustomOutline",u.castListToJSArray(a)])(c)(f))}}},-textured:function(a){return function(c){return b(0)(1)(c[2])(h(["Textured",a])(null)(c))}},sprite:function(a){return function(c){return function(f){return function(g){return b(0)(1)(g)(["FImage",c,f,u.castStringToJSString(a)])}}}},toForm:function(a){return function(c){return b(0)(1)(a)(["FElement",c])}},rotate:function(a){return function(c){a:{switch(c[0]){case "Form":var f=c[2],g=c[3],d=c[4],c=b(a+c[1])(f)(g)(d);break a}throw"Non-exhaustive pattern match in case";}return c}},scale:function(a){return function(c){return b(c[1])(a*-c[2])(c[3])(c[4])}},move:function(a){return function(c){return function(f){var g;a:{switch(f[0]){case "Form":g=f[1];var d=f[2],h=f[3],f=f[4];switch(h[0]){case "Tuple2":var e=h[1],h=h[2];g=b(g)(d)(["Tuple2",a+e,c+h])(f);break a}}throw"Non-exhaustive pattern match in case";}return g}}},isWithin:Collage.insideForm}}();-Elm.Text=function(){function e(a){return Value.toText(a)}var j=function(a){return function(b){return"<"+a+' style="padding:0;margin:0">'+b+"</"+a+">"}},a=function(a,b){return function(g){return"<span style='"+a+":"+b+"'>"+g+"</span>"}},d=function(b){b=Elm.JavaScript.castStringToJSString(b);return a("font-family",b)},i=j("h1"),b=a("font-style","italic"),j=j("b"),l=a("text-decoration","underline"),h=a("text-decoration","overline"),k=a("text-decoration","line-through");return{fromString:e,toText:e,header:i,-height:function(b){return a("font-size",b+"em")},italic:b,bold:j,underline:l,overline:h,strikeThrough:k,monospace:d("monospace"),typeface:d,color:function(b){return a("color",Elm.Color.extract(b))},link:function(a){return function(b){return"<a href='"+e(a)+"'>"+b+"</a>"}}}}();-var Render=function(){function e(a){a=document.createElement(a);a.style.padding="0";a.style.margin="0";return a}function j(a){return a}function a(a){a.style.styleFloat="left";a.style.cssFloat="left";return a}function d(a){a.style.position="absolute";return a}function i(a,b,g){for(var d=e("div"),h=g.length;h--;){var i=a(b(g[h]));d.appendChild(i)}return d}function b(a){switch(a[0]){case "Absolute":return a[1]+"px";case "Relative":return 100*a[1]+"%"}}function l(a,c){c.style.position="absolute";c.style.margin=-"auto";switch(a[0]){case "Position":"Far"!==a[1][0]&&(c.style.left=0);"Near"!==a[1][0]&&(c.style.right=0);"Far"!==a[2][0]&&(c.style.top=0);"Near"!==a[2][0]&&(c.style.bottom=0);break;case "PositionAt":c.style.top=b(a[2]);c.style.left=b(a[1]);var g="translate("+~~(-c.style.width.slice(0,-2)/2)+"px,"+~~(-c.style.height.slice(0,-2)/2)+"px)";c.style.transform=g;c.style.msTransform=g;c.style.MozTransform=g;c.style.webkitTransform=g;c.style.OTransform=g;break;default:g=a[0].slice(-2),c.style["T"===g[0]?-"top":"bottom"]=b(a[2]),c.style["L"===g[1]?"left":"right"]=b(a[1])}}function h(b){var c={};switch(b[2][0]){case "EText":var c=b[2][1],g=b[2][2],r=e("div");r.innerHTML=g;r.style.textAlign=c;c=r;break;case "EImage":c=b[2][1];g=e("img");g.src=c;g.name=c;g.style.display="block";c=g;break;case "EVideo":r=b[2][1];c=e("video");c.controls="controls";g=e("source");g.src=r;r=r.split(".");g.type="video/"+r[r.length-1];c.appendChild(g);c.style.display="block";break;case "EFittedImage":var m=b[3],n=b[4],c=b[2][1],-g=e("div");g.style.width=m+"px";g.style.height=n+"px";g.style.position="relative";g.style.overflow="hidden";var k=e("img");k.onload=function(){k.style.position="absolute";k.style.margin="auto";var a=m,b=n;m/n>this.width/this.height?b=Math.round(this.height*m/this.width):a=Math.round(this.width*n/this.height);k.style.width=a+"px";k.style.height=b+"px";k.style.left=(m-a)/2+"px";k.style.top=(n-b)/2+"px"};k.src=c;k.name=c;g.appendChild(k);c=g;break;case "EFlow":a:{c=b[2][2];switch(b[2][1][0]){case "DDown":c=-c.slice(0).reverse();case "DUp":c=i(j,h,c);break a;case "DRight":c=c.slice(0).reverse();case "DLeft":c=i(a,h,c);break a;case "DOut":c=c.slice(0).reverse();case "DIn":c=i(d,h,c);break a}c=void 0}break;case "ECollage":c=Collage.collage(b[2][1],b[2][2],b[2][3]);break;case "EEmpty":c=e("div");break;case "EContainer":g=b[2][1];c=h(b[2][2]);l(g,c);g=e("div");g.style.position="relative";g.style.overflow="hidden";g.appendChild(c);c=g;break;case "EHtml":c=b[2][1];"button"!==c.type&&(g=Value.getExcess(c),b[3]-=-g[0],b[4]-=g[1]);break;case "EExternalHtml":c=e("div"),c.appendChild(b[2][1])}c.id=b[1];c.style.width=~~b[3]+"px";c.style.height=~~b[4]+"px";1!==b[5]&&(c.style.opacity=b[5]);"Just"===b[6][0]&&(c.style.backgroundColor=Elm.Color.extract(b[6][1]));return"Just"===b[7][0]?(g=e("a"),g.href=b[7][1],g.appendChild(c),g):c}function k(b,c,g){"A"===b.tagName&&(b=b.firstChild);if(c[1]!==g[1]){if(c[2][0]!==g[2][0])return b.parentNode.replaceChild(h(g),b);var e=g[2],i=c[2];switch(e[0]){case "EText":e[1]!==i[1]&&-(b.style.textAlign=e[1]);e[2]!==i[2]&&(b.innerHTML=e[2]);break;case "EImage":e[1]!==i[1]&&(b.src=e[1]);break;case "EVideo":case "EFittedImage":if(!Value.eq(e,i)||g[3]!==c[3]||g[4]!==c[4])return b.parentNode.replaceChild(h(g),b);break;case "ECollage":if(e[1]!==i[1]||e[2]!==i[2]||e[3].length!==i[3].length)return b.parentNode.replaceChild(h(g),b);Collage.updateCollage(b,i[3],e[3]);break;case "EFlow":if(e[1]!==i[1])return b.parentNode.replaceChild(h(g),b);var n=e[2],u=b.childNodes;if(n.length!==u.length)return b.parentNode.replaceChild(h(g),-b);var i=i[2],x=function(a){return a};switch(e[1][0]){case "DDown":case "DUp":x=j;break;case "DRight":case "DLeft":x=a;break;case "DOut":case "DIn":x=d}for(e=u.length;e--;)k(u[e],i[e],n[e]),x(u[e]);break;case "EContainer":k(b.childNodes[0],i[2],e[2]);l(e[1],b.childNodes[0]);break;case "EHtml":g[1]!==c[1]&&(n=h(g),b.parentNode.replaceChild(n,b),b=n);"button"!==n.type&&(e=Value.getExcess(b),g[3]-=e[0],g[4]-=e[1]);break;case "EExternalHtml":g[1]!==c[1]&&b.parentNode.replaceChild(h(g),b)}g[3]!==c[3]&&-(b.style.width=~~g[3]+"px");g[4]!==c[4]&&(b.style.height=~~g[4]+"px");g[5]!==c[5]&&(b.style.opacity=g[5]);2===g[6].length&&(e=Elm.Color.extract(g[6][1]),e!==b.style.backgroundColor&&(b.style.backgroundColor=e));if(2===g[7].length&&(1===c[7].length||g[7][1]!==c[7][1]))b.parentNode.href=g[7][1];g[1]=c[1]}}return{render:h,update:k,addTo:function(a,b){a.appendChild(b)},newElement:e,flowWith:i,goIn:d}}();-Elm.Signal=function(){function e(a){this.id=Guid.guid();this.value=a;this.kids=[];this.defaultNumberOfKids=0;this.recv=function(a,b,c){if(b=b===this.id)this.value=c;k(this,a,b);return b};Dispatcher.inputs.push(this)}function j(a,b){this.id=Guid.guid();this.value=null;this.kids=[];this.count=0;this.changed=!1;b.reverse();this.recalc=function(){for(var d=a,f=b.length;f--;)d=d(b[f].value);this.value=d};this.recalc();this.recv=function(a,c){this.count+=1;c&&(this.changed=!0);this.count==b.length&&(this.changed&&-this.recalc(),k(this,a,this.changed),this.changed=!1,this.count=0)};for(var d=b.length;d--;)b[d].kids.push(this)}function a(a,b,d,f){this.id=Guid.guid();this.value=d?b(f.value):b;this.kids=[];this.recv=function(b,d){d&&(this.value=a(f.value)(this.value));k(this,b,d)};f.kids.push(this)}function d(a,b,d){this.id=Guid.guid();this.value=a(d.value)?b:d.value;this.kids=[];this.recv=function(b,g){var f=g&&!a(d.value);f&&(this.value=d.value);k(this,b,f)};d.kids.push(this)}function i(a){this.id=Guid.guid();-this.value=a.value;this.kids=[];this.recv=function(b,d){var f=d&&!Value.eq(this.value,a.value);f&&(this.value=a.value);k(this,b,f)};a.kids.push(this)}function b(a,b){this.id=Guid.guid();var d=(new window.Date).getTime();this.value=a?Value.Tuple(d,b.value):d;this.kids=[];this.recv=function(d,f){f&&(this.value=a?Value.Tuple(d,b.value):d);k(this,d,f)};b.kids.push(this)}function l(a,b){this.id=Guid.guid();this.value=b.value;this.kids=[];this.count=0;this.changed=!1;this.recv=function(d,f,e){e===a.id&&-(this.changed=f);this.count+=1;2==this.count&&(this.changed&&(this.value=b.value),k(this,d,this.changed),this.count=0,this.changed=!1)};a.kids.push(this);b.kids.push(this)}function h(a,b){this.id=Guid.guid();this.value=a.value;this.kids=[];this.next=null;this.count=0;this.changed=!1;this.recv=function(d,f,e){this.count+=1;f&&(this.changed=!0,e==b.id&&null===this.next&&(this.next=b.value),e==a.id&&(this.next=a.value));2==this.count&&(this.changed&&(this.value=this.next,this.next=null),k(this,d,this.changed),-this.changed=!1,this.count=0)};a.kids.push(this);b.kids.push(this)}var k=function(a,b,d){for(var f=a.kids,e=f.length;e--;)f[e].recv(b,d,a.id)},f=function(a){return function(b){return function(f){f=new j(function(a){return function(b){return[a,b]}},[a,f]);f=new d(function(a){return a[0]},[!0,b],f);return new j(function(a){return a[1]},[f])}}};return{constant:function(a){return new e(a)},lift:function(a){return function(b){return new j(a,[b])}},lift2:function(a){return function(b){return function(d){return new j(a,-[b,d])}}},lift3:function(a){return function(b){return function(d){return function(f){return new j(a,[b,d,f])}}}},lift4:function(a){return function(b){return function(d){return function(f){return function(e){return new j(a,[b,d,f,e])}}}}},lift5:function(a){return function(b){return function(d){return function(f){return function(e){return function(h){return new j(a,[b,d,f,e,h])}}}}}},lift6:function(a){return function(b){return function(d){return function(f){return function(e){return function(h){return function(i){return new j(a,-[b,d,f,e,h,i])}}}}}}},lift7:function(a){return function(b){return function(d){return function(f){return function(e){return function(h){return function(i){return function(k){return new j(a,[b,d,f,e,h,i,k])}}}}}}}},lift8:function(a){return function(b){return function(d){return function(f){return function(e){return function(h){return function(i){return function(k){return function(l){return new j(a,[b,d,f,e,h,i,k,l])}}}}}}}}},foldp:function(b){return function(d){return function(f){return new a(b,d,!1,-f)}}},foldp_:function(b){return function(d){return function(f){return new a(b,d,!0,f)}}},foldp1:function(b){return function(d){return new a(b,function(a){return a},!0,d)}},delay:function(a){return function(b){var d=new e(b.value),f=!0,b=new l(d,new j(function(a){return function(){return a}},[d,new j(function(b){f||setTimeout(function(){Dispatcher.notify(d.id,b)},a)},[b])])),f=!1;return b}},merge:function(a){return function(b){return new h(a,b)}},merges:function(a){return Elm.List.foldl1(function(a){return function(b){return new h(a,-b)}})(a)},average:function(a){return function(b){for(var d=Array(a),f=a;f--;)d[f]=0;var f=0,e=!1,h=0;return new j(function(b){h+=b-d[f];d[f]=b;b=h/Math.max(1,e?a:f);++f==a&&(e=!0,f=0);return b},[b])}},count:function(b){return new a(function(){return function(a){return a+1}},0,!1,b)},countIf:function(b){return function(d){return new a(function(a){return function(d){return b(a)?d+1:d}},0,!1,d)}},keepIf:function(a){return function(b){return function(f){return new d(function(b){return!a(b)},b,f)}}},dropIf:function(a){return function(b){return function(f){return new d(a,-b,f)}}},keepWhen:function(a){return f(new j(function(a){return!a},[a]))},dropWhen:f,dropRepeats:function(a){return new i(a)},sampleOn:function(a){return function(b){return new l(a,b)}},timestamp:function(a){return new b(!0,a)},timeOf:function(a){return new b(!1,a)}}}();-var Dispatcher=function(){function e(a){if(!a.hasOwnProperty("defaultNumberOfKids"))return!0;var b=a.kids.length;if(0==b)return!1;if(b>a.defaultNumberOfKids)return!0;for(var d=!1;b--;)d=d||e(a.kids[b]);return d}var j=null,a=[],d=null;return{initialize:function(){j=Elm.main();j.hasOwnProperty("recv")||(j=Elm.Signal.constant(j));d=j.value;for(var i=[],b=a.length;b--;)e(a[b])&&i.push(a[b]);a=i;document.getElementById("content").appendChild(Render.render(d));i=document.getElementById("widthChecker").offsetWidth;-i!==window.innerWidth&&Dispatcher.notify(Elm.Window.dimensions.id,Value.Tuple(i,window.innerHeight));j=Elm.Signal.lift(function(a){var b=document.getElementById("content");Render.update(b.firstChild,d,a);return d=a})(j)},notify:function(d,b){for(var e=(new window.Date).getTime(),h=!1,j=a.length;j--;)h=a[j].recv(e,d,b)||h;return h},inputs:a}}();-Elm.HTTP=function(){function e(a){return function(d){return function(f){return function(c){return{"0":"Request",length:1,verb:b.castStringToJSString(a),url:b.castStringToJSString(d),data:null===f?null:b.castStringToJSString(f),headers:c}}}}}function j(a){return e("GET")(a)(null)(["Nil"])}function a(a,e){return function(f){if(""!==f.url){var c={value:["Waiting"]};a.push(c);var g=null;window.ActiveXObject&&(g=new ActiveXObject("Microsoft.XMLHTTP"));window.XMLHttpRequest&&(g=new XMLHttpRequest);g.onreadystatechange=-function(){4===g.readyState&&(c.value=200===g.status?["Success",l(g.responseText)]:["Failure",g.status,l(g.statusText)],setTimeout(function(){d(a,e)},0))};g.open(f.verb,f.url,!0);Elm.List.map(function(a){g.setRequestHeader(b.castStringToJSString(a[1]),b.castStringToJSString(a[2]))})(f.headers);g.send(f.data)}}}function d(a,b){0<a.length&&(Dispatcher.notify(b.id,a[0].value),"Waiting"!==a[0].value[0]&&(a.shift(),setTimeout(function(){d(a,b)},0)))}function i(b){var d=Elm.Signal.constant(["Waiting"]),-b=Elm.Signal.lift(a([],d))(b);return Elm.Signal.lift2(function(a){return function(){return a}})(d)(b)}var b=Elm.JavaScript,l=Elm.JavaScript.castJSStringToString;return{get:j,post:function(a){return function(b){return e("POST")(a)(b)(["Nil"])}},request:e,send:i,sendGet:function(a){return i(Elm.Signal.lift(j)(a))}}}();-Elm.Input=function(){var e=Elm.JavaScript,j=Elm.JavaScript.castJSStringToString,a=function(a,d){a.placeholder=e.castStringToJSString(d);var h=Elm.Signal.constant(["Nil"]);Value.addListener(a,"keyup",function(){Dispatcher.notify(h.id,j(a.value));a.focus()});a.style.padding="1px";return Value.Tuple(Value.wrap(a),h)},d=function(a){a=document.createElement(a);a.style.padding="0";a.style.margin="0";return a},i=function(a){for(var e=d("select"),h=[];"Cons"===a[0];){var i=d("option"),f=Value.toText(a[1][1]);-i.value=f;i.innerHTML=f;e.appendChild(i);h.push(a[1][2]);a=a[2]}var c=Elm.Signal.constant(h[0]);Value.addListener(e,"change",function(){Dispatcher.notify(c.id,h[e.selectedIndex])});return Value.Tuple(Value.wrap(e),c)};return{textArea:function(b){return function(e){var h=d("textarea");h.rows=e;h.cols=b;return a(h,"")}},textField:function(b){var e=d("input");e.type="text";return a(e,b)},password:function(b){var e=d("input");e.type="password";return a(e,b)},checkbox:function(a){var e=d("input");e.type=-"checkbox";e.checked=a;var h=Elm.Signal.constant(a);Value.addListener(e,"change",function(){Dispatcher.notify(h.id,e.checked)});return Value.Tuple(Value.wrap(e),h)},dropDown:i,stringDropDown:function(a){return i(Elm.List.map(function(a){return Value.Tuple(a,a)})(a))},button:function(a){var i=d("input");i.type="button";i.value=e.castStringToJSString(a);var h=Elm.Signal.constant(!1);Value.addListener(i,"click",function(){Dispatcher.notify(h.id,!0);Dispatcher.notify(h.id,!1)});return Value.Tuple(Value.wrap(i),-h)}}}();-Elm.Keyboard={Raw:function(){function e(a,i){return"Nil"===i[0]?i:i[1]===a?i[2]:["Cons",i[1],e(a,i[2])]}var j=Elm.Signal.constant(["Nil"]),a=Elm.Signal.constant(["Nothing"]);Value.addListener(document,"keydown",function(a){var e;a:{for(e=j.value;"Nil"!==e[0];){if(e[1]===a.keyCode){e=!0;break a}e=e[2]}e=!1}e||Dispatcher.notify(j.id,["Cons",a.keyCode,j.value])||this.removeEventListener("keydown",arguments.callee,!1)});Value.addListener(document,"keyup",function(a){var i=e(a.keyCode,j.value);Dispatcher.notify(j.id,-i)||this.removeEventListener("keyup",arguments.callee,!1)});Value.addListener(window,"blur",function(a){Dispatcher.notify(j.id,["Nil"])||this.removeEventListener("blur",arguments.callee,!1)});Value.addListener(document,"keypress",function(d){var e=Dispatcher.notify(a.id,["Just",d.charCode||d.keyCode]);Dispatcher.notify(a.id,["Nothing"]);e||this.removeEventListener("keypress",arguments.callee,!1)});return{keysDown:j,charPressed:a}}()};-Elm.Mouse=function(){function e(a){var b=0,d=0;a||(a=window.event);if(a.pageX||a.pageY)b=a.pageX,d=a.pageY;else if(a.clientX||a.clientY)b=a.clientX+document.body.scrollLeft+document.documentElement.scrollLeft,d=a.clientY+document.body.scrollTop+document.documentElement.scrollTop;return Value.Tuple(b,d)}var j=Elm.Signal.constant(Value.Tuple(0,0));j.defaultNumberOfKids=2;var a=Elm.Signal.lift(function(a){return a[1]})(j);a.defaultNumberOfKids=0;var d=Elm.Signal.lift(function(a){return a[2]})(j);d.defaultNumberOfKids=-0;var i=Elm.Signal.constant(!1),b=Elm.Signal.constant(!1),l=Elm.Signal.constant(Value.Tuple());Value.addListener(document,"click",function(a){var d=Dispatcher.notify(b.id,!0),f=Dispatcher.notify(l.id,Value.Tuple());Dispatcher.notify(b.id,!1);!d&&!f&&this.removeEventListener("click",arguments.callee,!1)});Value.addListener(document,"mousedown",function(a){Dispatcher.notify(i.id,!0)||this.removeEventListener("mousedown",arguments.callee,!1)});Value.addListener(document,"mouseup",function(a){Dispatcher.notify(i.id,-!1)||this.removeEventListener("mouseup",arguments.callee,!1)});Value.addListener(document,"mousemove",function(a){Dispatcher.notify(j.id,e(a))||this.removeEventListener("mousemove",arguments.callee,!1)});return{position:j,x:a,y:d,isClicked:b,isDown:i,clicks:l,isClickedOn:function(a){var a=Render.render(a),b=Elm.Signal.constant(!1);Value.addListener(a,"click",function(){Dispatcher.notify(b.id,!0);Dispatcher.notify(b.id,!1)});return Value.Tuple(Value.wrap(a),b)}}}();-Elm.Random=function(){return{inRange:function(e){return function(j){return Elm.Signal.constant(Math.floor(Math.random()*(j-e+1))+e)}},randomize:function(e){return function(j){return function(a){return Elm.Signal.lift(function(){return Math.floor(Math.random()*(j-e+1))+e})(a)}}}}}();-Elm.Time=function(){function e(){return(new window.Date).getTime()}function j(a){return function(d){var i=1E3/a,b=e(),j=b,h=0,k=!0,f=Elm.Signal.constant(h),c=0;return Elm.Signal.lift2(function(a){return function(d){if(a){var m=!k&&a;c=setTimeout(function(){j=e();h=m?0:j-b;b=j;Dispatcher.notify(f.id,h)},i)}else k&&clearTimeout(c);k=a;return d}})(d)(f)}}Elm.Signal.constant(!0);return{fpsWhen:j,fps:function(a){return j(a)(Elm.Signal.constant(!0))},every:function(a){var d=Elm.Signal.constant(e());setInterval(function(){Dispatcher.notify(d.id,-e())},a);return d},delay:Elm.Signal.delay,since:function(a){return function(d){var e=Elm.Signal.count(Elm.Signal.delay(a)(d));return Elm.Signal.lift2(function(a){return function(d){return!Value.eq(a,d)}})(Elm.Signal.count(d))(e)}},after:function(a){var a=1E3*a,d=Elm.Signal.constant(!1);setTimeout(function(){Dispatcher.notify(d.id,!0)},a);return d},before:function(a){var a=1E3*a,d=Elm.Signal.constant(!0);setTimeout(function(){Dispatcher.notify(d.id,!1)},a);return d},hour:36E5,minute:6E4,second:1E3,-ms:1,inHours:function(a){return a/36E5},inMinutes:function(a){return a/6E4},inSeconds:function(a){return a/1E3},inMss:function(a){return a},toDate:function(a){return new window.Date(a)},read:function(a){a=window.Date.parse(a);return isNaN(a)?["Nothing"]:["Just",a]}}}();-Elm.Window=function(){var e=Elm.Signal.constant(Value.Tuple(window.innerWidth,window.innerHeight));e.defaultNumberOfKids=2;var j=Elm.Signal.lift(function(a){return a[1]})(e);j.defaultNumberOfKids=0;var a=Elm.Signal.lift(function(a){return a[2]})(e);a.defaultNumberOfKids=0;Value.addListener(window,"resize",function(a){var i=document.getElementById("widthChecker").offsetWidth;Dispatcher.notify(e.id,Value.Tuple(i,window.innerHeight))||this.removeEventListener("resize",arguments.callee,!1)});return{dimensions:e,-width:j,height:a}}();-Elm.Date=function(){var e="Sun Mon Tue Wed Thu Fri Sat".split(" "),j="Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec".split(" ");return{read:function(a){a=new window.Date(Elm.JavaScript.castStringToJSString(a));return isNaN(a.getTime())?["Nothing"]:["Just",a]},year:function(a){return a.getFullYear()},month:function(a){return[j[a.getMonth()]]},day:function(a){return a.getDate()},hour:function(a){return a.getHours()},minute:function(a){return a.getMinutes()},second:function(a){return a.getSeconds()},dayOfWeek:function(a){return[e[a.getDay()]]},-toTime:function(a){return a.getTime()},Mon:["Mon"],Tue:["Tue"],Wed:["Wed"],Thu:["Thu"],Fri:["Fri"],Sat:["Sat"],Sun:["Sun"],Jan:["Jan"],Feb:["Feb"],Mar:["Mar"],Apr:["Apr"],May:["May"],Jun:["Jun"],Jul:["Jul"],Aug:["Aug"],Sep:["Sep"],Oct:["Oct"],Nov:["Nov"],Dec:["Dec"]}}();Value.addListener(document,"elm_log",function(e){console.log(e.value)});Value.addListener(document,"elm_title",function(e){document.title=e.value});-Value.addListener(document,"elm_redirect",function(e){0<e.value.length&&(window.location=e.value)});-Elm.Prelude=function(){function e(a){return function(d){if(a instanceof Array&&d instanceof Array){var i=a.length;if(i==d.length){for(var b=1;b<i;++b){var j=e(a[b])(d[b]);if("EQ"!==j[0])return j}return["EQ"]}return[1==d.length?"GT":"LT"]}return[a===d?"EQ":a<d?"LT":"GT"]}}var j=function(a){return function(d){var e=a%d,e=0==a?0:0<d?0<=a?e:e+d:-j(-a)(-d);return e==d?0:e}};return{eq:Value.eq,id:function(a){return a},not:function(a){return!a},fst:function(a){return a[1]},snd:function(a){return a[2]},rem:function(a){return function(d){return a%-d}},div:function(a){return function(d){return~~(a/d)}},otherwise:!0,compare:e,toFloat:function(a){return a},round:function(a){return Math.round(a)},floor:function(a){return Math.floor(a)},ceiling:function(a){return Math.ceil(a)},truncate:function(a){return~~a},readInt:function(a){var a=Elm.JavaScript.castStringToJSString(a),d=a.length;if(0===d)return["Nothing"];var e=0;if("-"==a[0]){if(1===d)return["Nothing"];e=1}for(;e<d;++e)if(!Elm.Char.isDigit(a[e]))return["Nothing"];return["Just",parseInt(a)]},-readFloat:function(a){var a=Elm.JavaScript.castStringToJSString(a),d=a.length;if(0===d)return["Nothing"];var e=0;if("-"==a[0]){if(1===d)return["Nothing"];e=1}for(var b=0;e<d;++e)if(!Elm.Char.isDigit(a[e])){if("."===a[e]&&(b+=1,1>=b))continue;return["Nothing"]}return["Just",parseFloat(a)]},sqrt:Math.sqrt,abs:Math.abs,pi:Math.PI,e:Math.E,sin:Math.sin,cos:Math.cos,tan:Math.tan,asin:Math.asin,acos:Math.acos,atan:Math.atan,atan2:function(a){return function(d){return Math.atan2(a,d)}},mod:j,min:function(a){return function(d){return Math.min(a,-d)}},max:function(a){return function(d){return Math.max(a,d)}},flip:function(a){return function(d){return function(e){return a(e)(d)}}},clamp:function(a){return function(d){return function(e){return Math.min(d,Math.max(a,e))}}},curry:function(a){return function(d){return function(e){return a(["Tuple2",d,e])}}},uncurry:function(a){return function(d){if("Tuple2"!==d[0])throw"Function was uncurry'd but was not given a pair.";return a(d[1])(d[2])}},logBase:function(a){return function(d){return Math.log(d)/-Math.log(a)}},Just:Elm.Maybe.Just,Nothing:Elm.Maybe.Nothing,maybe:Elm.Maybe.maybe,map:Elm.List.map,zip:Elm.List.zip,zipWith:Elm.List.zipWith,filter:Elm.List.filter,head:Elm.List.head,tail:Elm.List.tail,last:Elm.List.last,length:Elm.List.length,reverse:Elm.List.reverse,foldr:Elm.List.foldr,foldr1:Elm.List.foldr1,foldl:Elm.List.foldl,foldl1:Elm.List.foldl1,and:Elm.List.and,or:Elm.List.or,all:Elm.List.all,any:Elm.List.any,sum:Elm.List.sum,product:Elm.List.product,concat:Elm.List.concat,concatMap:Elm.List.concatMap,-maximum:Elm.List.maximum,minimum:Elm.List.minimum,scanl:Elm.List.scanl,scanl1:Elm.List.scanl1,take:Elm.List.take,drop:Elm.List.drop,zip:Elm.List.zip,unzip:Elm.List.unzip,lift:Elm.Signal.lift,lift2:Elm.Signal.lift2,lift3:Elm.Signal.lift3,lift4:Elm.Signal.lift4,lift5:Elm.Signal.lift5,lift6:Elm.Signal.lift6,lift7:Elm.Signal.lift7,lift8:Elm.Signal.lift8,foldp:Elm.Signal.foldp,foldp1:Elm.Signal.foldp1,foldp_:Elm.Signal.foldp_,constant:Elm.Signal.constant,merge:Elm.Signal.merge,count:Elm.Signal.count,countIf:Elm.Signal.countIf,-average:Elm.Signal.average,keepIf:Elm.Signal.keepIf,dropIf:Elm.Signal.dropIf,keepWhen:Elm.Signal.keepWhen,dropWhen:Elm.Signal.dropWhen,dropRepeats:Elm.Signal.dropRepeats,sampleOn:Elm.Signal.sampleOn,timestamp:Elm.Signal.timestamp,timeOf:Elm.Signal.timeOf}}();(function(){var e=function(e){for(var a in e)Elm.Prelude[a]=e[a]};e(Elm.Color);e(Elm.Text);e(Elm.Graphics);e(Elm.Time);show=Value.show})();-Elm.Dict=function(){function e(a){return function(b){return function(c){return function(d){return function(e){return["RBNode",a,b,c,d,e]}}}}}function j(a){a:{switch(a[0]){case "RBEmpty":throw"(min RBEmpty) is not defined";case "RBNode":switch(a[4][0]){case "RBEmpty":a=["Tuple2",a[2],a[3]];break a}a=j(a[4]);break a}throw"Non-exhaustive pattern match in case";}return a}function a(b){return function(c){var d;a:{switch(c[0]){case "RBEmpty":d=v;break a;case "RBNode":d=function(){switch(p(b)(c[2])[0]){case "EQ":return z(c[3]);-case "GT":return a(b)(c[5]);case "LT":return a(b)(c[4])}throw"Non-exhaustive pattern match in case";}();break a}throw"Non-exhaustive pattern match in case";}return d}}function d(a){return function(b){return function(c){var e;a:{switch(c[0]){case "RBEmpty":e=a;break a;case "RBNode":e=function(){switch(p(b)(c[2])[0]){case "EQ":return c[3];case "GT":return d(a)(b)(c[5]);case "LT":return d(a)(b)(c[4])}throw"Non-exhaustive pattern match in case";}();break a}throw"Non-exhaustive pattern match in case";-}return e}}}function i(b){return function(c){return E(a(b)(c))}}function b(a){a:{switch(a[0]){case "RBNode":switch(a[5][0]){case "RBNode":a=e(a[1])(a[5][2])(a[5][3])(e(A)(a[2])(a[3])(a[4])(a[5][4]))(a[5][5]);break a}}throw"rotateLeft of a node without enough children";}return a}function l(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":a=e(a[1])(a[4][2])(a[4][3])(a[4][4])(e(A)(a[2])(a[3])(a[4][5])(a[5]));break a}}throw"rotateRight of a node without enough children";}return a}function h(a){a:{switch(a[0]){case "Black":a=-A;break a;case "Red":a=D;break a}throw"Non-exhaustive pattern match in case";}return a}function k(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[5][0]){case "RBNode":a=e(h(a[1]))(a[2])(a[3])(e(h(a[4][1]))(a[4][2])(a[4][3])(a[4][4])(a[4][5]))(e(h(a[5][1]))(a[5][2])(a[5][3])(a[5][4])(a[5][5]));break a}}}throw"color_flip called on a RBEmpty or RBNode with a RBEmpty child";}return a}function f(a){a:switch(a[0]){case "RBNode":switch(a[5][0]){case "RBNode":switch(a[5][1][0]){case "Red":a=-b(a);break a}}}a:switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][1][0]){case "Red":switch(a[4][4][0]){case "RBNode":switch(a[4][4][1][0]){case "Red":a=l(a);break a}}}}}a:switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][1][0]){case "Red":switch(a[5][0]){case "RBNode":switch(a[5][1][0]){case "Red":a=k(a);break a}}}}}return a}function c(a){a:switch(a[0]){case "RBNode":switch(a[1][0]){case "Red":a=e(D)(a[2])(a[3])(a[4])(a[5]);break a}}return a}function g(a){return function(b){return function(d){var g=-function(c){var d;a:{switch(c[0]){case "RBEmpty":d=e(A)(a)(b)(y)(y);break a;case "RBNode":d=function(){switch(p(a)(c[2])[0]){case "EQ":return e(c[1])(c[2])(b)(c[4])(c[5]);case "GT":return e(c[1])(c[2])(c[3])(c[4])(g(c[5]));case "LT":return e(c[1])(c[2])(c[3])(g(c[4]))(c[5])}throw"Non-exhaustive pattern match in case";}();d=f(d);break a}throw"Non-exhaustive pattern match in case";}return d};return c(g(d))}}}function r(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][1][0]){case "Red":a=-!0;break a}}}a=!1}return a}function m(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][4][0]){case "RBNode":switch(a[4][4][1][0]){case "Red":a=!0;break a}}}}a=!1}return a}function n(a){if(w(r(a))&&w(m(a))){a=k(a);a:switch(a[0]){case "RBNode":b:switch(a[5][0]){case "RBNode":switch(a[5][4][0]){case "RBNode":switch(a[5][4][1][0]){case "Red":a=k(b(e(a[1])(a[2])(a[3])(a[4])(l(a[5]))));break b}}}break a}}return a}function u(a){return function(b){var d=function(b){a:{switch(b[0]){case "RBEmpty":b=-y;break a;case "RBNode":if("LT"===p(a)(b[2])[0])b:{b=n(b);switch(b[0]){case "RBEmpty":throw"delLT on RBEmpty";case "RBNode":b=f(e(b[1])(b[2])(b[3])(d(b[4]))(b[5]));break b}break}else{var g=r(b)?l(b):b,h;b:{switch(g[0]){case "RBNode":switch(g[5][0]){case "RBEmpty":h=C(a,g[2]);break b}}h=!1}if(h)b=g[4];else{g=w;b:{switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":h=!0;break b}}}h=!1}if(g=g(h)){g=w;b:{switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][4][0]){case "RBNode":switch(b[5][4][1][0]){case "Red":h=-!0;break b}}}}h=!1}g=g(h)}g&&(b=k(b),b=m(b)?k(l(b)):b);b:{switch(b[0]){case "RBNode":g=C(a,b[2]);break b}g=!1}if(g)b:{switch(b[0]){case "RBEmpty":throw"delEQ called on a RBEmpty";case "RBNode":h=j(b[5]);c:{switch(h[0]){case "Tuple2":g=h[1];break c}break}c:{switch(h[0]){case "Tuple2":h=h[2];break c}break}var g=e(b[1])(g)(h)(b[4]),i=function(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBEmpty":a=y;break a}}b:{a=n(a);switch(a[0]){case "RBEmpty":a=y;break b;case "RBNode":a=f(e(a[1])(a[2])(a[3])(i(a[4]))(a[5]));-break b}throw"Non-exhaustive pattern match in case";}}return a},b=c(i(b[5])),b=f(g(b));break b}break}else b:{switch(b[0]){case "RBEmpty":throw"delGT called on a RBEmpty";case "RBNode":b=f(e(b[1])(b[2])(b[3])(b[4])(d(b[5])));break b}break}}}break a}throw"Non-exhaustive pattern match in case";}return b};return i(a)(b)?c(d(b)):b}}function x(a){return function(b){a:{switch(b[0]){case "RBEmpty":b=y;break a;case "RBNode":b=e(b[1])(b[2])(a(b[3]))(x(a)(b[4]))(x(a)(b[5]));break a}throw"Non-exhaustive pattern match in case";-}return b}}function q(a){return function(b){return function(c){a:{switch(c[0]){case "RBEmpty":c=b;break a;case "RBNode":c=q(a)(a(c[2])(c[3])(q(a)(b)(c[4])))(c[5]);break a}throw"Non-exhaustive pattern match in case";}return c}}}function t(a){return function(b){return function(c){a:{switch(c[0]){case "RBEmpty":c=b;break a;case "RBNode":c=t(a)(a(c[2])(c[3])(t(a)(b)(c[5])))(c[4]);break a}throw"Non-exhaustive pattern match in case";}return c}}}var p=Elm.Prelude.compare,s=Elm.Prelude.uncurry,v=Elm.Prelude.Nothing,-z=Elm.Prelude.Just,w=Elm.Prelude.not,C=Elm.Prelude.eq,E=Elm.Maybe.isJust,A=["Red"],D=["Black"],y=["RBEmpty"],B=y;return{$op:{},empty:B,lookup:a,findWithDefault:d,member:i,insert:g,singleton:function(a){return function(b){return g(a)(b)(y)}},remove:u,map:x,foldl:q,foldr:t,union:function(a){return function(b){return q(g)(b)(a)}},intersect:function(a){return function(b){return q(function(a){return function(c){return function(d){return i(a)(b)?g(a)(c)(d):d}}})(B)(a)}},diff:function(a){return function(b){return q(function(a){return function(){return function(b){return u(a)(b)}}})(a)(b)}},-keys:function(a){return t(function(a){return function(){return function(b){return["Cons",a,b]}}})(["Nil"])(a)},values:function(a){return t(function(){return function(a){return function(b){return["Cons",a,b]}}})(["Nil"])(a)},toList:function(a){return t(function(a){return function(b){return function(c){return["Cons",["Tuple2",a,b],c]}}})(["Nil"])(a)},fromList:function(a){return Elm.List.foldl(s(g))(B)(a)}}}();-Elm.Set=function(){var e=Elm.Dict.empty,j=Elm.Dict.remove,a=Elm.Dict.member,d=Elm.Dict.union,i=Elm.Dict.intersect,b=Elm.Dict.diff,l=Elm.Dict.keys,h=Elm.List.foldl(function(a){return function(b){return Elm.Dict.insert(a)(["Tuple0"])(b)}})(e);return{empty:e,singleton:function(a){return Elm.Dict.singleton(a)(["Tuple0"])},insert:function(a){return Elm.Dict.insert(a)(["Tuple0"])},remove:j,member:a,union:d,intersect:i,diff:b,toList:l,fromList:h,foldl:function(a){return Elm.Dict.foldl(function(b){return function(){return function(c){return a(b)(c)}}})},-foldr:function(a){return Elm.Dict.foldr(function(b){return function(){return function(c){return a(b)(c)}}})},map:function(a){return function(b){b=l(b);return h(Elm.List.map(a)(b))}}}}();-(function(){try{var e={};for(this.i in Elm)eval("var "+this.i+"=Elm[this.i];");if(Elm.Automaton)throw"Module name collision, 'Automaton' is already defined.";Elm.Automaton=function(){function a(a){return["Automaton",a]}function d(b){return a(function(a){var c=unzip(map(function(b){a:{switch(b[0]){case "Automaton":b=b[1](a);break a}throw"Non-exhaustive pattern match in case";}return b})(b)),e;a:{switch(c[0]){case "Tuple2":e=c[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(c[0]){case "Tuple2":c=-c[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",e,d(c)]})}function i(b){return a(function(a){return["Tuple2",b(a),i(b)]})}function b(c){return function(d){return a(function(a){a=d(a)(c);return["Tuple2",a,b(a)(d)]})}}function j(b){return function(c){return a(function(a){var d=c(a)(b);a:{switch(d[0]){case "Tuple2":a=d[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(d[0]){case "Tuple2":d=d[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",-a,j(d)(c)]})}}function h(a){return function(b){a:{switch(a[0]){case "Tuple2":b:{switch(b[0]){case "Tuple2":b=["Tuple2",a[1]-b[1],a[2]-b[2]];break b}break}break a}throw"Non-exhaustive pattern match in case";}return b}}function k(a){return function(b){var c;a:{switch(a[0]){case "Tuple2":b:{switch(b[0]){case "Tuple2":var d=function(a){return["Tuple2",b[2],["Tuple2",a,b[2]]]};c=function(){switch(b[1][0]){case "DragFrom":var c;a[1]?c=["Tuple2",uncurry(move)(h(a[2])(b[1][1]))(b[2]),["Tuple2",["DragFrom",-b[1][1]],b[2]]]:(c=uncurry(move)(h(a[2])(b[1][1]))(b[2]),c=["Tuple2",c,["Tuple2",g,c]]);return c;case "Ignore":return d(a[1]?r:g);case "Listen":return d(not(a[1])?g:isWithin(a[2])(b[2])?["DragFrom",a[2]]:r)}throw"Non-exhaustive pattern match in case";}();break b}break}break a}throw"Non-exhaustive pattern match in case";}return c}}try{if(!(Elm.Prelude instanceof Object))throw"module not found";}catch(f){throw"Module 'Prelude' is missing. Compile with --make flag or load missing module in a separate JavaScript file.";-}var c={};for(this.i in Elm.Prelude)c[this.i]||eval("var "+this.i+" = Elm.Prelude[this.i];");var g=["Listen"],r=["Ignore"];e[">>>"]=function(b){return function(c){var d;a:{switch(b[0]){case "Automaton":d=b[1];break a}throw"Non-exhaustive pattern match in case";}var f;a:{switch(c[0]){case "Automaton":f=c[1];break a}throw"Non-exhaustive pattern match in case";}return a(function(a){var a=d(a),b;a:{switch(a[0]){case "Tuple2":b=a[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(a[0]){case "Tuple2":a=-a[2];break a}throw"Non-exhaustive pattern match in case";}var c=f(b);a:{switch(c[0]){case "Tuple2":b=c[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(c[0]){case "Tuple2":c=c[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",b,e[">>>"](a)(c)]})}};e["<<<"]=function(a){return function(b){return e[">>>"](b)(a)}};e["^>>"]=function(a){return function(b){return e[">>>"](i(a))(b)}};e[">>^"]=function(a){return function(b){return e[">>>"](a)(i(b))}};e["^<<"]=function(a){return function(b){return e[">>>"](b)(i(a))}};-e["<<^"]=function(a){return function(b){return e[">>>"](i(b))(a)}};c=b(0)(function(){return function(a){return 1+a}});return{$op:{">>>":e[">>>"],"<<<":e["<<<"],"^>>":e["^>>"],">>^":e[">>^"],"^<<":e["^<<"],"<<^":e["<<^"]},run:function(a){return function(b){a:{switch(a[0]){case "Automaton":b=lift(fst)(foldp_(function(a){return function(b){a:{switch(b[0]){case "Tuple2":switch(b[2][0]){case "Automaton":b=b[2][1](a);break a}}throw"Non-exhaustive pattern match in case";}return b}})(a[1])(b));break a}throw"Non-exhaustive pattern match in case";-}return b}},step:function(a){return function(b){a:{switch(a[0]){case "Automaton":b=a[1](b);break a}throw"Non-exhaustive pattern match in case";}return b}},combine:d,pure:i,init:b,init_:j,count:c,draggable:function(a){return j(["Tuple2",g,a])(k)}}}();Elm.main=function(){return Elm.Automaton.main}}catch(j){Elm.main=function(){document.body.innerHTML=Elm.Text.monospace('<br/><h2>Your browser may not be supported. Are you using a modern browser?</h2><br/><span style="color:grey">Runtime Error in Automaton module:<br/>'+-j+"</span>");throw j;}}})();
+ elm-runtime-0.7.js view
@@ -0,0 +1,135 @@+Elm={};var Guid=function(){var e=0;return{guid:function(){return e+=1}}}();+Elm.JavaScript=function(){function e(b){for(var a=["Nil"],m=b.length;m--;)a=["Cons",b[m],a];return a}function k(b){for(var a=[];"Cons"===b[0];)a.push(b[1]),b=b[2];return a}function b(b){return b.slice(1)}function d(b){return["Tuple"+b.length].concat(b)}return{castJSBoolToBool:function(b){return b},castBoolToJSBool:function(b){return b},castJSNumberToFloat:function(b){return b},castFloatToJSNumber:function(b){return b},castJSNumberToInt:function(b){return~~b},castIntToJSNumber:function(b){return b},+Experimental:{castJSElementToElement:function(b){return function(a){return function(m){return["Element",Guid.guid(),["EExternalHtml",m],b,a,1,["Nothing"],["Nothing"]]}}},castElementToJSElement:function(b){return Render.render(b)}},castJSArrayToList:e,castListToJSArray:k,castJSStringToString:e,castStringToJSString:function(b){return"string"===typeof b?b:k(b).join("")},castTupleToJSTuple2:b,castTupleToJSTuple3:b,castTupleToJSTuple4:b,castTupleToJSTuple5:b,castJSTupleToTuple2:d,castJSTupleToTuple3:d,+castJSTupleToTuple4:d,castJSTupleToTuple5:d}}();var JSjson=window.JSON;+Elm.JSON=function(){function e(a,b){return function(g){return function(l){var h=d.castStringToJSString(g);return l[1].hasOwnProperty(h)&&(l=l[1][h],l[0]===a)?l[1]:b}}}function k(a){return function(b){function g(a){switch(a[0]){case "JsonNull":return null;case "JsonString":return d.castStringToJSString(a[1]);case "JsonObject":var h={};a=a[1][1];for(var c in a)h[c]=g(a[c]);return h;case "JsonArray":h=d.castListToJSArray(a[1]);for(c=h.length;c--;)h[c]=g(h[c]);return h;default:return a[1]}}return JSjson.stringify(g(["JsonObject",+b]),null,d.castStringToJSString(a))}}function b(a){function b(a){switch(typeof a){case "string":return["JsonString",d.castJSStringToString(a)];case "number":return["JsonNumber",d.castJSNumberToFloat(a)];case "boolean":return["JsonBool",d.castJSBoolToBool(a)];case "object":if(null===a)return["JsonNull"];for(var h in a)a[h]=b(a[h]);return a instanceof Array?["JsonArray",d.castJSArrayToList(a)]:["JsonObject",["JSON",a]]}}a=JSjson.parse(a);for(var g in a)a[g]=b(a[g]);return["JSON",a]}var d=Elm.JavaScript,+j=["JSON",{}];return{empty:j,singleton:function(a){return function(b){var g={};g[d.castStringToJSString(a)]=b;return["JSON",g]}},insert:function(a){return function(b){return function(g){g=g[1];var l={},h;for(h in g)l[h]=g[h];l[d.castStringToJSString(a)]=b;return["JSON",l]}}},lookup:function(a){return function(b){var g=d.castStringToJSString(a);return b[1].hasOwnProperty(g)?["Just",b[1][g]]:["Nothing"]}},findString:e("JsonString",["Nil"]),findObject:e("JsonObject",j),findArray:e("JsonArray",["Nil"]),+findWithDefault:function(a){return function(b){return function(g){var l=d.castStringToJSString(b);return g[1].hasOwnProperty(l)?g[1][l]:a}}},remove:function(a){return function(b){b=b[1];var g={},l;for(l in b)g[l]=b[l];delete g[d.castStringToJSString(a)];return["JSON",g]}},toPrettyJSString:k,toJSString:k(""),fromJSString:b,toPrettyString:function(a){return function(b){return d.castJSStringToString(k(a)(b))}},toString:function(a){return d.castJSStringToString(k("")(a))},fromString:function(a){return b(d.castStringToJSString(a))},+toList:function(a){a=a[1];var b=[],g;for(g in a)b.push(Value.Tuple(d.castJSStringToString(g),a[g]));return d.castJSArrayToList(b)},fromList:function(a){a=d.castListToJSArray(a);for(var b={},g=a.length;g--;)b[d.castStringToJSString(a[g][1])]=a[g][2];return["JSON",b]},JsonString:function(a){return["JsonString",a]},JsonNumber:function(a){return["JsonNumber",a]},JsonBool:function(a){return["JsonBool",a]},JsonNull:["JsonNull"],JsonArray:function(a){return["JsonArray",a]},JsonObject:function(a){return["JsonObject",+a]}}}();+var Value=function(){function e(a){if(0==a.length)return a;a=a.replace(/"/g,""").replace(/'/g,"'").replace(/</g,"<").replace(/>/g,">").replace(/\n/g,"<br/>");a=a.split("<br/>");for(var b=a.length;b--;){var g=a,d=b,h;h=a[b];if(0!=h.length){h=h.split("");" "==h[0]&&(h[0]=" ");for(var c=h.length;--c;)" "==h[c][0]&&" "==h[c-1]&&(h[c-1]+=h[c],h[c]="");for(c=h.length;c--;)if(1<h[c].length&&" "==h[c][0]){for(var f=h[c].split(""),v=f.length-2;0<=v;v-=2)f[v]=" ";h[c]=f.join("")}h=h.join("");+h=" "===h[h.length-1]?h.slice(0,-1)+" ":h}g[d]=h}return a.join("<br/>")}var k=function(a,b){if("object"===typeof a){if(a.hasOwnProperty("_")){for(var g in a)if(a[g]!=b[g])return!1;for(g in b)if(a[g]!=b[g])return!1;return!0}if(a===b)return!0;if(a.length!==b.length)return!1;for(g=a.length;g--;)if(!k(a[g],b[g]))return!1;return!0}return a===b},b=function(a){if("function"===typeof a)return"<function>";if("boolean"===typeof a)return a?"True":"False";if("number"!==typeof a){if("string"===typeof a&&+2>a.length)return"'"+a+"'";if("object"===typeof a&&a.hasOwnProperty("_")){var d=[],g;for(g in a)if("_"!=g)for(var l=a[g].length;l--;)d.push(g+" = "+b(a[g][l]));return 0===d.length?"{}":"{ "+d.join(", ")+" }"}if(a[0]){if("Tuple"===a[0].substring(0,5)){d=Array(a.length-1);for(l=a.length;--l;)d[l-1]=b(a[l]);return"("+d.join(",")+")"}if("Cons"===a[0]){g="string"===typeof a[1]?'"':"]";var l="string"===typeof a[1]?"":",",h="string"===typeof a[1]?function(a){return a}:b,d=("string"===typeof a[1]?'"':"[")++h(a[1]);for(a=a[2];;)if("Cons"===a[0])d+=l+h(a[1]),a=a[2];else return d+g}else{if("Nil"===a[0])return"[]";if("JSON"===a[0])return"(JSON.fromList "+b(Elm.JSON.toList(a))+")";if("RBNode"===a[0]||"RBEmpty"===a[0])return a=Elm.Dict.foldr(function(a){return function(b){return function(h){return["Cons",["Tuple2",a,b],h]}}})(["Nil"])(a),d="Dict","Cons"===a[0]&&"Tuple0"===a[1][2][0]&&(d="Set",a=Elm.List.map(function(a){return a[1]})(a)),"("+d+".fromList "+b(a)+")";d=[];for(l=a.length;--l;)d.push(b(a[l]));+d=a[0]+" "+d.join(" ");return 1<a.length?"("+d+")":d}}}return a+""},d=function(a){for(var b=["Nil"],d=a.length;d--;)b=["Cons",a[d],b];return b},j;j=document.addEventListener?function(a,b,d){a.addEventListener(b,d,!1)}:function(a,b,d){a.attachEvent("on"+b,d)};return{eq:k,str:d,show:function(a){return d(b(a))},Tuple:function(){var a=arguments.length,b=Array(a+1);for(b[0]="Tuple"+arguments.length;a--;)b[a+1]=arguments[a];return b},append:function(a,b){if("string"===typeof a&&"string"===typeof b)return a.concat(b);+if("Nil"===a[0])return b;var d=["Cons",a[1],["Nil"]],l=d;for(a=a[2];"Cons"===a[0];)l[2]=["Cons",a[1],["Nil"]],a=a[2],l=l[2];l[2]=b;return d},listToArray:function(a){for(var b=[];"Cons"===a[0];)b.push(a[1]),a=a[2];return b},toText:function(a){if("string"===typeof a)return e(a);for(var b=[];"Cons"===a[0];)b.push(a[1]),a=a[2];return e(b.join(""))},properEscape:e,getTextSize:function(a,b,d){var l=document.createElement("div");l.innerHTML=d;l.style.textAlign="left";0<a&&(l.style.width=a+"px");l.style.visibility=+"hidden";l.style.styleFloat="left";l.style.cssFloat="left";document.body.appendChild(l);d=window.getComputedStyle(l,null);a=d.getPropertyValue("width").slice(0,-2)-0;d=d.getPropertyValue("height").slice(0,-2)-0;document.body.removeChild(l);return[Math.ceil(a),Math.ceil(Math.max(b,d))]},getSize:function(a){a=a.cloneNode(!0);a.style.visibility="hidden";a.style.styleFloat="left";a.style.cssFloat="left";document.body.appendChild(a);var b=a.offsetWidth,d=a.offsetHeight;document.body.removeChild(a);return[b,+d]},getExcess:function(b){b=b.cloneNode(!0);b.style.visibility="hidden";b.style.styleFloat="left";b.style.cssFloat="left";document.body.appendChild(b);var d=b.offsetWidth,g=b.offsetHeight,l=window.getComputedStyle(b,null),h=l.getPropertyValue("width").slice(0,-2)-0,l=l.getPropertyValue("height").slice(0,-2)-0;document.body.removeChild(b);return[d-h,g-l]},groupForms:function(b){b=Elm.JavaScript.castListToJSArray(b);for(var d=[],g=[],l=b.length;l--;){var h=b[l];switch(h[4][0]){case "FElement":0<g.length&&+(d.push(g),g=[]);d.push(h);break;default:g.push(h)}}0<g.length&&d.push(g);return d},wrap:function(b){var d=Value.getSize(b);return["Element",Guid.guid(),["EHtml",b],d[0],d[1],1,["Nothing"],["Nothing"]]},addListener:j}}();+Elm.List=function(){function e(b){return function(a){if("Nil"===a[0])return a;"Cons"!==a[0]&&h("map");var c=["Cons",b(a[1]),["Nil"]],f=c;for(a=a[2];"Cons"===a[0];)f[2]=["Cons",b(a[1]),["Nil"]],a=a[2],f=f[2];return c}}function k(b){return function(a){return function(c){var f=a;if("Nil"===c[0])return f;for("Cons"!==c[0]&&h("foldl");"Cons"===c[0];)f=b(c[1])(f),c=c[2];return f}}}function b(b){return function(a){return function(c){var f=a;if("Nil"===c[0])return f;"Cons"!==c[0]&&h("foldr");for(var d=[];"Cons"===+c[0];)d.push(c[1]),c=c[2];for(c=d.length;c--;)f=b(d[c])(f);return f}}}function d(b){return function(a){var h;"Cons"!==a[0]?h=void 0:(h=a[1],a=a[2],h=k(b)(h)(a));return h}}function j(b){return function(a){return function(c){if("Nil"===c[0])return["Cons",a,["Nil"]];"Cons"!==c[0]&&h("scanl");for(var f=[a];"Cons"===c[0];)a=b(c[1])(a),f.push(a),c=c[2];c=["Nil"];for(var d=f.length;d--;)c=["Cons",f[d],c];return c}}}function a(b){return function(h){a:{for(var c=[function(b){return"Nil"!==b[0]?void 0:["Tuple2",+["Nil"],["Nil"]]},function(h){if("Cons"===h[0]){var c=h[1];h=h[2];var f=a(b)(h);"Tuple2"!==f[0]?c=void 0:(h=f[1],f=f[2],c=b(c)?["Tuple2",["Cons",c,h],f]:["Tuple2",h,["Cons",c,f]]);return c}}],f=c.length;f--;){var d=c[f](h);if(void 0!==d){h=d;break a}}h=void 0}return h}}function m(b){a:{for(var a=[function(b){return"Nil"!==b[0]?void 0:["Tuple2",["Nil"],["Nil"]]},function(b){if("Cons"!==b[0])b=void 0;else if(b=["Tuple2",b[1],m(b[2])],"Tuple2"!==b[0]||"Tuple2"!==b[1][0])b=void 0;else{var a=b[1][1],h=+b[1][2];b="Tuple2"!==b[2][0]?void 0:["Tuple2",["Cons",a,b[2][1]],["Cons",h,b[2][2]]]}return b}],h=a.length;h--;){var c=a[h](b);if(void 0!==c){b=c;break a}}b=void 0}return b}function g(b){return function(a){a:{for(var h=[function(b){return"Nil"!==b[0]?void 0:["Nil"]},function(b){if("Cons"===b[0]){var a=b[1];return"Nil"!==b[2][0]?void 0:["Cons",a,["Nil"]]}},function(a){if("Cons"===a[0]){var h=a[1];if("Cons"===a[2][0]){var c=a[2][1];a=a[2][2];return["Cons",h,["Cons",b,g(b)(["Cons",c,a])]]}}}],c=h.length;c--;){var f=+h[c](a);if(void 0!==f){a=f;break a}}a=void 0}return a}}function l(b){return function(a){a:{for(var h=[function(b){return"Nil"!==b[0]?void 0:["Nil"]},function(b){if("Cons"===b[0]){var a=b[1];return"Nil"!==b[2][0]?void 0:a}},function(a){if("Cons"===a[0]){var h=a[1];if("Cons"===a[2][0]){var c=a[2][1];a=a[2][2];return Value.append(h,Value.append(b,l(b)(["Cons",c,a])))}}}],c=h.length;c--;){var f=h[c](a);if(void 0!==f){a=f;break a}}a=void 0}return a}}var h=function(b){throw"Function '"+b+"' expecting a list!";+},c=k(function(b){return function(a){return["Cons",b,a]}})(["Nil"]),f=b(function(b){return function(a){return Value.append(b,a)}})(["Nil"]),v=k(function(b){return function(a){return b&&a}})(!0),n=k(function(b){return function(a){return b||a}})(!1),p=k(function(b){return function(a){return b+a}})(0),r=k(function(b){return function(a){return b*a}})(1),y=d(function(b){return function(a){return Math.max(b,a)}}),s=d(function(b){return function(a){return Math.min(b,a)}});return{head:function(b){if("Cons"!==+b[0])throw"Error: 'head' only accepts lists of length greater than one.";return b[1]},tail:function(b){if("Cons"!==b[0])throw"Error: 'tail' only accepts lists of length greater than one.";return b[2]},last:function(b){if("Cons"!==b[0])throw"Error: 'last' only accepts lists of length greater than one.";for(var a=b[1];"Cons"===b[0];)a=b[1],b=b[2];return a},map:e,foldl:k,foldr:b,foldl1:d,foldr1:function(b){return function(a){if("Nil"===a[0])throw"'foldr1' requires an non-empty list.";"Cons"!==a[0]&&+h("foldr1");for(var c=[];"Cons"===a[0];)c.push(a[1]),a=a[2];a=c.pop();for(var f=c.length;f--;)a=b(c[f])(a);return a}},scanl:j,scanl1:function(b){return function(a){if("Cons"!==a[0])throw"Error: 'scanl1' requires a list of at least length 1.";return j(b)(a[1])(a[2])}},filter:function(b){return function(a){if("Nil"===a[0])return a;"Cons"!==a[0]&&h("filter");for(var c=[];"Cons"===a[0];)b(a[1])&&c.push(a[1]),a=a[2];a=["Nil"];for(var f=c.length;f--;)a=["Cons",c[f],a];return a}},length:function(b){for(var a=+0;"Cons"===b[0];)a+=1,b=b[2];return a},reverse:c,concat:f,concatMap:function(b){return function(a){return f(e(b)(a))}},and:v,or:n,all:function(b){return k(function(a){return function(h){return h&&b(a)}})(!0)},any:function(b){return k(function(a){return function(h){return h||b(a)}})(!1)},sum:p,product:r,maximum:y,minimum:s,partition:a,zipWith:function(b){return function(a){return function(c){if("Nil"===a[0]||"Nil"===c[0])return["Nil"];("Cons"!==a[0]||"Cons"!==c[0])&&h("zipWith");for(var f=[];"Cons"===+a[0]&&"Cons"===c[0];)f.push(b(a[1])(c[1])),a=a[2],c=c[2];c=["Nil"];for(var d=f.length;d--;)c=["Cons",f[d],c];return c}}},zip:function(b){return function(a){if("Nil"===b[0]||"Nil"===a[0])return["Nil"];("Cons"!==b[0]||"Cons"!==a[0])&&h("zip");for(var c=[];"Cons"===b[0]&&"Cons"===a[0];)c.push(["Tuple2",b[1],a[1]]),b=b[2],a=a[2];a=["Nil"];for(var f=c.length;f--;)a=["Cons",c[f],a];return a}},unzip:m,intersperse:g,intercalate:l,sort:function(b){if("Nil"===b[0])return b;"Cons"!==b[0]&&h("sort");for(var a=+[];"Cons"===b[0];)a.push(b[1]),b=b[2];a.sort(function(b,a){return b-a});b=["Nil"];for(var c=a.length;c--;)b=["Cons",a[c],b];return b},take:function(b){return function(a){if(0>=b)return["Nil"];if("Nil"===a[0])return a;"Cons"!==a[0]&&h("take");var c=["Cons",a[1],["Nil"]],f=c;a=a[2];for(--b;"Cons"===a[0]&&0<b;)f[2]=["Cons",a[1],["Nil"]],f=f[2],a=a[2],--b;return c}},drop:function(b){return function(a){if("Nil"===a[0])return a;for("Cons"!==a[0]&&h("drop");"Cons"===a[0]&&0<b;)a=a[2],--b;return a}}}}();+Elm.Maybe=function(){function e(b){return function(d){return"Just"===b[0]?["Cons",b[1],d]:d}}function k(b){return function(d){return function(j){var a=b(d);return"Just"===a[0]?["Cons",a[1],j]:j}}}return{Just:function(b){return["Just",b]},Nothing:["Nothing"],catMaybes:Elm.List.foldr(e)(["Nil"]),isJust:function(b){return"Just"===b[0]},isNothing:function(b){return"Nothing"===b[0]},fromMaybe:function(b){return function(d){return"Just"===d[0]?d[1]:b}},consMaybe:e,mapMaybe:function(b){return Elm.List.foldr(k(b))(["Nil"])},+maybe:function(b){return function(d){return function(j){return"Just"===j[0]?d(j[1]):b}}}}}();+Elm.Char=function(){function e(b,a){return function(d){d=d.charCodeAt(0);return b<=d&&d<=a}}var k=e(48,57),b=e(97,102),d=e(65,70);return{fromCode:function(b){return String.fromCharCode(b)},toCode:function(b){return b.charCodeAt(0)},toUpper:function(b){return b.toUpperCase()},toLower:function(b){return b.toLowerCase()},toLocaleUpper:function(b){return b.toLocaleUpperCase()},toLocaleLower:function(b){return b.toLocaleLowerCase()},isLower:e(97,122),isUpper:e(65,90),isDigit:k,isOctDigit:e(48,55),isHexDigit:function(e){return k(e)||+b(e)||d(e)}}}();+Elm.Color=function(){function e(e){var b=e.value*e.saturation,d=e.hue/60,j=b*(1-Math.abs(d%2-1)),a=0,m=0,g=0;0<=d&&1>d?(a=b,m=j,g=0):1<=d&&2>d?(a=j,m=b,g=0):2<=d&&3>d?(a=0,m=b,g=j):3<=d&&4>d?(a=0,m=j,g=b):4<=d&&5>d?(a=j,m=0,g=b):5<=d&&6>d&&(a=b,m=0,g=j);e=e.value-b;return["Color",Math.round(255*(a+e)),Math.round(255*(m+e)),Math.round(255*(g+e)),1]}return{rgba:function(e){return function(b){return function(d){return function(j){return["Color",e,b,d,j]}}}},rgb:function(e){return function(b){return function(d){return["Color",e,+b,d,1]}}},hsva:function(k){return function(b){return function(d){return function(j){var a=e({hue:k,saturation:b,value:d});a[4]=j;return a}}}},hsv:function(k){return function(b){return function(d){return e({hue:k,saturation:b,value:d})}}},red:["Color",255,0,0,1],green:["Color",0,255,0,1],blue:["Color",0,0,255,1],yellow:["Color",255,255,0,1],cyan:["Color",0,255,255,1],magenta:["Color",255,0,255,1],black:["Color",0,0,0,1],white:["Color",255,255,255,1],gray:["Color",128,128,128,1],grey:["Color",128,128,+128,1],complement:function(k){var b;b=k[1]/255;var d=k[2]/255;k=k[3]/255;var j=Math.max(b,d,k),a=Math.min(b,d,k),a=j-a,m=0;0===a?m=0:j===b?m=(d-k)/a%6:j===d?m=(k-b)/a+2:j===k&&(m=(b-d)/a+4);b={value:j,hue:60*m,saturation:0===j?0:a/j};b.hue=(b.hue+180)%360;return e(b)},extract:function(e){return 1===e[4]?"rgb("+e[1]+","+e[2]+","+e[3]+")":"rgba("+e[1]+","+e[2]+","+e[3]+","+e[4]+")"}}}();+var Collage=function(){function e(b,a){var c=a.length-1;if(!(0>=c))for(b.moveTo(a[c][1],a[c][2]);c--;)b.lineTo(a[c][1],a[c][2])}function k(b,a,c,f){0===b.length&&(b=[8,4]);var d=f.length-1;if(!(0>=d)){var n=f[d][1],g=f[d][2],e=0,j=0,k=0,m=0,q=0,t=0,w=b.length,A=!0,x=b[0];for(a.moveTo(n,g);d--;){e=f[d][1];j=f[d][2];k=e-n;m=j-g;for(q=Math.sqrt(k*k+m*m);x<=q;)n+=k*x/q,g+=m*x/q,a[A?"lineTo":"moveTo"](n,g),k=e-n,m=j-g,q=Math.sqrt(k*k+m*m),A=!A,t=(t+1)%w,x=b[t];0<q&&(a[A?"lineTo":"moveTo"](e,j),x-=q);n=+e;g=j}}a.strokeStyle=Elm.Color.extract(c);a.stroke()}function b(b,a,c,f,d){a.clearRect(0,0,c,f);for(c=d.length;c--;){var n=d[c],p=b;f=a;var j=n[1],m=n[2],s=n[3][1],u=n[3][2],n=n[4];f.save();(0!==s||0!==u)&&f.translate(s,u);j!==~~j&&f.rotate(2*Math.PI*j);1!==m&&f.scale(m,m);f.beginPath();switch(n[0]){case "FLine":a:switch(p=f,j=n,n=j[3][1],j[1][0]){case "Solid":j=j[2];e(p,n);p.strokeStyle=Elm.Color.extract(j);p.stroke();break;case "Dotted":k([3,3],p,j[2],n);break a;case "Dashed":k([8,4],p,j[2],n);+break a;case "Custom":k(j[1][1],p,j[2],n)}break;case "FShape":a:switch(s=p,m=f,p=n[1],j=n[2],n=n[3][1],p[0]){case "Filled":p=m;e(p,n);p.fillStyle=Elm.Color.extract(j);p.fill();break a;case "Outlined":p=m;e(p,n);p.strokeStyle=Elm.Color.extract(j);p.stroke();break a;case "Textured":j=s;p=p[1];s=new Image;s.src=g.castStringToJSString(p);s.onload=j;e(m,n);m.fillStyle=m.createPattern(s,"repeat");m.fill();break a;case "CustomOutline":k(p[1],m,j,n)}break;case "FImage":j=f,m=n[1],s=n[2],n=n[3],u=new Image,+u.onload=p,u.src=g.castStringToJSString(n),j.drawImage(u,-m/2,-s/2,m,s)}f.restore()}}function d(a,h,c){var f=Render.newElement("canvas");a=~~a;h=~~h;f.style.width=a+"px";f.style.height=h+"px";f.style.display="block";f.width=a;f.height=h;if(f.getContext){var d=f.getContext("2d");b(function(){b(this,d,a,h,c)},d,a,h,c);return f}f.innerHTML="Your browser does not support the canvas element.";return f}function j(b,a,c,f,d,n,g){var e=Render.render(g);c="translate("+(d-g[3]/2)+"px,"+(n-g[4]/2)+"px) "+(1===+f?"":"scale("+f+","+f+")")+" "+(c===~~c?"":"rotate("+360*c+"deg)");e.style.transform=c;e.style.msTransform=c;e.style.MozTransform=c;e.style.webkitTransform=c;e.style.OTransform=c;c=Render.newElement("div");Render.addTo(c,e);c.style.width=~~b+"px";c.style.height=~~a+"px";c.style.overflow="hidden";return c}function a(a,h,c){if(!Value.eq(c,h)){var f=a.style.width.slice(0,-2)-0,g=a.style.height.slice(0,-2)-0;if("object"===typeof c[0]){if("object"===typeof h[0]&&a.getContext){var n=a.getContext("2d");+return b(function(){b(this,n,f,g,c)},n,f,g,c)}h=d(f,g,c);h.style.position="absolute";return a.parentNode.replaceChild(h,a)}h=j(f,g,c[1],c[2],c[3][1],c[3][2],c[4][1]);h.style.position="absolute";return a.parentNode.replaceChild(h,a)}}function m(b,a,c,f,d){var g=0,e,j=(b[1]-f[1])/c;b=(b[2]-f[2])/c;0!==a&&(a*=-2*Math.PI,c=j*Math.cos(a)-b*Math.sin(a),b=j*Math.sin(a)+b*Math.cos(a),j=c);if(0===d.length)return!1;e=d[0];for(c=d.length-1;c--;){a=d[c];f=e[1];e=e[2];var k=a[1],m=a[2];if(e<m)var u=e,q=m;else u=+m,q=e;if(f<k)var t=f,w=k;else t=k,w=f;u<b&&b<=q&&j<=w&&(j<=t||j<=(b-e)*(k-f)/(m-e)+f)&&++g;e=a}return 1===g%2}var g=Elm.JavaScript;return{collage:function(b,a,c){if(0===c.length)return d(b,a,[]);for(var f=Array(c.length),e=c.length;e--;){var g=c[e];f[e]="string"===typeof g[0]?j(b,a,g[1],g[2],g[3][1],g[3][2],g[4][1]):d(b,a,g)}return 1===c.length?f[0]:Render.flowWith(Render.goIn,function(b){return b},f)},updateCollage:function(b,h,c){if(1===c.length)return a(b,h[0],c[0]);b=b.childNodes;for(var f=b.length,+d=f;d--;)a(b[f-d-1],h[d],c[d])},insideForm:function(b){return function(a){var c=b[1],f=b[2];if(6>a.length){var d=a[3][1],g=a[3][2],e=0,j=a[2];switch(a[4][0]){case "FShape":for(var k=a[4][3][1],s=k.length;--s;)var u=k[s],e=Math.max(e,u[1]*u[1]+u[2]*u[2]);e*=j*j;break;case "FImage":k=j*a[4][1]/2;j=j*a[4][2]/2;e=k*k+j*j;break;case "FElement":k=j*a[4][1][3]/2,j=j*a[4][1][4]/2,e=k*k+j*j}a.push(function(a,b){var c=a-d,h=b-g;return c*c+h*h<e+1})}if(!a[5](c,f))return!1;var q,t;switch(a[4][0]){case "FShape":return m(b,+a[1],a[2],a[3],a[4][3][1]);case "FLine":return!1;case "FImage":q=a[4][1]/2;t=a[4][2]/2;break;case "FElement":q=a[4][1][3]/2,t=a[4][1][4]/2}return m(b,a[1],a[2],a[3],[[null,q,t],[null,-q,t],[null,-q,-t],[null,q,-t],[null,q,t]])}}}}();+Elm.Graphics=function(){function e(a){return function(b){return["Position",a,b]}}function k(a){return function(b){return["EText",a,b]}}function b(a){return function(b){return["EFlow",a,r.castListToJSArray(b)]}}function d(a){return["Line",r.castListToJSArray(a)]}function j(a){return function(b){var c=r.castListToJSArray(a);0<c.length&&c.push(c[0]);return["Shape",c,b]}}function a(a){return function(b){return function(c){return function(h){return["Form",a,b,c,h]}}}}function m(a){return function(b){return function(c){return["FLine",+a,b,c]}}}function g(a){return function(b){return function(c){return["FShape",a,b,c]}}}function l(a,b,c,h,f,d){return["Element",Guid.guid(),a,b,c,h,f,d]}function h(a,b,c){return["Element",Guid.guid(),a,b,c,1,["Nothing"],["Nothing"]]}function c(a){return~~a[3]}function f(a){return~~a[4]}function v(a){return function(b){return function(c){return h(["EImage",r.castStringToJSString(c)],a,b)}}}function n(a){return function(b){return h(A,a,b)}}function p(a){return function(b){return function(c){var h=map(function(c){return["Tuple2",+a/2*Math.cos(2*(Math.PI/50)*c),b/2*Math.sin(2*(Math.PI/50)*c)]}),f=49,d=["Nil"];if(0<=f){do d=["Cons",f,d];while(0<f--)}return j(h(d))(c)}}}for(this.i in Elm.List)eval("var "+this.i+" = Elm.List[this.i];");var r=Elm.JavaScript,y=["DRight"],s=["DDown"],u=["DOut"],q=["Near"],t=["Mid"],w=["Far"],A=["EEmpty"],x=["Solid"],D=["Dotted"],F=["Dashed"],B=["Filled"],E=["Outlined"],z=e(q)(q),C=e(w)(q),G=e(q)(w),H=e(w)(w),I=e(q)(t),J=e(w)(t),q=e(t)(q),w=e(t)(w),t=e(t)(t);return{left:["DLeft"],right:y,down:s,up:["DUp"],+inward:["DIn"],outward:u,topLeft:z,topRight:C,bottomLeft:G,bottomRight:H,midLeft:I,midRight:J,midTop:q,midBottom:w,middle:t,middleAt:function(a){return function(b){return["PositionAt",a,b]}},topLeftAt:function(a){return function(b){return["PositionTL",a,b]}},topRightAt:function(a){return function(b){return["PositionTR",a,b]}},bottomLeftAt:function(a){return function(b){return["PositionBL",a,b]}},bottomRightAt:function(a){return function(b){return["PositionBR",a,b]}},absolute:function(a){return["Absolute",+a]},relative:function(a){return["Relative",a]},width:function(a){return function(b){var c=b[2];switch(c[0]){case "EImage":case "EVideo":return l(b[2],a,b[4]*a/b[3],b[5],b[6],b[7]);case "EText":return c=Value.getTextSize(a,b[4],c[2]),l(b[2],a,c[1],b[5],b[6],b[7])}return l(b[2],a,b[4],b[5],b[6],b[7])}},height:function(a){return function(b){switch(b[2][0]){case "EImage":case "EVideo":return l(b[2],b[3]*a/b[4],a,b[5],b[6],b[7])}return l(b[2],b[3],a,b[5],b[6],b[7])}},size:function(b){return function(a){return function(c){return l(c[2],+b,a,c[5],c[6],c[7])}}},opacity:function(b){return function(a){return l(a[2],a[3],a[4],b,a[6],a[7])}},color:function(a){return function(b){return l(b[2],b[3],b[4],b[5],["Just",a],b[7])}},link:function(b){return function(a){return l(a[2],a[3],a[4],a[5],a[6],["Just",r.castStringToJSString(b)])}},widthOf:c,heightOf:f,sizeOf:function(a){return["Tuple2",~~a[3],~~a[4]]},text:function(a){var b=Value.getTextSize(0,0,a);return h(k("left")(a),b[0],b[1])},asText:function(a){a=Elm.Text.monospace(Value.toText(Value.show(a)));+var b=Value.getTextSize(0,0,a);return h(k("left")(a),b[0],b[1])},plainText:function(a){a=Value.toText(a);var b=Value.getTextSize(0,0,a);return h(k("left")(a),b[0],b[1])},centeredText:function(a){var b=Value.getTextSize(0,0,a);return h(k("center")(a),b[0],b[1])},justifiedText:function(a){var b=Value.getTextSize(0,0,a);return h(k("justify")(a),b[0],b[1])},rightedText:function(a){var b=Value.getTextSize(0,0,a);return h(k("right")(a),b[0],b[1])},image:v,images:function(a){var b=Elm.Signal.constant(n(0)(0));+a=Elm.Signal.lift(function(a){a=r.castStringToJSString(a);var c=new Image;c.onload=function(){Dispatcher.notify(b.id,v(this.width)(this.height)(a))};c.src=a})(a);return Elm.Signal.lift2(function(a){return function(){return a}})(b)(a)},video:function(a){return function(b){return function(c){return h(["EVideo",r.castStringToJSString(c)],a,b)}}},fittedImage:function(a){return function(b){return function(c){return h(["EFittedImage",r.castStringToJSString(c)],a,b)}}},flow:function(a){return function(d){var e;+e=map(c)(d);a:{switch(a[0]){case "DLeft":e=sum(e);break a;case "DRight":e=sum(e);break a}e=maximum(e)}var g;g=map(f)(d);a:{switch(a[0]){case "DDown":g=sum(g);break a;case "DUp":g=sum(g);break a}g=maximum(g)}return h(b(a)(d),e,g)}},above:function(a){return function(c){return h(b(s)(["Cons",a,["Cons",c,["Nil"]]]),Math.max(~~a[3],~~c[3]),~~a[4]+~~c[4])}},below:function(a){return function(c){return h(b(s)(["Cons",c,["Cons",a,["Nil"]]]),Math.max(~~a[3],~~c[3]),~~a[4]+~~c[4])}},beside:function(a){return function(c){return h(b(y)(["Cons",+a,["Cons",c,["Nil"]]]),~~a[3]+~~c[3],Math.max(~~a[4],~~c[4]))}},layers:function(a){return h(b(u)(a),maximum(map(c)(a)),maximum(map(f)(a)))},collage:function(a){return function(b){return function(c){return h(["ECollage",a,b,Value.groupForms(c)],a,b)}}},spacer:n,container:function(a){return function(b){return function(c){return function(f){return h(["EContainer",c,f],a,b)}}}},line:d,segment:function(a){return function(b){return d(["Cons",a,["Cons",b,["Nil"]]])}},polygon:j,rect:function(a){return function(b){return function(c){return j(["Cons",+["Tuple2",0-a/2,0-b/2],["Cons",["Tuple2",0-a/2,b/2],["Cons",["Tuple2",a/2,b/2],["Cons",["Tuple2",a/2,0-b/2],["Nil"]]]]])(c)}}},oval:p,circle:function(a){return p(2*a)(2*a)},ngon:function(a){return function(b){return function(c){var h=map(function(c){return["Tuple2",b*Math.cos(2*(Math.PI/a)*c),b*Math.sin(2*(Math.PI/a)*c)]}),f=a-1,d=["Nil"];if(0<=f){do d=["Cons",f,d];while(0<f--)}return j(h(d))(c)}}},solid:function(b){return function(c){return a(0)(1)(["Tuple2",0,0])(m(x)(b)(c))}},dotted:function(b){return function(c){return a(0)(1)(["Tuple2",+0,0])(m(D)(b)(c))}},dashed:function(b){return function(c){return a(0)(1)(["Tuple2",0,0])(m(F)(b)(c))}},customLine:function(b){return function(c){return function(h){return a(0)(1)(["Tuple2",0,0])(m(["Custom",r.castListToJSArray(b)])(c)(h))}}},filled:function(b){return function(c){return a(0)(1)(c[2])(g(B)(b)(c))}},outlined:function(b){return function(c){return a(0)(1)(c[2])(g(E)(b)(c))}},customOutline:function(b){return function(c){return function(h){return a(0)(1)(h[2])(g(["CustomOutline",r.castListToJSArray(b)])(c)(h))}}},+textured:function(b){return function(c){return a(0)(1)(c[2])(g(["Textured",b])(null)(c))}},sprite:function(b){return function(c){return function(h){return function(f){return a(0)(1)(f)(["FImage",c,h,r.castStringToJSString(b)])}}}},toForm:function(b){return function(c){return a(0)(1)(b)(["FElement",c])}},rotate:function(b){return function(c){a:{switch(c[0]){case "Form":var h=c[2],f=c[3],d=c[4];c=a(b+c[1])(h)(f)(d);break a}throw"Non-exhaustive pattern match in case";}return c}},scale:function(b){return function(c){return a(c[1])(b*+c[2])(c[3])(c[4])}},move:function(b){return function(c){return function(h){var f;a:{switch(h[0]){case "Form":f=h[1];var d=h[2],e=h[3];h=h[4];switch(e[0]){case "Tuple2":var g=e[1],e=e[2];f=a(f)(d)(["Tuple2",b+g,c+e])(h);break a}}throw"Non-exhaustive pattern match in case";}return f}}},isWithin:Collage.insideForm}}();+Elm.Text=function(){function e(a){return Value.toText(a)}var k=function(a){return function(b){return"<"+a+' style="padding:0;margin:0">'+b+"</"+a+">"}},b=function(a,b){return function(f){return"<span style='"+a+":"+b+"'>"+f+"</span>"}},d=function(a){a=Elm.JavaScript.castStringToJSString(a);return b("font-family",a)},j=k("h1"),a=b("font-style","italic"),k=k("b"),m=b("text-decoration","underline"),g=b("text-decoration","overline"),l=b("text-decoration","line-through");return{fromString:e,toText:e,header:j,+height:function(a){return b("font-size",a+"em")},italic:a,bold:k,underline:m,overline:g,strikeThrough:l,monospace:d("monospace"),typeface:d,color:function(a){return b("color",Elm.Color.extract(a))},link:function(a){return function(b){return"<a href='"+e(a)+"'>"+b+"</a>"}}}}();+var Render=function(){function e(a){a=document.createElement(a);a.style.padding="0";a.style.margin="0";return a}function k(a){return a}function b(a){a.style.styleFloat="left";a.style.cssFloat="left";return a}function d(a){a.style.position="absolute";return a}function j(a,b,f){for(var d=e("div"),g=f.length;g--;){var j=a(b(f[g]));d.appendChild(j)}return d}function a(a){switch(a[0]){case "Absolute":return a[1]+"px";case "Relative":return 100*a[1]+"%"}}function m(b,c){c.style.position="absolute";c.style.margin=+"auto";switch(b[0]){case "Position":"Far"!==b[1][0]&&(c.style.left=0);"Near"!==b[1][0]&&(c.style.right=0);"Far"!==b[2][0]&&(c.style.top=0);"Near"!==b[2][0]&&(c.style.bottom=0);break;case "PositionAt":c.style.top=a(b[2]);c.style.left=a(b[1]);var f="translate("+~~(-c.style.width.slice(0,-2)/2)+"px,"+~~(-c.style.height.slice(0,-2)/2)+"px)";c.style.transform=f;c.style.msTransform=f;c.style.MozTransform=f;c.style.webkitTransform=f;c.style.OTransform=f;break;default:f=b[0].slice(-2),c.style["T"===f[0]?+"top":"bottom"]=a(b[2]),c.style["L"===f[1]?"left":"right"]=a(b[1])}}function g(a){var c={};switch(a[2][0]){case "EText":var c=a[2][1],f=a[2][2],l=e("div");l.innerHTML=f;l.style.textAlign=c;c=l;break;case "EImage":c=a[2][1];f=e("img");f.src=c;f.name=c;f.style.display="block";c=f;break;case "EVideo":l=a[2][1];c=e("video");c.controls="controls";f=e("source");f.src=l;l=l.split(".");f.type="video/"+l[l.length-1];c.appendChild(f);c.style.display="block";break;case "EFittedImage":var n=a[3],p=a[4],c=a[2][1],+f=e("div");f.style.width=n+"px";f.style.height=p+"px";f.style.position="relative";f.style.overflow="hidden";var r=e("img");r.onload=function(){r.style.position="absolute";r.style.margin="auto";var a=n,b=p;n/p>this.width/this.height?b=Math.round(this.height*n/this.width):a=Math.round(this.width*p/this.height);r.style.width=a+"px";r.style.height=b+"px";r.style.left=(n-a)/2+"px";r.style.top=(p-b)/2+"px"};r.src=c;r.name=c;f.appendChild(r);c=f;break;case "EFlow":a:{c=a[2][2];switch(a[2][1][0]){case "DDown":c=+c.slice(0).reverse();case "DUp":c=j(k,g,c);break a;case "DRight":c=c.slice(0).reverse();case "DLeft":c=j(b,g,c);break a;case "DOut":c=c.slice(0).reverse();case "DIn":c=j(d,g,c);break a}c=void 0}break;case "ECollage":c=Collage.collage(a[2][1],a[2][2],a[2][3]);break;case "EEmpty":c=e("div");break;case "EContainer":f=a[2][1];c=g(a[2][2]);m(f,c);f=e("div");f.style.position="relative";f.style.overflow="hidden";f.appendChild(c);c=f;break;case "EHtml":c=a[2][1];"button"!==c.type&&(f=Value.getExcess(c),a[3]-=+f[0],a[4]-=f[1]);break;case "EExternalHtml":c=e("div"),c.appendChild(a[2][1])}c.id=a[1];c.style.width=~~a[3]+"px";c.style.height=~~a[4]+"px";1!==a[5]&&(c.style.opacity=a[5]);"Just"===a[6][0]&&(c.style.backgroundColor=Elm.Color.extract(a[6][1]));return"Just"===a[7][0]?(f=e("a"),f.href=a[7][1],f.appendChild(c),f):c}function l(a,c,f){"A"===a.tagName&&(a=a.firstChild);if(c[1]!==f[1]){if(c[2][0]!==f[2][0])return a.parentNode.replaceChild(g(f),a);var e=f[2],j=c[2];switch(e[0]){case "EText":e[1]!==j[1]&&+(a.style.textAlign=e[1]);e[2]!==j[2]&&(a.innerHTML=e[2]);break;case "EImage":e[1]!==j[1]&&(a.src=e[1]);break;case "EVideo":case "EFittedImage":if(!Value.eq(e,j)||f[3]!==c[3]||f[4]!==c[4])return a.parentNode.replaceChild(g(f),a);break;case "ECollage":if(e[1]!==j[1]||e[2]!==j[2]||e[3].length!==j[3].length)return a.parentNode.replaceChild(g(f),a);Collage.updateCollage(a,j[3],e[3]);break;case "EFlow":if(e[1]!==j[1])return a.parentNode.replaceChild(g(f),a);var p=e[2],r=a.childNodes;if(p.length!==r.length)return a.parentNode.replaceChild(g(f),+a);var j=j[2],y=function(a){return a};switch(e[1][0]){case "DDown":case "DUp":y=k;break;case "DRight":case "DLeft":y=b;break;case "DOut":case "DIn":y=d}for(e=r.length;e--;)l(r[e],j[e],p[e]),y(r[e]);break;case "EContainer":l(a.childNodes[0],j[2],e[2]);m(e[1],a.childNodes[0]);break;case "EHtml":f[1]!==c[1]&&(p=g(f),a.parentNode.replaceChild(p,a),a=p);"button"!==p.type&&(e=Value.getExcess(a),f[3]-=e[0],f[4]-=e[1]);break;case "EExternalHtml":f[1]!==c[1]&&a.parentNode.replaceChild(g(f),a)}f[3]!==c[3]&&+(a.style.width=~~f[3]+"px");f[4]!==c[4]&&(a.style.height=~~f[4]+"px");f[5]!==c[5]&&(a.style.opacity=f[5]);2===f[6].length&&(e=Elm.Color.extract(f[6][1]),e!==a.style.backgroundColor&&(a.style.backgroundColor=e));if(2===f[7].length&&(1===c[7].length||f[7][1]!==c[7][1]))a.parentNode.href=f[7][1];f[1]=c[1]}}return{render:g,update:l,addTo:function(a,b){a.appendChild(b)},newElement:e,flowWith:j,goIn:d}}();+Elm.Signal=function(){function e(a){this.id=Guid.guid();this.value=a;this.kids=[];this.defaultNumberOfKids=0;this.recv=function(a,b,c){if(b=b===this.id)this.value=c;l(this,a,b);return b};Dispatcher.inputs.push(this)}function k(a,b){this.id=Guid.guid();this.value=null;this.kids=[];this.count=0;this.changed=!1;b.reverse();this.recalc=function(){for(var d=a,e=b.length;e--;)d=d(b[e].value);this.value=d};this.recalc();this.recv=function(a,c){this.count+=1;c&&(this.changed=!0);this.count==b.length&&(this.changed&&+this.recalc(),l(this,a,this.changed),this.changed=!1,this.count=0)};for(var d=b.length;d--;)b[d].kids.push(this)}function b(a,b,d,e){this.id=Guid.guid();this.value=d?b(e.value):b;this.kids=[];this.recv=function(b,d){d&&(this.value=a(e.value)(this.value));l(this,b,d)};e.kids.push(this)}function d(a,b,d){this.id=Guid.guid();this.value=a(d.value)?b:d.value;this.kids=[];this.recv=function(b,f){var e=f&&!a(d.value);e&&(this.value=d.value);l(this,b,e)};d.kids.push(this)}function j(a){this.id=Guid.guid();+this.value=a.value;this.kids=[];this.recv=function(b,d){var e=d&&!Value.eq(this.value,a.value);e&&(this.value=a.value);l(this,b,e)};a.kids.push(this)}function a(a,b){this.id=Guid.guid();var d=(new window.Date).getTime();this.value=a?Value.Tuple(d,b.value):d;this.kids=[];this.recv=function(d,e){e&&(this.value=a?Value.Tuple(d,b.value):d);l(this,d,e)};b.kids.push(this)}function m(a,b){this.id=Guid.guid();this.value=b.value;this.kids=[];this.count=0;this.changed=!1;this.recv=function(d,e,g){g===a.id&&+(this.changed=e);this.count+=1;2==this.count&&(this.changed&&(this.value=b.value),l(this,d,this.changed),this.count=0,this.changed=!1)};a.kids.push(this);b.kids.push(this)}function g(a,b){this.id=Guid.guid();this.value=a.value;this.kids=[];this.next=null;this.count=0;this.changed=!1;this.recv=function(d,e,g){this.count+=1;e&&(this.changed=!0,g==b.id&&null===this.next&&(this.next=b.value),g==a.id&&(this.next=a.value));2==this.count&&(this.changed&&(this.value=this.next,this.next=null),l(this,d,this.changed),+this.changed=!1,this.count=0)};a.kids.push(this);b.kids.push(this)}var l=function(a,b,d){for(var e=a.kids,g=e.length;g--;)e[g].recv(b,d,a.id)},h=function(a){return function(b){return function(e){e=new k(function(a){return function(b){return[a,b]}},[a,e]);e=new d(function(a){return a[0]},[!0,b],e);return new k(function(a){return a[1]},[e])}}};return{constant:function(a){return new e(a)},lift:function(a){return function(b){return new k(a,[b])}},lift2:function(a){return function(b){return function(d){return new k(a,+[b,d])}}},lift3:function(a){return function(b){return function(d){return function(e){return new k(a,[b,d,e])}}}},lift4:function(a){return function(b){return function(d){return function(e){return function(g){return new k(a,[b,d,e,g])}}}}},lift5:function(a){return function(b){return function(d){return function(e){return function(g){return function(h){return new k(a,[b,d,e,g,h])}}}}}},lift6:function(a){return function(b){return function(d){return function(e){return function(g){return function(h){return function(j){return new k(a,+[b,d,e,g,h,j])}}}}}}},lift7:function(a){return function(b){return function(d){return function(e){return function(g){return function(h){return function(j){return function(l){return new k(a,[b,d,e,g,h,j,l])}}}}}}}},lift8:function(a){return function(b){return function(d){return function(e){return function(g){return function(h){return function(j){return function(l){return function(m){return new k(a,[b,d,e,g,h,j,l,m])}}}}}}}}},foldp:function(a){return function(d){return function(e){return new b(a,d,!1,+e)}}},foldp_:function(a){return function(d){return function(e){return new b(a,d,!0,e)}}},foldp1:function(a){return function(d){return new b(a,function(a){return a},!0,d)}},delay:function(a){return function(b){var d=new e(b.value),g=!0;b=new m(d,new k(function(a){return function(){return a}},[d,new k(function(b){g||setTimeout(function(){Dispatcher.notify(d.id,b)},a)},[b])]));g=!1;return b}},merge:function(a){return function(b){return new g(a,b)}},merges:function(a){return Elm.List.foldl1(function(a){return function(b){return new g(a,+b)}})(a)},average:function(a){return function(b){for(var d=Array(a),e=a;e--;)d[e]=0;var e=0,g=!1,h=0;return new k(function(b){h+=b-d[e];d[e]=b;b=h/Math.max(1,g?a:e);++e==a&&(g=!0,e=0);return b},[b])}},count:function(a){return new b(function(){return function(a){return a+1}},0,!1,a)},countIf:function(a){return function(d){return new b(function(b){return function(d){return a(b)?d+1:d}},0,!1,d)}},keepIf:function(a){return function(b){return function(e){return new d(function(b){return!a(b)},b,e)}}},dropIf:function(a){return function(b){return function(e){return new d(a,+b,e)}}},keepWhen:function(a){return h(new k(function(a){return!a},[a]))},dropWhen:h,dropRepeats:function(a){return new j(a)},sampleOn:function(a){return function(b){return new m(a,b)}},timestamp:function(b){return new a(!0,b)},timeOf:function(b){return new a(!1,b)}}}();+var Dispatcher=function(){function e(b){if(!b.hasOwnProperty("defaultNumberOfKids"))return!0;var a=b.kids.length;if(0==a)return!1;if(a>b.defaultNumberOfKids)return!0;for(var d=!1;a--;)d=d||e(b.kids[a]);return d}var k=null,b=[],d=null;return{initialize:function(){k=Elm.main();k.hasOwnProperty("recv")||(k=Elm.Signal.constant(k));d=k.value;for(var j=[],a=b.length;a--;)e(b[a])&&j.push(b[a]);b=j;document.getElementById("content").appendChild(Render.render(d));j=document.getElementById("widthChecker").offsetWidth;+j!==window.innerWidth&&Dispatcher.notify(Elm.Window.dimensions.id,Value.Tuple(j,window.innerHeight));k=Elm.Signal.lift(function(a){var b=document.getElementById("content");Render.update(b.firstChild,d,a);return d=a})(k)},notify:function(d,a){for(var e=(new window.Date).getTime(),g=!1,k=b.length;k--;)g=b[k].recv(e,d,a)||g;return g},inputs:b}}();+Elm.HTTP=function(){function e(b){return function(d){return function(e){return function(c){return{"0":"Request",length:1,verb:a.castStringToJSString(b),url:a.castStringToJSString(d),data:null===e?null:a.castStringToJSString(e),headers:c}}}}}function k(a){return e("GET")(a)(null)(["Nil"])}function b(b,e){return function(h){if(""!==h.url){var c={value:["Waiting"]};b.push(c);var f=null;window.ActiveXObject&&(f=new ActiveXObject("Microsoft.XMLHTTP"));window.XMLHttpRequest&&(f=new XMLHttpRequest);f.onreadystatechange=+function(){4===f.readyState&&(c.value=200===f.status?["Success",m(f.responseText)]:["Failure",f.status,m(f.statusText)],setTimeout(function(){d(b,e)},0))};f.open(h.verb,h.url,!0);Elm.List.map(function(b){f.setRequestHeader(a.castStringToJSString(b[1]),a.castStringToJSString(b[2]))})(h.headers);f.send(h.data)}}}function d(a,b){0<a.length&&(Dispatcher.notify(b.id,a[0].value),"Waiting"!==a[0].value[0]&&(a.shift(),setTimeout(function(){d(a,b)},0)))}function j(a){var d=Elm.Signal.constant(["Waiting"]);+a=Elm.Signal.lift(b([],d))(a);return Elm.Signal.lift2(function(a){return function(){return a}})(d)(a)}var a=Elm.JavaScript,m=Elm.JavaScript.castJSStringToString;return{get:k,post:function(a){return function(b){return e("POST")(a)(b)(["Nil"])}},request:e,send:j,sendGet:function(a){return j(Elm.Signal.lift(k)(a))}}}();+Elm.Input=function(){var e=Elm.JavaScript,k=Elm.JavaScript.castJSStringToString,b=function(a,b){a.placeholder=e.castStringToJSString(b);var d=Elm.Signal.constant(["Nil"]);Value.addListener(a,"keyup",function(){Dispatcher.notify(d.id,k(a.value));a.focus()});a.style.padding="1px";return Value.Tuple(Value.wrap(a),d)},d=function(a){a=document.createElement(a);a.style.padding="0";a.style.margin="0";return a},j=function(a){for(var b=d("select"),e=[];"Cons"===a[0];){var j=d("option"),h=Value.toText(a[1][1]);+j.value=h;j.innerHTML=h;b.appendChild(j);e.push(a[1][2]);a=a[2]}var c=Elm.Signal.constant(e[0]);Value.addListener(b,"change",function(){Dispatcher.notify(c.id,e[b.selectedIndex])});return Value.Tuple(Value.wrap(b),c)};return{textArea:function(a){return function(e){var g=d("textarea");g.rows=e;g.cols=a;return b(g,"")}},textField:function(a){var e=d("input");e.type="text";return b(e,a)},password:function(a){var e=d("input");e.type="password";return b(e,a)},checkbox:function(a){var b=d("input");b.type=+"checkbox";b.checked=a;var e=Elm.Signal.constant(a);Value.addListener(b,"change",function(){Dispatcher.notify(e.id,b.checked)});return Value.Tuple(Value.wrap(b),e)},dropDown:j,stringDropDown:function(a){return j(Elm.List.map(function(a){return Value.Tuple(a,a)})(a))},button:function(a){var b=d("input");b.type="button";b.value=e.castStringToJSString(a);var g=Elm.Signal.constant(!1);Value.addListener(b,"click",function(){Dispatcher.notify(g.id,!0);Dispatcher.notify(g.id,!1)});return Value.Tuple(Value.wrap(b),+g)}}}();+Elm.Keyboard={Raw:function(){function e(b,j){return"Nil"===j[0]?j:j[1]===b?j[2]:["Cons",j[1],e(b,j[2])]}var k=Elm.Signal.constant(["Nil"]),b=Elm.Signal.constant(["Nothing"]);Value.addListener(document,"keydown",function(b){var e;a:{for(e=k.value;"Nil"!==e[0];){if(e[1]===b.keyCode){e=!0;break a}e=e[2]}e=!1}e||Dispatcher.notify(k.id,["Cons",b.keyCode,k.value])||this.removeEventListener("keydown",arguments.callee,!1)});Value.addListener(document,"keyup",function(b){var j=e(b.keyCode,k.value);Dispatcher.notify(k.id,+j)||this.removeEventListener("keyup",arguments.callee,!1)});Value.addListener(window,"blur",function(b){Dispatcher.notify(k.id,["Nil"])||this.removeEventListener("blur",arguments.callee,!1)});Value.addListener(document,"keypress",function(d){var e=Dispatcher.notify(b.id,["Just",d.charCode||d.keyCode]);Dispatcher.notify(b.id,["Nothing"]);e||this.removeEventListener("keypress",arguments.callee,!1)});return{keysDown:k,charPressed:b}}()};+Elm.Mouse=function(){function e(a){var b=0,d=0;a||(a=window.event);if(a.pageX||a.pageY)b=a.pageX,d=a.pageY;else if(a.clientX||a.clientY)b=a.clientX+document.body.scrollLeft+document.documentElement.scrollLeft,d=a.clientY+document.body.scrollTop+document.documentElement.scrollTop;return Value.Tuple(b,d)}var k=Elm.Signal.constant(Value.Tuple(0,0));k.defaultNumberOfKids=2;var b=Elm.Signal.lift(function(a){return a[1]})(k);b.defaultNumberOfKids=0;var d=Elm.Signal.lift(function(a){return a[2]})(k);d.defaultNumberOfKids=+0;var j=Elm.Signal.constant(!1),a=Elm.Signal.constant(!1),m=Elm.Signal.constant(Value.Tuple());Value.addListener(document,"click",function(b){var d=Dispatcher.notify(a.id,!0),e=Dispatcher.notify(m.id,Value.Tuple());Dispatcher.notify(a.id,!1);!d&&!e&&this.removeEventListener("click",arguments.callee,!1)});Value.addListener(document,"mousedown",function(a){Dispatcher.notify(j.id,!0)||this.removeEventListener("mousedown",arguments.callee,!1)});Value.addListener(document,"mouseup",function(a){Dispatcher.notify(j.id,+!1)||this.removeEventListener("mouseup",arguments.callee,!1)});Value.addListener(document,"mousemove",function(a){Dispatcher.notify(k.id,e(a))||this.removeEventListener("mousemove",arguments.callee,!1)});return{position:k,x:b,y:d,isClicked:a,isDown:j,clicks:m,isClickedOn:function(a){a=Render.render(a);var b=Elm.Signal.constant(!1);Value.addListener(a,"click",function(){Dispatcher.notify(b.id,!0);Dispatcher.notify(b.id,!1)});return Value.Tuple(Value.wrap(a),b)}}}();+Elm.Random=function(){return{inRange:function(e){return function(k){return Elm.Signal.constant(Math.floor(Math.random()*(k-e+1))+e)}},randomize:function(e){return function(k){return function(b){return Elm.Signal.lift(function(){return Math.floor(Math.random()*(k-e+1))+e})(b)}}}}}();+Elm.Time=function(){function e(){return(new window.Date).getTime()}function k(b){return function(d){var j=1E3/b,a=e(),k=a,g=0,l=!0,h=Elm.Signal.constant(g),c=0;return Elm.Signal.lift2(function(b){return function(d){if(b){var n=!l&&b;c=setTimeout(function(){k=e();g=n?0:k-a;a=k;Dispatcher.notify(h.id,g)},j)}else l&&clearTimeout(c);l=b;return d}})(d)(h)}}Elm.Signal.constant(!0);return{fpsWhen:k,fps:function(b){return k(b)(Elm.Signal.constant(!0))},every:function(b){var d=Elm.Signal.constant(e());setInterval(function(){Dispatcher.notify(d.id,+e())},b);return d},delay:Elm.Signal.delay,since:function(b){return function(d){var e=Elm.Signal.count(Elm.Signal.delay(b)(d));return Elm.Signal.lift2(function(a){return function(b){return!Value.eq(a,b)}})(Elm.Signal.count(d))(e)}},after:function(b){b*=1E3;var d=Elm.Signal.constant(!1);setTimeout(function(){Dispatcher.notify(d.id,!0)},b);return d},before:function(b){b*=1E3;var d=Elm.Signal.constant(!0);setTimeout(function(){Dispatcher.notify(d.id,!1)},b);return d},hour:36E5,minute:6E4,second:1E3,ms:1,+inHours:function(b){return b/36E5},inMinutes:function(b){return b/6E4},inSeconds:function(b){return b/1E3},inMss:function(b){return b},toDate:function(b){return new window.Date(b)},read:function(b){b=window.Date.parse(b);return isNaN(b)?["Nothing"]:["Just",b]}}}();+Elm.Window=function(){var e=Elm.Signal.constant(Value.Tuple(window.innerWidth,window.innerHeight));e.defaultNumberOfKids=2;var k=Elm.Signal.lift(function(b){return b[1]})(e);k.defaultNumberOfKids=0;var b=Elm.Signal.lift(function(b){return b[2]})(e);b.defaultNumberOfKids=0;Value.addListener(window,"resize",function(b){var j=document.getElementById("widthChecker").offsetWidth;Dispatcher.notify(e.id,Value.Tuple(j,window.innerHeight))||this.removeEventListener("resize",arguments.callee,!1)});return{dimensions:e,+width:k,height:b}}();+Elm.Date=function(){var e="Sun Mon Tue Wed Thu Fri Sat".split(" "),k="Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec".split(" ");return{read:function(b){b=new window.Date(Elm.JavaScript.castStringToJSString(b));return isNaN(b.getTime())?["Nothing"]:["Just",b]},year:function(b){return b.getFullYear()},month:function(b){return[k[b.getMonth()]]},day:function(b){return b.getDate()},hour:function(b){return b.getHours()},minute:function(b){return b.getMinutes()},second:function(b){return b.getSeconds()},dayOfWeek:function(b){return[e[b.getDay()]]},+toTime:function(b){return b.getTime()},Mon:["Mon"],Tue:["Tue"],Wed:["Wed"],Thu:["Thu"],Fri:["Fri"],Sat:["Sat"],Sun:["Sun"],Jan:["Jan"],Feb:["Feb"],Mar:["Mar"],Apr:["Apr"],May:["May"],Jun:["Jun"],Jul:["Jul"],Aug:["Aug"],Sep:["Sep"],Oct:["Oct"],Nov:["Nov"],Dec:["Dec"]}}();Value.addListener(document,"elm_log",function(e){console.log(e.value)});Value.addListener(document,"elm_title",function(e){document.title=e.value});+Value.addListener(document,"elm_redirect",function(e){0<e.value.length&&(window.location=e.value)});+Elm.Prelude=function(){function e(b){return function(d){if(b instanceof Array&&d instanceof Array){var j=b.length;if(j==d.length){for(var a=1;a<j;++a){var k=e(b[a])(d[a]);if("EQ"!==k[0])return k}return["EQ"]}return[1==d.length?"GT":"LT"]}return[b===d?"EQ":b<d?"LT":"GT"]}}var k=function(b){return function(d){var e=b%d,e=0==b?0:0<d?0<=b?e:e+d:-k(-b)(-d);return e==d?0:e}};return{eq:Value.eq,id:function(b){return b},not:function(b){return!b},fst:function(b){return b[1]},snd:function(b){return b[2]},rem:function(b){return function(d){return b%+d}},div:function(b){return function(d){return~~(b/d)}},otherwise:!0,compare:e,toFloat:function(b){return b},round:function(b){return Math.round(b)},floor:function(b){return Math.floor(b)},ceiling:function(b){return Math.ceil(b)},truncate:function(b){return~~b},readInt:function(b){b=Elm.JavaScript.castStringToJSString(b);var d=b.length;if(0===d)return["Nothing"];var e=0;if("-"==b[0]){if(1===d)return["Nothing"];e=1}for(;e<d;++e)if(!Elm.Char.isDigit(b[e]))return["Nothing"];return["Just",parseInt(b)]},+readFloat:function(b){b=Elm.JavaScript.castStringToJSString(b);var d=b.length;if(0===d)return["Nothing"];var e=0;if("-"==b[0]){if(1===d)return["Nothing"];e=1}for(var a=0;e<d;++e)if(!Elm.Char.isDigit(b[e])){if("."===b[e]&&(a+=1,1>=a))continue;return["Nothing"]}return["Just",parseFloat(b)]},sqrt:Math.sqrt,abs:Math.abs,pi:Math.PI,e:Math.E,sin:Math.sin,cos:Math.cos,tan:Math.tan,asin:Math.asin,acos:Math.acos,atan:Math.atan,atan2:function(b){return function(d){return Math.atan2(b,d)}},mod:k,min:function(b){return function(d){return Math.min(b,+d)}},max:function(b){return function(d){return Math.max(b,d)}},flip:function(b){return function(d){return function(e){return b(e)(d)}}},clamp:function(b){return function(d){return function(e){return Math.min(d,Math.max(b,e))}}},curry:function(b){return function(d){return function(e){return b(["Tuple2",d,e])}}},uncurry:function(b){return function(d){if("Tuple2"!==d[0])throw"Function was uncurry'd but was not given a pair.";return b(d[1])(d[2])}},logBase:function(b){return function(d){return Math.log(d)/+Math.log(b)}},Just:Elm.Maybe.Just,Nothing:Elm.Maybe.Nothing,maybe:Elm.Maybe.maybe,map:Elm.List.map,zip:Elm.List.zip,zipWith:Elm.List.zipWith,filter:Elm.List.filter,head:Elm.List.head,tail:Elm.List.tail,last:Elm.List.last,length:Elm.List.length,reverse:Elm.List.reverse,foldr:Elm.List.foldr,foldr1:Elm.List.foldr1,foldl:Elm.List.foldl,foldl1:Elm.List.foldl1,and:Elm.List.and,or:Elm.List.or,all:Elm.List.all,any:Elm.List.any,sum:Elm.List.sum,product:Elm.List.product,concat:Elm.List.concat,concatMap:Elm.List.concatMap,+maximum:Elm.List.maximum,minimum:Elm.List.minimum,scanl:Elm.List.scanl,scanl1:Elm.List.scanl1,take:Elm.List.take,drop:Elm.List.drop,zip:Elm.List.zip,unzip:Elm.List.unzip,lift:Elm.Signal.lift,lift2:Elm.Signal.lift2,lift3:Elm.Signal.lift3,lift4:Elm.Signal.lift4,lift5:Elm.Signal.lift5,lift6:Elm.Signal.lift6,lift7:Elm.Signal.lift7,lift8:Elm.Signal.lift8,foldp:Elm.Signal.foldp,foldp1:Elm.Signal.foldp1,foldp_:Elm.Signal.foldp_,constant:Elm.Signal.constant,merge:Elm.Signal.merge,count:Elm.Signal.count,countIf:Elm.Signal.countIf,+average:Elm.Signal.average,keepIf:Elm.Signal.keepIf,dropIf:Elm.Signal.dropIf,keepWhen:Elm.Signal.keepWhen,dropWhen:Elm.Signal.dropWhen,dropRepeats:Elm.Signal.dropRepeats,sampleOn:Elm.Signal.sampleOn,timestamp:Elm.Signal.timestamp,timeOf:Elm.Signal.timeOf}}();(function(){var e=function(e){for(var b in e)Elm.Prelude[b]=e[b]};e(Elm.Color);e(Elm.Text);e(Elm.Graphics);e(Elm.Time);show=Value.show})();+Elm.Dict=function(){function e(a){return function(b){return function(c){return function(e){return function(d){return["RBNode",a,b,c,e,d]}}}}}function k(a){a:{switch(a[0]){case "RBEmpty":throw"(min RBEmpty) is not defined";case "RBNode":switch(a[4][0]){case "RBEmpty":a=["Tuple2",a[2],a[3]];break a}a=k(a[4]);break a}throw"Non-exhaustive pattern match in case";}return a}function b(a){return function(c){var e;a:{switch(c[0]){case "RBEmpty":e=w;break a;case "RBNode":e=function(){switch(q(a)(c[2])[0]){case "EQ":return A(c[3]);+case "GT":return b(a)(c[5]);case "LT":return b(a)(c[4])}throw"Non-exhaustive pattern match in case";}();break a}throw"Non-exhaustive pattern match in case";}return e}}function d(a){return function(b){return function(c){var e;a:{switch(c[0]){case "RBEmpty":e=a;break a;case "RBNode":e=function(){switch(q(b)(c[2])[0]){case "EQ":return c[3];case "GT":return d(a)(b)(c[5]);case "LT":return d(a)(b)(c[4])}throw"Non-exhaustive pattern match in case";}();break a}throw"Non-exhaustive pattern match in case";+}return e}}}function j(a){return function(c){return F(b(a)(c))}}function a(a){a:{switch(a[0]){case "RBNode":switch(a[5][0]){case "RBNode":a=e(a[1])(a[5][2])(a[5][3])(e(B)(a[2])(a[3])(a[4])(a[5][4]))(a[5][5]);break a}}throw"rotateLeft of a node without enough children";}return a}function m(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":a=e(a[1])(a[4][2])(a[4][3])(a[4][4])(e(B)(a[2])(a[3])(a[4][5])(a[5]));break a}}throw"rotateRight of a node without enough children";}return a}function g(a){a:{switch(a[0]){case "Black":a=+B;break a;case "Red":a=E;break a}throw"Non-exhaustive pattern match in case";}return a}function l(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[5][0]){case "RBNode":a=e(g(a[1]))(a[2])(a[3])(e(g(a[4][1]))(a[4][2])(a[4][3])(a[4][4])(a[4][5]))(e(g(a[5][1]))(a[5][2])(a[5][3])(a[5][4])(a[5][5]));break a}}}throw"color_flip called on a RBEmpty or RBNode with a RBEmpty child";}return a}function h(b){a:switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":b=+a(b);break a}}}a:switch(b[0]){case "RBNode":switch(b[4][0]){case "RBNode":switch(b[4][1][0]){case "Red":switch(b[4][4][0]){case "RBNode":switch(b[4][4][1][0]){case "Red":b=m(b);break a}}}}}a:switch(b[0]){case "RBNode":switch(b[4][0]){case "RBNode":switch(b[4][1][0]){case "Red":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":b=l(b);break a}}}}}return b}function c(a){a:switch(a[0]){case "RBNode":switch(a[1][0]){case "Red":a=e(E)(a[2])(a[3])(a[4])(a[5]);break a}}return a}function f(a){return function(b){return function(d){var f=+function(c){var d;a:{switch(c[0]){case "RBEmpty":d=e(B)(a)(b)(z)(z);break a;case "RBNode":d=function(){switch(q(a)(c[2])[0]){case "EQ":return e(c[1])(c[2])(b)(c[4])(c[5]);case "GT":return e(c[1])(c[2])(c[3])(c[4])(f(c[5]));case "LT":return e(c[1])(c[2])(c[3])(f(c[4]))(c[5])}throw"Non-exhaustive pattern match in case";}();d=h(d);break a}throw"Non-exhaustive pattern match in case";}return d};return c(f(d))}}}function v(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][1][0]){case "Red":a=+!0;break a}}}a=!1}return a}function n(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][4][0]){case "RBNode":switch(a[4][4][1][0]){case "Red":a=!0;break a}}}}a=!1}return a}function p(b){if(x(v(b))&&x(n(b))){b=l(b);a:switch(b[0]){case "RBNode":b:switch(b[5][0]){case "RBNode":switch(b[5][4][0]){case "RBNode":switch(b[5][4][1][0]){case "Red":b=l(a(e(b[1])(b[2])(b[3])(b[4])(m(b[5]))));break b}}}break a}}return b}function r(a){return function(b){var d=function(b){a:{switch(b[0]){case "RBEmpty":b=+z;break a;case "RBNode":if("LT"===q(a)(b[2])[0])b:{b=p(b);switch(b[0]){case "RBEmpty":throw"delLT on RBEmpty";case "RBNode":b=h(e(b[1])(b[2])(b[3])(d(b[4]))(b[5]));break b}break}else{var f=v(b)?m(b):b,g;b:{switch(f[0]){case "RBNode":switch(f[5][0]){case "RBEmpty":g=D(a,f[2]);break b}}g=!1}if(g)b=f[4];else{f=x;b:{switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":g=!0;break b}}}g=!1}if(f=f(g)){f=x;b:{switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][4][0]){case "RBNode":switch(b[5][4][1][0]){case "Red":g=+!0;break b}}}}g=!1}f=f(g)}f&&(b=l(b),b=n(b)?l(m(b)):b);b:{switch(b[0]){case "RBNode":f=D(a,b[2]);break b}f=!1}if(f)b:{switch(b[0]){case "RBEmpty":throw"delEQ called on a RBEmpty";case "RBNode":g=k(b[5]);c:{switch(g[0]){case "Tuple2":f=g[1];break c}break}c:{switch(g[0]){case "Tuple2":g=g[2];break c}break}var f=e(b[1])(f)(g)(b[4]),j=function(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBEmpty":a=z;break a}}b:{a=p(a);switch(a[0]){case "RBEmpty":a=z;break b;case "RBNode":a=h(e(a[1])(a[2])(a[3])(j(a[4]))(a[5]));+break b}throw"Non-exhaustive pattern match in case";}}return a};b=c(j(b[5]));b=h(f(b));break b}break}else b:{switch(b[0]){case "RBEmpty":throw"delGT called on a RBEmpty";case "RBNode":b=h(e(b[1])(b[2])(b[3])(b[4])(d(b[5])));break b}break}}}break a}throw"Non-exhaustive pattern match in case";}return b};return j(a)(b)?c(d(b)):b}}function y(a){return function(b){a:{switch(b[0]){case "RBEmpty":b=z;break a;case "RBNode":b=e(b[1])(b[2])(a(b[3]))(y(a)(b[4]))(y(a)(b[5]));break a}throw"Non-exhaustive pattern match in case";+}return b}}function s(a){return function(b){return function(c){a:{switch(c[0]){case "RBEmpty":c=b;break a;case "RBNode":c=s(a)(a(c[2])(c[3])(s(a)(b)(c[4])))(c[5]);break a}throw"Non-exhaustive pattern match in case";}return c}}}function u(a){return function(b){return function(c){a:{switch(c[0]){case "RBEmpty":c=b;break a;case "RBNode":c=u(a)(a(c[2])(c[3])(u(a)(b)(c[5])))(c[4]);break a}throw"Non-exhaustive pattern match in case";}return c}}}var q=Elm.Prelude.compare,t=Elm.Prelude.uncurry,w=Elm.Prelude.Nothing,+A=Elm.Prelude.Just,x=Elm.Prelude.not,D=Elm.Prelude.eq,F=Elm.Maybe.isJust,B=["Red"],E=["Black"],z=["RBEmpty"],C=z;return{$op:{},empty:C,lookup:b,findWithDefault:d,member:j,insert:f,singleton:function(a){return function(b){return f(a)(b)(z)}},remove:r,map:y,foldl:s,foldr:u,union:function(a){return function(b){return s(f)(b)(a)}},intersect:function(a){return function(b){return s(function(a){return function(c){return function(d){return j(a)(b)?f(a)(c)(d):d}}})(C)(a)}},diff:function(a){return function(b){return s(function(a){return function(){return function(b){return r(a)(b)}}})(a)(b)}},+keys:function(a){return u(function(a){return function(){return function(b){return["Cons",a,b]}}})(["Nil"])(a)},values:function(a){return u(function(){return function(a){return function(b){return["Cons",a,b]}}})(["Nil"])(a)},toList:function(a){return u(function(a){return function(b){return function(c){return["Cons",["Tuple2",a,b],c]}}})(["Nil"])(a)},fromList:function(a){return Elm.List.foldl(t(f))(C)(a)}}}();+Elm.Set=function(){var e=Elm.Dict.empty,k=Elm.Dict.remove,b=Elm.Dict.member,d=Elm.Dict.union,j=Elm.Dict.intersect,a=Elm.Dict.diff,m=Elm.Dict.keys,g=Elm.List.foldl(function(a){return function(b){return Elm.Dict.insert(a)(["Tuple0"])(b)}})(e);return{empty:e,singleton:function(a){return Elm.Dict.singleton(a)(["Tuple0"])},insert:function(a){return Elm.Dict.insert(a)(["Tuple0"])},remove:k,member:b,union:d,intersect:j,diff:a,toList:m,fromList:g,foldl:function(a){return Elm.Dict.foldl(function(b){return function(){return function(c){return a(b)(c)}}})},+foldr:function(a){return Elm.Dict.foldr(function(b){return function(){return function(c){return a(b)(c)}}})},map:function(a){return function(b){b=m(b);return g(Elm.List.map(a)(b))}}}}();+(function(){try{var e={};for(this.i in Elm)eval("var "+this.i+"=Elm[this.i];");if(Elm.Automaton)throw"Module name collision, 'Automaton' is already defined.";Elm.Automaton=function(){function b(a){return["Automaton",a]}function d(a){return b(function(b){var c=unzip(map(function(a){a:{switch(a[0]){case "Automaton":a=a[1](b);break a}throw"Non-exhaustive pattern match in case";}return a})(a)),e;a:{switch(c[0]){case "Tuple2":e=c[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(c[0]){case "Tuple2":c=+c[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",e,d(c)]})}function j(a){return b(function(b){return["Tuple2",a(b),j(a)]})}function a(c){return function(d){return b(function(b){b=d(b)(c);return["Tuple2",b,a(b)(d)]})}}function k(a){return function(c){return b(function(b){var d=c(b)(a);a:{switch(d[0]){case "Tuple2":b=d[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(d[0]){case "Tuple2":d=d[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",+b,k(d)(c)]})}}function g(a){return function(b){a:{switch(a[0]){case "Tuple2":b:{switch(b[0]){case "Tuple2":b=["Tuple2",a[1]-b[1],a[2]-b[2]];break b}break}break a}throw"Non-exhaustive pattern match in case";}return b}}function l(a){return function(b){var c;a:{switch(a[0]){case "Tuple2":b:{switch(b[0]){case "Tuple2":var d=function(a){return["Tuple2",b[2],["Tuple2",a,b[2]]]};c=function(){switch(b[1][0]){case "DragFrom":var c;a[1]?c=["Tuple2",uncurry(move)(g(a[2])(b[1][1]))(b[2]),["Tuple2",["DragFrom",+b[1][1]],b[2]]]:(c=uncurry(move)(g(a[2])(b[1][1]))(b[2]),c=["Tuple2",c,["Tuple2",f,c]]);return c;case "Ignore":return d(a[1]?v:f);case "Listen":return d(not(a[1])?f:isWithin(a[2])(b[2])?["DragFrom",a[2]]:v)}throw"Non-exhaustive pattern match in case";}();break b}break}break a}throw"Non-exhaustive pattern match in case";}return c}}try{if(!(Elm.Prelude instanceof Object))throw"module not found";}catch(h){throw"Module 'Prelude' is missing. Compile with --make flag or load missing module in a separate JavaScript file.";+}var c={};for(this.i in Elm.Prelude)c[this.i]||eval("var "+this.i+" = Elm.Prelude[this.i];");var f=["Listen"],v=["Ignore"];e[">>>"]=function(a){return function(c){var d;a:{switch(a[0]){case "Automaton":d=a[1];break a}throw"Non-exhaustive pattern match in case";}var f;a:{switch(c[0]){case "Automaton":f=c[1];break a}throw"Non-exhaustive pattern match in case";}return b(function(a){a=d(a);var b;a:{switch(a[0]){case "Tuple2":b=a[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(a[0]){case "Tuple2":a=+a[2];break a}throw"Non-exhaustive pattern match in case";}var c=f(b);a:{switch(c[0]){case "Tuple2":b=c[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(c[0]){case "Tuple2":c=c[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",b,e[">>>"](a)(c)]})}};e["<<<"]=function(a){return function(b){return e[">>>"](b)(a)}};e["^>>"]=function(a){return function(b){return e[">>>"](j(a))(b)}};e[">>^"]=function(a){return function(b){return e[">>>"](a)(j(b))}};e["^<<"]=function(a){return function(b){return e[">>>"](b)(j(a))}};+e["<<^"]=function(a){return function(b){return e[">>>"](j(b))(a)}};c=a(0)(function(){return function(a){return 1+a}});return{$op:{">>>":e[">>>"],"<<<":e["<<<"],"^>>":e["^>>"],">>^":e[">>^"],"^<<":e["^<<"],"<<^":e["<<^"]},run:function(a){return function(b){a:{switch(a[0]){case "Automaton":b=lift(fst)(foldp_(function(a){return function(b){a:{switch(b[0]){case "Tuple2":switch(b[2][0]){case "Automaton":b=b[2][1](a);break a}}throw"Non-exhaustive pattern match in case";}return b}})(a[1])(b));break a}throw"Non-exhaustive pattern match in case";+}return b}},step:function(a){return function(b){a:{switch(a[0]){case "Automaton":b=a[1](b);break a}throw"Non-exhaustive pattern match in case";}return b}},combine:d,pure:j,init:a,init_:k,count:c,draggable:function(a){return k(["Tuple2",f,a])(l)}}}();Elm.main=function(){return Elm.Automaton.main}}catch(k){Elm.main=function(){document.body.innerHTML=Elm.Text.monospace('<br/><h2>Your browser may not be supported. Are you using a modern browser?</h2><br/><span style="color:grey">Runtime Error in Automaton module:<br/>'++k+"</span>");throw k;}}})();
src/Ast.hs view
@@ -1,6 +1,7 @@ module Ast where +import Context import Data.Char (isDigit) import Data.List (intercalate) import Types.Types @@ -15,48 +16,52 @@ deriving (Eq,Ord) -data Pattern = PData String [Pattern] | PVar String | PAnything +data Pattern = PData String [Pattern] + | PRecord [String] + | PVar String + | PAnything deriving (Eq) +type CExpr = Context Expr data Expr = IntNum Int | FloatNum Float | Chr Char | Str String | Boolean Bool - | Range Expr Expr - | Access Expr String - | Binop String Expr Expr - | Lambda String Expr - | App Expr Expr - | If Expr Expr Expr - | Guard [(Expr,Expr)] - | Lift Expr [Expr] - | Fold Expr Expr Expr - | Async Expr - | Input String - | Let [Def] Expr + | Range CExpr CExpr + | Access CExpr String + | Remove CExpr String + | Insert CExpr String CExpr + | Modify CExpr [(String,CExpr)] + | Record [(String,[String],CExpr)] + | Binop String CExpr CExpr + | Lambda String CExpr + | App CExpr CExpr + | If CExpr CExpr CExpr + | MultiIf [(CExpr,CExpr)] + | Let [Def] CExpr | Var String - | Case Expr [(Pattern,Expr)] - | Data String [Expr] + | Case CExpr [(Pattern,CExpr)] + | Data String [CExpr] | Markdown Pandoc.Pandoc deriving (Eq) -data Def = FnDef String [String] Expr - | OpDef String String String Expr - deriving (Eq) +data Def = FnDef String [String] CExpr + | OpDef String String String CExpr + deriving (Eq) data Statement = Definition Def | Datatype String [X] [(String,[Type])] - | ImportEvent String Expr String Type + | ImportEvent String CExpr String Type | ExportEvent String String Type deriving (Eq,Show) -cons h t = Data "Cons" [h,t] -nil = Data "Nil" [] +cons h t = epos h t (Data "Cons" [h,t]) +nil = C (Just "[]") NoSpan (Data "Nil" []) list = foldr cons nil tuple es = Data ("Tuple" ++ show (length es)) es -delist (Data "Cons" [h,t]) = h : delist t +delist (C _ _ (Data "Cons" [h,t])) = h : delist t delist _ = [] @@ -65,7 +70,10 @@ plist = foldr pcons pnil ptuple es = PData ("Tuple" ++ show (length es)) es +brkt s = "{ " ++ s ++ " }" + instance Show Pattern where + show (PRecord fs) = brkt (intercalate ", " fs) show (PVar x) = x show PAnything = "_" show (PData "Cons" [hd@(PData "Cons" _),tl]) = @@ -80,43 +88,55 @@ where parens s = "(" ++ s ++ ")" instance Show Expr where - show (IntNum n) = show n - show (FloatNum n) = show n - show (Chr c) = show c - show (Str s) = show s - show (Boolean b) = show b - show (Range e1 e2) = "[" ++ show e1 ++ ".." ++ show e2 ++ "]" - show (Access e x) = show' e ++ "." ++ x - show (Binop op e1 e2) = show' e1 ++ " " ++ op ++ " " ++ show' e2 - show (Lambda x e) = let (xs,e') = getLambdas (Lambda x e) in + show e = + case e of + IntNum n -> show n + FloatNum n -> show n + Chr c -> show c + Str s -> show s + Boolean b -> show b + Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]" + Access e x -> show' e ++ "." ++ x + Remove e x -> brkt (show e ++ " - " ++ x) + Insert (C _ _ (Remove e y)) x v -> + brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v) + Insert e x v -> brkt (show e ++ " | " ++ x ++ " = " ++ show v) + Modify e fs -> brkt (show e ++" | "++ intercalate ", " (map field fs)) + where field (x,e) = x ++ " <- " ++ show e + Record r -> brkt (intercalate ", " (map fields r)) + where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e + Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2 + Lambda x e -> let (xs,e') = getLambdas (noContext $ Lambda x e) in concat [ "\\", intercalate " " xs, " -> ", show e' ] - show (App e1 e2) = show' e1 ++ " " ++ show' e2 - show (If e1 e2 e3) = concat [ "if ", show e1, " then ", show e2, " else ", show e3 ] - show (Guard ps) = concatMap (\(b,e) -> concat ["\n | ",show b," = ",show e]) ps - show (Let defs e) = "let { " ++ intercalate " ; " (map show defs) ++ " } in " ++ show e - show (Var x) = x - show (Case e pats) = "case " ++ show e ++ " of { " ++ intercalate " ; " (map (\(p,e) -> show p ++ " -> " ++ show e) pats) ++ " }" - show (Data name es) - | name == "Cons" = ("["++) . (++"]") . intercalate "," . map show $ delist (Data "Cons" es) - | name == "Nil" = "[]" - | otherwise = name ++ " " ++ intercalate " " (map show' es) - show (Lift f es) = concat [ "lift", show $ length es, " ", show' f, " ", intercalate " " (map show' es) ] - show (Fold e1 e2 e3) = concat [ "foldp ", show' e1, " ", show' e2, " ", show' e3 ] - show (Async e) = "async " ++ show' e - show (Input i) = i - show (Markdown _) = "[markdown| ... |]" + App e1 e2 -> show' e1 ++ " " ++ show' e2 + If e1 e2 e3 -> concat [ "if ", show e1, " then ", show e2, " else ", show e3 ] + MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ] + where iff (b,e) = show b ++ " -> " ++ show e + sep = concatMap ("\n | " ++) + Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e + Var x -> x + Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats') + where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats + Data name es + | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $ + delist (noContext $ Data "Cons" es) + | name == "Nil" -> "[]" + | otherwise -> name ++ " " ++ intercalate " " (map show' es) + Markdown _ -> "[markdown| ... |]" instance Show Def where - show (FnDef v [] e) = v ++ " = " ++ show e - show (FnDef f args e) = f ++ " " ++ intercalate " " args ++ " = " ++ show e - show (OpDef op a1 a2 e) = intercalate " " [a1,op,a2] ++ " = " ++ show e + show e = + case e of + FnDef v [] e -> v ++ " = " ++ show e + FnDef f args e -> f ++ " " ++ intercalate " " args ++ " = " ++ show e + OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e -getLambdas (Lambda x e) = (x:xs,e') +getLambdas (C _ _ (Lambda x e)) = (x:xs,e') where (xs,e') = getLambdas e getLambdas e = ([],e) -show' e = if needsParens e then "(" ++ show e ++ ")" else show e +show' (C _ _ e) = if needsParens e then "(" ++ show e ++ ")" else show e needsParens (Binop _ _ _) = True needsParens (Lambda _ _) = True @@ -125,7 +145,4 @@ needsParens (Let _ _) = True needsParens (Case _ _) = True needsParens (Data name (x:xs)) = name /= "Cons" -needsParens (Lift _ _) = True -needsParens (Fold _ _ _) = True -needsParens (Async _) = True needsParens _ = False
+ src/Context.hs view
@@ -0,0 +1,43 @@+ +module Context where + +import Text.Parsec.Pos + + +data SrcPos = Pos Int Int + deriving (Eq,Ord) + +data SrcSpan = Span SrcPos SrcPos | NoSpan + deriving (Eq,Ord) + +data Context e = C (Maybe String) SrcSpan e deriving (Eq,Ord) + + +instance Show SrcPos where + show (Pos r c) = "Line " ++ show r ++ ", Column " ++ show c + +instance Show SrcSpan where + show span = + case span of + Span start end -> show start + NoSpan -> "" + +instance Show e => Show (Context e) where + show (C _ _ e) = show e + + + +noContext = C Nothing NoSpan + +pos start end = C Nothing + (Span (Pos (sourceLine start) (sourceColumn start)) + (Pos (sourceLine end ) (sourceColumn end ))) + +epos (C _ s1 _) (C _ s2 _) = C Nothing span + where span = case (s1,s2) of + (Span start _, Span _ end) -> Span start end + (_, NoSpan) -> s1 + (NoSpan, _) -> s2 + +addCtx x (C Nothing span e) = C (Just (show x)) span e +addCtx x (C txt span e) = C txt span e
src/Gen/Cases.hs view
@@ -7,6 +7,7 @@ import Data.Maybe (fromMaybe) import Ast +import Context import Guid import Substitute @@ -20,7 +21,7 @@ data Match = Match String [Clause] Match | Break | Fail - | Other Expr + | Other CExpr | Seq [Match] deriving Show @@ -31,18 +32,20 @@ matchSubst _ Break = Break matchSubst _ Fail = Fail matchSubst pairs (Seq ms) = Seq (map (matchSubst pairs) ms) -matchSubst pairs (Other e) = - Other $ foldr ($) e $ map (\(x,y) -> subst x (Var y)) pairs -matchSubst pairs (Match n cs m) = Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m) - where clauseSubst (Clause c vs m) = Clause c (map varSubst vs) (matchSubst pairs m) - varSubst v = fromMaybe v (lookup v pairs) +matchSubst pairs (Other (C t s e)) = + Other . C t s $ foldr ($) e $ map (\(x,y) -> subst x (Var y)) pairs +matchSubst pairs (Match n cs m) = + Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m) + where varSubst v = fromMaybe v (lookup v pairs) + clauseSubst (Clause c vs m) = + Clause c (map varSubst vs) (matchSubst pairs m) isCon (PData _ _ : _, _) = True isCon _ = False isVar p = not (isCon p) -match :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match +match :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match match [] [] def = return def match [] [([],e)] Fail = return $ Other e match [] [([],e)] Break = return $ Other e @@ -52,19 +55,19 @@ | all isCon cs = matchCon vs cs def | otherwise = matchMix vs cs def -matchVar :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match +matchVar :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match matchVar (v:vs) cs def = match vs (map subVar cs) def - where subVar (PVar x : ps, e) = (ps, subst x (Var v) e) - subVar (PAnything : ps, e) = (ps, e) + where subVar (PVar x : ps, C t s e) = (ps, C t s $ subst x (Var v) e) + subVar (PAnything : ps, ce) = (ps, ce) -matchCon :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match +matchCon :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css where css = groupBy (withName (==)) $ sortBy (withName compare) cs withName f (PData n1 _:_,_) (PData n2 _:_,_) = f n1 n2 toClause cs = let (PData name _ : _ , _) = head cs in matchClause name (v:vs) cs Break -matchClause :: String -> [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Clause +matchClause :: String -> [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Clause matchClause c (v:vs) cs def = do vs' <- getVars Clause c vs' `liftM` match (vs' ++ vs) (map flatten cs) def @@ -72,6 +75,6 @@ getVars = let (PData _ ps : _, _) = head cs in mapM (\_ -> newVar) ps -matchMix :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match +matchMix :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match matchMix vs cs def = foldM (flip $ match vs) def (reverse css) where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs
src/Gen/CompileToJS.hs view
@@ -1,12 +1,12 @@- module CompileToJS (showErr, jsModule) where import Ast+import Context import Control.Arrow (first) import Control.Monad (liftM,(<=<),join,ap) import Data.Char (isAlpha,isDigit) import Data.List (intercalate,sortBy,inits,foldl')-import Data.Map (toList)+import qualified Data.Map as Map import Data.Either (partitionEithers) import qualified Text.Pandoc as Pan @@ -141,22 +141,22 @@ toJS :: a -> GuidCounter String instance ToJS Def where- toJS (FnDef x [] e) = assign x `liftM` toJS e+ toJS (FnDef x [] e) = assign x `liftM` toJS' e toJS (FnDef f (a:as) e) =- do body <- toJS (foldr Lambda e as)+ do body <- toJS' (foldr (\x e -> noContext (Lambda x e)) e as) return $ concat ["\nfunction ",f,parens a, braces . indent $ ret body] toJS (OpDef op a1 a2 e) =- do body <- toJS (foldr Lambda e [a1,a2])+ do body <- toJS' (foldr (\x e -> noContext (Lambda x e)) e [a1,a2]) return $ concat [ "\n$op['", op, "'] = ", body, ";" ] instance ToJS Statement where toJS (Definition d) = toJS d toJS (Datatype _ _ tcs) = concat `liftM` mapM (toJS . toDef) tcs- where toDef (name,args) =- Definition . FnDef name vars $ Data (derename name) (map Var vars)+ where toDef (name,args) = Definition . FnDef name vars . noContext $+ Data (derename name) (map (noContext . Var) vars) where vars = map (('a':) . show) [1..length args] toJS (ImportEvent js base elm _) =- do v <- toJS base+ do v <- toJS' base return $ concat [ "\nvar " ++ elm ++ "=Elm.Signal.constant(" ++ v ++ ");" , "\nValue.addListener(document, '" ++ js , "', function(e) { Dispatcher.notify(" ++ elm@@ -168,47 +168,99 @@ , "e.value = v;" , "document.dispatchEvent(e); return v; })(", elm, ");" ] -instance ToJS Expr where- toJS expr =+toJS' :: CExpr -> GuidCounter String+toJS' (C txt span expr) = case expr of- IntNum n -> return $ show n- FloatNum n -> return $ show n- Var x -> return $ x- Chr c -> return $ quoted [c]- Str s -> return $ "Value.str" ++ parens (quoted s)- Boolean b -> return $ if b then "true" else "false"- Range lo hi -> jsRange `liftM` toJS lo `ap` toJS hi- Access e lbl -> (\s -> s ++ "." ++ lbl) `liftM` toJS e- Binop op e1 e2 -> binop op `liftM` toJS e1 `ap` toJS e2- If eb et ef -> parens `liftM` (iff `liftM` toJS eb `ap` toJS et `ap` toJS ef)- Guard ps -> guardToJS ps- Lambda v e -> liftM (jsFunc v . ret) (toJS e)- App (Var "toText") (Str s) -> return $ "toText" ++ parens (quoted s)- App (Var "link") (Str s) -> return $ "link(" ++ quoted s ++ ")"- App (Var "plainText") (Str s) -> return $ "plainText(" ++ quoted s ++ ")"- App e1 e2 -> (++) `liftM` (toJS e1) `ap` (parens `liftM` toJS e2)- Let defs e -> jsLet defs e- Case e cases -> caseToJS e cases- Data name es -> (\ss -> jsList $ quoted name : ss) `liftM` mapM toJS es- Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"- where md = formatMarkdown $ Pan.writeHtmlString Pan.defaultWriterOptions doc- pad = "<div style=\"height:0;width:0;\"> </div>"+ MultiIf ps -> multiIfToJS span ps+ Case e cases -> caseToJS span e cases+ _ -> toJS expr +recordToJS e loop cmds = + do e' <- toJS' e+ return $ jsFunc "" (concat [ assign "r" "{_:[true]}"+ , assign "e" e'+ , "\nfor(var i in e){", loop, "}"+ , cmds+ , ret "r" ]) ++ "()"++remove x = concat [ "\n if (i!='", x, "') { r[i]=e[i]; }"+ , "\n else if (e[i].length>1) { r[i]=e[i].slice(1); }" ]+addField (x,e) = ((++add) . assign "v") `liftM` toJS' e+ where add = concat [ "\nif (r.hasOwnProperty('", x, "')) {"+ , "\n r.", x, " = r.", x, ".slice(0);"+ , "\n r.", x, ".unshift(v);"+ , "\n} else { r.", x, " = [v]; }" ]+setField (x,e) = do+ set <- globalAssign ("r." ++ x ++ "[0]") `liftM` toJS' e+ return (globalAssign ("r." ++ x) ("r." ++ x ++ ".slice(0)") ++ set)+access x e = jsFunc "r" (ret body) ++ parens e+ where body = "r.hasOwnProperty('_') ? r." ++ x ++ "[0] : r." ++ x+makeRecord kvs = do+ kvs' <- (Map.toList . foldl' combine Map.empty) `liftM` mapM prep kvs+ let fs = map (\(k,vs) -> k ++ " : " ++ jsList vs) kvs' ++ ["_ : [true]"]+ return $ braces ("\n " ++ intercalate ",\n " fs)+ where combine r (k,v) = Map.insertWith (++) k v r+ prep (k, as, e@(C t s _)) =+ do v <- toJS' (foldr (\x e -> C t s $ Lambda x e) e as)+ return (k,[v])+++instance ToJS Expr where+ toJS expr =+ case expr of+ IntNum n -> return $ show n+ FloatNum n -> return $ show n+ Var x -> return $ x+ Chr c -> return $ quoted [c]+ Str s -> return $ "Value.str" ++ parens (quoted s)+ Boolean b -> return $ if b then "true" else "false"+ Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi+ Access e x -> access x `liftM` toJS' e+ Remove e x -> recordToJS e (remove x) ""+ Insert e x v -> recordToJS e "r[i]=e[i];" =<< addField (x,v)+ Modify e fs -> recordToJS e "r[i]=e[i];" . concat =<< mapM setField fs+ Record fs -> makeRecord fs+ Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2++ If eb et ef ->+ parens `liftM` (iff `liftM` toJS' eb `ap` toJS' et `ap` toJS' ef)++ Lambda v e -> liftM (jsFunc v . ret) (toJS' e)++ App (C _ _ (Var "toText")) (C _ _ (Str s)) ->+ return $ "toText" ++ parens (quoted s)++ App (C _ _ (Var "link")) (C _ _ (Str s)) ->+ return $ "link(" ++ quoted s ++ ")"++ App (C _ _ (Var "plainText")) (C _ _ (Str s)) ->+ return $ "plainText(" ++ quoted s ++ ")"++ App e1 e2 -> (++) `liftM` (toJS' e1) `ap` (parens `liftM` toJS' e2)+ Let defs e -> jsLet defs e+ Data name es -> (\ss -> jsList $ quoted name : ss) `liftM` mapM toJS' es++ Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"+ where pad = "<div style=\"height:0;width:0;\"> </div>"+ md = formatMarkdown $+ Pan.writeHtmlString Pan.defaultWriterOptions doc+ formatMarkdown = concatMap f where f '\'' = "\\'" f '\n' = "\\n" f '"' = "\"" f c = [c] -guardToJS ps = format `liftM` mapM f ps+multiIfToJS span ps = format `liftM` mapM f ps where format cs = foldr (\c e -> parens $ c ++ " : " ++ e) err cs- err = "(function(){throw \"Non-exhaustive guard expression\";}())"- f (b,e) = do b' <- toJS b- e' <- toJS e+ err = concat [ "(function(){throw \"Non-exhaustive "+ , "multi-way-if expression (", show span, ")\";}())" ]+ f (b,e) = do b' <- toJS' b+ e' <- toJS' e return (b' ++ " ? " ++ e') jsLet defs e' = do- body <- (++) `liftM` jsDefs defs `ap` (ret `liftM` toJS e')+ body <- (++) `liftM` jsDefs defs `ap` (ret `liftM` toJS' e') return $ jsFunc "" body ++ "()" jsDefs defs = concat `liftM` mapM toJS (sortBy f defs)@@ -216,28 +268,29 @@ valueOf (FnDef _ args _) = min 1 (length args) valueOf (OpDef _ _ _ _) = 1 -caseToJS e ps = do+caseToJS span e ps = do match <- caseToMatch ps- e' <- toJS e+ e' <- toJS' e (match',stmt) <- case (match,e) of- (Match name _ _, Var x) -> return (matchSubst [(name,x)] match, "")- (Match name _ _, _ ) -> return (match, assign name e')- _ -> liftM (\n -> (match, e')) guid- matches <- matchToJS match'+ (Match name _ _, C _ _ (Var x)) -> return (matchSubst [(name,x)] match, "")+ (Match name _ _, _) -> return (match, assign name e')+ _ -> liftM (\n -> (match, e')) guid+ matches <- matchToJS span match' return $ concat [ "function(){", stmt, matches, "}()" ] -matchToJS (Match name clauses def) = do- cases <- concat `liftM` mapM (clauseToJS name) clauses- finally <- matchToJS def+matchToJS span (Match name clauses def) = do+ cases <- concat `liftM` mapM (clauseToJS span name) clauses+ finally <- matchToJS span def return $ concat [ "\nswitch(", name, "[0]){", indent cases, "\n}", finally ]-matchToJS Fail = return "\nthrow \"Non-exhaustive pattern match in case\";"-matchToJS Break = return "break;"-matchToJS (Other e) = ret `liftM` toJS e-matchToJS (Seq ms) = concat `liftM` mapM matchToJS ms+matchToJS span Fail = return ("\nthrow \"Non-exhaustive pattern match " +++ "in case expression (" ++ show span ++ ")\";")+matchToJS span Break = return "break;"+matchToJS span (Other e) = ret `liftM` toJS' e+matchToJS span (Seq ms) = concat `liftM` mapM (matchToJS span) ms -clauseToJS var (Clause name vars e) = do+clauseToJS span var (Clause name vars e) = do let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]- s <- matchToJS $ matchSubst (zip vars vars') e+ s <- matchToJS span $ matchSubst (zip vars vars') e return $ concat [ "\ncase ", quoted name, ":", s ] jsNil = "[\"Nil\"]"@@ -265,6 +318,9 @@ e2 ++ ")[0]; return ord==='LT' || ord==='EQ'; }()" ">=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++ e2 ++ ")[0]; return ord==='GT' || ord==='EQ'; }()"+ "<~" -> "lift" ++ parens e1 ++ parens e2+ "~" -> "lift2(function(f){return function(x){return f(x);};})" +++ parens e1 ++ parens e2 _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2) | otherwise -> concat [ "$op['", o:p, "']" , parens e1, parens e2 ]
src/Gen/ExtractNoscript.hs view
@@ -2,6 +2,7 @@ module ExtractNoscript (extractNoscript) where import Ast +import Context import qualified Text.Pandoc as Pan extractNoscript :: Module -> String @@ -22,6 +23,9 @@ extract (FnDef _ _ e) = extract e extract (OpDef _ _ _ e) = extract e +instance Extract e => Extract (Context e) where + extract (C _ _ e) = extract e + instance Extract Expr where extract expr = let f = extract in @@ -31,13 +35,13 @@ ("++", [s1], [s2]) -> [s1 ++ s2] (_ , ss1 , ss2 ) -> ss1 ++ ss2 Lambda v e -> f e - App (App (Var "link") src) txt -> linkExtract src txt - App (App (Var "Graphics.link") src) txt -> linkExtract src txt - App (App (Var "Text.link") src) txt -> linkExtract src txt - App (Var "header") e -> tag "h1" e - App (Var "bold") e -> tag "b" e - App (Var "italic") e -> tag "i" e - App (Var "monospace") e -> tag "code" e + App (C _ _ (App (C _ _ (Var "link")) src)) txt -> linkExtract src txt + App (C _ _ (App (C _ _ (Var "Graphics.link")) src)) txt -> linkExtract src txt + App (C _ _ (App (C _ _ (Var "Text.link")) src)) txt -> linkExtract src txt + App (C _ _ (Var "header")) e -> tag "h1" e + App (C _ _ (Var "bold")) e -> tag "b" e + App (C _ _ (Var "italic")) e -> tag "i" e + App (C _ _ (Var "monospace")) e -> tag "code" e App e1 e2 -> f e1 ++ f e2 If eb et ef -> f et ++ f ef Let defs e -> concatMap extract defs ++ f e
src/Optimize.hs view
@@ -1,6 +1,7 @@ module Optimize (optimize) where import Ast+import Context import Control.Arrow (second) import Data.Char (isAlpha) import Substitute@@ -22,8 +23,10 @@ instance Simplify Def where simp (FnDef func args e) = FnDef func args (simp e) simp (OpDef op a1 a2 e) = OpDef op a1 a2 (simp e)- +instance Simplify e => Simplify (Context e) where+ simp (C t s e) = C t s (simp e)+ instance Simplify Expr where simp expr = let f = simp in@@ -31,9 +34,11 @@ Range e1 e2 -> Range (f e1) (f e2) Binop op e1 e2 -> simp_binop op (f e1) (f e2) Lambda x e -> Lambda x (f e)- App (Lambda x e1) e2 -> - if isValue e2' then subst x e2' e1' else App (Lambda x e1') e2'- where { e1' = f e1 ; e2' = f e2 }+ Record fs -> Record (map (\(f,as,e) -> (f, as, simp e)) fs)+ App (C t s (Lambda x e1)) e2 -> + if isValue e2' then subst x e2' e1' else App (C t s (Lambda x ce1')) ce2'+ where ce1'@(C _ _ e1') = f e1+ ce2'@(C _ _ e2') = f e2 App e1 e2 -> App (f e1) (f e2) If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3) Let defs e -> Let (map simp defs) (f e)@@ -41,75 +46,89 @@ Case e cases -> Case (f e) (map (second f) cases) _ -> expr -simp_if (Boolean b) e2 e3 = if b then e2 else e3+simp_if (C _ _ (Boolean b)) (C _ _ e2) (C _ _ e3) = if b then e2 else e3 simp_if a b c = If a b c -isValue e = case e of { IntNum _ -> True- ; FloatNum _ -> True- ; Chr _ -> True- ; Str _ -> True- ; Boolean _ -> True- ; Var _ -> True- ; Data _ _ -> True- ; _ -> False }+isValue e =+ case e of { IntNum _ -> True+ ; FloatNum _ -> True+ ; Chr _ -> True+ ; Str _ -> True+ ; Boolean _ -> True+ ; Var _ -> True+ ; Data _ _ -> True+ ; _ -> False } simp_binop = binop -binop op (IntNum n) (IntNum m) = f n m- where f a b = case op of- { "+" -> IntNum $ (+) a b- ; "-" -> IntNum $ (-) a b- ; "*" -> IntNum $ (*) a b- ; "div" -> IntNum $ div a b- ; "mod" -> IntNum $ mod a b- ; "<" -> Boolean $ a < b- ; ">" -> Boolean $ a < b- ; "<=" -> Boolean $ a <= b- ; ">=" -> Boolean $ a >= b- ; "==" -> Boolean $ a == b- ; "/=" -> Boolean $ a /= b- ; _ -> Binop op (IntNum n) (IntNum m) }+binop op ce1@(C t1 s1 e1) ce2@(C t2 s2 e2) =+ let c1 = C t1 s1 in+ let c2 = C t2 s2 in+ case (op, e1, e2) of+ (_, IntNum n, IntNum m) -> case op of+ { "+" -> IntNum $ (+) n m+ ; "-" -> IntNum $ (-) n m+ ; "*" -> IntNum $ (*) n m+ ; "^" -> IntNum $ n ^ m+ ; "div" -> IntNum $ div n m+ ; "mod" -> IntNum $ mod n m+ ; "<" -> Boolean $ n < m+ ; ">" -> Boolean $ n < m+ ; "<=" -> Boolean $ n <= m+ ; ">=" -> Boolean $ n >= m+ ; "==" -> Boolean $ n == m+ ; "/=" -> Boolean $ n /= m+ ; _ -> Binop op ce1 ce2 } -binop "-" e (IntNum 0) = e-binop "+" (IntNum 0) e = e-binop "+" e (IntNum 0) = e-binop "+" (IntNum n) (Binop "+" (IntNum m) e) = binop "+" (IntNum (n+m)) e-binop "+" (IntNum n) (Binop "+" e (IntNum m)) = binop "+" (IntNum (n+m)) e+ -- flip order to move lone integers to the left+ ("+", _, IntNum n) -> binop "+" ce2 ce1+ ("*", _, IntNum n) -> binop "*" ce2 ce1 -binop "/" e (IntNum 1) = e-binop "div" e (IntNum 1) = e-binop "*" (IntNum 0) e = IntNum 0-binop "*" (IntNum 1) e = e-binop "*" (IntNum n) (Binop "*" (IntNum m) e) = binop "*" (IntNum (n*m)) e-binop "*" (IntNum n) (Binop "*" e (IntNum m)) = binop "*" (IntNum (n*m)) e+ ("+", IntNum 0, _) -> e2+ ("+", IntNum n, Binop "+" (C _ _ (IntNum m)) ce) ->+ binop "+" (c1 $ IntNum (n+m)) ce+ ("+", Binop "+" (C _ _ (IntNum n)) ce1'+ , Binop "+" (C _ _ (IntNum m)) ce2') ->+ binop "+" (noContext $ IntNum (n+m)) (noContext $ Binop "+" ce1' ce2') -binop "+" e (IntNum n) = binop "+" (IntNum n) e-binop "*" e (IntNum n) = binop "*" (IntNum n) e+ ("*", IntNum 0, _) -> e1+ ("*", IntNum 1, _) -> e2+ ("*", IntNum n, Binop "*" (C _ _ (IntNum m)) ce) ->+ binop "*" (noContext $ IntNum (n*m)) ce+ ("*", Binop "*" (C _ _ (IntNum n)) ce1'+ , Binop "*" (C _ _ (IntNum m)) ce2') ->+ binop "*" (noContext $ IntNum (n*m)) (noContext $ Binop "*" ce1' ce2') -binop op (Boolean n) (Boolean m) = f n m- where f a b = case op of { "&&" -> Boolean $ (&&) n m- ; "||" -> Boolean $ (||) n m- ; _ -> Binop op (Boolean n) (Boolean m) }+ ("-", _, IntNum 0) -> e1+ ("/", _, IntNum 1) -> e1+ ("div", _, IntNum 1) -> e1 -binop "&&" (Boolean True) e = e-binop "&&" (Boolean False) e = Boolean False-binop "||" (Boolean True) e = Boolean True-binop "||" (Boolean False) e = e+ (_, Boolean n, Boolean m) -> case op of "&&" -> Boolean $ n && m+ "||" -> Boolean $ n || m+ _ -> Binop op ce1 ce2 -binop "&&" e (Boolean n) = binop "&&" (Boolean n) e-binop "||" e (Boolean n) = binop "||" (Boolean n) e+ ("&&", Boolean True, _) -> e2+ ("&&", Boolean False, _) -> Boolean False+ ("||", Boolean True, _) -> Boolean True+ ("||", Boolean False, _) -> e2 -binop ":" h t = cons h t-binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2-binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e-binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)-binop "++" (Data "Nil" []) e = e-binop "++" e (Data "Nil" []) = e-binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]+ (":", _, _) -> let (C _ _ e) = cons ce1 ce2 in e -binop "$" e1 e2 = App e1 e2-binop "." e1 e2 = Lambda "x" (App e1 (App e2 (Var "x")))+ ("++", Str s1, Str s2) -> Str $ s1 ++ s2+ ("++", Str s1, Binop "++" (C _ _ (Str s2)) ce) ->+ Binop "++" (c1 $ Str $ s1 ++ s2) ce+ ("++", Binop "++" e (C _ _ (Str s1)), Str s2) ->+ Binop "++" e (c1 $ Str $ s1 ++ s2) -binop op e1 e2- | isAlpha (head op) || '_' == head op = App (App (Var op) e1) e2- | otherwise = Binop op e1 e2+ ("++", Data "Nil" [], _) -> e2+ ("++", _, Data "Nil" []) -> e1+ ("++", Data "Cons" [h,t], _) -> Data "Cons" [h, noContext $ binop "++" t ce2]++ ("$", _, _) -> App ce1 ce2+ (".", _, _) ->+ Lambda "x" (noContext $+ App ce1 (noContext $ App ce2 (noContext $ Var "x")))++ _ | isAlpha (head op) || '_' == head op ->+ App (noContext $ App (noContext $ Var op) ce1) ce2+ | otherwise -> Binop op ce1 ce2
src/Parse/Binops.hs view
@@ -1,9 +1,11 @@ module Parse.Binops (binops) where import Ast+import Context import Control.Monad (liftM,guard) import Control.Monad.Error-import Data.List (foldl',splitAt,elemIndices,group,groupBy,sortBy,find)+import Data.List (foldl',splitAt,elemIndices+ ,group,groupBy,sortBy,find,intercalate) import qualified Data.Map as Map import Data.Maybe (mapMaybe) @@ -12,6 +14,9 @@ data Assoc = L | N | R deriving (Eq,Show) +type OpTable = [(Int, Assoc, String)]++table :: OpTable table = [ (9, R, ".") , (8, R, "^") , (7, L, "*"), (7, L, "/"), (7, L, "mod"), (7, L, "div"), (7, L, "rem")@@ -19,51 +24,65 @@ , (5, R, ":" ), (5, R, "++") , (4, N, "<="), (4, N, ">="), (4, N, "<") , (4, N, "=="), (4, N, "/="), (4, N, ">")+ , (4, L, "~"), (4, L, "<~") , (3, R, "&&") , (2, R, "||") , (0, R, "$") ] +opLevel op = Map.findWithDefault 9 op dict+ where dict = Map.fromList (map (\(lvl,_,op) -> (op,lvl)) table)++opAssoc op = Map.findWithDefault R op dict+ where dict = Map.fromList (map (\(_,assoc,op) -> (op,assoc)) table)++hasLevel n (op,e) = opLevel op == n++sortOps :: OpTable -> OpTable sortOps = sortBy (\(i,_,_) (j,_,_) -> compare i j) +binops :: IParser CExpr -> IParser String -> IParser CExpr binops term anyOp = do e <- term- (ops,es) <- liftM unzip $- many (commitIf (whitespace >> anyOp) $ do { whitespace ; op <- anyOp- ; whitespace ; e <- term- ; return (op,e) })- case binopOf Map.empty (sortOps table) ops (e:es) of- Right e -> return e- Left msg -> fail msg+ split 0 e =<< many (commitIf (whitespace >> anyOp) $ do+ whitespace ; op <- anyOp+ whitespace ; e <- term+ return (op,e)) -binopSplit seen opTable i ops es =- case (splitAt i ops, splitAt (i+1) es) of- ((befores, op:afters), (pres, posts)) ->- do e1 <- binopOf seen opTable befores pres- e2 <- binopOf seen opTable afters posts- return $ Binop op e1 e2+split :: Int -> CExpr -> [(String, CExpr)] -> IParser CExpr+split _ e [] = return e+split n e eops = do+ assoc <- getAssoc n eops+ es <- sequence (splitLevel n e eops)+ let ops = map fst (filter (hasLevel n) eops)+ case assoc of R -> joinR es ops+ _ -> joinL es ops -binopOf _ _ _ [e] = return e-binopOf seen [] ops es = binopOf seen [(9,L,head ops)] ops es+splitLevel :: Int -> CExpr -> [(String, CExpr)] -> [IParser CExpr]+splitLevel n e eops =+ case break (hasLevel n) eops of+ (lops, (op,e'):rops) -> split (n+1) e lops : splitLevel n e' rops+ (lops, []) -> [ split (n+1) e lops ] -binopOf seen (tbl@((lvl, L, op):rest)) ops es =- case elemIndices op ops of- [] -> binopOf seen rest ops es- is -> case Map.lookup lvl seen of- Nothing -> binopSplit (Map.insert lvl (L,op) seen) tbl (last is) ops es- Just (L,_) -> binopSplit seen tbl (last is) ops es- Just (assoc,op') -> Left $ errorMessage lvl op L op' assoc-binopOf seen (tbl@((lvl, assoc, op):rest)) ops es =- case elemIndices op ops of- [] -> binopOf seen rest ops es- i:_ -> case Map.lookup lvl seen of- Nothing -> binopSplit (Map.insert lvl (assoc,op) seen) tbl i ops es- Just (assoc',op') ->- if assoc == assoc' && assoc /= N then- binopSplit seen tbl i ops es- else Left $ errorMessage lvl op assoc op' assoc'+joinL :: [CExpr] -> [String] -> IParser CExpr+joinL [e] [] = return e+joinL (a:b:es) (op:ops) = joinL (epos a b (Binop op a b) : es) ops+joinL _ _ = fail "Ill-formed binary expression. Report a compiler bug." -errorMessage lvl op1 assoc1 op2 assoc2 =- "Cannot have (" ++ op1 ++ ") with [" ++ show assoc1 ++ " " ++- show lvl ++ "] and (" ++ op2 ++ ") with [" ++ show assoc2 ++ " " ++- show lvl ++ "]"+joinR :: [CExpr] -> [String] -> IParser CExpr+joinR [e] [] = return e+joinR (a:b:es) (op:ops) = do e <- joinR (b:es) ops+ return (epos a e (Binop op a e))+joinR _ _ = fail "Ill-formed binary expression. Report a compiler bug."++getAssoc :: Int -> [(String,CExpr)] -> IParser Assoc+getAssoc n eops | all (==L) assocs = return L+ | all (==R) assocs = return R + | all (==N) assocs = case assocs of [_] -> return N+ _ -> fail msg+ where levelOps = filter (hasLevel n) eops+ assocs = map (opAssoc . fst) levelOps+ msg = concat [ "Conflicting precedence for binary operators ("+ , intercalate ", " (map fst eops), "). "+ , "Consider adding parentheses to disambiguate." ]+
src/Parse/Expr.hs view
@@ -1,6 +1,7 @@ module Parse.Expr (def,term) where import Ast+import Context import Control.Applicative ((<$>), (<*>)) import Control.Monad import Data.Char (isSymbol, isDigit)@@ -45,74 +46,124 @@ chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\'')) <?> "character" +accessor :: IParser Expr+accessor = do+ start <- getPosition+ lbl <- try (string "." >> rLabel)+ end <- getPosition+ let ctx e = addCtx ("." ++ lbl) (pos start end e)+ return (Lambda "_" (ctx $ Access (ctx $ Var "_") lbl)) + -------- Complex Terms -------- listTerm :: IParser Expr-listTerm = (do { try $ string "[markdown|"- ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")- ; return . Markdown $ Pan.readMarkdown Pan.defaultParserState md })- <|> (braces $ choice- [ try $ do { lo <- expr; whitespace; string ".." ; whitespace- ; Range lo <$> expr }- , list <$> commaSep expr ])+listTerm =+ (do { try $ string "[markdown|"+ ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")+ ; return . Markdown $ Pan.readMarkdown Pan.defaultParserState md })+ <|> (braces $ choice+ [ try $ do { lo <- expr; whitespace; string ".." ; whitespace+ ; Range lo <$> expr }+ , do (C _ _ e) <- list <$> commaSep expr+ return e+ ]) -parensTerm :: IParser Expr+parensTerm :: IParser CExpr parensTerm = parens $ choice- [ do op <- anyOp- return . Lambda "x" . Lambda "y" $ Binop op (Var "x") (Var "y")- , do let comma = char ',' <?> "comma ','"+ [ do start <- getPosition+ op <- try anyOp+ end <- getPosition+ let ctxt = pos start end+ return . ctxt . Lambda "x" . ctxt . Lambda "y" . ctxt $+ Binop op (ctxt $ Var "x") (ctxt $ Var "y")+ , do start <- getPosition+ let comma = char ',' <?> "comma ','" commas <- comma >> many (whitespace >> comma)+ end <- getPosition let vars = map (('v':) . show) [ 0 .. length commas + 1 ]- return $ foldr Lambda (tuple $ map Var vars) (vars)- , do es <- commaSep expr- return $ case es of { [e] -> e; _ -> tuple es }+ ctxt = pos start end+ return $ foldr (\x e -> ctxt $ Lambda x e)+ (ctxt . tuple $ map (ctxt . Var) vars) vars+ , do start <- getPosition+ es <- commaSep expr+ end <- getPosition+ return $ case es of [e] -> e+ _ -> pos start end (tuple es) ] -term :: IParser Expr-term = choice [ numTerm, strTerm, chrTerm- , accessible varTerm- , listTerm, parensTerm ]- <?> "basic term (4, x, 'c', etc.)"+recordTerm :: IParser CExpr+recordTerm = brackets $ choice [ misc, addContext record ]+ where field = do+ fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix patternTerm+ whitespace+ e <- string "=" >> whitespace >> expr+ run $ flattenPatterns fDefs e+ extract [ FnDef f args exp ] = return (f,args,exp)+ extract _ = fail "Improperly formed record field."+ record = Record <$> (mapM extract =<< commaSep field)+ change = do+ lbl <- rLabel+ whitespace >> string "<-" >> whitespace+ (,) lbl <$> expr+ remove r = addContext (string "-" >> whitespace >> Remove r <$> rLabel)+ insert r = addContext $ do+ string "|" >> whitespace+ Insert r <$> rLabel <*>+ (whitespace >> string "=" >> whitespace >> expr)+ modify r = addContext+ (string "|" >> whitespace >> Modify r <$> commaSep1 change)+ misc = try $ do+ record <- addContext (Var <$> rLabel)+ whitespace+ opt <- optionMaybe (remove record)+ whitespace+ case opt of+ Just e -> try (insert e) <|> return e+ Nothing -> try (insert record) <|> try (modify record)+ +term :: IParser CExpr+term = addContext (choice [ numTerm, strTerm, chrTerm, listTerm, accessor ])+ <|> accessible (addContext varTerm <|> parensTerm <|> recordTerm)+ <?> "basic term (4, x, 'c', etc.)"+ -------- Applications -------- -appExpr :: IParser Expr+appExpr :: IParser CExpr appExpr = do tlist <- spaceSep1 term return $ case tlist of t:[] -> t- t:ts -> foldl' App t ts+ t:ts -> foldl' (\f x -> epos f x $ App f x) t ts -------- Normal Expressions -------- -binaryExpr :: IParser Expr+binaryExpr :: IParser CExpr binaryExpr = binops appExpr anyOp ifExpr :: IParser Expr-ifExpr = do reserved "if" ; whitespace ; e1 <- expr ; whitespace- reserved "then" ; whitespace ; e2 <- expr ; (whitespace <?> "an 'else' branch")- reserved "else" <?> "an 'else' branch" ; whitespace ; If e1 e2 <$> expr+ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)+ where normal = do e1 <- expr ; whitespace+ reserved "then" ; whitespace ; e2 <- expr+ whitespace <?> "an 'else' branch"+ reserved "else" <?> "an 'else' branch" ; whitespace+ If e1 e2 <$> expr+ multiIf = (MultiIf <$> spaceSep1 iff)+ where iff = do string "|" ; whitespace+ b <- expr ; whitespace ; string "->" ; whitespace+ (,) b <$> expr -lambdaExpr :: IParser Expr+lambdaExpr :: IParser CExpr lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function" whitespace pats <- spaceSep1 patternTerm whitespace ; arrow ; whitespace e <- expr- return $ makeLambda pats e+ return . run $ makeLambda pats e defSet :: IParser [Def]-defSet = do- brace <- optionMaybe $ do- string "{" <?> "a set of definitions { x = ... ; y = ... }"- whitespace >> return "{"- case brace of- Nothing -> concat <$> block (do d <- assignExpr ; whitespace ; return d)- Just "{" -> do dss <- semiSep1 assignExpr- whitespace- string "}" <?> "closing bracket '}'"- return (concat dss)+defSet = concat <$> block (do d <- assignExpr ; whitespace ; return d) letExpr :: IParser Expr letExpr = do@@ -130,8 +181,10 @@ with = brackets (semiSep1 (case_ <?> "cases { x -> ... }")) without = block (do c <- case_ ; whitespace ; return c) -expr = choice [ ifExpr, letExpr, caseExpr- , lambdaExpr, binaryExpr ] <?> "an expression"+expr = addContext (choice [ ifExpr, letExpr, caseExpr ])+ <|> lambdaExpr+ <|> binaryExpr + <?> "an expression" funcDef = try (do p1 <- try patternTerm ; infics p1 <|> func p1) <|> ((:[]) <$> patternExpr)@@ -149,13 +202,8 @@ assignExpr = withPos $ do fDefs <- funcDef whitespace- e <- (string "=" >> whitespace >> expr) <|> guardExpr- flattenPatterns fDefs e--guardExpr = (Guard <$> spaceSep1 gExpr)- where gExpr = do string "|" ; whitespace- b <- expr ; whitespace ; string "=" ; whitespace- (,) b <$> expr+ e <- string "=" >> whitespace >> expr+ run $ flattenPatterns fDefs e def = map Definition <$> assignExpr
src/Parse/Library.hs view
@@ -2,10 +2,12 @@ module Parse.Library where import Ast+import Context import Control.Applicative ((<$>),(<*>)) import Control.Monad import Control.Monad.State-import Data.Char (isSymbol)+import Data.Char (isSymbol,isUpper)+import Rename (deprime) import Text.Parsec hiding (newline,spaces,State) import Text.Parsec.Indent @@ -36,6 +38,9 @@ capVar :: IParser String capVar = makeVar (upper <?> "upper case variable") +rLabel :: IParser String+rLabel = deprime <$> lowVar+ innerVarChar :: IParser Char innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> "" @@ -57,7 +62,9 @@ symOp :: IParser String symOp = do op <- many1 (satisfy isOp) guard (op `notElem` [ "=", "..", "->", "--", "|", "\8594" ])- return op+ case op of+ "." -> notFollowedBy lower >> return op+ _ -> return op arrow :: IParser String arrow = string "->" <|> string "\8594" <?> "arrow (->)"@@ -114,14 +121,29 @@ brackets :: IParser a -> IParser a brackets = surround '{' '}' "bracket" -accessible :: IParser Expr -> IParser Expr-accessible expr = do+addContext :: IParser Expr -> IParser CExpr+addContext expr = do+ start <- getPosition e <- expr- access <- optionMaybe . try $- (do { char '.' ; notFollowedBy (char '.') } <?> "field access (e.g. List.map)")- case access of- Just _ -> accessible (Access e `liftM` var <?> "field access (e.g. List.map)")- Nothing -> return e+ end <- getPosition+ return (pos start end e)++accessible :: IParser CExpr -> IParser CExpr+accessible expr = do+ start <- getPosition+ ce@(C s t e) <- expr+ let rest f = do+ let dot = char '.' >> notFollowedBy (char '.')+ access <- optionMaybe (try dot <?> "field access (e.g. List.map)")+ case access of+ Nothing -> return ce+ Just _ -> accessible $ do+ v <- var <?> "field access (e.g. List.map)"+ end <- getPosition+ return (pos start end (f v))+ case e of Var (c:cs) | isUpper c -> rest (\v -> Var (c:cs ++ '.':v))+ | otherwise -> rest (Access ce)+ _ -> rest (Access ce) spaces :: IParser String
src/Parse/Patterns.hs view
@@ -1,10 +1,13 @@+ module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) where import Ast-import Data.Char (isUpper)+import Context import Control.Applicative ((<$>),(<*>)) import Control.Monad import Control.Monad.State+import Data.Char (isUpper)+import Guid import Text.Parsec hiding (newline,spaces,State) import Text.Parsec.Indent import Parse.Library@@ -16,6 +19,9 @@ return $ if isUpper c then PData x [] else PVar x ] +patternRecord :: IParser Pattern+patternRecord = PRecord <$> brackets (commaSep1 lowVar)+ patternTuple :: IParser Pattern patternTuple = do ps <- parens (commaSep patternExpr) return $ case ps of { [p] -> p; _ -> ptuple ps }@@ -24,7 +30,8 @@ patternList = plist <$> braces (commaSep patternExpr) patternTerm :: IParser Pattern-patternTerm = patternTuple <|> patternList <|> patternBasic <?> "pattern"+patternTerm = choice [ patternRecord, patternTuple, patternList, patternBasic ]+ <?> "pattern" patternConstructor :: IParser Pattern patternConstructor = PData <$> capVar <*> spacePrefix patternTerm@@ -32,34 +39,66 @@ patternExpr :: IParser Pattern patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) <?> "pattern" --makeLambda pats body = foldr Lambda (makeBody pats body) (map getName pats)+makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr+makeLambda pats body = go (reverse pats) body+ where go [] body = return body+ go (p:ps) body@(C t s _) = do+ (x,e) <- extract p body+ go ps (C t s $ Lambda x e)+ +extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)+extract pattern body@(C t s _) =+ let ctx = C t s in+ let fn x e = (x,e) in+ case pattern of+ PAnything -> return $ fn "_" body+ PVar x -> return $ fn x body+ PData name ps -> do+ x <- guid+ let a = 'a' : show x+ return . fn a . ctx $ Case (ctx (Var a)) [(pattern, body)]+ PRecord fs -> do+ x <- guid+ let a = 'a' : show x+ toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)+ return . fn a . ctx $ Let (map toDef fs) body -makeBody pats body = foldr func body pats- where func PAnything e = e- func (PVar x) e = e- func p e = Case (Var $ getName p) [(p,e)]+extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)+extracts ps body = go [] (reverse ps) body+ where go args [] body = return (args, body)+ go args (p:ps) body = do (x,e) <- extract p body+ go (x:args) ps e -flattenPatterns (PVar f : args) exp- | isOp (head f) = let [a,b] = (map getName args) in- return [ OpDef f a b (makeBody args exp) ]- | otherwise = return [ FnDef f (map getName args) (makeBody args exp) ]+flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])+flattenPatterns patterns exp@(C t s _) =+ let ctx = C t s in+ case patterns of+ PVar f : args -> do+ (as,e) <- extracts args exp+ return . return $+ if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]+ else [ FnDef f as e ] + [p] -> return `liftM` matchSingle p exp p -flattenPatterns [p] exp = return $ matchSingle p exp p+ _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) +++ ") cannot be used on the left-hand side of an assign statement." -flattenPatterns ps _ = - fail $ "Pattern (" ++ unwords (map show ps) ++- ") cannot be used on the left-hand side of an assign statement."+matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]+matchSingle pat exp@(C t s _) p =+ let ctx = C t s in+ case p of+ PData _ ps -> do x <- guid+ let v = 'a' : show x+ dss <- mapM (matchSingle p . ctx $ Var v) ps+ return (FnDef v [] exp : concat dss) -matchSingle pat exp p@(PData _ ps) =- (FnDef v [] exp) : concatMap (matchSingle p $ Var v) ps- where v = getName p-matchSingle pat exp (PVar x) = [ FnDef x [] (Case exp [(pat,Var x)]) ]-matchSingle pat exp PAnything = []+ PVar x ->+ return [ FnDef x [] (ctx $ Case exp [(pat, ctx $ Var x)]) ] -getName p = f p- where f (PData n ps) = n ++ "$" ++ concatMap getName ps- f (PAnything) = "_"- f (PVar x) = x+ PRecord fs -> do+ a <- (\x -> 'a' : show x) `liftM` guid+ let toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)+ return (FnDef a [] exp : map toDef fs) + PAnything -> return []
src/Parse/Types.hs view
@@ -16,6 +16,7 @@ data ParseType = VarPT String | LambdaPT ParseType ParseType | ADTPT String [ParseType]+ | RecordPT [(String,ParseType)] listPT t = ADTPT "List" [t] tuplePT ts = ADTPT ("Tuple" ++ show (length ts)) ts@@ -30,8 +31,14 @@ typeTuple = do ts <- parens (commaSep typeExpr) return $ case ts of { [t] -> t ; _ -> tuplePT ts } +typeRecord :: IParser ParseType+typeRecord = fmap RecordPT . brackets . commaSep $ do+ lbl <- rLabel+ whitespace >> string "::" >> whitespace+ (,) lbl <$> typeExpr+ typeUnambiguous :: IParser ParseType-typeUnambiguous = typeList <|> typeTuple+typeUnambiguous = typeList <|> typeTuple <|> typeRecord typeSimple :: IParser ParseType typeSimple = dealias <$> var@@ -80,6 +87,8 @@ Just v -> Right v Nothing -> Left $ msg x | otherwise = return $ ADT x []+ toT (RecordPT fs) = do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs+ return (RecordT (recordT fs') EmptyRecord) msg x = "Type variable '" ++ x ++ "' is unbound in type constructor '" ++ name ++ "'."
src/Rename.hs view
@@ -2,6 +2,7 @@ module Rename (renameModule, derename, deprime) where import Ast+import Context import Control.Arrow (first) import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM) import Control.Monad.State (evalState, State, get, put)@@ -48,6 +49,9 @@ ImportEvent _ _ n _ -> [n] _ -> [] +instance Rename a => Rename (Context a) where+ rename env (C t s e) = C t s `liftM` rename env e+ instance Rename Expr where rename env expr = let rnm = rename env in@@ -59,6 +63,19 @@ Access e x -> Access `liftM` rnm e `ap` return x + Remove e x -> flip Remove x `liftM` rnm e++ Insert e x v -> flip Insert x `liftM` rnm e+ `ap` rnm v++ Modify e fs -> Modify `liftM` rnm e+ `ap` mapM (\(x,e) -> (,) x `liftM` rnm e) fs++ Record fs -> Record `liftM` mapM frnm fs+ where frnm (f,as,e) = do env' <- extends env as+ e' <- rename env' e+ return (f, map env' as, e') + Binop op@(h:_) e1 e2 -> let rop = if isLower h || '_' == h then env op@@ -77,19 +94,10 @@ `ap` rnm e2 `ap` rnm e3 - Guard ps -> Guard `liftM` mapM grnm ps+ MultiIf ps -> MultiIf `liftM` mapM grnm ps where grnm (b,e) = (,) `liftM` rnm b `ap` rnm e - Lift e es -> Lift `liftM` rnm e- `ap` mapM rnm es-- Fold e1 e2 e3 -> Fold `liftM` rnm e1- `ap` rnm e2- `ap` rnm e3-- Async e -> Async `liftM` rnm e- Let defs e -> renameLet env defs e Var x -> return . Var $ env x@@ -122,7 +130,7 @@ where f (rps,env') p = do (rp,env'') <- patternExtend p env' return (rp:rps, env'') -patternRename :: (String -> String) -> (Pattern, Expr) -> GuidCounter (Pattern, Expr)+patternRename :: (String -> String) -> (Pattern, CExpr) -> GuidCounter (Pattern, CExpr) patternRename env (p,e) = do (rp,env') <- patternExtend p env re <- rename env' e
src/Substitute.hs view
@@ -1,24 +1,24 @@ module Substitute (subst) where -import Control.Arrow (second, (***)) - import Ast +import Context +import Control.Arrow (second, (***)) subst :: String -> Expr -> Expr -> Expr subst old new expr = - let f = subst old new in + let f (C t s e) = C t s (subst old new e) in case expr of Range e1 e2 -> Range (f e1) (f e2) Access e x -> Access (f e) x + Remove e x -> Remove (f e) x + Insert e x v -> Insert (f e) x (f v) + Modify r fs -> Modify (f r) (map (second f) fs) + Record fs -> Record (map (\(lbl,as,e) -> (lbl,as,f e)) fs) Binop op e1 e2 -> Binop op (f e1) (f e2) Lambda x e -> if x == old then expr else Lambda x (f e) App e1 e2 -> App (f e1) (f e2) If e1 e2 e3 -> If (f e1) (f e2) (f e3) - Guard ps -> Guard (map (f *** f) ps) - Lift e es -> Lift (f e) (map f es) - Fold e1 e2 e3 -> Fold (f e1) (f e2) (f e3) - Async e -> Async (f e) - Input _ -> expr + MultiIf ps -> MultiIf (map (f *** f) ps) Let defs e -> Let (map substDef defs) (f e) where substDef (FnDef name vs e) = FnDef name vs (f e) substDef (OpDef op a1 a2 e) = OpDef op a1 a2 (f e)
src/Types/Constrain.hs view
@@ -1,23 +1,20 @@ module Types.Constrain (constrain) where -import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf) -import qualified Data.Set as Set -import qualified Data.Map as Map import Control.Arrow (second) import Control.Monad (liftM,mapM,zipWithM,foldM) import Control.Monad.State (evalState) +import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf) +import qualified Data.Map as Map +import qualified Data.Set as Set import Ast +import Context import Guid import Types.Types import Types.Substitutions ---import System.IO.Unsafe - -prints xs v = v --} unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v - beta = VarT `liftM` guid unionA = Map.unionWith (++) unionsA = Map.unionsWith (++) @@ -53,114 +50,175 @@ allHints = Map.fromList (aliasHints ++ concat schemess) assumptions <- foldM insert (unionsA ass) $ map fst (concat schemess) findAmbiguous (map fst hints) (map fst aliasHints) assumptions $ do - let f k s vs = map (\v -> Context k $ v :<<: s) vs + let f k s vs = map (\v -> C (Just k) NoSpan $ v :<<: s) vs cs = concat . Map.elems $ Map.intersectionWithKey f allHints assumptions escapees = Map.keys $ Map.difference assumptions allHints return . Right . (,) escapees $ cs ++ Set.toList (Set.unions css) -gen :: Expr -> GuidCounter (Map.Map String [X], - Set.Set (Context String Constraint), - Type) +type TVarMap = Map.Map String [X] +type ConstraintSet = Set.Set (Context Constraint) -gen (Var x) = - do b <- guid - return (Map.singleton x [b], Set.empty, VarT b) +ctx e span = C (Just $ show e) span -gen e@(App e1 e2) = - do (a1,c1,t1) <- gen e1 - (a2,c2,t2) <- gen e2 - b <- beta - return ( unionA a1 a2 - , Set.unions [c1,c2,Set.singleton . ctx e $ t1 :=: (LambdaT t2 b)] - , b ) -gen (Lambda x e) = - do (a,c,t) <- gen e - b <- beta - v <- guid - return ( Map.delete x a - , Set.union c . Set.fromList . map (\x -> ctx e $ VarT x :=: b) $ - Map.findWithDefault [v] x a - , LambdaT b t ) -gen (Let defs e) = - do (as,cs,t) <- gen e - (ass, schemes) <- liftM unzip (mapM defScheme defs) - let assumptions = unionsA (as:ass) - getName (FnDef f _ _) = f - getName (OpDef op _ _ _) = op - names = map getName defs - genCs name s = do - v <- guid - let vs = Map.findWithDefault [v] name assumptions - return $ map (\x -> ctx (Var name) $ x :<<: s) vs - cs' <- zipWithM genCs names schemes - return ( foldr Map.delete assumptions names - , Set.union (Set.fromList . concat $ cs') cs - , t ) +gen :: CExpr -> GuidCounter (TVarMap, ConstraintSet, Type) +gen (C _ span expr) = + let ctx' = C (Just $ show expr) span in + case expr of + Var x -> + do b <- guid + return (Map.singleton x [b], Set.empty, VarT b) -gen ce@(Case e cases) = - do (as,cs,t) <- gen e - (ass,css,ts) <- liftM unzip3 $ mapM (caseGen t) cases - return ( unionsA $ as:ass - , let combine t1 t2 = ctx ce (t1 :=: t2) in - Set.unions $ Set.fromList (zipWith combine ts $ tail ts) : cs : css - , head ts) + App e1 e2 -> + do (a1,c1,t1) <- gen e1 + (a2,c2,t2) <- gen e2 + b <- beta + return ( unionA a1 a2 + , Set.unions [c1,c2 + ,Set.singleton . ctx' $ t1 :=: (LambdaT t2 b)] + , b ) -gen e@(If e1 e2 e3) = - do (a1,c1,t1) <- gen e1 - (a2,c2,t2) <- gen e2 - (a3,c3,t3) <- gen e3 - return ( unionsA [a1,a2,a3] - , Set.unions [c1,c2,c3, Set.fromList [ ctx e1 (t1 :=: bool), ctx e (t2 :=: t3) ] ] - , t2 ) + Lambda x e -> + do (a,c,t) <- gen e + b <- beta + v <- guid + return ( Map.delete x a + , Set.union c . Set.fromList . + map (\x -> ctx' $ VarT x :=: b) $ + Map.findWithDefault [v] x a + , LambdaT b t ) -gen (Data name es) = gen $ foldl' App (Var name) es -gen (Binop op e1 e2) = gen (Var op `App` e1 `App` e2) + Let defs e -> + do (as,cs,t) <- gen e + (ass, schemes) <- liftM unzip (mapM defScheme defs) + let assumptions = unionsA (as:ass) + getName d = case d of FnDef f _ _ -> f + OpDef op _ _ _ -> op + names = map getName defs + genCs name s = do + v <- guid + let vs = Map.findWithDefault [v] name assumptions + return $ map (\x -> ctx name span $ x :<<: s) vs + cs' <- zipWithM genCs names schemes + return ( foldr Map.delete assumptions names + , Set.union (Set.fromList . concat $ cs') cs + , t ) -gen (Access (Var a) b) = gen . Var $ a ++ "." ++ b -gen (Access (Access (Var a) b) c) = gen . Var $ intercalate "." [a, b, c] -gen (Access (Access (Access (Var a) b) c) d) = gen . Var $ intercalate "." [a, b, c, d] + Case e cases -> + do (as,cs,t) <- gen e + (ass,css,ts) <- liftM unzip3 $ mapM (caseGen t) cases + return ( unionsA $ as:ass + , let cases' = map snd cases + ctxs = zipWith epos cases' (tail cases') + csts = zipWith (:=:) ts (tail ts) + cs' = Set.fromList (zipWith ($) ctxs csts) + in Set.unions $ cs' : cs : css + , head ts) -gen (Range e1 e2) = - do (a1,c1,t1) <- gen e1 - (a2,c2,t2) <- gen e2 - return ( unionsA [a1,a2] - , Set.unions [ c1, c2, Set.fromList [ ctx e1 (t1 :=: int) - , ctx e2 (t2 :=: int) ] ] - , listOf int ) + If e1 e2 e3 -> + do (a1,c1,t1) <- gen e1 + (a2,c2,t2) <- gen e2 + (a3,c3,t3) <- gen e3 + return ( unionsA [a1,a2,a3] + , let c4 = Set.fromList [ ctx e1 span (t1 :=: bool) + , ctx' (t2 :=: t3) ] + in Set.unions [c1,c2,c3,c4] + , t2 ) -gen e@(Guard ps) = do (ass,css,t:ts) <- unzip3 `liftM` mapM genPair ps - let cs = Set.fromList (map (ctx e . (t :=:)) ts) - return (unionsA ass, Set.unions (cs:css), t) - where genPair (b,e) = do - (a1,c1,t1) <- gen b - (a2,c2,t2) <- gen e - return ( unionsA [a1,a2] - , Set.unions [ c1, c2, Set.singleton (ctx b (t1 :=: bool)) ] - , t2 ) + Data name es -> + gen $ foldl' (\f x -> epos f x $ App f x) (ctx' $ Var name) es -gen other = - case other of - IntNum _ -> do t <- beta - return (Map.empty, Set.singleton (ctx other $ t :<: number), t) - FloatNum _ -> primitive float - Chr _ -> primitive char - Str _ -> primitive string - Boolean _ -> primitive bool - Markdown _ -> primitive element + Binop op e1 e2 -> + gen $ ctx' (App (ctx' $ App (ctx' $ Var op) e1) e2) + + Access e label -> + do (as,cs,rtype) <- gen e + t <- beta + rtype' <- beta + let fs = Map.singleton label [t] + c = (ctx' (RecordT fs rtype' :=: rtype)) + return (as, Set.insert c cs, t) + + Remove e x -> + do (as,cs,rtype) <- gen e + t <- beta + rtype' <- beta + let c = (ctx' (RecordT (Map.singleton x [t]) rtype' :=: rtype)) + return (as, Set.insert c cs, rtype') + + Insert e x v -> + do (eas,ecs,etype) <- gen e + (vas,vcs,vtype) <- gen v + return ( unionA eas vas + , Set.union ecs vcs + , RecordT (Map.singleton x [vtype]) etype ) + + Modify record fields -> + do (ras,rcs,rtype) <- gen record + (ass,css,newTs) <- unzip3 `liftM` mapM gen (map snd fields) + oldTs <- mapM (\_ -> beta) fields + rtype' <- beta + let rT ts = RecordT (recordT (zip (map fst fields) ts)) rtype' + c = Set.singleton (ctx' (rtype :=: rT oldTs)) + return ( unionsA (ras:ass), Set.unions (c : rcs : css), rT newTs ) + + Record fields -> + let insert label tipe = Map.insertWith (++) label [tipe] + getScheme (f,args,e) = do + (as, _, (label, Forall _ cs tipe)) <- defGenHelp f args e + return (as, cs, insert label tipe) + in do (ass, css, fs) <- unzip3 `liftM` mapM getScheme fields + return ( unionsA ass + , Set.fromList (concat css) + , RecordT (foldr ($) Map.empty fs) EmptyRecord ) + + Range e1@(C w1 s1 _) e2@(C w2 s2 _) -> + do (a1,c1,t1) <- gen e1 + (a2,c2,t2) <- gen e2 + return ( unionsA [a1,a2] + , Set.unions [ c1, c2, Set.fromList [ C w1 s1 (t1 :=: int) + , C w1 s2 (t2 :=: int) ] ] + , listOf int ) + + MultiIf ps -> do (ass,css,t:ts) <- unzip3 `liftM` mapM genPair ps + let cs = Set.fromList (map (ctx' . (t :=:)) ts) + return (unionsA ass, Set.unions (cs:css), t) + where genPair (b@(C t s _),e) = do + (a1,c1,t1) <- gen b + (a2,c2,t2) <- gen e + return ( unionsA [a1,a2] + , Set.unions [ c1, c2 + , Set.singleton (C t s (t1 :=: bool)) ] + , t2 ) + + IntNum _ -> do t <- beta + return (Map.empty, Set.singleton (ctx' $ t :<: number), t) + + FloatNum _ -> primitive float + Chr _ -> primitive char + Str _ -> primitive string + Boolean _ -> primitive bool + Markdown _ -> primitive element -- _ -> beta >>= primitive +primitive :: Type -> GuidCounter (TVarMap, ConstraintSet, Type) primitive t = return (Map.empty, Set.empty, t) -caseGen tipe (p,e) = do - (as ,cs , t ) <- gen e +caseGen :: Type + -> (Pattern, CExpr) + -> GuidCounter (TVarMap, ConstraintSet, Type) +caseGen tipe (p, ce@(C _ span e)) = do + (as ,cs , t ) <- gen ce (as',cs',[t']) <- patternGen (as,cs,[]) p - let cs'' = Set.union cs' . Set.singleton . ctx p $ t' :=: tipe + let cs'' = Set.union cs' . Set.singleton . ctx p span $ t' :=: tipe return ( as', cs'', t ) +patternGen :: (TVarMap, ConstraintSet, [Type]) + -> Pattern + -> GuidCounter (TVarMap, ConstraintSet, [Type]) patternGen (as,cs,ts) PAnything = ((,,) as cs . (\t -> ts++[t])) `liftM` beta patternGen (as,cs,ts) (PVar v) = do b <- beta - let cs' = map (\x -> ctx (Var v) $ VarT x :=: b) $ Map.findWithDefault [] v as + let cs' = map (\x -> ctx v NoSpan $ VarT x :=: b) $ Map.findWithDefault [] v as return ( Map.delete v as, Set.union cs $ Set.fromList cs', ts ++ [b] ) patternGen (as,cs,ts) p@(PData name ps) = do constr <- guid @@ -169,11 +227,12 @@ let t = foldr (==>) output ts' let getC | isTupleString name = do vs <- mapM (\_ -> beta) ps - return . Set.singleton . ctx p $ output :=: ADT name vs + return . Set.singleton . C (Just $ show p) NoSpan $ output :=: ADT name vs | otherwise = return Set.empty cs'' <- getC return ( unionA as' (Map.singleton name [constr]) - , Set.unions [cs',cs'', Set.singleton . ctx p $ VarT constr :=: t] + , Set.unions [cs',cs'' + , Set.singleton . ctx p NoSpan $ VarT constr :=: t ] , ts ++ [output] ) @@ -181,22 +240,24 @@ defScheme def = do (as,cs,hint) <- defGen def return ( as, snd hint ) -defGen def = case def of FnDef f args e -> defGen' f args e - OpDef op a1 a2 e -> defGen' op [a1,a2] e - where defGen' name args e = do - argDict <- mapM (\a -> liftM ((,) a) guid) args - (as,cs,t) <- gen e - let as' = foldr Map.delete as args - tipe = foldr (==>) t $ map (VarT . snd) argDict - genCs (arg,x) = do - v <- guid - let as' = Map.findWithDefault [v] arg as - return $ map (\y -> Context arg $ VarT x :=: VarT y) as' - cs' <- concat `liftM` mapM genCs argDict - scheme <- generalize (concat $ Map.elems as') $ - Forall (map snd argDict) (cs' ++ Set.toList cs) tipe - return ( as', Set.empty, (name, scheme) ) +defGen def = case def of + FnDef f args e -> defGenHelp f args e + OpDef op a1 a2 e -> defGenHelp op [a1,a2] e +defGenHelp name args e = do + argDict <- mapM (\a -> liftM ((,) a) guid) args + (as,cs,t) <- gen e + let as' = foldr Map.delete as args + tipe = foldr (==>) t $ map (VarT . snd) argDict + genCs (arg,x) = do + v <- guid + let as' = Map.findWithDefault [v] arg as + return $ map (\y -> ctx arg NoSpan $ VarT x :=: VarT y) as' + cs' <- concat `liftM` mapM genCs argDict + scheme <- generalize (concat $ Map.elems as') $ + Forall (map snd argDict) (cs' ++ Set.toList cs) tipe + return ( as', Set.empty, (name, scheme) ) + stmtGen (Definition def) = do (as,cs,hint) <- defGen def return ( as, cs, [hint] ) @@ -210,7 +271,7 @@ | n == "Comparable" = vc rnm t = t tcs' = map (second (map rnm)) tcs - supers t = map (Context name) $ + supers t = map (ctx name NoSpan) $ zipWith (:<:) [va,vb,vc] [number,appendable t,comparable] gen' (n,ts) = do t <- beta let s = Forall (xs ++ [a,b,c]) (supers t) $ @@ -220,16 +281,15 @@ stmtGen (ExportEvent js elm tipe) = do x <- guid return ( Map.singleton elm [x] - , Set.singleton . ctx (Var elm) $ VarT x :=: tipe + , Set.singleton . ctx elm NoSpan $ VarT x :=: tipe , [] ) -stmtGen (ImportEvent js base elm tipe) = do - (as,cs,t) <- gen base +stmtGen (ImportEvent js e@(C txt span base) elm tipe) = do + (as,cs,t) <- gen e return ( as - , Set.insert (ctx base (signalOf t :=: tipe)) cs + , Set.insert (C txt span (signalOf t :=: tipe)) cs , [ (elm, Forall [] [] tipe) ] ) getDatatypeInfo (Datatype name args tcs) = Just (name, args, tcs) getDatatypeInfo _ = Nothing -
src/Types/Hints.hs view
@@ -1,12 +1,12 @@- module Types.Hints (hints) where -import Control.Monad (liftM,mapM)+import Context import Control.Arrow (first)+import Control.Monad (liftM,mapM) import Types.Types import Types.Substitutions (rescheme) -+ctx str = C (Just str) NoSpan prefix pre xs = map (first (\x -> pre ++ "." ++ x)) xs -------- Text and Elements --------@@ -151,7 +151,9 @@ [ sig 1 "constant" , sig 2 "lift" ] ++ map lyft [2..8] ++ [- "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b+ "<~" -:: (a ==> b) ==> signalOf a ==> signalOf b+ , "~" -:: signalOf (a ==> b) ==> signalOf a ==> signalOf b+ , "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b , "foldp1" -:: (a ==> a ==> a) ==> signalOf a ==> signalOf a , "foldp'" -:: (a ==> b ==> b) ==> (a ==> b) ==> signalOf a ==> signalOf b , "count" -:: signalOf a ==> signalOf int@@ -242,11 +244,11 @@ binop t = t ==> t ==> t scheme1 super t name =- (name, Forall [0] [ Context ("`" ++ name ++ "'") $ VarT 0 :<: super+ (name, Forall [0] [ ctx name $ VarT 0 :<: super ] (t (VarT 0))) scheme2 s1 s2 t name =- (name, Forall [0,1] [ Context ("`" ++ name ++ "'") $ VarT 0 :<: s1- , Context ("`" ++ name ++ "'") $ VarT 1 :<: s2+ (name, Forall [0,1] [ ctx name $ VarT 0 :<: s1+ , ctx name $ VarT 1 :<: s2 ] (t (VarT 0) (VarT 1))) numScheme t name = scheme1 number t name twoNums f name = scheme2 number number f name@@ -270,7 +272,7 @@ hasType (binop bool) ["&&","||"] ++ map (scheme1 comparable (\t -> t ==> t ==> bool)) ["<",">","<=",">="] ++ [ ( "compare"- , Forall [0,1] [ Context "`compare'" $ VarT 0 :<: comparable ] (VarT 0 ==> VarT 0 ==> VarT 1) )+ , Forall [0,1] [ ctx "compare" $ VarT 0 :<: comparable ] (VarT 0 ==> VarT 0 ==> VarT 1) ) ] chars = prefix "Char" (classify ++ convert1 ++ convert2)@@ -296,7 +298,7 @@ , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c) , "$" -:: (a ==> b) ==> a ==> b , ":" -:: a ==> listOf a ==> listOf a- , (,) "++" . Forall [0,1] [ Context "`++'" $ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0+ , (,) "++" . Forall [0,1] [ ctx "++" $ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0 , "Cons" -:: a ==> listOf a ==> listOf a , "Nil" -:: listOf a , "Just" -:: a ==> maybeOf a@@ -331,11 +333,11 @@ , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b- , (,) "concat" . Forall [0,1] [ Context "`concat'" $ VarT 0 :<: appendable (VarT 1) ] $+ , (,) "concat" . Forall [0,1] [ ctx "concat" $ VarT 0 :<: appendable (VarT 1) ] $ listOf (VarT 0) ==> VarT 0- , (,) "concatMap" . Forall [0,1,2] [ Context "`concatMap'" $ VarT 0 :<: appendable (VarT 1) ] $+ , (,) "concatMap" . Forall [0,1,2] [ ctx "concatMap" $ VarT 0 :<: appendable (VarT 1) ] $ (VarT 2 ==> VarT 0) ==> listOf (VarT 2) ==> VarT 0- , (,) "intercalate" . Forall [0,1] [ Context "`intercalate'" $ VarT 0 :<: appendable (VarT 1) ] $+ , (,) "intercalate" . Forall [0,1] [ ctx "intercalate" $ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> listOf (VarT 0) ==> VarT 0 , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
src/Types/Solver.hs view
@@ -1,6 +1,7 @@ module Types.Solver (solver) where +import Context import Control.Arrow (second) import Control.Monad (liftM) import Data.Either (lefts,rights)@@ -13,13 +14,11 @@ import Types.Constrain import Types.Substitutions --eq ctx t1 t2 = Context ctx (t1 :=: t2)--isSolved ss (Context _ (t1 :=: t2)) = t1 == t2-isSolved ss (Context _ (x :<<: _)) = isJust (lookup x ss)+isSolved ss (C _ _ (t1 :=: t2)) = t1 == t2+isSolved ss (C _ _ (x :<<: _)) = isJust (lookup x ss) isSolved ss c = False +crush :: Scheme -> GuidCounter (Either String Scheme) crush (Forall xs cs t) = do subs <- solver cs Map.empty return $ do ss' <- subs@@ -27,10 +26,10 @@ cs' = filter (not . isSolved ss) (subst ss cs) return $ Forall xs cs' (subst ss t) -schemeSubHelp ctx x s t1 rltn t2 = do+schemeSubHelp txt span x s t1 rltn t2 = do (t1',cs1) <- sub t1 (t2',cs2) <- sub t2- return (Context ctx (rltn t1' t2') : cs1 ++ cs2)+ return (C txt span (rltn t1' t2') : cs1 ++ cs2) where sub t | not (occurs x t) = return (t, []) | otherwise = do (st, cs) <- concretize s return (subst [(x,st)] t, cs)@@ -40,118 +39,161 @@ Right s'' -> Right `liftM` schemeSub' x s'' c Left err -> return $ Left err -schemeSub' x s (Context ctx (t1 :=: t2)) = schemeSubHelp ctx x s t1 (:=:) t2-schemeSub' x s (Context ctx (t1 :<: t2)) = schemeSubHelp ctx x s t1 (:<:) t2-schemeSub' x s c@(Context ctx (y :<<: Forall cxs ccs ctipe))- | not (occurs x c) = return [c]- | otherwise =- do Forall xs cs tipe <- rescheme s- let ss = [(x,tipe)]- constraints = subst ss (cs ++ ccs)- c' = y :<<: Forall (cxs ++ xs) constraints (subst ss ctipe)- return [ Context ctx c' ]-+schemeSub' x s c@(C txt span constraint) =+ case constraint of+ (t1 :=: t2) -> schemeSubHelp txt span x s t1 (:=:) t2+ (t1 :<: t2) -> schemeSubHelp txt span x s t1 (:<:) t2+ (y :<<: Forall cxs ccs ctipe)+ | not (occurs x c) -> return [c]+ | otherwise ->+ do Forall xs cs tipe <- rescheme s+ let ss = [(x,tipe)]+ constraints = subst ss (cs ++ ccs)+ c' = y :<<: Forall (cxs ++ xs) constraints (subst ss ctipe)+ return [ C txt span c' ] -solver :: [Context String Constraint]+recordConstraints eq fs t fs' t' =+ liftM concat . sequence $+ [ constrain fs fs'+ , liftM concat . mapM (\(k,ts) -> zipper [] k ts []) . Map.toList $+ Map.difference fs fs'+ , liftM concat . mapM (\(k,ts) -> zipper [] k [] ts) . Map.toList $+ Map.difference fs' fs+ ]+ where constrain :: Map.Map String [Type] -> Map.Map String [Type]+ -> GuidCounter [Context Constraint]+ constrain as bs = liftM concat . sequence . Map.elems $+ Map.intersectionWithKey (zipper []) as bs+ zipper :: [Context Constraint] -> String -> [Type] -> [Type]+ -> GuidCounter [Context Constraint]+ zipper cs k xs ys =+ case (xs,ys) of+ (a:as, b:bs) -> zipper (eq a b : cs) k as bs+ ([],[]) -> return cs+ (as,[]) -> do x <- guid+ let tipe = RecordT (Map.singleton k as) (VarT x)+ return (cs ++ [eq t' tipe])+ ([],bs) -> do x <- guid+ let tipe = RecordT (Map.singleton k bs) (VarT x)+ return (cs ++ [eq t tipe])+ +solver :: [Context Constraint] -> Map.Map X Type -> GuidCounter (Either String (Map.Map X Type)) solver [] subs = return $ Right subs+solver (C txt span c : cs) subs =+ let ctx = C txt span in+ let eq t1 t2 = ctx (t1 :=: t2) in+ case c of+ -- Destruct Type-constructors+ t1@(ADT n1 ts1) :=: t2@(ADT n2 ts2) ->+ if n1 /= n2 then uniError txt span t1 t2 else+ solver (zipWith eq ts1 ts2 ++ cs) subs --------- Destruct Type-constructors --------+ LambdaT t1 t2 :=: LambdaT t1' t2' ->+ solver ([ eq t1 t1', eq t2 t2' ] ++ cs) subs -solver ((Context ctx (t1@(ADT n1 ts1) :=: t2@(ADT n2 ts2))) : cs) subs =- if n1 /= n2 then uniError ctx t1 t2 else- solver (zipWith (eq ctx) ts1 ts2 ++ cs) subs-solver ((Context ctx (LambdaT t1 t2 :=: LambdaT t1' t2')) : cs) subs =- solver ([ eq ctx t1 t1', eq ctx t2 t2' ] ++ cs) subs+ RecordT fs t :=: RecordT fs' t' ->+ do cs' <- recordConstraints eq fs t fs' t'+ solver (cs' ++ cs) subs --------- Type-equality --------+ -- Type-equality+ VarT x :=: VarT y+ | x == y -> solver cs subs+ | otherwise ->+ case (Map.lookup x subs, Map.lookup y subs) of+ (Just (Super xts), Just (Super yts)) ->+ let ts = Set.intersection xts yts+ setXY t = Map.insert x t . Map.insert y t+ in case Set.toList ts of+ [] -> unionError txt span xts yts+ [t] -> let cs1 = subst [(x,t),(y,t)] cs in+ cs1 `seq` solver cs1 (setXY t subs)+ _ -> solver cs $ setXY (Super ts) subs+ (Just (Super xts), _) ->+ let cs2 = subst [(y,VarT x)] cs in+ solver cs2 $ Map.insert y (VarT x) subs+ (_, _) ->+ let cs3 = subst [(x,VarT y)] cs in+ solver cs3 $ Map.insert x (VarT y) subs -solver (Context ctx (VarT x :=: VarT y) : cs) subs- | x == y = solver cs subs- | otherwise =- case (Map.lookup x subs, Map.lookup y subs) of- (Just (Super xts), Just (Super yts)) ->- let ts = Set.intersection xts yts- setXY t = Map.insert x t . Map.insert y t- in case Set.toList ts of- [] -> unionError ctx xts yts- [t] -> let cs1 = subst [(x,t),(y,t)] cs in- cs1 `seq` solver cs1 (setXY t subs)- _ -> solver cs $ setXY (Super ts) subs- (Just (Super xts), _) ->- let cs2 = subst [(y,VarT x)] cs in- solver cs2 $ Map.insert y (VarT x) subs- (_, _) ->- let cs3 = subst [(x,VarT y)] cs in- solver cs3 $ Map.insert x (VarT y) subs-solver (Context ctx (VarT x :=: t) : cs) subs = do- if x `occurs` t then occursError ctx (VarT x) t else- (case Map.lookup x subs of- Nothing -> let cs4 = subst [(x,t)] cs in- solver cs4 . Map.map (subst [(x,t)]) $ Map.insert x t subs- Just (Super ts) ->- let ts' = Set.intersection ts (Set.singleton t) in- case Set.toList ts' of- [] -> solver (Context ctx (t :<: Super ts) : cs) subs- [t'] -> let cs5 = subst [(x,t)] cs in- solver cs5 $ Map.insert x t' subs- _ -> solver cs $ Map.insert x (Super ts') subs- Just t' -> solver (Context ctx (t' :=: t) : cs) subs- )-solver ((Context ctx (t :=: VarT x)) : cs) subs =- solver ((Context ctx (VarT x :=: t)) : cs) subs-solver ((Context ctx (t1 :=: t2)) : cs) subs- | t1 == t2 = solver cs subs- | otherwise = uniError ctx t1 t2+ VarT x :=: t -> do+ if x `occurs` t then occursError txt span (VarT x) t else+ (case Map.lookup x subs of+ Nothing -> let cs4 = subst [(x,t)] cs in+ solver cs4 . Map.map (subst [(x,t)]) $+ Map.insert x t subs+ Just (Super ts) ->+ let ts' = Set.intersection ts (Set.singleton t) in+ case Set.toList ts' of+ [] -> solver (ctx (t :<: Super ts) : cs) subs+ [t'] -> let cs5 = subst [(x,t)] cs in+ solver cs5 $ Map.insert x t' subs+ _ -> solver cs $ Map.insert x (Super ts') subs+ Just t' -> solver (ctx (t' :=: t) : cs) subs+ ) + t :=: VarT x -> solver ((ctx (VarT x :=: t)) : cs) subs --------- subtypes --------+ t1 :=: t2 | t1 == t2 -> solver cs subs+ | otherwise -> uniError txt span t1 t2 -solver (Context ctx (VarT x :<: Super ts) : cs) subs =- case Map.lookup x subs of- Nothing -> solver cs $ Map.insert x (Super ts) subs- Just (Super ts') ->- case Set.toList $ Set.intersection ts ts' of- [] -> unionError ctx ts ts'- [t] -> solver (subst [(x,t)] cs) $ Map.insert x t subs- ts'' -> solver cs $ Map.insert x (Super $ Set.fromList ts'') subs+ -- subtypes+ VarT x :<: Super ts ->+ case Map.lookup x subs of+ Nothing -> solver cs $ Map.insert x (Super ts) subs+ Just (Super ts') ->+ case Set.toList $ Set.intersection ts ts' of+ [] -> unionError txt span ts ts'+ [t] -> solver (subst [(x,t)] cs) $ Map.insert x t subs+ ts'' -> solver cs $+ Map.insert x (Super $ Set.fromList ts'') subs -solver (Context ctx (ADT "List" [t] :<: Super ts) : cs) subs- | any f (Set.toList ts) = solver cs subs- | otherwise = subtypeError ctx (ADT "List" [t]) (Super ts)- where f (ADT "List" [VarT _]) = True- f (ADT "List" [t']) = t == t'- f _ = False+ ADT "List" [t] :<: Super ts+ | any f (Set.toList ts) -> solver cs subs+ | otherwise -> subtypeError txt span (ADT "List" [t]) (Super ts)+ where f (ADT "List" [VarT _]) = True+ f (ADT "List" [t']) = t == t'+ f _ = False -solver (Context ctx (t :<: Super ts) : cs) subs- | Set.member t ts = solver cs subs- | otherwise = subtypeError ctx t (Super ts)+ t :<: Super ts+ | Set.member t ts -> solver cs subs+ | otherwise -> subtypeError txt span t (Super ts) -solver (Context ctx (x :<<: s) : cs) subs- | any (occurs x) cs =- do css <- mapM (schemeSub x s) cs- case lefts css of- err : _ -> return $ Left err- [] -> solver (concat (rights css)) subs- | otherwise =- do (t,cs7) <- concretize s- let cs'' = (cs ++ Context ctx (VarT x :=: t) : map (extendCtx ctx) cs7)- solver cs'' subs+ x :<<: s+ | any (occurs x) cs ->+ do css <- mapM (schemeSub x s) cs+ case lefts css of+ err : _ -> return $ Left err+ [] -> solver (concat (rights css)) subs+ | otherwise ->+ do (t,cs7) <- concretize s+ let cs'' = (cs ++ ctx (VarT x :=: t) : cs7)+ solver cs'' subs -occursError ctx t1 t2 =- return . Left $ "Type error: Occurs check: cannot construct the infinite type: " ++ show t1 ++- " = " ++ show t2 ++- " in context " ++ ctx-uniError ctx t1 t2 =- return . Left $ "Type error: " ++ show t1 ++- " is not equal to " ++ show t2 ++- " in context " ++ ctx-unionError ctx ts ts' =- return . Left $ concat [ "Type error: There are no types in both "- , show (Super ts), " and ", show (Super ts')- , " in context ", ctx ]-subtypeError ctx t s =- return . Left $ concat [ "Type error: ", show t, " is not a ", show s- , " in context ", ctx ]+showMsg msg = case msg of+ Just str -> "\nIn context: " ++ str+ Nothing -> ""++occursError msg span t1 t2 =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , "Occurs check: cannot construct the infinite type:\n"+ , show t1, " = ", show t2, showMsg msg ]++uniError msg span t1 t2 =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , show t1, " is not equal to ", show t2, showMsg msg ]++unionError msg span ts ts' =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , "There are no types in both "+ , show (Super ts), " and ", show (Super ts'), showMsg msg ]++subtypeError msg span t s =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , show t, " is not a ", show s, showMsg msg ]
src/Types/Substitutions.hs view
@@ -5,25 +5,30 @@ ,rescheme ,generalize) where +import Context import Control.DeepSeq (NFData (..), deepseq) import Control.Monad (liftM) import Data.List (foldl') import qualified Data.Set as Set+import qualified Data.Map as Map import Guid import Types.Types - class Subst a where subst :: [(X,Type)] -> a -> a instance Subst Type where- subst ss (VarT x) = case lookup x ss of- Nothing -> VarT x- Just (Super _) -> VarT x- Just t -> t- subst ss (LambdaT t1 t2) = LambdaT (subst ss t1) (subst ss t2)- subst ss (ADT name ts) = ADT name (subst ss ts)- subst ss (Super ts) = Super ts+ subst ss t =+ case t of+ VarT x -> case lookup x ss of+ Nothing -> VarT x+ Just (Super _) -> VarT x+ Just t -> t+ LambdaT t1 t2 -> LambdaT (subst ss t1) (subst ss t2)+ ADT name ts -> ADT name (subst ss ts)+ RecordT fs t -> RecordT (Map.map (subst ss) fs) (subst ss t)+ EmptyRecord -> EmptyRecord+ Super ts -> Super ts instance Subst Scheme where subst ss (Forall vs cs t) = Forall vs (subst ss cs) (subst ss t)@@ -33,8 +38,8 @@ subst ss (t :<: super) = subst ss t :<: super subst ss (x :<<: poly) = x :<<: subst ss poly -instance Subst a => Subst (Context c a) where- subst ss (Context ctx c) = Context ctx (subst ss c)+instance Subst a => Subst (Context a) where+ subst ss (C str span c) = C str span (subst ss c) instance Subst a => Subst [a] where subst ss as = map (subst ss) as@@ -47,6 +52,9 @@ freeVars (VarT v) = [v] freeVars (LambdaT t1 t2) = freeVars t1 ++ freeVars t2 freeVars (ADT _ ts) = concatMap freeVars ts+ freeVars (RecordT fs t) =+ freeVars (concat $ Map.elems fs) ++ freeVars t+ freeVars EmptyRecord = [] freeVars (Super _ ) = [] instance FreeVars Constraint where@@ -55,29 +63,15 @@ freeVars (x :<<: Forall xs cs t) = filter (`notElem` xs) frees where frees = concatMap freeVars cs ++ freeVars t -instance FreeVars a => FreeVars (Context c a) where- freeVars (Context _ c) = freeVars c ---class Occurs a where- occurs :: X -> a -> Bool--instance Occurs Type where- occurs v (VarT x) = v == x- occurs v (LambdaT t1 t2) = occurs v t1 || occurs v t2- occurs v (ADT _ ts) = any (occurs v) ts- occurs v (Super _ ) = False+instance FreeVars a => FreeVars (Context a) where+ freeVars (C _ _ c) = freeVars c -instance Occurs Constraint where- occurs x (t1 :=: t2) = occurs x t1 || occurs x t2- occurs x (t1 :<: t2) = occurs x t1 || occurs x t2- occurs x (y :<<: Forall xs cs t) = x == y || occurs x t || inCs- where inCs = x `notElem` xs && any (occurs x) cs+instance FreeVars a => FreeVars [a] where+ freeVars = concatMap freeVars -instance Occurs a => Occurs (Context c a) where- occurs x (Context _ c) = occurs x c+occurs x t = x `elem` freeVars t -concretize :: Scheme -> GuidCounter (Type, [Context String Constraint])+concretize :: Scheme -> GuidCounter (Type, [Context Constraint]) concretize (Forall xs cs t) = do ss <- zip xs `liftM` mapM (\_ -> liftM VarT guid) xs return (subst ss t, subst ss cs)
src/Types/Types.hs view
@@ -1,37 +1,35 @@ module Types.Types where +import Context import Data.Char (isDigit) import Data.List (intercalate,isPrefixOf) import qualified Data.Set as Set+import qualified Data.Map as Map type X = Int data Type = LambdaT Type Type | VarT X | ADT String [Type]+ | EmptyRecord+ | RecordT (Map.Map String [Type]) Type | Super (Set.Set Type) deriving (Eq, Ord) -data Scheme = Forall [X] [Context String Constraint] Type deriving (Eq, Ord)+data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord) data Constraint = Type :=: Type | Type :<: Type | X :<<: Scheme deriving (Eq, Ord, Show) -data Context c v = Context c v deriving (Eq, Show)--ctx c = Context ("`" ++ show c ++ "'")-extendCtx ctx2 (Context ctx1 c) = Context (ctx1 ++ " in " ++ ctx2) c--instance (Ord a, Eq c) => Ord (Context c a) where- compare (Context _ x) (Context _ y) = compare x y-+recordT :: [(String,Type)] -> Map.Map String [Type]+recordT fields =+ foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields tipe t = ADT t [] - int = tipe "Int" float = tipe "Float" number = Super (Set.fromList [ int, float ])@@ -95,13 +93,25 @@ ; ADT name cs -> if isTupleString name then parens . intercalate "," $ map show cs- else case cs of [] -> name- _ -> parens $ name ++ " " ++ unwords (map show cs)+ else case cs of+ [] -> name+ _ -> parens $ name ++ " " ++ unwords (map show cs) ; Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"+ ; EmptyRecord -> "{}"+ ; RecordT fs t ->+ start ++ intercalate ", " (concatMap fields $ Map.toList fs) ++ " }"+ where field n s = n ++ " :: " ++ show s+ fields (n,ss) = map (field n) ss+ start = case t of+ EmptyRecord -> "{ "+ _ -> "{ " ++ show t ++ " | " } instance Show Scheme where- show (Forall xs cs t) = "Forall " ++ show xs ++ cs' ++ "\n " ++ show t- where cs' = concatMap (concatMap ("\n "++) . lines . show) cs+ show (Forall [] [] t) = show t+ show (Forall xs cs t) =+ concat [ "Forall ", show xs+ , concatMap (("\n "++) . show) cs+ , "\n ", parens (show t) ] isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)
src/Types/Unify.hs view
@@ -14,5 +14,6 @@ Left msg -> return (Left msg) Right (escapees, cs) -> do subs <- solver cs Map.empty- return ((,) escapees `liftM` subs)+ return $ do ss <- subs+ return (escapees, ss)