ats-format-0.1.0.24: test/data/polyglot.dats
#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