Skip to content

Commit fe8c947

Browse files
thautwarmthautwarm
committed
done
1 parent d19a843 commit fe8c947

5 files changed

Lines changed: 412 additions & 4 deletions

File tree

‎.travis.yml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ os:
44
- linux
55
- osx
66
julia:
7-
- 1.0
7+
- 1.1
88
- nightly
99
matrix:
1010
allow_failures:
@@ -17,7 +17,7 @@ after_success:
1717
jobs:
1818
include:
1919
- stage: Documentation
20-
julia: 1.0
20+
julia: 1.1
2121
script: julia --project=docs -e '
2222
using Pkg;
2323
Pkg.develop(PackageSpec(path=pwd()));

‎Project.toml‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,9 @@ uuid = "d16e510f-c236-4b74-8eb3-5d2ec9a3ec6e"
33
authors = ["thautwarm"]
44
version = "0.1.0"
55

6+
[deps]
7+
MLStyle = "d8e11817-5142-5d16-987a-aa16d5891078"
8+
69
[compat]
710
julia = "1"
811

‎README.md‎

Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,101 @@
44
[![Dev](https://img.shields.io/badge/docs-dev-blue.svg)](https://thautwarm.github.io/ParameterisedModule.jl/dev)
55
[![Build Status](https://travis-ci.com/thautwarm/ParameterisedModule.jl.svg?branch=master)](https://travis-ci.com/thautwarm/ParameterisedModule.jl)
66
[![Codecov](https://codecov.io/gh/thautwarm/ParameterisedModule.jl/branch/master/graph/badge.svg)](https://codecov.io/gh/thautwarm/ParameterisedModule.jl)
7+
8+
9+
ML parameterised modules in Julia.
10+
11+
# APIs
12+
13+
- `@sig struct ... end` : define module signatures, like `sig` in OCaml.
14+
- `@structure struct ... end` : define module structures, like `struct` in OCaml.
15+
- `@open ModuleType Module` : using module, like `open` in OCaml.
16+
- `@open ModuleType Module body` : using module when evaluating `body`, like `let open` in OCaml.
17+
18+
# Non-Parametric Example
19+
20+
```julia
21+
using ParameterisedModule
22+
23+
# this is the module type declaration
24+
@sig struct NatAlgebra
25+
struct Eltype end # this is type declaration
26+
succ :: Function
27+
zero :: Eltype
28+
end
29+
30+
# make a module `num_nat`, whose module type is NatAlgebra
31+
num_nat = @structure struct NatAlgebra
32+
Eltype = Int
33+
succ(x) = x + 1
34+
zero = 0
35+
end
36+
37+
@open NatAlgebra num_nat begin
38+
println(succ(succ(zero))) # 2
39+
end
40+
41+
println(succ(succ(zero)))
42+
# ERROR: UndefVarError: succ not defined
43+
44+
str_nat = @structure struct NatAlgebra
45+
Eltype = String
46+
succ(x) = "succ($x)"
47+
zero = "zero"
48+
end
49+
50+
@open NatAlgebra str_nat begin
51+
println(succ(succ(zero))) # succ(succ(zero))
52+
end
53+
```
54+
55+
# Parametric Examples
56+
57+
```julia
58+
59+
Functor = Function
60+
@sig struct TF{Eltype}
61+
e :: Eltype
62+
end
63+
64+
TFZero(nat :: NatAlgebra) =
65+
@structure struct TF{nat.Eltype}
66+
e = nat.zero
67+
end
68+
69+
word_algebra =
70+
@structure struct NatAlgebra
71+
Eltype = Functor
72+
zero = TFZero
73+
succ(T1) =
74+
function (N::NatAlgebra)
75+
@structure struct TF{N.Eltype}
76+
e = N.succ(T1(N).e)
77+
end
78+
end
79+
end
80+
81+
@sig struct H
82+
h :: Function
83+
end
84+
85+
HTFC(N::NatAlgebra) =
86+
@structure struct H
87+
h(T) = T(N).e
88+
end
89+
90+
using Test
91+
@open H HTFC(num_nat) begin
92+
@test h(word_algebra.zero) == num_nat.zero
93+
94+
case(x::Functor) =
95+
h(word_algebra.succ(x)) == num_nat.succ(h(x))
96+
97+
words = Functor[TFZero]
98+
for i = 1:100
99+
push!(words, word_algebra.succ(words[end]))
100+
end
101+
@test all(words) do x; case(x) end
102+
end
103+
104+
```

‎src/ParameterisedModule.jl‎

Lines changed: 163 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,167 @@
11
module ParameterisedModule
2+
using MLStyle
23

3-
greet() = print("Hello World!")
4+
export @sig, @structure, @open, mk_signature, mk_structure, open_module, module_get, module_types, module_values
5+
6+
abstract type MLModule end
7+
8+
extract_tvar(var :: Union{Symbol, Expr})::Symbol =
9+
@match var begin
10+
:($a <: $_) => a
11+
:($a >: $_) => a
12+
:($_ >: $a >: $_) => a
13+
:($_ <: $a <: $_) => a
14+
a::Symbol => a
15+
end
16+
17+
function module_get end
18+
function module_values end
19+
function module_types end
20+
21+
function mk_signature(__source__, __module__, ex)
22+
@when :(struct $modtype; $(decls...) end) = ex begin
23+
typedecls = Symbol[]
24+
valsigs = Tuple{Symbol, Any}[]
25+
line = __source__
26+
(modn, modps) = @match modtype begin
27+
:($modn{$(modps...)}) => (modn, modps)
28+
modn::Symbol => (modn, [])
29+
a => error("invalid signature name $a")
30+
end
31+
foreach(decls) do decl
32+
@match decl begin
33+
:(struct $(n::Symbol); $(_...) end) => push!(typedecls, n)
34+
:($x :: $t) =>
35+
if x isa Symbol
36+
push!(valsigs, (x, t))
37+
else
38+
error("invalid value declaration $x, expect a Symbol.")
39+
end
40+
l::LineNumberNode => (line = l)
41+
a => error("invalid declaration $a")
42+
end
43+
end
44+
45+
valns = map(x -> x[1], valsigs)
46+
valts = map(x->x[2], valsigs)
47+
ex_valts = Expr(:curly, :Tuple, valts...)
48+
use_modps = map(extract_tvar, modps)
49+
50+
val_type_conflicts = [n in typedecls for n in valns]
51+
52+
any(val_type_conflicts) &&
53+
error("Name conflicts: names $val_type_conflicts in both types and values.")
54+
55+
@gensym Values
56+
@gensym values
57+
58+
fieldgetter = Expr[]
59+
60+
append!(fieldgetter, [
61+
:(
62+
$ParameterisedModule.module_get($values :: $modn, ::Val{$(QuoteNode(n))}) =
63+
getfield($values, $(QuoteNode(values)))[$i]
64+
)
65+
for (i, n) in enumerate(valns)
66+
])
67+
68+
append!(fieldgetter, [
69+
:(
70+
$ParameterisedModule.module_get(
71+
$values :: $modn{$(use_modps...),
72+
$(typedecls...)},
73+
$Values::Val{$(QuoteNode(n))}) where {$(use_modps...), $(typedecls...)} = $n
74+
)
75+
for n in typedecls
76+
])
77+
quote
78+
$__source__
79+
80+
struct $modn{
81+
$(modps...),
82+
$(typedecls...),
83+
$Values <: $ex_valts
84+
} <: $MLModule
85+
$values :: $Values
86+
end
87+
88+
$ParameterisedModule.module_types(::Type{$modn}) = $(Tuple(typedecls))
89+
$ParameterisedModule.module_values(::Type{$modn}) = $(Tuple(valns))
90+
91+
Base.getproperty($values :: $modn, $Values::Symbol) =
92+
$ParameterisedModule.module_get($values, Val{$Values}())
93+
94+
$(fieldgetter...)
95+
end
96+
@otherwise
97+
error("invalid signature")
98+
end
99+
end
100+
101+
function mk_structure(__source__, __module__, ex)
102+
@when :(struct $modtype; $(decls...) end) = ex begin
103+
line = __source__
104+
(modn, modps) = @match modtype begin
105+
:($modn{$(modps...)}) => (modn, modps)
106+
modn::Symbol => (modn, [])
107+
a => error("invalid signature name $a")
108+
end
109+
mod = __module__.eval(modn)
110+
type_ns = module_types(mod)
111+
value_ns = module_values(mod)
112+
body = Any[]
113+
for decl in decls
114+
@match decl begin
115+
Expr(:abstract, _...) || Expr(:struct, _...) => __module__.eval(decl)
116+
_ => push!(body, decl)
117+
end
118+
end
119+
120+
vals = Expr(:tuple, value_ns...)
121+
@gensym val
122+
push!(body,
123+
:(
124+
let $val = $vals
125+
$mod{$(modps...), $(type_ns...), typeof($val)}($val)
126+
end
127+
))
128+
Expr(:let, Expr(:block), Expr(:block, body...))
129+
@otherwise
130+
error("invalid structure")
131+
end
132+
end
133+
134+
macro sig(ex)
135+
__module__.eval(mk_signature(__source__, __module__, ex))
136+
end
137+
138+
macro structure(ex)
139+
esc(mk_structure(__source__, __module__, ex))
140+
end
141+
142+
function open_module(::Type{M}, m) where M <: MLModule
143+
value_ns = module_values(M)
144+
type_ns = module_types(M)
145+
ret = Expr[]
146+
for each in value_ns
147+
push!(ret, :($each = $m.$each))
148+
end
149+
for each in type_ns
150+
push!(ret, :($each = $m.$each))
151+
end
152+
ret
153+
end
154+
155+
macro open(mtype, m)
156+
esc(Expr(:block, open_module(__module__.eval(mtype), m)...))
157+
end
158+
159+
macro open(mtype, m, inner)
160+
esc(
161+
Expr(:let,
162+
Expr(:block, open_module(__module__.eval(mtype), m)...),
163+
inner
164+
))
165+
end
4166

5167
end # module

0 commit comments

Comments
 (0)