deleted file mode 100755

@@ -1,30 +0,0 @@

-`cl-yaml` is a [libyaml](http://pyyaml.org/wiki/LibYAML)-based YAML parser for Common Lisp.

-

-# Usage

-

-```lisp

-CL-YAML> (yaml:parse #p"network/hosts.yaml")

-{"prod" => ("something.herokuapp.com" 6767), "db" => ("somewhere.org" 5432)}

-CL-YAML> (yaml:parse "{arch: x86-64, cc: clang, user: eudoxia}")

-{"arch" => "x86-64", "cc" => "clang", "user" => "eudoxia"}

-CL-USER> (yaml:emit (list "foo" "bar"))

-"[\"foo\", \"bar\"]"

-CL-USER> (yaml:emit '((a 1) (b 2) (c 3)))

-"[[A, 1], [B, 2], [C, 3]]"

-```

-

-[Hash table syntax](http://frank.kank.net/essays/hash.html) is used in the examples. I recommend at least using its hash table printer because the default is basically useless.

-

-# Installation

-

-You need `libyaml` for this to work.

-

-# License

-

-Copyright (C) 2013 Fernando Borretti

-

-Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

-

-The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

-

-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

deleted file mode 100644

@@ -1,11 +0,0 @@

-(defsystem cl-yaml-test

-  :author "Fernando Borretti"

-  :license "MIT"

-  :depends-on (:cl-yaml

-               :fiveam)

-  :components ((:module "t"

-                :serial t

-                :components

-                ((:file "cl-yaml")

-		 (:file "bench"))))

-  :perform (load-op :after (op c) (asdf:clear-system c)))

deleted file mode 100755

@@ -1,76 +0,0 @@

-(in-package :cl-user)

-(defpackage cl-yaml-asd

-  (:use :cl :asdf))

-(in-package :cl-yaml-asd)

-

-(defclass c->so (source-file) ())

-

-(defmethod source-file-type ((c c->so) (s module)) "c")

-

-(defmethod output-files ((operation compile-op) (f c->so))

-  (values

-    (list

-      (make-pathname :name "yaml_wrapper"

-                     :type #+unix "so" #+darwin "dylib" #+windows "dll"

-                     :defaults

-                     (merge-pathnames

-                      (make-pathname :directory '(:relative :up))

-                      (component-pathname f)))) t))

-

-(defmethod perform ((o load-op) (c c->so)) t)

-

-(defparameter +c-flags+ "-Wall -Wextra -c -fPIC -O0 -g")

-(defparameter +linker-flags+ "-lyaml")

-

-(defun comp (file out)

-  (format t "cc ~A -o out.o ~A && cc out.o -shared -o ~A ~A && rm out.o"

-          (namestring file) +c-flags+ (namestring out) +linker-flags+)

-  (format nil "cc ~A -o out.o ~A && cc out.o -shared -o ~A ~A && rm out.o"

-          (namestring file) +c-flags+ (namestring out) +linker-flags+))

-

-(defmethod perform ((o compile-op) (c c->so))

-  (if (not (zerop (run-shell-command

-                   (comp (make-pathname :name "yaml"

-                                        :type "c"

-                                        :defaults

-                                        (merge-pathnames

-                                         "src"

-                                         (component-pathname c)))

-                         (make-pathname :name "yaml_wrapper"

-                                        :type "so"

-                                        :defaults

-                                        (merge-pathnames

-                                         (make-pathname :directory '(:relative :up))

-                                         (component-pathname c)))))))

-      (error 'operation-error :component c :operation o)

-      t))

-

-(defsystem cl-yaml

-  :version "0.2"

-  :author "Fernando Borretti"

-  :license "MIT"

-  :depends-on (:cffi

-               :split-sequence)

-  :serial t

-  :components ((:module "src"

-                :serial t

-                :components

-                ((:static-file "yaml.h")

-                 (c->so "yaml" :depends-on ("yaml.h"))

-                 (:file "ffi")

-                 (:file "cl-yaml")))

-               (:module "spec"))

-  :description ""

-  :long-description

-  #.(with-open-file (stream (merge-pathnames

-                             #p"README.md"

-                             (or *load-pathname* *compile-file-pathname*))

-                            :if-does-not-exist nil

-                            :direction :input)

-      (when stream

-        (let ((seq (make-array (file-length stream)

-                               :element-type 'character

-                               :fill-pointer t)))

-          (setf (fill-pointer seq) (read-sequence seq stream))

-          seq)))

-  :in-order-to ((test-op (load-op cl-yaml-test))))

deleted file mode 100755

@@ -1,143 +0,0 @@

-(defpackage :yaml

-  (:use :cl :split-sequence :libyaml)

-  (:import-from :cffi

-                :with-foreign-string

-                :foreign-string-to-lisp)

-  (:export :parse

-           :emit))

-(in-package :yaml)

-

-(defun clean (tokens)

-  "I am not a clever man."

-  (remove-if

-   #'(lambda (tok)

-       (or (eq (first tok) :stream-start)

-           (eq (first tok) :stream-end)))

-   tokens))

-

-(defparameter *delimiters*

-  (list :seq-start :seq-end :map-start :map-end

-        :stream-start :stream-end :doc-start :doc-end))

-

-(defun group-documents (tokens)

-  (remove-if #'(lambda (seq)

-                 (or (eql (length seq) 0)

-                     (and (eql (length seq) 1)

-                          (member (first (elt seq 0))

-                                  *delimiters*))))

-             (split-sequence-if

-              #'(lambda (tok)

-                  (or (eq (first tok) :doc-start)

-                      (eq (first tok) :doc-end)))

-              tokens)))

