Enigma Machine in ATS

README.md

Enigma Machine in ATS

This is an Enigma Machine implementation in ATS programming language. Please visit this blog for more information.

License: GPL v3

enigma.dats

staload "util.sats"
staload "enigma.sats"
#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

#define ATS_DYNLOADFLAG 0

implement rotate_single (r) = let 
	val R (s, m, notch) = r
	val s = if s = 25 then 0 else s + 1
in 
	R (s, m, notch)
end

implement rotate_all (e) = let 

	fun step (low: rotor, high: rotor): (bool, rotor) = let 
		val R (s, m, n) = low
	in 
		if shift ('A', s) = n 
		then (true, rotate (high))
		else 
			if double_step (low, high) 
			then (true, rotate (high))
			else (false, high)
	end

	and double_step (low: rotor, high: rotor): bool = let 
		val R (sl, ml, nl) = low
		val R (sh, mh, nh) = high
	in 
		if shift ('A', sl) = shift (nl, 1) andalso shift ('A', sh) = shift (nh, ~1)
		then true
		else false
	end

	val E (r1, r2, r3, f, p) = e
	val r1 = rotate (r1)
	val (cont, r2) = step (r1, r2)
	val r3 = if cont then (step (r2, r3)).1 else r3
in 
	E (r1, r2, r3, f, p)
end

implement apply_all (e, c) = let
	val e = rotate (e)
	val E (r1, r2, r3, f, p) = e
	val c = apply_plugboard (p, c)
	val c = apply_rotor (r1, c)
	val c = apply_rotor (r2, c)
	val c = apply_rotor (r3, c)
	val c = apply_reflector (f, c)
	val c = apply_rotor_inverse (r3, c)
	val c = apply_rotor_inverse (r2, c)
	val c = apply_rotor_inverse (r1, c)
	val c = apply_plugboard (p, c)
in 
	(e, c)
end

implement apply_rotor (r, c) = let 
	val R (s, m, _) = r
	val c = shift (c, s)
	val c = cstring_get (m, c - 'A')
	val c = shift (c, ~s)
in 
	c 
end

implement apply_rotor_inverse (r, c) = let 
	val R (s, m, _) = r
	val c = shift (c, s)
	val i = cstring_indexof (m, c)
	val c = shift ('A', i)
	val c = shift (c, ~s)
in 
	c
end

implement apply_reflector (f, c) = let 
	val F (setting) = f
	val c = cstring_get (setting, c - 'A')
in 
	c 
end

implement apply_plugboard (p, c) = let 
	val P (setting) = p
	val c = cstring_get (setting, c - 'A')
in 
	c 
end

implement init (s1, s2, s3) = let 

	fun rotate_until (r: rotor, off: int): rotor = 
		if off = 0
		then r  
		else rotate_until (rotate (r), off - 1)

	val r1 = R (0, "EKMFLGDQVZNTOWYHXUSPAIBRCJ", 'R')
	val r2 = R (0, "AJDKSIRUXBLHWTMCQGZNPYFVOE", 'F')
	val r3 = R (0, "BDFHJLCPRTXVZNYEIWGAKMUSQO", 'W')
	val r1 = rotate_until (r1, s1 - 'A')
	val r2 = rotate_until (r2, s2 - 'A')
	val r3 = rotate_until (r3, s3 - 'A')

	val f = F ("YRUHQSLDPXNGOKMIEBFZCWVJAT")
	val p = P ("ABCDEFGHIJKLMNOPQRSTUVWXYZ")

in 
	E (r3, r2, r1, f, p)
end

implement encrypt (e, s) = let 
	val r = cstring_clone (s)

	fun foreach (e: enigma, s: string, i: int): (enigma, string) =
		if i >= cstring_len (s)
		then (e, s)
		else let 
			val c = cstring_get (s, i)
			val (e, c) = apply_all (e, c)
			val _ = cstring_set (s, i, c)
		in 
			foreach (e, s, i+1)
		end
in 
	foreach (e, r, 0)
end


implement main0 () = () where {

	val e = init ('A', 'A', 'A')
	val questi = "XWIAFZZLYYUPHZRHJUTDIYYRLNTTLPOAQTDHXXUPSYNXLFRJITNDEDOSJLZSYBTWIRQTNJTXADHLFQKKJHVEYHNVHHJBABQRWJPPSQEAQMIZADSASDASDASDASDASDASD"
	val (e, s) = encrypt (e, questi)
	val _ = println! s
	val answer = "GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGZNBKIRMWNXEUIPSBKQNNG"
	val _ = if cstring_cmp (answer, s) = 0 then println! "YES" else println! "NO"
}

enigma.sats

datatype rotor = R of (int, string, char)
datatype reflector = F of (string)
datatype plugboard = P of (string)
datatype enigma = E of (rotor, rotor, rotor, reflector, plugboard)


symintr rotate

fun rotate_single (rotor): rotor
fun rotate_all (enigma): enigma
overload rotate with rotate_single
overload rotate with rotate_all

fun apply_rotor (rotor, char): char
fun apply_rotor_inverse (rotor, char): char
fun apply_plugboard (plugboard, char): char 
fun apply_reflector (reflector, char): char
fun apply_all (enigma, char): (enigma, char)

fun init (char, char, char): enigma

fun encrypt (enigma, string): (enigma, string)

util.dats

staload "util.sats"


%{#
#include <string.h>

void cstring_set (char *str, int index, char c) {
	str[index] = c;
}

char cstring_get (char *str, int index) {
	return str[index];
}

char* cstring_append (char *str, char c) {
	int len = strlen(str);
	char *ret = (char *)malloc(sizeof(char) * (len+2));
	strcpy(ret, str);
	ret[len] = c;
	ret[len+1] = '\0';
	return ret;
}

char *cstring_tail (char *str) {
	int len = strlen(str);
	char *ret = (char *)malloc(sizeof(char) * len);
	memcpy(ret, str+1, len-1);
	ret[len-1] = '\0';
	return ret;
}

int cstring_indexof (char *str, char c) {
	int len = strlen(str);
	int i;
	for (i = 0; i < len; i++) {
		if (str[i] == c)
			return i;
	}
	return -1;
}

char* cstring_clone (char *str) {
	int len = strlen(str);
	char *ret = (char *)malloc(sizeof(char) * (len+1));
	memcpy(ret, str, len+1);
	return ret;
}

char shift (char c, int i) {
	return (c - 'A' + i + 26) % 26 + 'A';
}

%}

#define ATS_DYNLOADFLAG 0

util.sats

fun cstring_set (string, int, char): void = "mac#cstring_set"
fun cstring_len (string): int = "mac#strlen"
fun cstring_get (string, int): char = "mac#cstring_get"
fun cstring_append (string, char): string = "mac#cstring_append"
fun cstring_tail (string): string = "mac#cstring_tail"
fun cstring_indexof (string, char): int = "mac#cstring_indexof"
fun cstring_clone (string): string = "mac#cstring_clone"
fun shift (char, int): char = "mac#shift"
fun cstring_cmp (string, string): int = "mac#strcmp"