ats-format-0.1.0.24: test/data/polyglot.out
#include "share/atspre_staload.hats"
#include "share/HATS/atslib_staload_libats_libc.hats"
#include "prelude/DATS/filebas.dats"
#include "libats/ML/DATS/filebas_dirent.dats"
#include "libats/libc/DATS/dirent.dats"
#include "src/concurrency.dats"
#include "libats/DATS/athread_posix.dats"
#include "prelude/DATS/stream_vt.dats"
%{^
#include "libats/libc/CATS/string.cats"
#include "prelude/CATS/filebas.cats"
%}
staload "prelude/SATS/stream_vt.sats"
staload "libats/ML/DATS/list0.dats"
staload "libats/SATS/athread.sats"
staload "libats/ML/DATS/string.dats"
staload "libats/libc/SATS/stdio.sats"
staload "prelude/SATS/filebas.sats"
staload "src/filetype.sats"
staload "libats/ML/DATS/filebas.dats"
staload EXTRA = "libats/ML/SATS/filebas.sats"
staload "libats/libc/SATS/unistd.sats"
staload "libats/DATS/athread.dats"
fun to_file(s : string, pre : Option(string)) : file =
let
val is_comment = case+ pre of
| Some (x) => string_is_prefix(x, s)
| None => false
in
if s = "" then
@{ lines = 1, blanks = 1, comments = 0, files = 0 }
else
if is_comment then
@{ lines = 1, blanks = 0, comments = 1, files = 0 }
else
@{ lines = 1, blanks = 0, comments = 0, files = 0 }
end
fun empty_file() : file =
let
var f = @{ files = 0, blanks = 0, comments = 0, lines = 0 } : file
in
f
end
fun acc_file() : file =
let
var f = @{ files = 1, blanks = 0, comments = 0, lines = ~1 } : file
in
f
end
// monoidal addition for 'file' type
fun add_results(x : file, y : file) : file =
let
var next = @{ lines = x.lines + y.lines, blanks = x.blanks
+ y.blanks, comments = x.comments + y.comments, files = x.files
+ y.files }
in
next
end
overload + with add_results
// Given a string representing a filepath, return an integer.
fun line_count(s : string, pre : Option(string)) : file =
let
var ref = fileref_open_opt(s, file_mode_r)
in
case ref of
| ~Some_vt (x) =>
begin
let
var viewstream: stream_vt(string) = $EXTRA.streamize_fileref_line(x)
val n: file = stream_vt_foldleft_cloptr( viewstream
, acc_file()
, lam (acc, f) =<cloptr1> acc + to_file(f, pre)
)
val _ = fileref_close(x)
in
n
end
end
| ~None_vt() => ( println!("\33[33mWarning:\33[0m could not open file at "
+ s)
; to_file(s, None)
)
end
// Pad a string of bounded length on the right by adding spaces.
fnx right_pad { k : int | k >= 0 }{ m : int | m <= k } .<k>.
(s : string(m), n : int(k)) : string =
case+ length(s) < n of
| true when n > 0 => right_pad(s, n - 1) + " "
| _ => s
// Pad a string on the left by adding spaces.
fnx left_pad { k : int | k >= 0 } .<k>. (s : string, n : int(k)) :
string =
case+ length(s) < n of
| true when n > 0 => " " + left_pad(s, n - 1)
| _ => s
// helper function for make_output
fun maybe_string(s : string, n : int) : string =
if n > 0 then
s + ": " + tostring_int(n) + "\n"
else
""
// helper function for make_table
fun maybe_table { k : int | k >= 0 && k < 20 } ( s : string(k)
, f : file
) : string =
let
var code = f.lines - f.comments - f.blanks
in
if f.files > 0 then
" " + right_pad(s, 21) + left_pad(tostring_int(f.files), 5)
+ left_pad(tostring_int(f.lines), 12) + left_pad(tostring_int(code), 13)
+ left_pad(tostring_int(f.comments), 13)
+ left_pad(tostring_int(f.blanks), 13) + "\n"
else
""
end
// helper function for make_output
fun with_nonempty(s1 : string, s2 : string) : string =
if s2 != "" then
s1 + s2
else
""
// helper function to make totals for tabular output.
fun sum_fields(sc : source_contents) : file =
let
var f = @{ lines = sc.rust.lines + sc.haskell.lines + sc.ats.lines
+ sc.python.lines + sc.vimscript.lines + sc.elm.lines + sc.idris.lines
+ sc.madlang.lines + sc.tex.lines + sc.markdown.lines + sc.yaml.lines
+ sc.toml.lines + sc.cabal.lines + sc.happy.lines + sc.alex.lines
+ sc.go.lines + sc.html.lines + sc.css.lines + sc.verilog.lines
+ sc.vhdl.lines + sc.c.lines + sc.purescript.lines + sc.futhark.lines
+ sc.brainfuck.lines + sc.ruby.lines + sc.julia.lines + sc.perl.lines
+ sc.ocaml.lines + sc.agda.lines + sc.cobol.lines + sc.tcl.lines
+ sc.r.lines + sc.lua.lines + sc.cpp.lines + sc.lalrpop.lines
+ sc.header.lines + sc.sixten.lines + sc.dhall.lines + sc.ipkg.lines
+ sc.makefile.lines + sc.justfile.lines + sc.ion.lines + sc.bash.lines
+ sc.hamlet.lines + sc.cassius.lines + sc.lucius.lines + sc.julius.lines
+ sc.mercury.lines + sc.yacc.lines + sc.lex.lines + sc.coq.lines
+ sc.jupyter.lines + sc.java.lines + sc.scala.lines + sc.erlang.lines
+ sc.elixir.lines + sc.pony.lines + sc.clojure.lines
+ sc.cabal_project.lines + sc.assembly.lines + sc.nix.lines
+ sc.php.lines + sc.javascript.lines + sc.kotlin.lines + sc.fsharp.lines
+ sc.fortran.lines + sc.swift.lines + sc.csharp.lines + sc.nim.lines
+ sc.cpp_header.lines + sc.elisp.lines + sc.plaintext.lines
+ sc.rakefile.lines + sc.llvm.lines + sc.autoconf.lines + sc.batch.lines
+ sc.powershell.lines + sc.m4.lines + sc.objective_c.lines
+ sc.automake.lines, blanks = sc.rust.blanks + sc.haskell.blanks
+ sc.ats.blanks + sc.python.blanks + sc.vimscript.blanks + sc.elm.blanks
+ sc.idris.blanks + sc.madlang.blanks + sc.tex.blanks
+ sc.markdown.blanks + sc.yaml.blanks + sc.toml.blanks + sc.cabal.blanks
+ sc.happy.blanks + sc.alex.blanks + sc.go.blanks + sc.html.blanks
+ sc.css.blanks + sc.verilog.blanks + sc.vhdl.blanks + sc.c.blanks
+ sc.purescript.blanks + sc.futhark.blanks + sc.brainfuck.blanks
+ sc.ruby.blanks + sc.julia.blanks + sc.perl.blanks + sc.ocaml.blanks
+ sc.agda.blanks + sc.cobol.blanks + sc.tcl.blanks + sc.r.blanks
+ sc.lua.blanks + sc.cpp.blanks + sc.lalrpop.blanks + sc.header.blanks
+ sc.sixten.blanks + sc.dhall.blanks + sc.ipkg.blanks
+ sc.makefile.blanks + sc.justfile.blanks + sc.ion.blanks
+ sc.bash.blanks + sc.hamlet.blanks + sc.cassius.blanks
+ sc.lucius.blanks + sc.julius.blanks + sc.mercury.blanks
+ sc.yacc.blanks + sc.lex.blanks + sc.coq.blanks + sc.jupyter.blanks
+ sc.java.blanks + sc.scala.blanks + sc.erlang.blanks + sc.elixir.blanks
+ sc.pony.blanks + sc.clojure.blanks + sc.cabal_project.blanks
+ sc.assembly.blanks + sc.nix.blanks + sc.php.blanks
+ sc.javascript.blanks + sc.kotlin.blanks + sc.fsharp.blanks
+ sc.fortran.blanks + sc.swift.blanks + sc.csharp.blanks + sc.nim.blanks
+ sc.cpp_header.blanks + sc.elisp.blanks + sc.plaintext.blanks
+ sc.rakefile.blanks + sc.llvm.blanks + sc.autoconf.blanks
+ sc.batch.blanks + sc.powershell.blanks + sc.m4.blanks
+ sc.objective_c.blanks
+ sc.automake.blanks, comments = sc.rust.comments + sc.haskell.comments
+ sc.ats.comments + sc.python.comments + sc.vimscript.comments
+ sc.elm.comments + sc.idris.comments + sc.madlang.comments
+ sc.tex.comments + sc.markdown.comments + sc.yaml.comments
+ sc.toml.comments + sc.cabal.comments + sc.happy.comments
+ sc.alex.comments + sc.go.comments + sc.html.comments + sc.css.comments
+ sc.verilog.comments + sc.vhdl.comments + sc.c.comments
+ sc.purescript.comments + sc.futhark.comments + sc.brainfuck.comments
+ sc.ruby.comments + sc.julia.comments + sc.perl.comments
+ sc.ocaml.comments + sc.agda.comments + sc.cobol.comments
+ sc.tcl.comments + sc.r.comments + sc.lua.comments + sc.cpp.comments
+ sc.lalrpop.comments + sc.header.comments + sc.sixten.comments
+ sc.dhall.comments + sc.ipkg.comments + sc.makefile.comments
+ sc.justfile.comments + sc.ion.comments + sc.bash.comments
+ sc.hamlet.comments + sc.cassius.comments + sc.lucius.comments
+ sc.julius.comments + sc.mercury.comments + sc.yacc.comments
+ sc.lex.comments + sc.coq.comments + sc.jupyter.comments
+ sc.java.comments + sc.scala.comments + sc.erlang.comments
+ sc.elixir.comments + sc.pony.comments + sc.clojure.comments
+ sc.cabal_project.comments + sc.assembly.comments + sc.nix.comments
+ sc.php.comments + sc.javascript.comments + sc.kotlin.comments
+ sc.fsharp.comments + sc.fortran.comments + sc.swift.comments
+ sc.csharp.comments + sc.nim.comments + sc.cpp_header.comments
+ sc.elisp.comments + sc.plaintext.comments + sc.rakefile.comments
+ sc.llvm.comments + sc.autoconf.comments + sc.batch.comments
+ sc.powershell.comments + sc.m4.comments + sc.objective_c.comments
+ sc.automake.comments, files = sc.rust.files + sc.haskell.files
+ sc.ats.files + sc.python.files + sc.vimscript.files + sc.elm.files
+ sc.idris.files + sc.madlang.files + sc.tex.files + sc.markdown.files
+ sc.yaml.files + sc.toml.files + sc.cabal.files + sc.happy.files
+ sc.alex.files + sc.go.files + sc.html.files + sc.css.files
+ sc.verilog.files + sc.vhdl.files + sc.c.files + sc.purescript.files
+ sc.futhark.files + sc.brainfuck.files + sc.ruby.files + sc.julia.files
+ sc.perl.files + sc.ocaml.files + sc.agda.files + sc.cobol.files
+ sc.tcl.files + sc.r.files + sc.lua.files + sc.cpp.files
+ sc.lalrpop.files + sc.header.files + sc.sixten.files + sc.dhall.files
+ sc.ipkg.files + sc.makefile.files + sc.justfile.files + sc.ion.files
+ sc.bash.files + sc.hamlet.files + sc.cassius.files + sc.lucius.files
+ sc.julius.files + sc.mercury.files + sc.yacc.files + sc.lex.files
+ sc.coq.files + sc.jupyter.files + sc.java.files + sc.scala.files
+ sc.erlang.files + sc.elixir.files + sc.pony.files + sc.clojure.files
+ sc.cabal_project.files + sc.assembly.files + sc.nix.files
+ sc.php.files + sc.javascript.files + sc.kotlin.files + sc.fsharp.files
+ sc.fortran.files + sc.swift.files + sc.csharp.files + sc.nim.files
+ sc.cpp_header.files + sc.elisp.files + sc.plaintext.files
+ sc.rakefile.files + sc.llvm.files + sc.autoconf.files + sc.batch.files
+ sc.powershell.files + sc.m4.files + sc.objective_c.files
+ sc.automake.files }
in
f
end
// function to print tabular output at the end
fun make_table(isc : source_contents) : string =
"-------------------------------------------------------------------------------\n \33[35mLanguage\33[0m \33[35mFiles\33[0m \33[35mLines\33[0m \33[35mCode\33[0m \33[35mComments\33[0m \33[35mBlanks\33[0m\n-------------------------------------------------------------------------------\n"
+ maybe_table("Alex", isc.alex) + maybe_table("Agda", isc.agda)
+ maybe_table("Assembly", isc.assembly) + maybe_table("ATS", isc.ats)
+ maybe_table("Autoconf", isc.autoconf) + maybe_table( "Automake"
, isc.automake
) + maybe_table("Bash", isc.bash) + maybe_table( "Batch"
, isc.batch
)
+ maybe_table("Brainfuck", isc.brainfuck) + maybe_table("C", isc.c)
+ maybe_table("C Header", isc.header) + maybe_table( "C++ cpp_header"
, isc.cpp_header
) + maybe_table("C++", isc.cpp) + maybe_table("C#", isc.csharp)
+ maybe_table("Cabal", isc.cabal) + maybe_table( "Cabal Project"
, isc.cabal_project
) + maybe_table("Cassius", isc.cassius) + maybe_table( "COBOL"
, isc.cobol
)
+ maybe_table("Coq", isc.coq) + maybe_table("CSS", isc.css)
+ maybe_table("Dhall", isc.dhall) + maybe_table("Elixir", isc.elixir)
+ maybe_table("Elm", isc.elm) + maybe_table("Emacs Lisp", isc.elisp)
+ maybe_table("Erlang", isc.erlang) + maybe_table("F#", isc.fsharp)
+ maybe_table("Fortran", isc.fortran) + maybe_table("Go", isc.go)
+ maybe_table("Hamlet", isc.hamlet) + maybe_table("Happy", isc.happy)
+ maybe_table("Haskell", isc.haskell) + maybe_table("HTML", isc.html)
+ maybe_table("Idris", isc.idris) + maybe_table("iPKG", isc.ipkg)
+ maybe_table("Ion", isc.ion) + maybe_table("Java", isc.java)
+ maybe_table("JavaScript", isc.javascript) + maybe_table( "Julius"
, isc.julius
) + maybe_table("Julia", isc.julia) + maybe_table( "Jupyter"
, isc.jupyter
)
+ maybe_table("Justfile", isc.justfile) + maybe_table( "Kotlin"
, isc.kotlin
) + maybe_table("LALRPOP", isc.lalrpop) + maybe_table( "Lex"
, isc.lex
)
+ maybe_table("LLVM", isc.llvm) + maybe_table("Lua", isc.lua)
+ maybe_table("Lucius", isc.lucius) + maybe_table("M4", isc.m4)
+ maybe_table("Madlang", isc.madlang) + maybe_table( "Makefile"
, isc.makefile
) + maybe_table("Margaret", isc.margaret) + maybe_table( "Markdown"
, isc.markdown
)
+ maybe_table("Mercury", isc.mercury) + maybe_table("Nim", isc.nim)
+ maybe_table("Nix", isc.nix) + maybe_table( "Objective C"
, isc.objective_c
) + maybe_table("OCaml", isc.ocaml) + maybe_table("Perl", isc.perl)
+ maybe_table("PHP", isc.php) + maybe_table("Plaintext", isc.plaintext)
+ maybe_table("PowerShell", isc.powershell) + maybe_table( "Pony"
, isc.pony
) + maybe_table("Python", isc.python)
+ maybe_table("PureScript", isc.purescript) + maybe_table("R", isc.r)
+ maybe_table("Rakefile", isc.rakefile) + maybe_table("Ruby", isc.ruby)
+ maybe_table("Rust", isc.rust) + maybe_table("Scala", isc.scala)
+ maybe_table("Sixten", isc.sixten) + maybe_table("Swift", isc.swift)
+ maybe_table("TCL", isc.tcl) + maybe_table("TeX", isc.tex)
+ maybe_table("TOML", isc.toml) + maybe_table("Verilog", isc.verilog)
+ maybe_table("VHDL", isc.vhdl) + maybe_table( "Vimscript"
, isc.vimscript
) + maybe_table("Yacc", isc.yacc) + maybe_table("YAML", isc.yaml)
+ "-------------------------------------------------------------------------------\n"
+ maybe_table("Total", sum_fields(isc))
+ "-------------------------------------------------------------------------------\n"
// Function to print output sorted by type of language.
fun make_output(isc : source_contents) : string =
with_nonempty( "\33[33mProgramming Languages:\33[0m\n"
, maybe_string("Agda", isc.agda.lines) + maybe_string( "Assembly"
, isc.assembly.lines
) + maybe_string("ATS", isc.ats.lines)
+ maybe_string("Brainfuck", isc.brainfuck.lines) + maybe_string( "C"
, isc.c.lines
) + maybe_string( "C Header"
, isc.header.lines
) + maybe_string( "C++"
, isc.cpp.lines
)
+ maybe_string("C++ Header", isc.cpp_header.lines) + maybe_string( "C#"
, isc.csharp.lines
) + maybe_string( "COBOL"
, isc.cobol.lines
) + maybe_string( "Coq"
, isc.coq.lines
)
+ maybe_string("Elixir", isc.elixir.lines) + maybe_string( "Elm"
, isc.elm.lines
) + maybe_string("Erlang", isc.erlang.lines)
+ maybe_string("F#", isc.fsharp.lines) + maybe_string( "Fortran"
, isc.fortran.lines
) + maybe_string("Go", isc.go.lines)
+ maybe_string("Haskell", isc.haskell.lines) + maybe_string( "Idris"
, isc.idris.lines
) + maybe_string("Kotline", isc.kotlin.lines)
+ maybe_string("Java", isc.java.lines) + maybe_string( "Julia"
, isc.julia.lines
) + maybe_string("Lua", isc.lua.lines)
+ maybe_string("Margaret", isc.margaret.lines) + maybe_string( "Mercury"
, isc.mercury.lines
) + maybe_string("Nim", isc.nim.lines)
+ maybe_string("Objective C", isc.objective_c.lines)
+ maybe_string("OCaml", isc.ocaml.lines) + maybe_string( "Perl"
, isc.perl.lines
) + maybe_string("Pony", isc.pony.lines)
+ maybe_string("PureScript", isc.purescript.lines)
+ maybe_string("Python", isc.python.lines) + maybe_string( "R"
, isc.r.lines
) + maybe_string("Ruby", isc.ruby.lines)
+ maybe_string("Rust", isc.rust.lines) + maybe_string( "Scala"
, isc.scala.lines
) + maybe_string("Sixten", isc.sixten.lines)
+ maybe_string("Swift", isc.swift.lines) + maybe_string( "TCL"
, isc.tcl.lines
)
) + with_nonempty( "\n\33[33mEditor Plugins:\33[0m\n"
, maybe_string("Emacs Lisp", isc.elisp.lines)
+ maybe_string("Vimscript", isc.vimscript.lines)
) + with_nonempty( "\n\33[33mDocumentation:\33[0m\n"
, maybe_string("Markdown", isc.markdown.lines)
+ maybe_string("Plaintext", isc.plaintext.lines) + maybe_string( "TeX"
, isc.tex.lines
)
) + with_nonempty( "\n\33[33mConfiguration:\33[0m\n"
, maybe_string("Cabal", isc.cabal.lines)
+ maybe_string( "Cabal Project"
, isc.cabal_project.lines
) + maybe_string( "Dhall"
, isc.dhall.lines
) + maybe_string( "iPKG"
, isc.ipkg.lines
)
+ maybe_string("TOML", isc.toml.lines)
+ maybe_string("YAML", isc.yaml.lines)
) + with_nonempty( "\n\33[33mShell:\33[0m\n"
, maybe_string( "Bash"
, isc.bash.lines
)
+ maybe_string( "Batch"
, isc.batch.lines
) + maybe_string( "Ion"
, isc.ion.lines
)
+ maybe_string( "PowerShell"
, isc.powershell.lines
)
)
+ with_nonempty( "\n\33[33mParser Generators:\33[0m\n"
, maybe_string("Alex", isc.alex.lines) + maybe_string( "Happy"
, isc.happy.lines
) + maybe_string("LALRPOP", isc.lalrpop.lines)
+ maybe_string("Lex", isc.lex.lines) + maybe_string( "Yacc"
, isc.yacc.lines
)
) + with_nonempty( "\n\33[33mWeb:\33[0m\n"
, maybe_string("Cassius", isc.cassius.lines) + maybe_string( "CSS"
, isc.css.lines
) + maybe_string( "Hamlet"
, isc.hamlet.lines
)
+ maybe_string("HTML", isc.html.lines) + maybe_string( "JavaScript"
, isc.javascript.lines
) + maybe_string( "Julius"
, isc.julius.lines
)
+ maybe_string("Lucius", isc.lucius.lines)
) + with_nonempty( "\n\33[33mHardware:\33[0m\n"
, maybe_string("Verilog", isc.verilog.lines) + maybe_string( "VHDL"
, isc.vhdl.lines
)
) + with_nonempty( "\n\33[33mNotebooks:\33[0m\n"
, maybe_string("Jupyter", isc.jupyter.lines)
) + with_nonempty( "\n\33[33mOther:\33[0m\n"
, maybe_string( "Autoconf"
, isc.autoconf.lines
)
+ maybe_string( "Automake"
, isc.automake.lines
)
+ maybe_string( "Justfile"
, isc.justfile.lines
)
+ maybe_string( "LLVM"
, isc.llvm.lines
)
+ maybe_string("M4", isc.m4.lines)
+ maybe_string( "Madlang"
, isc.madlang.lines
)
+ maybe_string( "Makefile"
, isc.makefile.lines
)
+ maybe_string( "Rakefile"
, isc.rakefile.lines
)
)
fun add_contents(x : source_contents, y : source_contents) :
source_contents =
let
var next = @{ rust = x.rust + y.rust, haskell = x.haskell
+ y.haskell, ats = x.ats + y.ats, python = x.python
+ y.python, vimscript = x.vimscript + y.vimscript, elm = x.elm
+ y.elm, idris = x.idris + y.idris, madlang = x.madlang
+ y.madlang, tex = x.tex + y.tex, markdown = x.markdown
+ y.markdown, yaml = x.yaml + y.yaml, toml = x.toml
+ y.toml, cabal = x.cabal + y.cabal, happy = x.happy
+ y.happy, alex = x.alex + y.alex, go = x.go + y.go, html = x.html
+ y.html, css = x.css + y.css, verilog = x.verilog
+ y.verilog, vhdl = x.vhdl + y.vhdl, c = x.c
+ y.c, purescript = x.purescript + y.purescript, futhark = x.futhark
+ y.futhark, brainfuck = x.brainfuck + y.brainfuck, ruby = x.ruby
+ y.ruby, julia = x.julia + y.julia, perl = x.perl
+ y.perl, ocaml = x.ocaml + y.ocaml, agda = x.agda
+ y.agda, cobol = x.cobol + y.cobol, tcl = x.tcl + y.tcl, r = x.r
+ y.r, lua = x.lua + y.lua, cpp = x.cpp + y.cpp, lalrpop = x.lalrpop
+ y.lalrpop, header = x.header + y.header, sixten = x.sixten
+ y.sixten, dhall = x.dhall + y.dhall, ipkg = x.ipkg
+ y.ipkg, makefile = x.makefile + y.makefile, justfile = x.justfile
+ y.justfile, ion = x.ion + y.ion, bash = x.bash
+ y.bash, hamlet = x.hamlet + y.hamlet, cassius = x.cassius
+ y.cassius, lucius = x.lucius + y.lucius, julius = x.julius
+ y.julius, mercury = x.mercury + y.mercury, yacc = x.yacc
+ y.yacc, lex = x.lex + y.lex, coq = x.coq + y.coq, jupyter = x.jupyter
+ y.jupyter, java = x.java + y.java, scala = x.scala
+ y.scala, erlang = x.erlang + y.erlang, elixir = x.elixir
+ y.elixir, pony = x.pony + y.pony, clojure = x.clojure
+ y.clojure, cabal_project = x.cabal_project
+ y.cabal_project, assembly = x.assembly + y.assembly, nix = x.nix
+ y.nix, php = x.php + y.php, javascript = x.javascript
+ y.javascript, kotlin = x.kotlin + y.kotlin, fsharp = x.fsharp
+ y.fsharp, fortran = x.fortran + y.fortran, swift = x.swift
+ y.swift, csharp = x.csharp + y.csharp, nim = x.nim
+ y.nim, cpp_header = x.cpp_header + y.cpp_header, elisp = x.elisp
+ y.elisp, plaintext = x.plaintext + y.plaintext, rakefile = x.rakefile
+ y.rakefile, llvm = x.llvm + y.llvm, autoconf = x.autoconf
+ y.autoconf, batch = x.batch + y.batch, powershell = x.powershell
+ y.powershell, m4 = x.m4 + y.m4, objective_c = x.objective_c
+ y.objective_c, automake = x.automake
+ y.automake, margaret = x.margaret + y.margaret } : source_contents
in
next
end
// This is the step function used when streaming directory contents.
fun adjust_contents(prev : source_contents, scf : pl_type) :
source_contents =
let
val sc_r = ref<source_contents>(prev)
val _ = case+ scf of
| ~haskell n => sc_r->haskell := prev.haskell + n
| ~ats n => sc_r->ats := prev.ats + n
| ~rust n => sc_r->rust := prev.rust + n
| ~markdown n => sc_r->markdown := prev.markdown + n
| ~python n => sc_r->python := prev.python + n
| ~vimscript n => sc_r->vimscript := prev.vimscript + n
| ~yaml n => sc_r->yaml := prev.yaml + n
| ~toml n => sc_r->toml := prev.toml + n
| ~happy n => sc_r->happy := prev.happy + n
| ~alex n => sc_r->alex := prev.alex + n
| ~idris n => sc_r->idris := prev.idris + n
| ~madlang n => sc_r->madlang := prev.madlang + n
| ~elm n => sc_r->elm := prev.elm + n
| ~c n => sc_r->c := prev.c + n
| ~go n => sc_r->go := prev.go + n
| ~cabal n => sc_r->cabal := prev.cabal + n
| ~verilog n => sc_r->verilog := prev.verilog + n
| ~vhdl n => sc_r->vhdl := prev.vhdl + n
| ~html n => sc_r->html := prev.html + n
| ~css n => sc_r->css := prev.css + n
| ~purescript n => sc_r->purescript := prev.purescript + n
| ~futhark n => sc_r->futhark := prev.futhark + n
| ~brainfuck n => sc_r->brainfuck := prev.brainfuck + n
| ~ruby n => sc_r->ruby := prev.ruby + n
| ~julia n => sc_r->julia := prev.julia + n
| ~tex n => sc_r->tex := prev.tex + n
| ~perl n => sc_r->perl := prev.perl + n
| ~ocaml n => sc_r->ocaml := prev.ocaml + n
| ~agda n => sc_r->agda := prev.agda + n
| ~cobol n => sc_r->cobol := prev.cobol + n
| ~tcl n => sc_r->tcl := prev.tcl + n
| ~r n => sc_r->r := prev.r + n
| ~lua n => sc_r->lua := prev.lua + n
| ~cpp n => sc_r->cpp := prev.cpp + n
| ~lalrpop n => sc_r->lalrpop := prev.lalrpop + n
| ~header n => sc_r->header := prev.header + n
| ~sixten n => sc_r->sixten := prev.sixten + n
| ~dhall n => sc_r->dhall := prev.dhall + n
| ~ipkg n => sc_r->ipkg := prev.ipkg + n
| ~justfile n => sc_r->justfile := prev.justfile + n
| ~makefile n => sc_r->makefile := prev.makefile + n
| ~ion n => sc_r->ion := prev.ion + n
| ~bash n => sc_r->bash := prev.bash + n
| ~hamlet n => sc_r->hamlet := prev.hamlet + n
| ~cassius n => sc_r->cassius := prev.cassius + n
| ~lucius n => sc_r->lucius := prev.lucius + n
| ~julius n => sc_r->julius := prev.julius + n
| ~mercury n => sc_r->mercury := prev.mercury + n
| ~yacc n => sc_r->yacc := prev.yacc + n
| ~lex n => sc_r->lex := prev.lex + n
| ~coq n => sc_r->coq := prev.coq + n
| ~jupyter n => sc_r->jupyter := prev.jupyter + n
| ~java n => sc_r->java := prev.java + n
| ~scala n => sc_r->scala := prev.scala + n
| ~erlang n => sc_r->erlang := prev.erlang + n
| ~elixir n => sc_r->elixir := prev.elixir + n
| ~pony n => sc_r->pony := prev.pony + n
| ~clojure n => sc_r->clojure := prev.clojure + n
| ~cabal_project n => sc_r->cabal_project := prev.cabal_project + n
| ~assembly n => sc_r->assembly := prev.assembly + n
| ~nix n => sc_r->nix := prev.nix + n
| ~php n => sc_r->php := prev.php + n
| ~javascript n => sc_r->javascript := prev.javascript + n
| ~kotlin n => sc_r->kotlin := prev.kotlin + n
| ~fsharp n => sc_r->fsharp := prev.fsharp + n
| ~fortran n => sc_r->fortran := prev.fortran + n
| ~swift n => sc_r->swift := prev.swift + n
| ~csharp n => sc_r->csharp := prev.csharp + n
| ~nim n => sc_r->nim := prev.nim + n
| ~cpp_header n => sc_r->cpp_header := prev.cpp_header + n
| ~elisp n => sc_r->elisp := prev.elisp + n
| ~plaintext n => sc_r->plaintext := prev.plaintext + n
| ~rakefile n => sc_r->rakefile := prev.rakefile + n
| ~llvm n => sc_r->llvm := prev.llvm + n
| ~autoconf n => sc_r->autoconf := prev.autoconf + n
| ~batch n => sc_r->batch := prev.batch + n
| ~powershell n => sc_r->powershell := prev.powershell + n
| ~m4 n => sc_r->m4 := prev.m4 + n
| ~objective_c n => sc_r->objective_c := prev.objective_c + n
| ~automake n => sc_r->automake := prev.automake + n
| ~margaret n => sc_r->margaret := prev.margaret + n
| ~unknown _ => ()
in
!sc_r
end
fun free_pl(pl : pl_type) : void =
case+ pl of
| ~unknown _ => ()
| ~rust _ => ()
| ~haskell _ => ()
| ~perl _ => ()
| ~lucius _ => ()
| ~cassius _ => ()
| ~hamlet _ => ()
| ~julius _ => ()
| ~bash _ => ()
| ~coq _ => ()
| ~justfile _ => ()
| ~makefile _ => ()
| ~yaml _ => ()
| ~toml _ => ()
| ~dhall _ => ()
| ~ipkg _ => ()
| ~ion _ => ()
| ~mercury _ => ()
| ~yacc _ => ()
| ~lex _ => ()
| ~r _ => ()
| ~c _ => ()
| ~cpp _ => ()
| ~lua _ => ()
| ~lalrpop _ => ()
| ~header _ => ()
| ~sixten _ => ()
| ~java _ => ()
| ~scala _ => ()
| ~elixir _ => ()
| ~erlang _ => ()
| ~happy _ => ()
| ~alex _ => ()
| ~go _ => ()
| ~html _ => ()
| ~css _ => ()
| ~brainfuck _ => ()
| ~ruby _ => ()
| ~julia _ => ()
| ~elm _ => ()
| ~purescript _ => ()
| ~vimscript _ => ()
| ~ocaml _ => ()
| ~madlang _ => ()
| ~agda _ => ()
| ~idris _ => ()
| ~futhark _ => ()
| ~ats _ => ()
| ~tex _ => ()
| ~cabal _ => ()
| ~cobol _ => ()
| ~tcl _ => ()
| ~verilog _ => ()
| ~vhdl _ => ()
| ~markdown _ => ()
| ~python _ => ()
| ~pony _ => ()
| ~jupyter _ => ()
| ~clojure _ => ()
| ~cabal_project _ => ()
| ~assembly _ => ()
| ~nix _ => ()
| ~php _ => ()
| ~javascript _ => ()
| ~kotlin _ => ()
| ~fsharp _ => ()
| ~fortran _ => ()
| ~swift _ => ()
| ~csharp _ => ()
| ~nim _ => ()
| ~cpp_header _ => ()
| ~elisp _ => ()
| ~plaintext _ => ()
| ~rakefile _ => ()
| ~llvm _ => ()
| ~autoconf _ => ()
| ~batch _ => ()
| ~powershell _ => ()
| ~m4 _ => ()
| ~objective_c _ => ()
| ~automake _ => ()
| ~margaret _ => ()
// match a particular word against a list of keywords
fun match_keywords { m : nat | m <= 10 } ( keys : list(string, m)
, word : string
) : bool =
list_foldright_cloref( keys
, lam (next, acc) =<cloref1> acc || eq_string_string(next, word)
, false
)
// TODO use list_vt{int}(0, 1, 2, 3, 4) instead?
// helper function for check_keywords
fun step_keyword( size : file
, pre : pl_type
, word : string
, ext : string
) : pl_type =
case+ pre of
| unknown _ => let
in
case+ ext of
| "y" => let
val _ = free_pl(pre)
var happy_keywords = list_cons("module", list_nil())
in
if match_keywords(happy_keywords, word) then
happy(size)
else
if let
var yacc_keywords = list_cons( "struct"
, list_cons("char", list_cons("int", list_nil()))
)
in
match_keywords(yacc_keywords, word)
end then
yacc(size)
else
unknown
end
| "v" => let
var _ = free_pl(pre)
var verilog_keywords = list_cons( "endmodule"
, list_cons( "posedge"
, list_cons( "edge"
, list_cons("always", list_cons("wire", list_nil()))
)
)
)
in
if match_keywords(verilog_keywords, word) then
verilog(size)
else
if let
var coq_keywords = list_cons( "Qed"
, list_cons( "Require"
, list_cons( "Hypothesis"
, list_cons( "Inductive"
, list_cons( "Remark"
, list_cons( "Lemma"
, list_cons( "Proof"
, list_cons( "Definition"
, list_cons( "Theorem"
, list_nil()
)
)
)
)
)
)
)
)
)
in
match_keywords(coq_keywords, word)
end then
coq(size)
else
unknown
end
| "m" => let
val _ = free_pl(pre)
var mercury_keywords = list_cons( "module"
, list_cons("pred", list_cons("mode", list_nil()))
)
in
if match_keywords(mercury_keywords, word) then
mercury(size)
else
if let
var objective_c_keywords = list_cons( "nil"
, list_cons("nullable", list_cons("nonnull", list_nil()))
)
in
match_keywords(objective_c_keywords, word)
end then
objective_c(size)
else
unknown
end
| _ => pre
end
| _ => pre
// Function to disambiguate extensions such as .v (Coq and Verilog) and .m
// (Mercury and Objective C). This should only be called when extensions are in
// conflict, as it reads the whole file.
fun check_keywords(s : string, size : file, ext : string) : pl_type =
let
var ref = fileref_open_opt(s, file_mode_r)
in
case+ ref of
| ~Some_vt (x) => let
var init: pl_type = unknown
var viewstream = $EXTRA.streamize_fileref_word(x)
val result = stream_vt_foldleft_cloptr( viewstream
, init
, lam (acc, next) => step_keyword(size, acc, next, ext)
)
val _ = fileref_close(x)
in
result
end
| ~None_vt() => ( println!("\33[33mWarning:\33[0m could not open file at "
+ s)
; unknown
)
end
// Check shebang on scripts.
//
// TODO flexible parser that drops spaces as appropriate
// TODO check magic number so as to avoid checking shebang of binary file
fun check_shebang(s : string) : pl_type =
let
val ref = fileref_open_opt(s, file_mode_r)
val str: string = case+ ref of
| ~Some_vt (x) => let
val s = strptr2string(fileref_get_line_string(x))
val _ = fileref_close(x)
in
s
end
| ~None_vt() => ( println!("\33[33mWarning:\33[0m could not open file at "
+ s)
; ""
)
in
case+ str of
| "#!/usr/bin/env ion" => ion(line_count(s, Some("#")))
| "#!/usr/bin/env bash" => bash(line_count(s, Some("#")))
| "#!/bin/bash" => bash(line_count(s, Some("#")))
| "#!python" => python(line_count(s, Some("#")))
| "#!python2" => python(line_count(s, Some("#")))
| "#!python3" => python(line_count(s, Some("#")))
| "#!/usr/bin/env python" => python(line_count(s, Some("#")))
| "#!/usr/bin/env python2" => python(line_count(s, Some("#")))
| "#!/usr/bin/env python3" => python(line_count(s, Some("#")))
| "#!/usr/bin/env perl" => perl(line_count(s, Some("#")))
| "#!/usr/bin/env perl6" => perl(line_count(s, Some("#")))
| "#!/usr/bin/perl" => perl(line_count(s, Some("#")))
| "#!/usr/bin/env stack" => haskell(line_count(s, Some("--")))
| "#!/usr/bin/env runhaskell" => haskell(line_count(s, Some("--")))
| "#!/usr/bin/env node" => javascript(line_count(s, None))
| _ => unknown
end
// Match based on filename (for makefiles, etc.)
fun match_filename(s : string) : pl_type =
let
val (prf | str) = filename_get_base(s)
val match = $UN.strptr2string(str)
prval () = prf(str)
in
case+ match of
| "Makefile" => makefile(line_count(s, Some("#")))
| "Makefile.tc" => makefile(line_count(s, Some("#")))
| "makefile" => makefile(line_count(s, Some("#")))
| "GNUmakefile" => makefile(line_count(s, Some("#")))
| "Justfile" => justfile(line_count(s, Some("#")))
| "justfile" => justfile(line_count(s, Some("#")))
| "Rakefile" => rakefile(line_count(s, None))
| "cabal.project.local" => cabal_project(line_count(s, Some("--")))
| _ => check_shebang(s)
end
// Match based on file extension (assuming the file name is passed in as an
// argument).
fun prune_extension(s : string, file_proper : string) : pl_type =
let
val (prf | str) = filename_get_ext(file_proper)
val match: string = if strptr2ptr(str) > 0 then
$UN.strptr2string(str)
else
""
prval () = prf(str)
in
case+ match of
| "hs" => haskell(line_count(s, Some("--")))
| "hs-boot" => haskell(line_count(s, Some("--")))
| "hsig" => haskell(line_count(s, Some("--")))
| "rs" => rust(line_count(s, Some("//")))
| "tex" => tex(line_count(s, Some("%")))
| "md" => markdown(line_count(s, None))
| "markdown" => markdown(line_count(s, None))
| "dats" => ats(line_count(s, Some("//")))
| "hats" => ats(line_count(s, Some("//")))
| "cats" => ats(line_count(s, Some("//")))
| "sats" => ats(line_count(s, Some("//")))
| "py" => python(line_count(s, None))
| "fut" => futhark(line_count(s, Some("--")))
| "pl" => perl(line_count(s, None))
| "agda" => agda(line_count(s, Some("--")))
| "idr" => idris(line_count(s, Some("--")))
| "v" => check_keywords(s, line_count(s, Some("--")), match)
| "m" => check_keywords(s, line_count(s, None), match)
| "vhdl" => vhdl(line_count(s, None))
| "vhd" => vhdl(line_count(s, None))
| "go" => go(line_count(s, Some("//")))
| "vim" => vimscript(line_count(s, None))
| "ml" => ocaml(line_count(s, None))
| "purs" => purescript(line_count(s, None))
| "elm" => elm(line_count(s, Some("--")))
| "mad" => madlang(line_count(s, Some("#")))
| "toml" => toml(line_count(s, Some("#")))
| "cabal" => cabal(line_count(s, Some("--")))
| "yml" => yaml(line_count(s, Some("#")))
| "yaml" => yaml(line_count(s, Some("#")))
| "y" => check_keywords(s, line_count(s, None), match)
| "ypp" => yacc(line_count(s, Some("//")))
| "x" => alex(line_count(s, Some("--")))
| "l" => lex(line_count(s, None))
| "lpp" => lex(line_count(s, None))
| "html" => html(line_count(s, None))
| "htm" => html(line_count(s, None))
| "css" => css(line_count(s, None))
| "vhdl" => vhdl(line_count(s, None))
| "vhd" => vhdl(line_count(s, None))
| "c" => c(line_count(s, Some("//")))
| "b" => brainfuck(line_count(s, None))
| "bf" => brainfuck(line_count(s, None))
| "rb" => ruby(line_count(s, None))
| "cob" => cobol(line_count(s, None))
| "cbl" => cobol(line_count(s, None))
| "cpy" => cobol(line_count(s, None))
| "ml" => ocaml(line_count(s, None))
| "tcl" => tcl(line_count(s, None))
| "r" => r(line_count(s, None))
| "R" => r(line_count(s, None))
| "lua" => lua(line_count(s, None))
| "cpp" => cpp(line_count(s, Some("//")))
| "cc" => cpp(line_count(s, Some("//")))
| "lalrpop" => lalrpop(line_count(s, Some("//")))
| "h" => header(line_count(s, None))
| "vix" => sixten(line_count(s, Some("--")))
| "dhall" => dhall(line_count(s, None))
| "ipkg" => ipkg(line_count(s, Some("--")))
| "mk" => makefile(line_count(s, Some("#")))
| "hamlet" => hamlet(line_count(s, None))
| "cassius" => cassius(line_count(s, None))
| "lucius" => cassius(line_count(s, None))
| "julius" => julius(line_count(s, None))
| "jl" => julia(line_count(s, None))
| "ion" => ion(line_count(s, Some("#")))
| "bash" => bash(line_count(s, Some("#")))
| "ipynb" => jupyter(line_count(s, None))
| "java" => java(line_count(s, None))
| "scala" => scala(line_count(s, None))
| "erl" => erlang(line_count(s, None))
| "hrl" => erlang(line_count(s, None))
| "ex" => elixir(line_count(s, None))
| "exs" => elixir(line_count(s, None))
| "pony" => pony(line_count(s, None))
| "clj" => clojure(line_count(s, None))
| "s" => assembly(line_count(s, Some(";")))
| "S" => assembly(line_count(s, Some(";")))
| "asm" => assembly(line_count(s, Some(";")))
| "nix" => nix(line_count(s, None))
| "php" => php(line_count(s, None))
| "local" => match_filename(s)
| "project" => cabal_project(line_count(s, Some("--")))
| "js" => javascript(line_count(s, None))
| "jsexe" => javascript(line_count(s, None))
| "kt" => kotlin(line_count(s, None))
| "kts" => kotlin(line_count(s, None))
| "fs" => fsharp(line_count(s, None))
| "f" => fortran(line_count(s, None))
| "for" => fortran(line_count(s, None))
| "f90" => fortran(line_count(s, None))
| "f95" => fortran(line_count(s, None))
| "swift" => swift(line_count(s, None))
| "csharp" => csharp(line_count(s, None))
| "nim" => nim(line_count(s, None))
| "el" => elisp(line_count(s, None))
| "txt" => plaintext(line_count(s, None))
| "ll" => llvm(line_count(s, None))
| "in" => autoconf(line_count(s, Some("#")))
| "bat" => batch(line_count(s, None))
| "ps1" => powershell(line_count(s, None))
| "ac" => m4(line_count(s, None))
| "mm" => objective_c(line_count(s, Some("//")))
| "am" => automake(line_count(s, Some("#")))
| "mgt" => margaret(line_count(s, Some("--")))
| "" => match_filename(s)
| "sh" => match_filename(s)
| "yamllint" => match_filename(s)
| _ => unknown
end
// filter out directories containing artifacts
fun bad_dir(s : string, excludes : List0(string)) : bool =
case+ s of
| "." => true
| ".." => true
| ".pijul" => true
| "_darcs" => true
| ".hg" => true
| ".git" => true
| "target" => true
| ".egg-info" => true
| "nimcache" => true
| ".shake" => true
| "dist-newstyle" => true
| "dist" => true
| ".psc-package" => true
| ".pulp-cache" => true
| "output" => true
| "bower_components" => true
| "elm-stuff" => true
| ".stack-work" => true
| ".reco" => true
| ".reco-work" => true
| ".cabal-sandbox" => true
| "node_modules" => true
| ".lein-plugins" => true
| ".sass-cache" => true
| _ => list_exists_cloref(excludes, lam x => x = s || x = s + "/")
fnx step_stream( acc : source_contents
, full_name : string
, file_proper : string
, excludes : List0(string)
) : source_contents =
if test_file_isdir(full_name) != 0 then
flow_stream(full_name, acc, excludes)
else
adjust_contents(acc, prune_extension(full_name, file_proper))
and flow_stream( s : string
, init : source_contents
, excludes : List0(string)
) : source_contents =
let
var files = streamize_dirname_fname(s)
var ffiles = stream_vt_filter_cloptr( files
, lam x => not(bad_dir(x, excludes))
)
in
stream_vt_foldleft_cloptr( ffiles
, init
, lam (acc, next) => step_stream(acc, s + "/" + next, next, excludes)
)
end
fun empty_contents() : source_contents =
let
var isc = @{ rust = empty_file()
, haskell = empty_file()
, ats = empty_file()
, python = empty_file()
, vimscript = empty_file()
, elm = empty_file()
, idris = empty_file()
, madlang = empty_file()
, tex = empty_file()
, markdown = empty_file()
, yaml = empty_file()
, toml = empty_file()
, cabal = empty_file()
, happy = empty_file()
, alex = empty_file()
, go = empty_file()
, html = empty_file()
, css = empty_file()
, verilog = empty_file()
, vhdl = empty_file()
, c = empty_file()
, purescript = empty_file()
, futhark = empty_file()
, brainfuck = empty_file()
, ruby = empty_file()
, julia = empty_file()
, perl = empty_file()
, ocaml = empty_file()
, agda = empty_file()
, cobol = empty_file()
, tcl = empty_file()
, r = empty_file()
, lua = empty_file()
, cpp = empty_file()
, lalrpop = empty_file()
, header = empty_file()
, sixten = empty_file()
, dhall = empty_file()
, ipkg = empty_file()
, makefile = empty_file()
, justfile = empty_file()
, ion = empty_file()
, bash = empty_file()
, hamlet = empty_file()
, cassius = empty_file()
, lucius = empty_file()
, julius = empty_file()
, mercury = empty_file()
, yacc = empty_file()
, lex = empty_file()
, coq = empty_file()
, jupyter = empty_file()
, java = empty_file()
, scala = empty_file()
, erlang = empty_file()
, elixir = empty_file()
, pony = empty_file()
, clojure = empty_file()
, cabal_project = empty_file()
, assembly = empty_file()
, nix = empty_file()
, php = empty_file()
, javascript = empty_file()
, kotlin = empty_file()
, fsharp = empty_file()
, fortran = empty_file()
, swift = empty_file()
, csharp = empty_file()
, nim = empty_file()
, cpp_header = empty_file()
, elisp = empty_file()
, plaintext = empty_file()
, rakefile = empty_file()
, llvm = empty_file()
, autoconf = empty_file()
, batch = empty_file()
, powershell = empty_file()
, m4 = empty_file()
, objective_c = empty_file()
, automake = empty_file()
, margaret = empty_file()
} : source_contents
in
isc
end
fun map_stream( acc : source_contents
, includes : List0(string)
, excludes : List0(string)
) : source_contents =
list_foldleft_cloref( includes
, acc
, lam (acc, next) => if test_file_exists(next) || next = "" then
step_stream(acc, next, next, excludes)
else
(prerr("\33[31mError:\33[0m directory '" + next
+ "' does not exist\n") ; exit(1) ; acc)
)
fun is_flag(s : string) : bool =
string_is_prefix("-", s)
fun process_excludes(s : string, acc : command_line) : command_line =
let
val acc_r = ref<command_line>(acc)
val () = if is_flag(s) then
(println!("Error: flag " + s
+ " found where a directory name was expected") ; exit(0) ; ())
else
acc_r->excludes := list_cons(s, acc.excludes)
in
!acc_r
end
fun process(s : string, acc : command_line, is_first : bool) :
command_line =
let
val acc_r = ref<command_line>(acc)
val () = if is_flag(s) then
case+ s of
| "--help" => acc_r->help := true
| "-h" => acc_r->help := true
| "--no-table" => if not(acc.no_table) then
acc_r->no_table := true
else
(println!("\33[31mError:\33[0m flag " + s
+ " cannot appear twice") ; exit(0) ; ())
| "-t" => if not(acc.no_table) then
acc_r->no_table := true
else
(println!("\33[31mError:\33[0m flag " + s
+ " cannot appear twice") ; exit(0) ; ())
| "--parallel" => acc_r->parallel := true
| "-p" => acc_r->parallel := true
| "--version" => acc_r->version := true
| "-V" => acc_r->version := true
| "-e" => (println!("\33[31mError:\33[0m flag " + s
+ " must be followed by an argument") ; exit(0) ; ())
| "--exclude" => (println!("\33[31mError:\33[0m flag " + s
+ " must be followed by an argument") ; exit(0) ; ())
| _ => (println!("\33[31mError:\33[0m flag '" + s
+ "' not recognized") ; exit(0) ; ())
else
if not(is_first) then
acc_r->includes := list_cons(s, acc.includes)
else
()
in
!acc_r
end
fnx get_cli { n : int | n >= 1 }{ m : nat | m < n } .<n-m>.
( argc : int(n)
, argv : !argv(n)
, current : int(m)
, prev_is_exclude : bool
, acc : command_line
) : command_line =
let
var arg = argv[current]
in
if current < argc - 1 then
if arg != "--exclude" && arg != "-e" then
let
val c = get_cli(argc, argv, current + 1, false, acc)
in
if prev_is_exclude && current != 0 then
process_excludes(arg, c)
else
if current != 0 then
process(arg, c, current = 0)
else
c
end
else
let
val c = get_cli(argc, argv, current + 1, true, acc)
in
c
end
else
if prev_is_exclude then
process_excludes(arg, acc)
else
process(arg, acc, current = 0)
end
fun version() : void =
println!("polygot version 0.3.11\nCopyright (c) 2017 Vanessa McHale")
fun help() : void =
print("polyglot - Count lines of code quickly.
\33[36mUSAGE:\33[0m poly [DIRECTORY] ... [OPTION] ...
\33[36mFLAGS:\33[0m
-V, --version show version information
-h, --help display this help and exit
-e, --exclude exclude a directory
-p, --parallel execute in parallel
-t, --no-table display results in alternate format
When no directory is provided poly will execute in the
current directory.
Bug reports and updates: nest.pijul.com/vamchale/polyglot\n")
fun head(xs : List0(string)) : string =
case+ xs of
| list_cons (x, xs) => x + ", " + head(xs)
| list_nil() => ""
// TODO channel to draw work? e.g. take a channel of strings, return a channel of source_contents
fun work( excludes : List0(string)
, send : channel(List0(string))
, chan : channel(source_contents)
) : void =
{
val- (n) = channel_remove(send)
var x = map_stream(empty_contents(), n, excludes)
val () = channel_insert(chan, x)
val- ~None_vt() = channel_unref(chan)
val- () = case channel_unref<List0(string)>(send) of
| ~None_vt() => ()
| ~Some_vt (snd) => queue_free<List0(string)>(snd)
}
// Function returning the number of CPU cores.
extern
fun ncpu() : int
%{^
#include <unistd.h>
int ncpu() {
return sysconf(_SC_NPROCESSORS_ONLN);
}
%}
#define NCPU 4
fun apportion(includes : List0(string)) :
(List0(string), List0(string)) =
let
var n = length(includes) / 2
val (p, q) = list_split_at(includes, n)
in
(list_vt2t(p), q)
end
// TODO maybe make a parallel fold?
fun threads(includes : List0(string), excludes : List0(string)) :
source_contents =
let
val chan = channel_make<source_contents>(2)
val chan2 = channel_ref(chan)
val chan3 = channel_ref(chan)
val send1 = channel_make<List0(string)>(1)
val send2 = channel_make<List0(string)>(1)
val send_r1 = channel_ref(send1)
val send_r2 = channel_ref(send2)
var new_includes = if length(includes) > 0 then
includes
else
list_cons(".", list_nil())
val (fst, snd) = apportion(new_includes)
val _ = channel_insert(send1, fst)
val _ = channel_insert(send2, snd)
val t2 = athread_create_cloptr_exn(llam () => work( excludes
, send_r1
, chan2
))
val t3 = athread_create_cloptr_exn(llam () => work( excludes
, send_r2
, chan3
))
val- ~None_vt() = channel_unref(send1)
val- ~None_vt() = channel_unref(send2)
val- (n) = channel_remove(chan)
val- (m) = channel_remove(chan)
val () = ignoret(usleep(1u))
val () = while(channel_refcount(chan) >= 2)()
val r = add_contents(n, m)
val- ~Some_vt (que) = channel_unref<source_contents>(chan)
val () = queue_free<source_contents>(que)
in
r
end
implement main0 (argc, argv) =
let
val cli = @{ version = false
, help = false
, no_table = false
, parallel = false
, excludes = list_nil()
, includes = list_nil()
} : command_line
val parsed = get_cli(argc, argv, 0, false, cli)
in
if parsed.help then
(help() ; exit(0))
else
if parsed.version then
(version() ; exit(0))
else
let
val result = if parsed.parallel then
threads(parsed.includes, parsed.excludes)
else
if length(parsed.includes) > 0 then
map_stream(empty_contents(), parsed.includes, parsed.excludes)
else
map_stream( empty_contents()
, list_cons(".", list_nil())
, parsed.excludes
)
in
if parsed.no_table then
print(make_output(result))
else
print(make_table(result))
end
end