stefano / nyac

Not-Yet-Arc Compiler

This URL has Read+Write access

nyac / comp-utils.arc
100644 61 lines (48 sloc) 1.216 kb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
;;;; Copyright (c) 2008 Dissegna Stefano
;;;; Released under the terms of the GNU LGPL
 
(def read-from-file (file-name)
  nil)
 
(def listify (x)
  (if (consp x) x (list x)))
 
(def flatten-1 (l)
  (apply append (map listify l)))
 
(def mappend (f l)
  (if l
    (let res (f (car l))
      (if (atom res)
        (cons res (mappend f (cdr l)))
(append res (mappend f (cdr l)))))
    nil))
 
(def atom (x) (not (consp x)))
 
(def union (l1 l2)
  (if (not l1) l2
      (not (mem (car l1) l2)) (cons (car l1) (union (cdr l1) l2))
      (union (cdr l1) l2)))
 
(def map-union (f l)
  (if l
      (with (res (f (car l))
tail (map-union f (cdr l)))
(if (atom res)
(if (not (mem res tail))
(cons res tail)
tail)
(union res tail)))
      nil))
 
(def compose funcs
  (reduce (fn (x y) (fn (a) (x (y a)))) (cdr funcs) (car funcs)))
 
(def length=1 (l)
  (is (cdr l) nil))
 
(def keep (f l)
  (if l
    (if (f (car l))
      (cons (car l) (keep f (cdr l)))
      (keep f (cdr l)))))
 
(def some (f l)
  (if l
    (or (f (car l)) (some f (cdr l)))
    nil))
 
(def remove-duplicates (l)
  (if l
    (if (mem (car l) (cdr l))
      (remove-duplicates (cdr l))
      (cons (car l) (remove-duplicates (cdr l))))))