Various changes
Various changes including work define-dfa macro in Racket/DFA.rkt and implementations of church booleans in javascript, racket, and lazy racket. Also implemented various other church encoded types in javascript. Signed-off-by: Collin J. Doering <collin.doering@rekahsoft.ca>
This commit is contained in:
vecāks
c4021c52b2
revīzija
9c89ee6ac3
|
@ -4,7 +4,7 @@
|
|||
|
||||
(map (fn [x] (* x x)) '(0 1 2 3 4 5))
|
||||
|
||||
;; Example factorial function with accumulator (tail call)
|
||||
;; Example factorial function with accumulator (aridity overloading)
|
||||
(defn factorial
|
||||
([n]
|
||||
(factorial n 1))
|
||||
|
|
|
@ -0,0 +1,28 @@
|
|||
;; (C) Copyright Collin J. Doering 2014
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;; File: rdm.el
|
||||
;; Author: Collin J. Doering <collin.doering@rekahsoft.ca>
|
||||
;; Date: Nov 6, 2014
|
||||
|
||||
(defun hi-there (arg)
|
||||
"Says 'Hi there!' in the message buffer. If called with the prefix
|
||||
argument, prompts the user to enter a name and then replies 'Hi there, name'"
|
||||
(interactive "P")
|
||||
(if (equal arg '(4))
|
||||
(let ((name (read-from-minibuffer "Enter your name: ")))
|
||||
(message "Hi there, %s." name))
|
||||
(message "Hi there!")))
|
||||
|
|
@ -0,0 +1,375 @@
|
|||
/**
|
||||
* (C) Copyright Collin J. Doering 2015
|
||||
*
|
||||
* This program is free software: you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation, either version 3 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
/**
|
||||
* File: rdm.js
|
||||
* Author: Collin J. Doering <collin.doering@rekahsoft.ca>
|
||||
* Date: Feb 2, 2015
|
||||
*/
|
||||
|
||||
var church = (function () {
|
||||
var spec,
|
||||
t = function (x) {
|
||||
var ret = function (y) {
|
||||
return x;
|
||||
};
|
||||
return ret;
|
||||
},
|
||||
f = function (x) {
|
||||
var ret = function (y) {
|
||||
return y;
|
||||
};
|
||||
return ret;
|
||||
},
|
||||
church_zero = function (f) {
|
||||
var ret = function (x) {
|
||||
return x;
|
||||
};
|
||||
return ret;
|
||||
},
|
||||
nil;
|
||||
|
||||
// ------------------------------
|
||||
// Church Boolean implementation
|
||||
// ------------------------------
|
||||
|
||||
function make_bool (b) {
|
||||
if (b) {
|
||||
return t;
|
||||
} else {
|
||||
return f;
|
||||
}
|
||||
}
|
||||
|
||||
function unchurch_bool (b) {
|
||||
return b(true)(false);
|
||||
}
|
||||
|
||||
function and (x) {
|
||||
var ret = function (y) {
|
||||
return x(y)(x);
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function or (x) {
|
||||
var ret = function (y) {
|
||||
return x(x)(y);
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function not (x) {
|
||||
var ret = function (y) {
|
||||
var aret = function (z) {
|
||||
return x(z)(y);
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function xor (x) {
|
||||
var ret = function (y) {
|
||||
return x(not(y))(y);
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function church_if (p) {
|
||||
var ret = function (a) {
|
||||
var aret = function (b) {
|
||||
return p(a)(b);
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
// -----------------------
|
||||
// Church natural numbers
|
||||
// -----------------------
|
||||
|
||||
function succ (n) {
|
||||
var ret = function (f) {
|
||||
var aret = function (x) {
|
||||
return f(n(f)(x));
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function add (n) {
|
||||
var ret = function (m) {
|
||||
var aret = function (f) {
|
||||
var bret = function (x) {
|
||||
return n(f)(m(f)(x));
|
||||
};
|
||||
return bret;
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function mult (n) {
|
||||
var ret = function (m) {
|
||||
var aret = function (f) {
|
||||
var bret = function (x) {
|
||||
return n(m(f))(x);
|
||||
};
|
||||
return bret;
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function expt (n) {
|
||||
var ret = function (m) {
|
||||
var aret = function (f) {
|
||||
var bret = function (x) {
|
||||
return (m(n))(f)(x);
|
||||
};
|
||||
return bret;
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function isZero (n) {
|
||||
var ret = n(function (x) {
|
||||
return f;
|
||||
})(t);
|
||||
return ret;
|
||||
}
|
||||
|
||||
function make_nat (n) {
|
||||
var i, ret = church_zero.bind({});
|
||||
for (i = 0; i < n; i += 1) {
|
||||
ret = succ(ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
function unchurch_nat (n) {
|
||||
var ret = function (i) {
|
||||
var aret = function (m) {
|
||||
i += 1;
|
||||
return i;
|
||||
};
|
||||
return aret;
|
||||
}, i = 0;
|
||||
return n(ret(i))(0);
|
||||
}
|
||||
|
||||
// -------------
|
||||
// Church Pairs
|
||||
// -------------
|
||||
|
||||
function make_pair (a) {
|
||||
var ret = function (b) {
|
||||
var aret = function (f) {
|
||||
return f(a)(b);
|
||||
};
|
||||
return aret;
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function fst (p) {
|
||||
return p(t);
|
||||
}
|
||||
|
||||
function snd (p) {
|
||||
return p(f);
|
||||
}
|
||||
|
||||
function unchurch_pair (p) {
|
||||
return [fst(p), snd(p)];
|
||||
}
|
||||
|
||||
// -------------
|
||||
// Church Lists
|
||||
// -------------
|
||||
|
||||
function make_list () {}
|
||||
|
||||
function unchurch_list (xs) {}
|
||||
|
||||
nil = make_pair(t)(t);
|
||||
isNil = fst;
|
||||
|
||||
function cons (h) {
|
||||
var ret = function (t) {
|
||||
return make_pair(f)(make_pair(h)(t));
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function head (l) {
|
||||
return fst(snd(l));
|
||||
}
|
||||
|
||||
function tail (l) {
|
||||
return snd(snd(l));
|
||||
}
|
||||
|
||||
// -----------------
|
||||
// The Y Combinator
|
||||
// -----------------
|
||||
// * This doesn't work as javascript is strictly evaluated
|
||||
// -----------------
|
||||
|
||||
function fix (g) {
|
||||
var f = function (x) {
|
||||
return g(x(x));
|
||||
};
|
||||
return f(f);
|
||||
}
|
||||
|
||||
// Setup specification object
|
||||
spec = {
|
||||
"if": church_if,
|
||||
fix: fix,
|
||||
bool: {
|
||||
make: make_bool,
|
||||
toNative: unchurch_bool,
|
||||
t: t,
|
||||
f: f,
|
||||
not: not,
|
||||
and: and,
|
||||
or: or,
|
||||
xor: xor
|
||||
},
|
||||
nat: {
|
||||
make: make_nat,
|
||||
toNative: unchurch_nat,
|
||||
zero: church_zero,
|
||||
succ: succ,
|
||||
add: add,
|
||||
mult: mult,
|
||||
expt: expt,
|
||||
isZero: isZero
|
||||
},
|
||||
pair: {
|
||||
make: make_pair,
|
||||
toNative: unchurch_pair,
|
||||
fst: fst,
|
||||
snd: snd
|
||||
},
|
||||
list: {
|
||||
make: make_list,
|
||||
toNative: unchurch_list,
|
||||
nil: nil,
|
||||
isNil: isNil,
|
||||
cons: cons,
|
||||
head: head,
|
||||
tail: tail
|
||||
}
|
||||
};
|
||||
return spec;
|
||||
})();
|
||||
|
||||
// -------------------------
|
||||
|
||||
function unchurch_church_nat_test (lim) {
|
||||
var i,
|
||||
lim = lim || 12;
|
||||
for (i = 0; i <= lim; i += 1) {
|
||||
if (i !== church.nat.toNative(church.nat.make(i))) {
|
||||
console.log('Failed church.nat.toNative(church.nat.make(' + i + '))');
|
||||
return false;
|
||||
}
|
||||
}
|
||||
console.log('Created church nats from 1 to ' + lim + ' successfully.');
|
||||
return true;
|
||||
}
|
||||
|
||||
function uncurry (f) {
|
||||
var ret = function (x, y) {
|
||||
return f(x)(y);
|
||||
};
|
||||
return ret;
|
||||
}
|
||||
|
||||
function matrix_test (f, g, n, tp) {
|
||||
var i, j,
|
||||
t = tp || 100,
|
||||
name = n || "unnamed";
|
||||
for (i = 0; i <= t; i += 1) {
|
||||
for (j = 0; j <= t; j += 1) {
|
||||
if (f(i,j) !== g(i,j)) {
|
||||
console.log('Failed matrix test for ' + name + ' with inputs ' + i + ' and ' + j + '.');
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
console.log('Successfully completed test for ' + name + '.');
|
||||
return true;
|
||||
}
|
||||
|
||||
unchurch_church_nat_test(100);
|
||||
|
||||
matrix_test(function (a, b) {
|
||||
return a + b;
|
||||
}, function (a, b) {
|
||||
return church.nat.toNative(church.nat.add(church.nat.make(a))(church.nat.make(b)));
|
||||
}, "Test church addition");
|
||||
|
||||
// matrix_test(function (a, b) {
|
||||
// return a - b;
|
||||
// }, function (a, b) {
|
||||
// return church.nat.toNative(minus(church.nat.make(a))(church.nat.make(b)));
|
||||
// });
|
||||
|
||||
matrix_test(function (a, b) {
|
||||
return a * b;
|
||||
}, function (a, b) {
|
||||
return church.nat.toNative(church.nat.mult(church.nat.make(a))(church.nat.make(b)));
|
||||
}, "Test church multiplication");
|
||||
|
||||
// very slow for some reason? (not that this implementation will ever be)
|
||||
matrix_test(function (a, b) {
|
||||
return Math.pow(a, b);
|
||||
}, function (a, b) {
|
||||
return church.nat.toNative(church.nat.expt(church.nat.make(a))(church.nat.make(b)));
|
||||
}, "Test church exponentiation", 7);
|
||||
|
||||
|
||||
// -------------------------------------------------------
|
||||
// Factorial function written similar to how the y-combinator works
|
||||
function factorial (x) {
|
||||
var g = function (h) {
|
||||
var f = function (n) {
|
||||
if (n < 2) {
|
||||
return 1;
|
||||
} else {
|
||||
return n * h(h)(n - 1);
|
||||
}
|
||||
};
|
||||
return f;
|
||||
};
|
||||
return g(g)(x);
|
||||
}
|
||||
|
||||
var i;
|
||||
for (i = 0; i < 10; i += 1) {
|
||||
console.log(factorial(i));
|
||||
}
|
115
Racket/DFA.rkt
115
Racket/DFA.rkt
|
@ -43,12 +43,16 @@
|
|||
#:description "dfa state transition"
|
||||
(pattern (in (~optional ->) out:id)))
|
||||
|
||||
(define-syntax-class state
|
||||
(define-splicing-syntax-class state
|
||||
#:description "dfa state"
|
||||
(pattern (name:id (~optional (~seq (~and #:end end?))) trans:transition ...+)
|
||||
(pattern (name:id #:end trans:transition ...+)
|
||||
#:with end? #'#t
|
||||
#:with (in ...) #'(trans.in ...)
|
||||
#:with (out ...) #'(trans.out ...))
|
||||
(pattern (name:id trans:transition ...+)
|
||||
#:with end? #'#f
|
||||
#:with (in ...) #'(trans.in ...)
|
||||
#:with (out ...) #'(trans.out ...)))
|
||||
;; (pattern (name:id (~seq (~and #:end end2?)) (~optional (~and #:end end?))))
|
||||
|
||||
(syntax-parse stx
|
||||
[(_ name:id alpha:expr start:state rests:state ...)
|
||||
|
@ -56,59 +60,78 @@
|
|||
(syntax->list
|
||||
#'(start.name rests.name ...)))
|
||||
"duplicate state names"
|
||||
(with-syntax ([startSt (if (syntax->datum (attribute start.end?)) #'dfaStartEndState #'dfaStartState)]
|
||||
[restsSt (map (lambda (x) (if (syntax->datum x) #'dfaEndState #'dfaState)) (attribute rests.end?))])
|
||||
#'(define name
|
||||
(letrec ([start.name
|
||||
(dfaStartState
|
||||
(startSt
|
||||
(match-lambda [start.in start.out] ...))]
|
||||
[rests.name
|
||||
(dfaState
|
||||
((if rests.end? dfaEndState dfaState) ;restsSt
|
||||
(match-lambda [rests.in rests.out] ...))] ...)
|
||||
(dfa 'alpha start.name '(start.name rests.name ...))))]))
|
||||
(dfa 'alpha start.name '(start.name rests.name ...)))))]))
|
||||
|
||||
;; Todo:
|
||||
;; - error when 'in' pattern in the transition syntax class is not an element of alpha
|
||||
;; - error when given no end state
|
||||
;; - add keyword #:dead to create a dead state: (define-dfa n (0 1) (s0 #:dead))
|
||||
;; - check to ensure all transitions goto a valid state name; fail otherwise
|
||||
;; - check to ensure all transitions 'come from' a valid input; fail otherwise
|
||||
;; ----------------------------------------------------------------------------
|
||||
|
||||
(define-dfa odd-binary (0 1)
|
||||
[s0 (0 -> s0)
|
||||
(1 -> s1)]
|
||||
[s1 (0 -> s0)
|
||||
(1 -> s1)]
|
||||
[s2 #:end
|
||||
(0 -> s2)
|
||||
(1 -> s1)]
|
||||
[s3 #:dead (0 -> s3) (1 -> s3)])
|
||||
|
||||
;; Odd binary dfa expansion
|
||||
(define odd-dfa
|
||||
(letrec ([s0 (dfaStartState (match-lambda [0 s0]
|
||||
[1 s1]))]
|
||||
[s1 (dfaEndState (match-lambda [0 s0]
|
||||
[1 s1]))])
|
||||
(dfa '(0 1) s0 '(s0 s1))))
|
||||
;(define odd-dfa
|
||||
; (letrec ([s0 (dfaStartState (match-lambda [0 s0]
|
||||
; [1 s1]))]
|
||||
; [s1 (dfaEndState (match-lambda [0 s0]
|
||||
; [1 s1]))])
|
||||
; (dfa '(0 1) s0 '(s0 s1))))
|
||||
|
||||
;; Even binary dfa expansion
|
||||
(define even-dfa
|
||||
(letrec ([s0 (dfaStartState (match-lambda [0 s0]
|
||||
[1 s1]))]
|
||||
[s1 (dfaState (match-lambda [0 s2]
|
||||
[1 s1]))]
|
||||
[s2 (dfaEndState (match-lambda [0 s0]
|
||||
[1 s1]))])
|
||||
(dfa '(0 1) s0 '(s0 s1 s2))))
|
||||
;(define even-dfa
|
||||
; (letrec ([s0 (dfaStartEndState (match-lambda [0 s0]
|
||||
; [1 s1]))]
|
||||
; [s1 (dfaState (match-lambda [0 s0]
|
||||
; [1 s1]))])
|
||||
; (dfa '(0 1) s0 '(s0 s1 s2))))
|
||||
|
||||
;; Odd binary dfa macro
|
||||
;; (define-dfa odd-dfa (0 1)
|
||||
;; [s0 (0 -> s0)
|
||||
;; (1 -> s1)]
|
||||
;; [s1 end
|
||||
;; (0 -> s0)
|
||||
;; (1 -> s1)])
|
||||
;; Even binary DFA
|
||||
(define-dfa even-dfa (0 1)
|
||||
[s0 (0 -> s1)
|
||||
(1 -> s2)]
|
||||
[s1 #:end
|
||||
(0 -> s1)
|
||||
(1 -> s2)]
|
||||
[s2 (0 -> s1)
|
||||
(1 -> s2)])
|
||||
|
||||
;; ;; Even binary dfa macro
|
||||
;; (define-dfa even-dfa (0 1)
|
||||
;; [s0 (0 -> s0)
|
||||
;; (1 -> s1)]
|
||||
;; [s1 (0 -> s2)
|
||||
;; (1 -> s1)]
|
||||
;; [s2 end
|
||||
;; (0 -> s0)
|
||||
;; (1 -> s1)])
|
||||
;; Odd binary DFA
|
||||
(define-dfa odd-dfa (0 1)
|
||||
[s0 (0 -> s2)
|
||||
(1 -> s1)]
|
||||
[s1 #:end
|
||||
(0 -> s2)
|
||||
(1 -> s1)]
|
||||
[s2 (0 -> s2)
|
||||
(1 -> s1)])
|
||||
|
||||
;; Only epsilon (empty) DFA
|
||||
;; (define (empty-dfa name xs)
|
||||
;; (define-dfa name xs
|
||||
;; [s0 #:end
|
||||
;; (_ -> s1)]
|
||||
;; [s1 #:dead]))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Some simple tests
|
||||
|
||||
(define (integer->binary-list n)
|
||||
(define (ibl n acc)
|
||||
(cond [(zero? n) acc]
|
||||
[else (ibl (quotient n 2) (cons (modulo n 2) acc))]))
|
||||
(if (zero? n) '(0) (ibl n '())))
|
||||
|
||||
(for ([i 1000])
|
||||
(displayln (compute-dfa even-dfa (integer->binary-list i)))
|
||||
(displayln (compute-dfa odd-dfa (integer->binary-list i)))
|
||||
(newline))
|
||||
|
|
|
@ -0,0 +1,50 @@
|
|||
#lang lazy
|
||||
|
||||
;; Implementation of booleans with only the use of define and lambda
|
||||
|
||||
(define my-true (lambda (x)
|
||||
(lambda (y) x)))
|
||||
(define my-false (lambda (x)
|
||||
(lambda (y) y)))
|
||||
|
||||
(define (to-built-in-bool a)
|
||||
((a #t) #f))
|
||||
|
||||
(define (not a)
|
||||
(lambda (x)
|
||||
(lambda (y)
|
||||
((a y) x))))
|
||||
|
||||
(define (and-op a b)
|
||||
((a b) a))
|
||||
|
||||
(define (my-and . xs)
|
||||
(foldr and-op my-true xs))
|
||||
|
||||
(define (or-op a b)
|
||||
((a a) b))
|
||||
|
||||
(define (my-or . xs)
|
||||
(foldr or-op my-false xs))
|
||||
|
||||
;;
|
||||
;; Testing the functions
|
||||
;;
|
||||
|
||||
(displayln "Testing and: should output false then #f on the next line indicating and (as well as and-op) did not evaluate its second argument")
|
||||
(to-built-in-bool
|
||||
(my-and
|
||||
(begin (displayln 'false)
|
||||
my-false)
|
||||
(begin (displayln 'what)
|
||||
my-true)))
|
||||
|
||||
(newline)
|
||||
|
||||
(displayln "Testing or: should output true then #t on the next line indicating or (and or-op) did not evaluate its second argument")
|
||||
(to-built-in-bool
|
||||
(my-or
|
||||
(begin (displayln 'true)
|
||||
my-true)
|
||||
(begin (displayln 'what)
|
||||
my-false)))
|
|
@ -0,0 +1,74 @@
|
|||
#lang racket
|
||||
|
||||
;; (C) Copyright Collin J. Doering 2014
|
||||
;;
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;; File: church-booleans.rkt
|
||||
;; Author: Collin J. Doering <collin.doering@rekahsoft.ca>
|
||||
;; Date: Oct 28, 2014
|
||||
|
||||
;; Implementation of booleans with only the use of define and lambda
|
||||
|
||||
(define my-true (lambda (x)
|
||||
(lambda (y) x)))
|
||||
(define my-false (lambda (x)
|
||||
(lambda (y) y)))
|
||||
|
||||
(define (to-built-in-bool a)
|
||||
((a #t) #f))
|
||||
|
||||
(define (not a)
|
||||
(lambda (x)
|
||||
(lambda (y)
|
||||
(((a) y) x))))
|
||||
|
||||
(define (and-op a b)
|
||||
(let ([evaled-a (a)])
|
||||
((evaled-a (b)) evaled-a)))
|
||||
|
||||
(define (my-and . xs)
|
||||
(foldr and-op my-true xs))
|
||||
|
||||
(define (or-op a b)
|
||||
(let ([evaled-a (a)])
|
||||
((evaled-a evaled-a) (b))))
|
||||
|
||||
(define (my-or . xs)
|
||||
(foldr or-op my-false xs))
|
||||
|
||||
;; (lazy-fun (f x1 ... xn) body) => macro with name "f-lazy" generated which is like the lazy-funcall macro
|
||||
;; (lazy-funcall f x1 ... xn) ==> (f (lambda () x1) ... (lambda () xn))
|
||||
|
||||
;;
|
||||
;; Testing the functions
|
||||
;;
|
||||
|
||||
(displayln "Testing and: should output false then #f on the next line indicating and (as well as and-op) did not evaluate its second argument")
|
||||
(to-built-in-bool
|
||||
(my-and
|
||||
(begin (displayln 'false)
|
||||
my-false)
|
||||
(begin (displayln 'what)
|
||||
my-true)))
|
||||
|
||||
(newline)
|
||||
|
||||
(displayln "Testing or: should output true then #t on the next line indicating or (and or-op) did not evaluate its second argument")
|
||||
(to-built-in-bool
|
||||
(my-or
|
||||
(begin (displayln 'true)
|
||||
my-true)
|
||||
(begin (displayln 'what)
|
||||
my-false)))
|
|
@ -42,3 +42,16 @@
|
|||
(define-syntax (mylet2 stx)
|
||||
(syntax-parse stx
|
||||
[(_ ((var:id rhs:expr) ...) body ...+) #'((lambda (var ...) body ...) rhs ...)]))
|
||||
|
||||
(define-syntax (mycond stx)
|
||||
(syntax-parse stx #:datum-literals (else)
|
||||
[(_) #'(void)]
|
||||
[(_ (else en:expr)) #'en]
|
||||
[(_ (p e:expr) (p1 e1:expr) ...) #'(if p e (mycond (p1 e1) ...))]))
|
||||
|
||||
;; (module+ test
|
||||
;; (test-suite "mycond macro"
|
||||
;; (test-case "mycond basecase"
|
||||
;; (check-true (void? (mycond)) "mycond when called with no arguments should return void")
|
||||
;; (check-eq (mycond [else 'val]) 'val ""))
|
||||
;; (test-case "mycond else")))
|
||||
|
|
Notiek ielāde…
Atsaukties uz šo jaunā problēmā