lispcommon-lisps-expression

How to convert a list of numbers to separated strings using Lisp?


Given the following code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Copyright (C) 2014  Wojciech Siewierski                               ;;
;;                                                                       ;;
;; 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/>. ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar *output*)
(defvar *indent*)

(defun format-tag (symbol &optional arg)
  (cond
    ((equal arg 'begin)
     (format nil "~{~a~}<~(~a~)" *indent* symbol))
    ((equal arg 'end)
     (format nil "~{~a~}<~(/~a~)>~%" *indent* symbol))
    (t
     (format nil "~{~a~}~a~%" *indent* symbol))))

(defun sexp-to-xml--inside-tag (sexp)
  (if sexp
      (if (listp (car sexp))
          (progn
            (sexp-to-xml--new-tag (car sexp))
            (sexp-to-xml--inside-tag (cdr sexp)))
          (progn
            (push (format-tag
                   (string (car sexp)))
                  *output*)
            (sexp-to-xml--inside-tag (cdr sexp))))))

(defun sexp-to-xml--attrs (plist)
  (when plist
    (push (format nil " ~(~a~)=~s"
                  (car plist)
                  (cadr plist))
          *output*)
    (sexp-to-xml--attrs (cddr plist))))

(defun sexp-to-xml--new-tag (sexp)
  (if (listp (car sexp))
      (progn
        (push (format-tag (caar sexp) 'begin)
              *output*)
        (sexp-to-xml--attrs (cdar sexp)))
      (push (format-tag (car sexp) 'begin)
            *output*))
  (unless (cdr sexp)
    (push (format nil " /")
          *output*))
  (push (format nil ">~%")
        *output*)
  (let ((*indent* (cons "  " *indent*)))
    (sexp-to-xml--inside-tag (cdr sexp)))
  (when (cdr sexp)
    (push (format-tag (if (listp (car sexp))
                          (caar sexp)
                          (car sexp))
                      'end)
          *output*)))

(defun sexp-to-xml-unquoted (&rest sexps)
  (apply #'concatenate 'string
         (apply #'concatenate 'list
                         (loop for sexp in sexps collecting
                              (let ((*output* nil)
                                    (*indent* nil))
                                (reverse (sexp-to-xml--new-tag  sexp)))))))

(defmacro sexp-to-xml (&rest sexps)
  `(format *standard-output* "~a"
           (sexp-to-xml-unquoted ,@(loop for sexp in sexps collecting
                                        `(quote ,sexp)))))
(defun file-get-contents (filename)
  (with-open-file (stream filename)
    (let ((contents (make-string (file-length stream))))
      (read-sequence contents stream)
      contents)))

(defun file-get-lines (filename)
  (with-open-file (stream filename)
    (loop for line = (read-line stream nil)
          while line
          collect line)))

(defun list-to-string (lst)
    (format nil "~{~A~}" lst))


(defun test1()
  (let((input (file-get-contents "sample2.sexp")))
    (format t (sexp-to-xml-unquoted (read-from-string "(head (title \"my-site\"))")))
  )
)

(defun test2()
  (let((input (file-get-lines "sample2.sexp")))
    (loop for sexp in input do (print (write-to-string sexp)))
  )
)

(defun test3()
  (let((input (file-get-lines "sample2.sexp")))
    (format t (list-to-string input))
  )
)


(defun :str->lst (str / i lst)
  (repeat (setq i (strlen str))
    (setq lst (cons (substr str (1+ (setq i (1- i))) 1) lst)))) 

(defun print-elements-recursively (list)
 (when list                            ; do-again-test
       (print (car list))              ; body
       (print-elements-recursively     ; recursive call
        (cdr list))))                  ; next-step-expression


(defun tokenize( str )(read-from-string (concatenate 'string "(" str
")")))


(defun test4()
  (let((input (file-get-contents "sample2.sexp")))
    (print-elements-recursively (tokenize input) )
  )
)


(defun test5()
  (let((input (file-get-contents "sample2.sexp")))
    (print (sexp-to-xml-unquoted (tokenize input)))
  )
)

(defun test6()
  (let((input (file-get-contents "sample2.sexp")))
    (loop for sexp in  (tokenize input) do (
      with-input-from-string (s (write-to-string sexp) ) 
        (print ( sexp-to-xml-unquoted (read s)) )

      )
    )
  )
)


(defun test7()
  (let((input (file-get-contents "sample2.sexp")))
    (loop for sexp in  (tokenize input) do (
      print sexp

      )
    )
  )
)

(defun test8()
  (let((input (file-get-contents "sample2.sexp")))
    (format t (sexp-to-xml-unquoted (read-from-string input)))
  )
)

I want to serialize into an xml file, specifically this sample file:

(supertux-tiles
  (tilegroup
    (name (_ "Snow"))
    (tiles
      7    8    9    202
      13   14   15   204
      10   11   12   206
      16   17   18   205

      30   31   114  113
      21   22   19   203
      20   23   207  208
      3044 3045 3046 3047
      3048 3049 3050 3051
      3052 3053 3054 3055
      3056 3057 3058 3059
      2134 115  116  214
      2135 117  118  1539

      3249 3250 3251 3252
      3253 3254 3255 3256
      3261 3262 3263 3264
      3265 3266 3267 3268

      2121 2122 2123 0
      2126 2127 2128 0
      2131 2132 2133 0
      2124 2125 0    0
      2129 2130 0    0

      2909 2910 2913 2914
      2911 2912 2915 2916
      1834    0    0 1835
      2917 2918 2921 2922
      2919 2920 2923 2924
         0 1826 1827    0
      1829 1830 1831 1832
      1833 1834 1835 1836
      3139 3140 3141 3142
      3143 3144 3145 3146
         0 3147 3148    0
      3149    0    0 3150
      3151 3152 3153 3154
      3155 3156 3157 3158
         0 1835 1834    0
      1837 1838 1843 1844
      1839 1840 1845 1846
      1841 1842 1847 1848
         0    0 1849 1850

      2925 2926 2929 2930
      0    2928 2931 0
      0    0    2937 2940
      2933 2935 2938 2941
      2934 2936 2939 2942

      2050 2051 2060 2061
      2055 2056 2065 2066
      2052 2053 2054 0
      2057 2058 2059 0
      2062 2063 2064 0
         0 2067 2068 2069
         0 2072 2073 2074
      2075 2079 2076 2070
      2077 2073 2078 2071

      2178 3038 3039 3040

      2406 3041 3042 3043

      2155 2156 2157 2163
      2158 2159 2154 2164
      2160 2161 2162 2165

      2166 2167 2168 2169
      2170 2171 2172 2173
      2174 2175 2176 2177

      2384 2385 2386 2949
      2387 2388 2389 2950
      2390 2391 2392 2951
      2393 2394 2395 2952
      2953 2954 2955 2956

      2957 2962 2398 2396
      2958 2961 2399 2397
      2959 2960 2997 2998

      0    0    2963 2969
      2975 2979 2964 2970
      2976 2980 2965 2971
      2977 2981 2966 2972
      2978 2982 2967 2973
      0    0    2968 2974
      0    2986 2990 0
      2983 2987 2991 2994
      2984 2988 2992 2995
      2985 2989 2993 2996
      33   32   34   1741
      35   37   39   1740
      38   36   43   1739
      40   41   42   1815
      119  121  120  1816
    )
  )
)

But using test8 it gives an error:

 7 is not a string designator.

Which led me to write a file like so:

(supertux-tiles (tilegroup (name (_ "Snow")) (tiles "7" ) ) )

Which then compiles fine and the xml is generated upon, but I don't know how to convert all the integers into their string representation, reading from the list. I tried parsing the string and using the write-to-string method but I think I'm missing something.

Any help will be grated.

Thanks!

-- EDIT --

Changing string with princ-to-string as coredump suggested fixes the parsing evaluation of raw numbers within the string, however, when attempting to evaluate symbols such as t this is what it happens:

no dispatch function defined for #\T

using as an example the following

(tile
    ; dupe of tile 70, this one will be removed.
    (id 63)
    (deprecated #t)
    (images
      "tilesets/background/backgroundtile1.png"
    )

  )

It looks, though, that evaluating to a variable outside Lisp will be kept by only checking for the "t" xml tag.

This got solved.


Solution

  • A quick search on google lead to the following repository (https://github.com/Vifon/sexp-to-xml/blob/master/sexp-to-xml.lisp); the linked code is enough to reproduce the error. Note that when I run it from inside Emacs/Slime, the debugger shows the backtrace:

      0: (STRING 7)
      1: (SEXP-TO-XML--INSIDE-TAG (7 8 9 202 13 14 ...))
      2: (SEXP-TO-XML--NEW-TAG (TILES 7 8 9 202 13 ...))
      3: (SEXP-TO-XML--INSIDE-TAG ((TILES 7 8 9 202 13 ...)))
      4: (SEXP-TO-XML--INSIDE-TAG ((NAME (_ "Snow")) (TILES 7 8 9 202 13 ...)))
      5: (SEXP-TO-XML--NEW-TAG (TILEGROUP (NAME (_ "Snow")) (TILES 7 8 9 202 13 ...)))
      6: (SEXP-TO-XML--INSIDE-TAG ((TILEGROUP (NAME #) (TILES 7 8 9 202 13 ...))))
      7: (SEXP-TO-XML--NEW-TAG (SUPERTUX-TILES (TILEGROUP (NAME #) (TILES 7 8 9 202 13 ...))))
      8: (SEXP-TO-XML-UNQUOTED (SUPERTUX-TILES (TILEGROUP (NAME #) (TILES 7 8 9 202 13 ...))))
    

    Pressing v on various stack frames listed above, I can locate the places where the code currently is halted across the call stack.

    I did not load a lisp file, but just evaluated the different forms in the current Emacs buffer, so there is no source file associated with functions. Yet, the AST form is stored for debugging purposes and the debugger can pinpoint where code execution currently is, wrapped in a fake (#:***HERE*** ...) form:

    (SB-INT:NAMED-LAMBDA SEXP-TO-XML--INSIDE-TAG
        (SEXP)
      (BLOCK SEXP-TO-XML--INSIDE-TAG
        (IF SEXP
            (IF (LISTP (CAR SEXP))
                (PROGN
                 (SEXP-TO-XML--NEW-TAG (CAR SEXP))
                 (SEXP-TO-XML--INSIDE-TAG (CDR SEXP)))
                (PROGN
                 (PUSH (FORMAT-TAG (#:***HERE*** (STRING (CAR SEXP)))) *OUTPUT*)
                 (SEXP-TO-XML--INSIDE-TAG (CDR SEXP)))))))
    

    Calling string on arbitrary values won't work, you need to replace that by princ-to-string in sexp-to-xml--inside-tag. Then it works as expected.