Return to batch.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / build

Annotation of researchv10no/cmd/sml/src/build/batch.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: functor Batch(structure M: CODEGENERATOR and A:ASSEMBLER)  : sig end =
        !             3: struct
        !             4: 
        !             5: val pr = output std_out
        !             6: open PrintUtil ProcessFile
        !             7: 
        !             8: (* command parsing *)
        !             9: 
        !            10: fun skip_white stream =
        !            11:     case lookahead stream
        !            12:       of " " => (input stream 1; skip_white stream)
        !            13:        | "\t" => (input stream 1; skip_white stream)
        !            14:        | "\n" => (input stream 1; skip_white stream)
        !            15:        | _ => ()
        !            16: 
        !            17: fun getword stream =
        !            18:     let val nextchar = input stream 1
        !            19:      in case nextchar
        !            20:          of "" => ""
        !            21:           | " " => ""
        !            22:           | "\t" => ""
        !            23:           | "\n" => ""
        !            24:           | _ => nextchar ^ getword stream
        !            25:     end
        !            26: 
        !            27: (* The commandline interpreter *)
        !            28: 
        !            29: val dir = ref ""
        !            30: val globalhandle = ref true
        !            31: val dumpCore = ref false
        !            32: 
        !            33: fun compile fname = 
        !            34:     let val file = !dir ^ fname
        !            35:         fun p(lexp,s) = 
        !            36:            let val code = M.generate lexp
        !            37:                val outfile = open_out(s ^ ".mo")
        !            38:             in output outfile code; close_out outfile
        !            39:            end
        !            40:      in pr ("[Compiling " ^ file ^ "]\n"); process(file, SOME p)
        !            41:     end
        !            42: 
        !            43: fun assemble s = 
        !            44:     let val file = !dir ^ s
        !            45:         fun p(lexp,s) = 
        !            46:            let val f = open_out(s ^ ".s")
        !            47:             in A.generate (lexp, f); close_out f
        !            48:            end
        !            49:      in pr ("[Assembling " ^ file ^ "]\n"); process(file, SOME p)
        !            50:     end
        !            51: 
        !            52: fun load s = 
        !            53:     let val file = !dir ^ s
        !            54:     in pr ("[Loading " ^ file ^ "]\n"); ProcessFile.load file
        !            55:     end
        !            56: 
        !            57: fun export s = 
        !            58:     let val file = !dir ^ s
        !            59:     in pr("[Exporting to " ^ file ^ "]\n"); exportML file; pr "hello there\n"
        !            60:     end
        !            61: 
        !            62: exception Notfound_Compile of string
        !            63: local open System.Control 
        !            64:       open CG Profile
        !            65:       val flags = [
        !            66:                ("internals",internals),
        !            67:                ("tailrecur",tailrecur),
        !            68:                ("recordopt",recordopt),
        !            69:                ("tail",tail),
        !            70:                ("profile",profile),
        !            71:                ("closureprint",closureprint),
        !            72:                ("hoist",hoist),
        !            73:                ("reduce",reduce),
        !            74:                ("foldconst",foldconst),
        !            75:                ("etasplit",etasplit),
        !            76:                ("comment",comment),
        !            77:                ("alphac",alphac),
        !            78:                ("printsize",printsize),
        !            79:                ("scheduling",scheduling),
        !            80:                ("MC.printArgs",MC.printArgs),
        !            81:                ("MC.printRet",MC.printRet),
        !            82:                ("MC.bindContainsVar",MC.bindContainsVar),
        !            83:                ("MC.bindExhaustive",MC.bindExhaustive),
        !            84:                ("MC.matchExhaustive",MC.matchExhaustive),
        !            85:                ("MC.matchRedundant",MC.matchRedundant),
        !            86:                ("MC.expandResult",MC.expandResult),
        !            87:                ("saveLvarNames",Access.saveLvarNames),
        !            88:                ("saveLambda",saveLambda),
        !            89:                 ("printit",printit),
        !            90:                ("debugging",debugging),
        !            91:                ("debugLook",debugLook),
        !            92:                ("debugBind",debugBind),
        !            93:                ("timings",timings),
        !            94:                ("dumpCore",dumpCore),
        !            95:                ("globalhandle",globalhandle),
        !            96:                ("profiling",profiling)]
        !            97: in
        !            98: fun getflag f =
        !            99:     let fun get nil = raise Notfound_Compile f
        !           100:          | get ((name,flag)::tl) = if f=name then flag else get tl
        !           101:      in get flags
        !           102:     end
        !           103: 
        !           104: fun printflags () =
        !           105:     (pr "[Flags:\n";
        !           106:      app (fn(name,flag:bool ref) => (pr name; pr " = "; print(!flag); pr "\n"))
        !           107:         flags;
        !           108:      pr "]\n")
        !           109: end
        !           110: 
        !           111: fun toggle "" = printflags()
        !           112:   | toggle arg =
        !           113:     let val flag = getflag arg
        !           114:        val new = not(!flag)
        !           115:     in pr ("["^arg^" := "^makestring new^"]\n"); flag := new
        !           116:     end
        !           117: 
        !           118: fun lsave () = (toggle "saveLambda"; toggle "saveLvarNames")
        !           119: 
        !           120: fun atoi s =
        !           121:     let val dtoi = fn "0" => 0 | "1" => 1 | "2" => 2 | "3" => 3 | "4" => 4
        !           122:                    | "5" => 5 | "6" => 6 | "7" => 7 | "8" => 8 | "9" => 9
        !           123:                    | _ => (pr "[garbled integer input]\n"; raise ProcessFile.Stop)
        !           124:     in case explode s
        !           125:        of "~" :: s' => ~ (revfold (fn(a,b) => b * 10 + dtoi a) s' 0)
        !           126:         | s' => revfold (fn(a,b) => b * 10 + dtoi a) s' 0
        !           127:     end
        !           128: 
        !           129: fun gcmessage() =
        !           130:     let val f = System.Control.Runtime.gcmessages
        !           131:     in f := (!f + 1) mod 4; pr "[gcmessages := "; print(!f); pr "]\n"
        !           132:     end
        !           133: 
        !           134: fun summary() =
        !           135:     (System.Stats.summary();
        !           136:      pr(makestring(!System.Control.CG.knowngen));
        !           137:      pr " knowngen\n";
        !           138:      pr(makestring(!System.Control.CG.knowncl));
        !           139:      pr " knowncl\n";
        !           140:      pr(makestring(!System.Control.CG.stdgen));
        !           141:      pr " stdgen\n";
        !           142:      ())
        !           143: 
        !           144: val execs =
        !           145:        [("lsave",lsave),
        !           146:        ("summary",summary),
        !           147:        ("prFun",fn () =>
        !           148:                ProcessFile.prFun(atoi(skip_white std_in; getword std_in))),
        !           149:        ("gcmessages",gcmessage),
        !           150:        ("setratio",fn () =>
        !           151:                let val i = atoi(skip_white std_in; getword std_in)
        !           152:                in  pr "[ratio := "; print i; pr "]\n";
        !           153:                    System.Control.Runtime.ratio := i
        !           154:                end),
        !           155:        ("setsoftmax",fn () =>
        !           156:                let val i = atoi(skip_white std_in; getword std_in)
        !           157:                in  pr "[softmax := "; print i; pr "]\n";
        !           158:                    System.Control.Runtime.softmax := i
        !           159:                end),
        !           160:        ("setbodysize",fn () =>
        !           161:                let val i = atoi(skip_white std_in; getword std_in)
        !           162:                in  pr "[bodysize := "; print i; pr "]\n";
        !           163:                    System.Control.CG.bodysize := i
        !           164:                end),
        !           165:        ("setrounds",fn () =>
        !           166:                let val i = atoi(skip_white std_in; getword std_in)
        !           167:                in  pr "[rounds := "; print i; pr "]\n";
        !           168:                    System.Control.CG.rounds := i
        !           169:                end),
        !           170:        ("setreducemore",fn () =>
        !           171:                let val i = atoi(skip_white std_in; getword std_in)
        !           172:                in  pr "[reducemore := "; print i; pr "]\n";
        !           173:                    System.Control.CG.reducemore := i
        !           174:                end),
        !           175:        ("setclosureStrategy",fn () =>
        !           176:                let val i = atoi(skip_white std_in; getword std_in)
        !           177:                in  pr "[closureStrategy := "; print i; pr "]\n";
        !           178:                    CGoptions.closureStrategy := i
        !           179:                end),
        !           180:        ("printslots",fn () => ProcessFile.printslots(skip_white std_in;
        !           181:                                                   getword std_in)),
        !           182:        ("flushstdout",fn () => set_term_out(std_out,true)),
        !           183:        ("dumpMap",ProcessFile.dumpMap),
        !           184:        ("asBoot",fn () => (ProcessFile.bootEnv assemble; ())),
        !           185:        ("mBoot",fn () => (ProcessFile.bootEnv compile; ())),
        !           186:        ("primeEnv",ProcessFile.primeEnv),
        !           187:        ("clear",System.Control.Profile.clear),
        !           188:        ("reset",System.Control.Profile.reset),
        !           189:        ("report",fn () => System.Control.Profile.report std_out),
        !           190:        ("profileOff",System.Control.Profile.profileOff),
        !           191:        ("profileOn",System.Control.Profile.profileOn)]
        !           192: 
        !           193: fun getexec f =
        !           194:     let fun get nil = raise Notfound_Compile f
        !           195:          | get ((name,exec)::tl) = if f=name then exec else get tl
        !           196:      in get execs
        !           197:     end
        !           198: 
        !           199: fun printexecs () =
        !           200:     (pr "[Available execs:\n";
        !           201:      app (fn ("setbodysize",_) =>
        !           202:               (pr "setbodysize <int> (currently ";
        !           203:                Integer.print(!System.Control.CG.bodysize); pr ")\n")
        !           204:           | ("setreducemore",_) =>
        !           205:               (pr "setreducemore <int> (currently ";
        !           206:                Integer.print(!System.Control.CG.reducemore); pr ")\n")
        !           207:           | ("setclosureStrategy",_) =>
        !           208:               (pr "setclosureStrategy <int> (currently ";
        !           209:                Integer.print(!CGoptions.closureStrategy);
        !           210:                pr ")\n")
        !           211:           | ("prFun",_) => pr "prFun <lvar>\n"
        !           212:           | ("printslots",_) => pr "printslots <structure>\n"
        !           213:           | (name,_) => (pr name; pr "\n"))
        !           214:         execs;
        !           215:      pr "]\n")
        !           216: 
        !           217: fun execute "" = printexecs()
        !           218:   | execute arg =
        !           219:     let val exec = getexec arg
        !           220:     in  pr("["^arg^"()]\n");
        !           221:        exec()
        !           222:     end
        !           223: 
        !           224: fun help() = pr "\
        !           225: \!file      => compile the file.\n\
        !           226: \*file      => assemble the file.\n\
        !           227: \<file      => parse the file.\n\
        !           228: \>file      => export to a file.\n\
        !           229: \%          => print the last generated lambda.\n\
        !           230: \#word      => comment; ignored.\n\
        !           231: \@directory => look for files in a directory.  directory should end in /.\n\
        !           232: \~function  => execute a function.\n\
        !           233: \^flag      => toggle a flag.\n\
        !           234: \?          => print this help message.\n"
        !           235: 
        !           236: fun interp "" = ()
        !           237:   | interp word =
        !           238:     let val arg = substring(word,1,size word - 1) handle Substring => ""
        !           239:     in  (case substring(word,0,1) of
        !           240:              "!" => compile arg
        !           241:            | "*" => assemble arg
        !           242:            | "<" => load arg
        !           243:            | ">" => export arg
        !           244:            | "%" => ProcessFile.prLambda()
        !           245:            | "#" => ()                 (* comment *)
        !           246:            | "@" => dir := arg         (* change load directory *)
        !           247:            | "~" => execute arg        (* execute function *)
        !           248:            | "^" => toggle arg         (* toggle flag *)
        !           249:            | "?" => help()             
        !           250:            |  _  => pr ("[What is \""^word^"\"?]\n")
        !           251:        ) handle e as Notfound_Compile f =>
        !           252:                   (pr("[flag \""^f^"\" not recognized]\n");
        !           253:                    raise e)
        !           254:     end
        !           255: 
        !           256: fun interp1 word =
        !           257:     if !globalhandle
        !           258:     then (interp word
        !           259:          handle ProcessFile.Stop =>
        !           260:                  (pr "[Failed on ";
        !           261:                   pr_mlstr word;
        !           262:                   pr "]\n";
        !           263:                   flush_out std_out)
        !           264:               | e =>
        !           265:                  (pr "[Failed on ";
        !           266:                   pr_mlstr word; pr " with ";
        !           267:                   pr(System.exn_name e); pr "]\n";
        !           268:                   flush_out std_out))
        !           269:     else interp word
        !           270:         handle e =>
        !           271:           (pr "[Failed on ";
        !           272:            pr_mlstr word; pr " with ";
        !           273:            pr(System.exn_name e); pr "]\n";
        !           274:            flush_out std_out;
        !           275:            if !dumpCore
        !           276:            then (toggle "globalhandle";
        !           277:                  toggle "dumpCore";
        !           278:                  pr "[Saving state]\n[Exporting to sml.save]\n";
        !           279:                  flush_out std_out;
        !           280:                  if exportML "sml.save"
        !           281:                   then pr "hello there\n"
        !           282:                   else (summary(); raise e))
        !           283:            else raise e)
        !           284:                 
        !           285: (* command-line interpreter top-level loop *)
        !           286: fun toplevel () =
        !           287:     if end_of_stream std_in
        !           288:     then ()
        !           289:     else (skip_white std_in;
        !           290:          if (end_of_stream std_in)
        !           291:          then () 
        !           292:          else (interp1(getword std_in); toplevel ()))
        !           293: 
        !           294: (* load the pervasives (no .mo files generated) *)
        !           295: val _ = ProcessFile.bootEnv load
        !           296: 
        !           297: (* start up command interpreter *)
        !           298: val _ = (pr "hello there\n"; toplevel ())
        !           299: 
        !           300: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.