src/main.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* Main interface *)
  20
  21 structure Main :> MAIN = struct
  22
  23 open Ast Print
  24
  25 val dmy = ErrorMsg.dummyLoc
  26
  27 val tInit = (TAction ((CRoot, dmy),
  28                       StringMap.empty,
  29                       StringMap.empty),
  30              dmy)
  31
  32
  33
  34 fun check' G fname =
  35     let
  36         (*val _ = print ("Check " ^ fname ^ "\n")*)
  37         val prog = Parse.parse fname
  38     in
  39         if !ErrorMsg.anyErrors then
  40             G
  41         else
  42             Tycheck.checkFile G tInit prog
  43     end
  44
  45 fun basis () =
  46     let
  47         val dir = Posix.FileSys.opendir Config.libRoot
  48
  49         fun loop files =
  50             case Posix.FileSys.readdir dir of
  51                 NONE => files
  52               | SOME fname =>
  53                 if String.isSuffix ".dtl" fname then
  54                     loop (String.concatWith "/" [Config.libRoot, fname]
  55                           :: files)
  56                 else
  57                     loop files
  58
  59         val files = loop []
  60         val files = Order.order files
  61     in
  62         foldl (fn (fname, G) => check' G fname) Env.empty files
  63     end
  64
  65 fun check fname =
  66     let
  67         val _ = ErrorMsg.reset ()
  68
  69         val b = basis ()
  70     in
  71         if !ErrorMsg.anyErrors then
  72             (b, NONE)
  73         else
  74             let
  75                 val prog = Parse.parse fname
  76             in
  77                 if !ErrorMsg.anyErrors then
  78                     (Env.empty, NONE)
  79                 else
  80                     let
  81                         val G' = Tycheck.checkFile b tInit prog
  82                     in
  83                         (G', #3 prog)
  84                     end
  85             end
  86     end
  87
  88 fun reduce fname =
  89     let
  90         val (G, body) = check fname
  91     in
  92         if !ErrorMsg.anyErrors then
  93             NONE
  94         else
  95             case body of
  96                 SOME body =>
  97                 let
  98                     val body' = Reduce.reduceExp G body
  99                 in
 100                     (*printd (PD.hovBox (PD.PPS.Rel 0,
 101                                          [PD.string "Result:",
 102                                           PD.space 1,
 103                                           p_exp body']))*)
 104                     SOME body'
 105                 end
 106               | _ => NONE
 107     end
 108
 109 fun eval fname =
 110     case reduce fname of
 111         (SOME body') =>
 112         if !ErrorMsg.anyErrors then
 113             ()
 114         else
 115             Eval.exec StringMap.empty body'
 116       | NONE => ()
 117
 118 end