1 ;;; tree.ils --- Solution to "how to convert a file to a list?" 2 3 ;; Copyright (C) 2013 Damien Diederen 4 5 ;; @author Damien Diederen <dd@crosstwine.com> 6 7 ;; Permission is hereby granted, free of charge, to any person 8 ;; obtaining a copy of this software and associated documentation 9 ;; files (the "Software"), to deal in the Software without 10 ;; restriction, including without limitation the rights to use, copy, 11 ;; modify, merge, publish, distribute, sublicense, and/or sell copies 12 ;; of the Software, and to permit persons to whom the Software is 13 ;; furnished to do so, subject to the following conditions: 14 ;; 15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 19 ;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN 20 ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 21 ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 ;; SOFTWARE. 23 24 ;;; Commentary: 25 26 ;; Cf. http://tech.groups.yahoo.com/group/skill_school/message/2262 27 ;; for a (succinct) description of the problem. Function 28 ;; MyTreeFromFile implements the requested functionality: 29 ;; 30 ;; (println (MyTreeFromFile "./my-file.dat")) 31 ;; => (a (b) c (d (f))) 32 ;; 33 ;; References: 34 ;; 35 ;; From: *redacted* 36 ;; Date: Sun, 06 Jan 2013 17:09:50 +0800 37 ;; Subject: how to convert a file to a list? 38 ;; List-Id: <skill_school.yahoogroups.com> 39 ;; Message-ID: <op.wqhfqojhuwf9wv@hamp-sz-0073.hamppcb.com> 40 41 ;;; Code: 42 43 (define MyTreeFromLiner nil) 44 (define MyTreeFromFile nil) 45 46 ;; Scope/hide utility functions and related data. 47 (let () 48 ;; Characters trimmed on the left and determining a particular 49 ;; line's "depth." 50 (define indentCharacterBag ".") 51 52 ;; Characters trimmed on the right. 53 (define chompCharacterBag "\n") 54 55 ;; According to the example, tree leaves ought to be symbols. 56 (defun TransformData (data) 57 (concat data)) 58 59 ;; TrimLeftIndex indicates how to trim the substring of string 60 ;; delimited by a and b to remove all leading characters contained 61 ;; in characterBag. 62 ;; 63 ;; Both a and b are inclusive. Use 1 and (strlen string) to trim 64 ;; the whole string. 65 ;; 66 ;; Returns the starting index in the resulting substring. 67 (defun TrimLeftIndex (characterBag string a b) 68 (while (and (a <= b) 69 (nindex characterBag (getchar string a))) 70 (setq a (a + 1))) 71 a) 72 73 ;; TrimLeftIndex indicates how to trim the substring of string 74 ;; delimited by a and b to remove all trailing characters contained 75 ;; in characterBag. 76 ;; 77 ;; Both a and b are inclusive. Use 1 and (strlen string) to trim 78 ;; the whole string. 79 ;; 80 ;; Returns the last index in the resulting substring. 81 (defun TrimRightIndex (characterBag string a b) 82 (while (and (a <= b) 83 (nindex characterBag (getchar string b))) 84 (setq b (b - 1))) 85 b) 86 87 ;; DepthAndData transforms a "raw" line into a list of two values: 88 ;; its integer depth, as indicated by the number of characters from 89 ;; indentCharacterBag, and the rest of the line, right-trimmed with 90 ;; chompCharacterBag. 91 (defun DepthAndData (line) 92 (letseq ((n (strlen line)) 93 (a (TrimLeftIndex indentCharacterBag line 1 n)) 94 (b (TrimRightIndex chompCharacterBag line a n))) 95 (list (a - 1) (substring line a (b - a + 1))))) 96 97 ;; EmptyTconc returns a new, empty "tconc structure." Used for code 98 ;; readability; cf. tconc's documentation for a description of tconc 99 ;; structures. 100 (defun EmptyTconc () 101 (list nil)) 102 103 ;; TconcData retrieves the newly-built list from "tconc structure" 104 ;; tc. Used for code readability; cf. tconc's documentation for a 105 ;; description of tconc structures. 106 (defun TconcData (tc) 107 (car tc)) 108 109 ;; Builds a tree from liner, a function which returns "raw" lines, 110 ;; or nil on "EOF." Cf. TreeFromFile and package commentary for 111 ;; details. 112 (defun TreeFromLiner (liner) 113 (let (;; Start with a single-level stack. Each stack level 114 ;; contains a "tconc structure" (cf. tconc's doc) holding 115 ;; the list being built. 116 (stack (list (EmptyTconc))) 117 ;; Current stack depth; accessing this is the same as 118 ;; calling (length stack), but faster. 119 (curDepth 1) 120 (line nil)) 121 (while (setq line (funcall liner)) 122 ;; Got a new raw line; split it into depth & data. 123 (let ((dnd (DepthAndData line))) 124 (let ((depth (car dnd)) 125 (data (TransformData (cadr dnd)))) 126 (cond 127 ((equal depth curDepth) 128 ;; Case 1: same level. No sweat, just append to the 129 ;; top of stack. 130 (let ((level (car stack))) 131 (tconc level data))) 132 ((equal depth (curDepth + 1)) 133 ;; Case 2: new level. Note that we add data to the new 134 ;; tconc structure *before* fetching its list and 135 ;; appending it to the old level; this means that both 136 ;; levels will share a pointer to the head of the list 137 ;; being built. 138 (let ((oldLevel (car stack)) 139 (newLevel (EmptyTconc))) 140 (tconc newLevel data) 141 (tconc oldLevel (TconcData newLevel)) 142 (push newLevel stack) 143 ;; Bookkeeping. 144 (setq curDepth depth))) 145 ((depth < curDepth) 146 ;; Case 3: backing up. This case is essentially the 147 ;; same as #1, except that we have to try and drop a 148 ;; number of levels first. 149 (while (depth < curDepth) 150 (pop stack) 151 (setq curDepth (curDepth - 1))) 152 (unless stack 153 (error "Stack underflow; line %L." line)) 154 (let ((level (car stack))) 155 (tconc level data))) 156 (t 157 ;; Some steps are missing in the data. One might want 158 ;; to extend case 2 to allow e.g.: 159 ;; 160 ;; .a 161 ;; .b 162 ;; ...c => (a (b ((c)))) 163 (error "Bad depth %L for line %L; current: %L." 164 depth line curDepth)))))) 165 (let ((topLevel (car (last stack)))) 166 ;; Note that we can just pick up the list as list pointers are 167 ;; shared--courtesy of our handling of case #2. 168 (TconcData topLevel)))) 169 170 (setq MyTreeFromLiner TreeFromLiner) 171 172 ;; Builds a "liner" (a function which returns "raw" lines and nil on 173 ;; EOF), from port. 174 (defun PortLiner (port) 175 (lambda () 176 (let (line) 177 (gets line port)))) 178 179 ;; Builds a tree (list of lists and symbols) by reading filename. 180 ;; 181 ;; Levels are determined by looking at the number of dots (which 182 ;; must be >= 1) in front of each line. The rest of each line, 183 ;; after the dots and up to the return carriage, if any, is 184 ;; transformed to a symbol and inserted as a leaf at the right 185 ;; position. Example: 186 ;; 187 ;; .a 188 ;; ..b 189 ;; .c => (a (b) c (d (f))) 190 ;; ..d 191 ;; ...f 192 ;; 193 ;; Cf. package commentary for additional details. 194 (defun TreeFromFile (filename) 195 (let ((port (or (infile filename) 196 (error "Cannot open %L for reading." filename)))) 197 (prog1 198 (TreeFromLiner (PortLiner port)) 199 (close port)))) 200 201 (setq MyTreeFromFile TreeFromFile)) 202 203 ;;; tree.ils ends here