# HG changeset patch # User Adam Chlipala # Date 1239907765 14400 # Node ID e0dd85ea58e12e0935722b6d795736a27fe610b1 # Parent 1b1047992ecf1eeca019168c8767bb4e49bd8d95 Label exported symbols by effect-ness; factor out some common datatypes diff -r 1b1047992ecf -r e0dd85ea58e1 src/cjr.sml --- a/src/cjr.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/cjr.sml Thu Apr 16 14:49:25 2009 -0400 @@ -29,7 +29,7 @@ type 'a located = 'a ErrorMsg.located -datatype datatype_kind = datatype Mono.datatype_kind +datatype datatype_kind = datatype DatatypeKind.datatype_kind datatype typ' = TFun of typ * typ @@ -120,6 +120,9 @@ | ServerAndPull | ServerAndPullAndPush -type file = decl list * (Core.export_kind * string * int * typ list * typ * sidedness) list +datatype effect = datatype Export.effect +datatype export_kind = datatype Export.export_kind + +type file = decl list * (export_kind * string * int * typ list * typ * sidedness) list end diff -r 1b1047992ecf -r e0dd85ea58e1 src/cjr_print.sml --- a/src/cjr_print.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/cjr_print.sml Thu Apr 16 14:49:25 2009 -0400 @@ -2208,8 +2208,8 @@ val fields = foldl (fn ((ek, _, _, ts, _, _), fields) => case ek of Core.Link => fields - | Core.Rpc => fields - | Core.Action => + | Core.Rpc _ => fields + | Core.Action _ => case List.nth (ts, length ts - 2) of (TRecord i, _) => let @@ -2331,8 +2331,8 @@ val (ts, defInputs, inputsVar) = case ek of Core.Link => (List.take (ts, length ts - 1), string "", string "") - | Core.Rpc => (List.take (ts, length ts - 1), string "", string "") - | Core.Action => + | Core.Rpc _ => (List.take (ts, length ts - 1), string "", string "") + | Core.Action _ => case List.nth (ts, length ts - 2) of (TRecord i, _) => let @@ -2414,8 +2414,8 @@ string "if (*request == '/') ++request;", newline, box (case ek of - Core.Rpc => [string "uw_write_header(ctx, \"Content-type: text/plain\\r\\n\");", - newline] + Core.Rpc _ => [string "uw_write_header(ctx, \"Content-type: text/plain\\r\\n\");", + newline] | _ => [string "uw_write_header(ctx, \"Content-type: text/html\\r\\n\");", newline, string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");", @@ -2457,12 +2457,12 @@ newline]) ts), defInputs, box (case ek of - Core.Rpc => [p_typ env ran, - space, - string "it0", - space, - string "=", - space] + Core.Rpc _ => [p_typ env ran, + space, + string "it0", + space, + string "=", + space] | _ => []), p_enamed env n, string "(", @@ -2474,7 +2474,7 @@ string ", uw_unit_v);", newline, box (case ek of - Core.Rpc => [urlify env ran] + Core.Rpc _ => [urlify env ran] | _ => [string "uw_write(ctx, \"\");", newline]), string "return;", diff -r 1b1047992ecf -r e0dd85ea58e1 src/core.sml --- a/src/core.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/core.sml Thu Apr 16 14:49:25 2009 -0400 @@ -70,7 +70,7 @@ withtype con = con' located -datatype datatype_kind = datatype Elab.datatype_kind +datatype datatype_kind = datatype DatatypeKind.datatype_kind datatype patCon = PConVar of int @@ -119,10 +119,8 @@ withtype exp = exp' located -datatype export_kind = - Link - | Action - | Rpc +datatype effect = datatype Export.effect +datatype export_kind = datatype Export.export_kind datatype decl' = DCon of string * int * kind * con diff -r 1b1047992ecf -r e0dd85ea58e1 src/core_print.sml --- a/src/core_print.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/core_print.sml Thu Apr 16 14:49:25 2009 -0400 @@ -470,8 +470,8 @@ fun p_export_kind ck = case ck of Link => string "link" - | Action => string "action" - | Rpc => string "rpc" + | Action _ => string "action" + | Rpc _ => string "rpc" fun p_datatype env (x, n, xs, cons) = let diff -r 1b1047992ecf -r e0dd85ea58e1 src/datatype_kind.sml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/datatype_kind.sml Thu Apr 16 14:49:25 2009 -0400 @@ -0,0 +1,35 @@ +(* Copyright (c) 2009, Adam Chlipala + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * - Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * - Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * - The names of contributors may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + *) + +structure DatatypeKind = struct + +datatype datatype_kind = + Enum + | Option + | Default + +end diff -r 1b1047992ecf -r e0dd85ea58e1 src/elab.sml --- a/src/elab.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/elab.sml Thu Apr 16 14:49:25 2009 -0400 @@ -81,10 +81,7 @@ withtype con = con' located -datatype datatype_kind = - Enum - | Option - | Default +datatype datatype_kind = datatype DatatypeKind.datatype_kind datatype patCon = PConVar of int diff -r 1b1047992ecf -r e0dd85ea58e1 src/expl.sml --- a/src/expl.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/expl.sml Thu Apr 16 14:49:25 2009 -0400 @@ -70,7 +70,7 @@ withtype con = con' located -datatype datatype_kind = datatype Elab.datatype_kind +datatype datatype_kind = datatype DatatypeKind.datatype_kind datatype patCon = PConVar of int diff -r 1b1047992ecf -r e0dd85ea58e1 src/export.sml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/export.sml Thu Apr 16 14:49:25 2009 -0400 @@ -0,0 +1,39 @@ +(* Copyright (c) 2009, Adam Chlipala + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * - Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * - Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * - The names of contributors may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + *) + +structure Export = struct + +datatype effect = + ReadOnly + | ReadWrite + +datatype export_kind = + Link + | Action of effect + | Rpc of effect + +end diff -r 1b1047992ecf -r e0dd85ea58e1 src/mono.sml --- a/src/mono.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/mono.sml Thu Apr 16 14:49:25 2009 -0400 @@ -29,7 +29,7 @@ type 'a located = 'a ErrorMsg.located -datatype datatype_kind = datatype Core.datatype_kind +datatype datatype_kind = datatype DatatypeKind.datatype_kind datatype typ' = TFun of typ * typ @@ -115,11 +115,14 @@ withtype exp = exp' located +datatype effect = datatype Export.effect +datatype export_kind = datatype Export.export_kind + datatype decl' = DDatatype of string * int * (string * int * typ option) list | DVal of string * int * typ * exp * string | DValRec of (string * int * typ * exp * string) list - | DExport of Core.export_kind * string * int * typ list * typ + | DExport of export_kind * string * int * typ list * typ | DTable of string * (string * typ) list * exp * exp | DSequence of string @@ -130,7 +133,6 @@ | DCookie of string | DStyle of string - withtype decl = decl' located type file = decl list diff -r 1b1047992ecf -r e0dd85ea58e1 src/rpcify.sml --- a/src/rpcify.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/rpcify.sml Thu Apr 16 14:49:25 2009 -0400 @@ -173,7 +173,7 @@ (#exported st, #export_decls st) else (IS.add (#exported st, n), - (DExport (Rpc, n), loc) :: #export_decls st) + (DExport (Rpc ReadWrite, n), loc) :: #export_decls st) val st = {cpsed = #cpsed st, cpsed_range = #cpsed_range st, diff -r 1b1047992ecf -r e0dd85ea58e1 src/sources --- a/src/sources Thu Apr 16 14:35:01 2009 -0400 +++ b/src/sources Thu Apr 16 14:49:25 2009 -0400 @@ -19,6 +19,9 @@ prim.sig prim.sml +datatype_kind.sml +export.sml + source.sml urweb.grm diff -r 1b1047992ecf -r e0dd85ea58e1 src/tag.sml --- a/src/tag.sml Thu Apr 16 14:35:01 2009 -0400 +++ b/src/tag.sml Thu Apr 16 14:49:25 2009 -0400 @@ -118,7 +118,7 @@ in case x of (CName "Link", _) => tagIt (Link, "Href") - | (CName "Action", _) => tagIt (Action, "Action") + | (CName "Action", _) => tagIt (Action ReadWrite, "Action") | _ => ((x, e, t), (count, tags, byTag, newTags)) end) s xets