-

-(defun process (str &optional (len (length str)))

-  (let ((tok-list (tokenize str len))

-        (tokens (make-array 64 :fill-pointer 0 :adjustable t)))

-    (if (list-err tok-list)

-        (error "Parsing error")

-        (progn

-          (loop for i from 0 to (list-len tok-list) do

-            (let* ((tok (nth-tok tok-list i))

-                   (type (gethash (tok-type tok) +enum+)))

-              (if type

-                  (progn

-                    (vector-push-extend (list type

-                                              (tok-value tok)

-                                              (tok-anchor tok))

-                                        tokens)

-                    (destroy-nth-tok tok-list i)))))

-          (destroy-token-list tok-list)

-          (group-documents (clean tokens))))))

-

-(defmacro with-preserved-case (&rest code)

-  `(unwind-protect

-     (progn

-       (setf (readtable-case *readtable*) :preserve)

-       ,@code)

-     (setf (readtable-case *readtable*) :upcase)))

-

-(defun extract-type (val)

-  (handler-case

-    (let ((res

-	   (if (position #\Space val)

-	       val

-	       (with-preserved-case

-	         (read-from-string val)))))

-      (if (symbolp res)

-	  (symbol-name res)

-	  res))

-    (error () val)))

-

-(defun parse% (documents)

-  (loop for tokens in documents collecting

-    (let ((contexts (list nil))

-          (aliases  (make-hash-table :test #'equal)))

-      (loop for tok across tokens do

-        (let ((type   (first tok))

-              (val    (second tok))

-              (anchor (third tok)))

-	  (cond

-	    ((eq type :seq-start)

-	     (push (list) contexts))

-	    ((eq type :seq-end)

-	     (let ((con (pop contexts)))

-	       (setf (first contexts) (append (first contexts) (list con)))))

-	    ((eq type :map-start)

-	     (push (list) contexts))

-	    ((eq type :map-end)

-	     (let ((con (pop contexts)))

-	       (setf (first contexts)

-                     (append (first contexts)

-                             (list

-                              (alexandria:plist-hash-table con :test #'equal))))))

-            ((eq type :alias)

-             (setf (gethash val aliases) (first contexts)))

-            (anchor

-             (setf (first contexts)

-                   (append (first contexts)

-                           (list (gethash val aliases)))))

-	    (t

-	     (setf (first contexts)

-                   (append (first contexts)

-                           (list (extract-type val))))))))

-             (caar contexts))))

-        

-(defun post-process (documents)

-  (if (cdr documents)

-      (mapcar #'(lambda (doc) (list :doc doc)) documents)

-      (car documents)))

-

-(defun slurp-stream (stream)

-  (let ((seq (make-string (file-length stream))))

-    (read-sequence seq stream)

-    seq))

-

-(defun parse (src)

-  (typecase src

-    (string

-     (post-process (parse% (process src (length src)))))

-    (pathname

-     (let ((str (with-open-file

-                    (stream src :direction :input :if-does-not-exist :error)

-                  (slurp-stream stream))))

-       (post-process

-        (parse%

-         (process str (length str))))))

-    (t

-      (error "Unknown input to yaml:load."))))

-

-(defun emit (obj)

-  (typecase obj

-    (number

-      (princ-to-string obj))

-    (string

-      (format nil "~S" obj))

-    (symbol

-      (format nil "~A" obj))

-    (list

-      (format nil "[~{~A~#[~:;, ~]~}]" (mapcar #'emit obj)))

-    (hash-table

-     (format nil "{~{~A~#[~:;, ~]~}}"

-	     (loop for key being the hash-keys of obj collecting

-		  (format nil "~A : ~A" key (gethash key obj)))))))

deleted file mode 100644

@@ -1,81 +0,0 @@

-(defpackage :libyaml

-  (:use :cl :cffi)

-  (:export :tokenize

-           :list-len

-           :list-err

-           :nth-tok

-           :destroy-nth-tok

-           :tok-type

-           :tok-value

-           :tok-anchor

-           :destroy-token-list

-           :+enum+

-           :+scalar+

-           :+alias+

-           :+seq-start+

-           :+seq-end+

-           :+map-start+

-           :+map-end+

-           :+doc-start+

-           :+doc-end+

-           :+stream-start+

-           :+stream-end+))

-(in-package :libyaml)

-

-(load-foreign-library

-  (namestring

-    (make-pathname :name "yaml_wrapper"

-                   :type #+unix "so" #+darwin "dylib" #+windows "dll"

-                   :defaults (asdf::component-relative-pathname

-                               (asdf:find-system :cl-yaml)))))

-

-(defcfun ("tokenize" tokenize) :pointer (str :string) (len :int))

-

-;; Accessors

-

-(defcfun ("list_len" list-len) :int (list :pointer))

-(defcfun ("nth_tok" nth-tok) :pointer (list :pointer) (n :int))

-(defcfun ("destroy_nth_tok" destroy-nth-tok) :void (list :pointer) (n :int))

-(defcfun ("list_err" list-err) :string (list :pointer))

-(defcfun ("tok_type" tok-type) :int (tok :pointer))

-(defcfun ("tok_value" tok-value) :string (tok :pointer))

-(defcfun ("tok_anchor" tok-anchor) :string (tok :pointer))

-

-(defcfun ("destroyTokenList" destroy-token-list) :void (list :pointer))

-

-;; Enum values

-

-(defcfun ("enum_scalar" enum-scalar) :int)

-(defcfun ("enum_alias" enum-alias) :int)

-(defcfun ("enum_seq_start" enum-seq-start) :int)

-(defcfun ("enum_seq_end" enum-seq-end) :int)

-(defcfun ("enum_map_start" enum-map-start) :int)

-(defcfun ("enum_map_end" enum-map-end) :int)

-(defcfun ("enum_doc_start" enum-doc-start) :int)

-(defcfun ("enum_doc_end" enum-doc-end) :int)

-(defcfun ("enum_stream_start" enum-stream-start) :int)

-(defcfun ("enum_stream_end" enum-stream-end) :int)

-

-(defparameter +enum+ (make-hash-table))

-

-(setf (gethash (enum-scalar) +enum+) :scalar)

-(setf (gethash (enum-alias) +enum+) :alias)

-(setf (gethash (enum-seq-start) +enum+) :seq-start)

-(setf (gethash (enum-seq-end) +enum+) :seq-end)

-(setf (gethash (enum-map-start) +enum+) :map-start)

-(setf (gethash (enum-map-end) +enum+) :map-end)

-(setf (gethash (enum-doc-start) +enum+) :doc-start)

-(setf (gethash (enum-doc-end) +enum+) :doc-end)

-(setf (gethash (enum-stream-start) +enum+) :stream-start)

-(setf (gethash (enum-stream-end) +enum+) :stream-end)

-

-(defparameter +scalar+ (enum-scalar))

-(defparameter +alias+ (enum-alias))

-(defparameter +seq-start+ (enum-seq-start))

-(defparameter +seq-end+ (enum-seq-end))

-(defparameter +map-start+ (enum-map-start))

-(defparameter +map-end+ (enum-map-end))

-(defparameter +doc-start+ (enum-doc-start))

-(defparameter +doc-end+ (enum-doc-end))

-(defparameter +stream-start+ (enum-stream-start))

-(defparameter +stream-end+ (enum-stream-end))

deleted file mode 100755

@@ -1,139 +0,0 @@

-#include "yaml.h"

-

-TokenList* createTokenList(void) {

-  TokenList* list = (TokenList*)malloc(sizeof(TokenList));

-  list->data = (Token*)malloc(sizeof(Token)*LIST_CHUNK_SIZE);

-  list->len = 0;

-  list->cap = LIST_CHUNK_SIZE;

-  list->err = NULL;

-  return list;

-}

-

-void appendToken(TokenList* list, Token tok) {

-  if((list->len + 1) == list->cap) {

-    list->cap += LIST_CHUNK_SIZE;

-    list->data = (Token*)realloc(list->data,list->cap*sizeof(Token));

-  }

-  list->data[list->len] = tok;

-  list->len++;

-}

-

-void destroyTokenList(TokenList* list) {

-  free(list->data);

-  free(list);

-}

-

-const char* copy(const char* source) {

-  return source;

-}

-

-TokenList* tokenize(const char* str, size_t len) {

-  /* Initialization */

-  yaml_parser_t parser;

-  yaml_event_t  event;

-  TokenList* tokens = createTokenList();

-

-  if(str == NULL) {

-    tokens->err = "Can't parse a null string.";

-    return tokens;

-  }

-  if(len == 0) {

-    tokens->err = "Can't parse a bstring with length zero.";

-    return tokens;

-  }

-  if(!yaml_parser_initialize(&parser)) {

-    tokens->err = "Could not initialize parser.";

-    return tokens;

-  }

-  yaml_parser_set_input_string(&parser, (const unsigned char*)str, len);

-

-  do {

-    Token tok;

-    size_t value_len = 0;

-    size_t anchor_len = 0;

-    tok.type = 0;

-    tok.value = NULL;

-    tok.anchor = NULL;

-    if(!yaml_parser_parse(&parser, &event)) {

-      tokens->err = "Parsing error";

-      return tokens;

-    }

-    tok.type = event.type;

-    switch(event.type) {

-    case YAML_SCALAR_EVENT:

-      tok.value = (char*)event.data.scalar.value;

-      tok.anchor = (char*)event.data.scalar.anchor;

-      if(tok.value) {

-        value_len = strlen(tok.value);

-        tok.value = malloc(value_len+1);

-        strcpy(tok.value, (const char*)event.data.scalar.value);

-      }

-      if(tok.anchor) {

-        anchor_len = strlen(tok.anchor);

-        tok.anchor = malloc(anchor_len+1);

-        strcpy(tok.anchor, (const char*)event.data.scalar.anchor);

-      }

-      break;

-    case YAML_ALIAS_EVENT:

-      tok.value = (char*)event.data.alias.anchor;

-      break;

-    default:

-      /* The token only carries type information */

-      break;

-    }

-    appendToken(tokens,tok);

-    if(event.type != YAML_STREAM_END_EVENT)

-      yaml_event_delete(&event);

-  } while(event.type != YAML_STREAM_END_EVENT);

-  

-  /* Finalize */

-  yaml_event_delete(&event);

-  yaml_parser_delete(&parser);

-

-  return tokens;

-}

-

-

-/* Accessors */

-

-size_t list_len(TokenList* list) {

-  return list->len;

-}

-

-Token* nth_tok(TokenList* list, size_t n) {

-  return &list->data[n];

-}

-

-void destroy_nth_tok(TokenList* list, size_t n) {

-  free(list->data[n].value);

-  free(list->data[n].anchor);

-}

-

-const char* list_err(TokenList* list) {

-  return list->err;

-}

-

-int tok_type(Token* tok) {

-  return tok->type;

-}

-

-const char* tok_value(Token* tok) {

-  return tok->value;

-}

-

-const char* tok_anchor(Token* tok) {

-  return tok->anchor;

-}

-

-/* Enum values */

-

-int enum_scalar() { return YAML_SCALAR_EVENT; }

-int enum_alias() { return YAML_ALIAS_EVENT; }

-int enum_seq_start() { return YAML_SEQUENCE_START_EVENT; }

-int enum_seq_end() { return YAML_SEQUENCE_END_EVENT; } 

-int enum_map_start() { return YAML_MAPPING_START_EVENT; }

-int enum_map_end() { return YAML_MAPPING_END_EVENT; }

-int enum_doc_start() { return YAML_DOCUMENT_START_EVENT; }

-int enum_doc_end() { return YAML_DOCUMENT_END_EVENT; }

-int enum_stream_start() { return YAML_STREAM_START_EVENT; }

-int enum_stream_end() { return YAML_STREAM_END_EVENT; }

deleted file mode 100644

@@ -1,52 +0,0 @@

-#include <yaml.h>

-#define LIST_CHUNK_SIZE 128

-

-typedef struct {

-  char* anchor;

-  char* value;

-  int type;

-} Token;

-

-/* To prevent frequent reallocations, lists initially

-  allocates space for 64 objects, and adds another 64

-  every time the list needs more space */

-

-/* TokenList */

-

-typedef struct {

-  Token* data;

-  size_t len;

-  size_t cap;

-  const char* err;

-} TokenList;

-

-TokenList* createTokenList(void);

-void appendToken(TokenList* list, Token tok);

-void destroyTokenList(TokenList* list);

-const char* copy(const char* source);

-

-TokenList* tokenize(const char* str, size_t len);

-

-

-/* Accessors */

-

-size_t list_len(TokenList* list);

-Token* nth_tok(TokenList* list, size_t n);

-void destroy_nth_tok(TokenList* list, size_t n);

-const char* list_err(TokenList* list);

-int tok_type(Token* tok);

-const char* tok_value(Token* tok);

-const char* tok_anchor(Token* tok);

-

-/* Enum values */

-

-int enum_scalar();

-int enum_alias();

-int enum_seq_start();

-int enum_seq_end();

-int enum_map_start();

-int enum_map_end();

-int enum_doc_start();

-int enum_doc_end();

-int enum_stream_start();

-int enum_stream_end();

deleted file mode 100644

@@ -1,23 +0,0 @@

-(in-package :yaml-test)

-

-(defun make-gen ()

-  (lambda () (random 99)))

-

-(defun generate-list (gen &optional (len 100))

-  (yaml:emit (loop repeat len collecting (funcall gen))))

-

-(defun benchmark (str)

-  (format t "Bytes: ~A~&Time to parse:~&" (length str))

-  (time (yaml:parse str))

-  (terpri))

-

-(defun benchmark-len (n)

-  (benchmark (generate-list (make-gen) n)))

-

-(defun run-benchmarks ()

-  (let ((gen (make-gen)))

-    (loop for i from 1 to 256 do

-	 (benchmark (generate-list (* 64 i))))))

-

-(export 'benchmark-len)

-(export 'run-benchmarks)

deleted file mode 100644

@@ -1,39 +0,0 @@

-(defpackage yaml-test

-  (:use :cl :fiveam)

-  (:import-from :yaml

-                :parse

-                :emit))

-(in-package :yaml-test)

-

-(def-suite yaml

-  :description "General unit tests.")

-

-(test finishes

-  (finishes

-    (parse "foo")

-    (parse "bar")

-    (parse "[1,2,3]")

-    (parse "[[a,b],[c,d]]")

-    (parse "{a : 1, b : 2, c : 3}")

-    (parse "{first : [1,2,{a : 1, b : 2}], second: {fst : a, snd : b}}")))

-

-(test flat-int

-  (is (equal (parse "[1,2,3]") (list 1 2 3))))

-

-(test flat-str

-  (is (equal (parse "[\"foo\",\"bar\"]") (list "foo" "bar"))))

-

-(test nested

-  (is (equal (parse "[[a,1],[b,2],[c,3]]")

-             (list (list "a" 1)

-                   (list "b" 2)

-                   (list "c" 3)))))

-

-(test flat-map

-  (is (equalp (parse "{a : 1, b : 2}")

-              (let ((map (make-hash-table :test #'equal)))

-                (setf (gethash "a" map) 1

-                      (gethash "b" map) 2)

-                map))))

-

-(run!)