Source

Opifex / src / Language / Language_drivers.ml

The branch 'port-stringpainter' does not exist.
Full commit
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open Command
open Batteries

(*************************************************************************************************
 * WHILE-related subcommands
 ************************************************************************************************)

module WHILE_driver : Language_driver = struct

    module Representation = struct
        let name = "WHILE"

        type ast = While_AST.program

        type value = While_Eval.value

        type result = unit

        type typecheck_result = unit

    end

    let parse lexbuf = While_Parser.parse While_Lexer.token lexbuf

    let pretty_print = print_endline -| While_PrettyPrinter.print_program

    let show_value = While_Eval.show_value

    let eval store ast =
        While_Eval.eval_program store (While_Eval.standard_io_driver) ast

    let print_result () = ()

    let print_typecheck_result _ = ()

    let typecheck ast = ()

end

(*************************************************************************************************
 * MiniML-related subcommands
 ************************************************************************************************)

module MiniML_driver = struct
    open MiniML_Util

    module Representation = struct

        let name = "MiniML"

        type ast = MiniML_AST.program

        type value = MiniML_Eval.value

        type result = MiniML_Eval.environment * MiniML_Eval.value

        type typecheck_result = MiniML_AST.type_expression Environment.t  * MiniML_AST.type_expression
    end


    let parse lexbuf = MiniML_Parser.parse MiniML_Lexer.token lexbuf

    let pretty_print = print_endline -| MiniML_PrettyPrinter.print_program

    let show_value = ValuePrinter.show_value

    let eval store ast = 
        MiniML_Eval.eval_program store (IODriver.standard_io_driver) ast

    let print_result (env, mval) =
            let print_env = Formatter.print_document -| ValuePrinter.show_environment in
            let print_val = Formatter.print_document -| show_value in
            print_val mval;
            print_env env


    let print_typecheck_result (tenv, mtp) = 
        let print_tenv  = Formatter.print_document -|  TypePrinter.show_environment in
        let print_tp    = Formatter.print_document -|  TypePrinter.show_type in
        print_tp mtp;
        print_tenv tenv

    let typecheck = MiniML_TypeChecker.infertype_program

end

(*************************************************************************************************
 * CWCPS-related subcommands
 ************************************************************************************************)

module CWCPS_driver = struct
    open CWCPS_Util

    module Representation = struct

        let name = "CWCPS"

        type ast = CWCPS_AST.program

        type value = CWCPS_Eval.value

        type result = CWCPS_Eval.environment

        type typecheck_result = CWCPS_AST.type_expression Environment.t 

    end

    let parse lexbuf = CWCPS_Parser.parse CWCPS_Lexer.token lexbuf

    let pretty_print = print_endline -| CWCPS_PrettyPrinter.print_program

    let pretty_expr = print_endline -| CWCPS_PrettyPrinter.print_expression

    let show_value = ValuePrinter.show_value

    let eval store ast = 
        CWCPS_Eval.eval_program store (IODriver.standard_io_driver) ast

    let print_result i = (*print_endline -| Formatter.build_string -| ValuePrinter.show_environment*) raise Exit

    let print_typecheck_result _ = raise Exit

    let typecheck = CWCPS_TypeChecker.infertype_program

end

(*************************************************************************************************
 * Supported languages
 ************************************************************************************************)

let language_drivers =
    [ (module WHILE_driver  : Language_driver)
    ; (module MiniML_driver : Language_driver)
    (*; (module CWCPS_driver  : Language_driver)*)
    ]