diff src/sql.sml @ 2203:39faa4a037f4

ML half of initial prototype. (Doesn't compile because there's no C yet.)
author Ziv Scully <ziv@mit.edu>
date Tue, 25 Mar 2014 02:04:06 -0400
parents 606af2c9b828
children 01c8aceac480
line wrap: on
line diff
--- a/src/sql.sml	Sat Mar 08 05:06:22 2014 -0500
+++ b/src/sql.sml	Tue Mar 25 02:04:06 2014 -0400
@@ -2,7 +2,7 @@
 
 open Mono
 
-val debug = ref true (*false*)
+val debug = ref false
 
 type lvar = int
 
@@ -425,81 +425,4 @@
 
 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