| 1 | (* |
| 2 | * Dynamic web page generation with Standard ML |
| 3 | * Copyright (C) 2003 Adam Chlipala |
| 4 | * |
| 5 | * This library is free software; you can redistribute it and/or |
| 6 | * modify it under the terms of the GNU Lesser General Public |
| 7 | * License as published by the Free Software Foundation; either |
| 8 | * version 2.1 of the License, or (at your option) any later version. |
| 9 | * |
| 10 | * This library is distributed in the hope that it will be useful, |
| 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 13 | * Lesser General Public License for more details. |
| 14 | * |
| 15 | * You should have received a copy of the GNU Lesser General Public |
| 16 | * License along with this library; if not, write to the Free Software |
| 17 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| 18 | *) |
| 19 | |
| 20 | (* Template language abstract syntax trees *) |
| 21 | |
| 22 | structure Tree = |
| 23 | struct |
| 24 | open Common |
| 25 | |
| 26 | type ident = string |
| 27 | type path = ident list |
| 28 | |
| 29 | type 'a withext = 'a * (int * int) |
| 30 | |
| 31 | (* Pattern *) |
| 32 | datatype pat' = |
| 33 | Wild_p | Int_p of int | String_p of string | Char_p of string | Real_p of real |
| 34 | | Ident_p of path |
| 35 | | Record_p of bool * (ident * pat) list |
| 36 | | FlexRecord_p of (ident * pat) list |
| 37 | | App_p of path * pat | Cons_p of pat * pat |
| 38 | | As_p of ident * pat |
| 39 | and pat = PAT of pat' withext |
| 40 | |
| 41 | (* Expression *) |
| 42 | and exp' = |
| 43 | Int_e of int | String_e of string | Char_e of string | Real_e of real | Ident_e of path |
| 44 | | Plus_e of exp * exp | Minus_e of exp * exp | Times_e of exp * exp |
| 45 | | Divide_e of exp * exp | Mod_e of exp * exp | Neg_e | Param_e |
| 46 | | Template_e of ident |
| 47 | | Orelse_e of exp * exp | Andalso_e of exp * exp |
| 48 | | StrCat_e of exp * exp |
| 49 | | Eq_e of exp * exp | Neq_e of exp * exp |
| 50 | | Gt_e of exp * exp | Gte_e of exp * exp |
| 51 | | Lt_e of exp * exp | Lte_e of exp * exp |
| 52 | | Cons_e of exp * exp | Compose_e of exp * exp |
| 53 | | Record_e of bool * (ident * exp) list |
| 54 | | RecordUpd_e of exp * (ident * exp) list |
| 55 | | Proj_e of ident | App_e of exp * exp |
| 56 | | Case_e of exp * (pat * exp) list |
| 57 | | Fn_e of (pat * exp) list |
| 58 | | Raise_e of exp |
| 59 | | Let_e of block * exp |
| 60 | | If_e of exp * exp * exp |
| 61 | and exp = EXP of exp' withext |
| 62 | |
| 63 | and blockItem' = |
| 64 | Html_i of string (* literal HTML code to be sent *) |
| 65 | | Ref_i of (ident * exp) list (* define some new refs *) |
| 66 | | Val_i of pat * exp (* val binding *) |
| 67 | | Assn_i of ident * exp (* assignment to ref *) |
| 68 | | Exp_i of exp (* expression to be evaluated *) |
| 69 | | Open_i of path list (* imports to top level *) |
| 70 | | Ifthenelse_i of exp * block * block option (* if statement *) |
| 71 | | Case_i of exp * (pat * block) list (* case statement *) |
| 72 | | Foreach_i of pat * exp * block (* foreach statement with list *) |
| 73 | | For_i of ident * exp * exp * block (* foreach statement with integer range *) |
| 74 | | TryCatch_i of block * (pat * block) list (* try...catch exception handlers w/ pattern matching *) |
| 75 | and blockItem = BITEM of blockItem' withext |
| 76 | (* Block of thingers to twiddle *) |
| 77 | and block = BLOCK of block' withext |
| 78 | withtype block' = blockItem list |
| 79 | and path = ident list |
| 80 | |
| 81 | fun unblock (BLOCK (x, _)) = x |
| 82 | fun unpat (PAT (x, _)) = x |
| 83 | fun unexp (EXP (x, _)) = x |
| 84 | |
| 85 | |
| 86 | fun expString (EXP (e, _)) = |
| 87 | (case e of |
| 88 | Int_e n => Int.toString n |
| 89 | | String_e s => "\"" ^ s ^ "\"" |
| 90 | | Ident_e [id] => id |
| 91 | | Ident_e [sn, id] => sn ^ "." ^ id |
| 92 | | Plus_e (e1, e2) => expString e1 ^ " + " ^ expString e2 |
| 93 | | Minus_e (e1, e2) => expString e1 ^ " - " ^ expString e2 |
| 94 | | Orelse_e (e1, e2) => expString e1 ^ " || " ^ expString e2 |
| 95 | | Andalso_e (e1, e2) => expString e1 ^ " && " ^ expString e2 |
| 96 | | Times_e (e1, e2) => expString e1 ^ " * " ^ expString e2 |
| 97 | | Divide_e (e1, e2) => expString e1 ^ " / " ^ expString e2 |
| 98 | | Mod_e (e1, e2) => expString e1 ^ " % " ^ expString e2 |
| 99 | | Eq_e (e1, e2) => expString e1 ^ " = " ^ expString e2 |
| 100 | | Neq_e (e1, e2) => expString e1 ^ " <> " ^ expString e2 |
| 101 | | Gt_e (e1, e2) => expString e1 ^ " > " ^ expString e2 |
| 102 | | Gte_e (e1, e2) => expString e1 ^ " >= " ^ expString e2 |
| 103 | | Lt_e (e1, e2) => expString e1 ^ " < " ^ expString e2 |
| 104 | | Lte_e (e1, e2) => expString e1 ^ " <= " ^ expString e2 |
| 105 | | Neg_e => "-" |
| 106 | | Param_e => "$" |
| 107 | | Template_e id => "@" ^ id |
| 108 | | Cons_e (e1, e2) => expString e1 ^ " :: " ^ expString e2 |
| 109 | | Record_e (true, elms) => foldl (fn ((_, e), s) => s ^ ", " ^ expString e) "(" elms ^ ")" |
| 110 | | Record_e (false, elms) => foldl (fn ((lab, e), s) => s ^ ", " ^ lab ^ " = " ^ expString e) "(" elms ^ ")" |
| 111 | | RecordUpd_e _ => "<RECORDUPDATE>" |
| 112 | | Proj_e id => "#" ^ id |
| 113 | | App_e (e1, e2) => expString e1 ^ "(" ^ expString e2 ^ ")" |
| 114 | | _ => "<NUTTY>") |
| 115 | |
| 116 | fun pathString [] = "<ERROR>" |
| 117 | | pathString [id] = id |
| 118 | | pathString (h::t) = h ^ "." ^ pathString t |
| 119 | end |