Source

Opifex / src / Main.ml

Full commit
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open Command
open Batteries
open MiniML_to_CWCPS
open CWCPS_ConstantFolding
open CWCPS_RemoveDeadCode
open CWCPS_BetaContraction
open CWCPS_EtaReduction
open Algebra_Monoid

(************************************************************************************************
 * About command
 ************************************************************************************************)

module About_command : Command = struct

    let handler _ = Util.print_lines
        [ Predefined.copyright_header
        ; Predefined.build_header
        ; "Sandbox for bringing programming languages into the Real World."
        ; ""
        ];
        0

    let description =
        { command_name = "about"
        ; command_title = "About this program"
        ; command_handler = handler
        ; command_synopsis = ["nothing"]
        }

end

module License_command : Command = struct

    let handler _ = Util.print_lines
        [ Predefined.license
        ];
        0

    let description =
        { command_name = "license"
        ; command_title = "Print the Simplified BSD License"
        ; command_handler = handler
        ; command_synopsis = ["nothing"]
        }

end

(************************************************************************************************
 * Temporary command
 ************************************************************************************************)

module Temporary_command : Command = struct
    open Language_drivers

    module MParser = Make_parser_command(MiniML_driver) 
    module LD      = MiniML_driver

    let typecheck path =
        try
            Util.print_words_ln [ "-"; "parsing"; path ];
            let ast    = MParser.parse path in
            Util.print_words_ln [ "-"; "result:" ];
            LD.pretty_print ast;
            Util.print_words_ln [ "-"; "transformation" ];
            let (mexpr, res) = MiniML_to_CWCPS.transform_program ast in
            Util.print_words_ln [ "-"; "encoded expression" ];
            LD.pretty_print (MiniML_AST.PROGRAM ([], mexpr));
            Util.print_words_ln [ "-"; "result" ];
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform ConstantFolding" ];
            let res = CWCPS_ConstantFolding.topdown res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
            let res = CWCPS_RemoveDeadCode.bottomup res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform BetaContraction" ];
            let res = CWCPS_BetaContraction.bottomup res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
            let res = CWCPS_RemoveDeadCode.bottomup res in
            CWCPS_driver.pretty_expr res;
            let res = CWCPS_BetaContraction.bottomup res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
            let res = CWCPS_RemoveDeadCode.bottomup res in
            CWCPS_driver.pretty_expr res;
            let res = CWCPS_BetaContraction.bottomup res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
            let res = CWCPS_RemoveDeadCode.bottomup res in
            CWCPS_driver.pretty_expr res;
            let res = CWCPS_BetaContraction.bottomup res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
            let res = CWCPS_RemoveDeadCode.bottomup res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform ConstantFolding" ];
            let res = CWCPS_ConstantFolding.topdown res in
            CWCPS_driver.pretty_expr res;
            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
            let res = CWCPS_RemoveDeadCode.bottomup res in
            CWCPS_driver.pretty_expr res;
            ()
        with
            | Parsing.Parse_error ->
                Util.print_words_ln [ "PARSING FAILED" ];
                ()

    let handler xs = 
            List.iter typecheck xs;
            0

    let description =
        { command_name = "temporary"
        ; command_title = "Temporary command, for testing etc"
        ; command_handler = handler
        ; command_synopsis = ["nothing"]
        }

end

(*************************************************************************************************
 * MENU
 ************************************************************************************************)

let rec main_commands =
    [ LeafCommand About_command.description
    ; LeafCommand Temporary_command.description
    ; create_language_command_trees Language_drivers.language_drivers
    ; LeafCommand License_command.description
    ]

(*************************************************************************************************
 * MAIN
 ************************************************************************************************)

let main () = 
    let system_arguments  = Array.to_list Sys.argv   in
    let program_name      = List.hd system_arguments in
    let program_arguments = List.tl system_arguments in
    exit (CommandTree_executor.execute_command_trees program_name main_commands program_arguments)