diff options
author | Ziv Scully <ziv@mit.edu> | 2014-03-25 02:04:06 -0400 |
---|---|---|
committer | Ziv Scully <ziv@mit.edu> | 2014-03-25 02:04:06 -0400 |
commit | 93d6de491838eb3607a12686bfdc250366aa60e4 (patch) | |
tree | 2da01b66e562296fe3720e6fcfdee0311bb7d077 /src/sql.sml | |
parent | 0e1252d5a6330570df698df924a0554b688042e8 (diff) |
ML half of initial prototype. (Doesn't compile because there's no C yet.)
Diffstat (limited to 'src/sql.sml')
-rw-r--r-- | src/sql.sml | 79 |
1 files changed, 1 insertions, 78 deletions
diff --git a/src/sql.sml b/src/sql.sml index 601b3510..6ac8bc68 100644 --- a/src/sql.sml +++ b/src/sql.sml @@ -2,7 +2,7 @@ structure Sql = struct open Mono -val debug = ref true (*false*) +val debug = ref false type lvar = int @@ -425,81 +425,4 @@ datatype querydml = val querydml = log "querydml" (altL [wrap dml Dml, wrap query Query]) -(* New stuff. *) - -fun subExps' (exp' : Mono.exp') = - case exp' of - ECon (_,_,SOME exp) => [exp] - | ESome (_,exp) => [exp] - | EFfiApp (_,_,xs) => map #1 xs - | EApp (exp1,exp2) => [exp1, exp2] - | EAbs (_,_,_,exp) => [exp] - | EUnop (_,exp) => [exp] - | EBinop (_,_,exp1,exp2) => [exp1, exp2] - | ERecord xs => map #2 xs - | EField (exp,_) => [exp] - | ECase (exp,xs,_) => exp :: map #2 xs - | EStrcat (exp1,exp2) => [exp1,exp2] - | EError (exp,_) => [exp] - | EReturnBlob {blob=NONE, mimeType, ...} => [mimeType] - | EReturnBlob {blob=SOME exp, mimeType, ...} => [exp, mimeType] - | ERedirect (exp,_) => [exp] - | EWrite exp => [exp] - | ESeq (exp1,exp2) => [exp1, exp2] - | ELet (_,_,exp1,exp2) => [exp1, exp2] - | EClosure (_,xs) => xs - | EQuery {query, body, initial, ...} => [query, body, initial] - | EDml (exp,_) => [exp] - | ENextval exp => [exp] - | ESetval (exp1,exp2) => [exp1, exp2] - | EUnurlify (exp,_,_) => [exp] - | EJavaScript (_,exp) => [exp] - | ESignalReturn exp => [exp] - | ESignalBind (exp1,exp2) => [exp1, exp2] - | ESignalSource exp => [exp] - | EServerCall (exp,_,_,_) => [exp] - | ERecv (exp,_) => [exp] - | ESleep exp => [exp] - | ESpawn exp => [exp] - | _ => [] - -val subExps : Mono.exp -> Mono.exp list = subExps' o #1 - -fun println str = print (str ^ "\n") -fun printlnExp exp = (Print.print (MonoPrint.p_exp MonoEnv.empty exp); println "") - -fun tablesRead (Query1 {From=tablePairs, ...}) = map #1 tablePairs - | tablesRead (Union (q1,q2)) = tablesRead q1 @ tablesRead q2 - -fun tableTouched (Insert (tab,_)) = tab - | tableTouched (Delete (tab,_)) = tab - | tableTouched (Update (tab,_,_)) = tab - -fun goExp (exp : Mono.exp) = - case #1 exp of - EQuery {query=e, ...} => ( - case parse query e of - SOME q => println ("Query reads from " ^ String.concatWith ", " (tablesRead q)) - | NONE => println "Couldn't parse query"; - printlnExp exp; println "") - | EDml (e,_) => ( - case parse dml e of - SOME d => println ("DML touches " ^ tableTouched d) - | NONE => println "Couldn't parse DML"; - printlnExp exp; println "") - | ENextval _ => (printlnExp exp; println "") - | ESetval _ => (printlnExp exp; println "") - (* Recurse down the syntax tree. *) - | _ => app goExp (subExps exp) - -fun goDecl (decl : decl) = - case #1 decl of - DVal (_,_,_,exp,_) => goExp exp - | DValRec xs => app (goExp o #4) xs - | _ => () - -fun goFile (file : file) = app goDecl (#1 file) - -fun go file = (println "Doing SQL analysis.\n"; goFile file; ()) - end |