Language 84

File

language84-0.4/84.84

Block
    Let root_path (parse_command_line)
    In
    (MAIN.run
        (MAIN.bind1 (parse_packages root_path)
            Func {packages}
                Let paths (LIST.map packages [Func {p} p.path])
                Let program (compile packages)
                In
                (MAIN.sequence2
                    (write_dependencies_file root_path paths)
                    (emit root_path program))))

Where

Define (parse_command_line)
    Let usage "usage: 84 <program>"
    In
    Let root_path
        If [(OS.fetch_argc) = 2]
            (OS.fetch_arg 1)
            (OS.die usage)
    In
    root_path

Define (parse_packages root_path)
    Let STRING_SET (SEARCH.SET STRING.compare)
    In
    Define (parse_file path)
        Let file_name (STRING.append path ".84")
        In
        (MAIN.bind1 (MAIN.read_file file_name)
            Func {text}
                Match (PARSE.file text)
                | 'succeed.expr (MAIN.pure expr)
                | 'fail.{message i}
                    Begin
                        (SYNTAX_ERROR.show file_name text message i)
                        (MAIN.die "Compilation failed.")
                    End
                ;)
    Define (push_paths stack filter paths)
        (LIST.reduce paths {stack filter}
            Func {{stack filter} path}
                Match (STRING_SET.search filter path)
                | 'just._ {stack filter}
                | 'nothing {[path & stack] (STRING_SET.insert filter path)}
                ;)
    In
    Define (rec rec packages stack filter)
        Match stack
        | 'nil (MAIN.pure packages)
        | 'cons.{path stack}
            (MAIN.bind1 (parse_file path)
                Func {expr}
                    Let imports (PACKAGE.gather_imports expr)
                    In
                    Let package {: path : imports : expr}
                    Let {stack filter} (push_paths stack filter imports)
                    In
                    (rec rec [package & packages] stack filter))
        ;
    In
    (MAIN.lift1
        (rec rec 'nil [root_path & 'nil] (STRING_SET.new [root_path & 'nil]))
        PACKAGE.sort_by_dependence)

Define (write_dependencies_file root_path paths)
    Let file_name (STRING.append root_path ".c.d")
    In
    (MAIN.bind1 (MAIN.file_create file_name)
        Func {file}
            Define (rec rec paths)
                Match paths
                | 'nil
                    (MAIN.sequence2
                        (MAIN.file_write file "\n")
                        (MAIN.file_close file))
                | 'cons.{path paths}
                    (MAIN.sequence2
                        (MAIN.file_write file
                            (STRING.concat [Right " " & path & ".84" & 'nil]))
                        (rec rec paths))
                ;
            In
            (MAIN.sequence2
                (MAIN.file_write file (STRING.append root_path ".c:"))
                (rec rec paths)))

Define (compile program)
    Let {_ program}
        (LIST.fold program {1 'nil}
            Func {package {i packages}}
                Let {init i functions}
                    (COMPILE.lift_functions i
                        (COMPILE.collect_free_variables package.expr))
                In
                Let package
                    {
                    : path package.path
                    : imports package.imports
                    : init
                    : functions
                    }
                In
                {i [package & packages]})
    In
    (COMPILE.collect_constants program)

Define (emit root_path program)
    (MAIN.lift1 (MAIN.file_create (STRING.append root_path ".c"))
        Func {file}
            Define (write string)
                (OS.file_write file string)
            In
            Begin
                (C.emit (C.elaborate program) write)
                (OS.file_close file)
            End)

Where

Let C Package "c"
Let COMPILE Package "compile"
Let LIST Package "list"
Let MAIN Package "main"
Let OS Package "os"
Let PACKAGE Package "package"
Let PARSE Package "parse"
Let SEARCH Package "search"
Let STDIO Package "stdio"
Let STRING Package "string"
Let SYNTAX_ERROR Package "syntax_error"