<commit_before>;; Copyright (c) 2015-2016 <NAME>
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

;; File    : cl.lfe
;; Author  : <NAME>, <NAME>
;; Purpose : LFE Common Lisp interface library.

(defmodule cl
  "LFE Common Lisp interface library."
  (export
   ;; Boolean conversion functions.
   (make-lfe-bool 1) (make-cl-bool 1)
   ;; Control structure.
   (mapcar 2) (maplist 2) (mapc 2) (mapl 2)
   ;; Symbol functions.
   (symbol-plist 1) (symbol-name 1)
   (get 2) (get 3) (getl 2) (putprop 3) (remprop 2)
   ;; Property list functions.
   (getf 2) (getf 3) (putf 3) (remf 2) (get-properties 2)
   ;; Sequences.
   (elt 2) (length 1) (reverse 1) (some 2) (every 2) (notany 2) (notevery 2)
   (reduce 2) (reduce 4) (reduce 6)
   (remove 2) (remove-if 2) (remove-if-not 2) (remove-duplicates 1)
   (substitute 3) (substitute-if 3) (substitute-if-not 3)
   (find 2) (find-if 2) (find-if-not 2)
   (position 2) (position-if 2) (position-if-not 2)
   (count 2) (count-if 2) (count-if-not 2)
   ;; Lists.
   (car 1) (cdr 1) (first 1) (rest 1) (nth 2)
   (nthcdr 2) (last 1) (butlast 1)
   ;; Substitution of expressions.
   (subst 3) (subst-if 3) (subst-if-not 3) (sublis 2)
   ;; Lists as sets.
   (member 2) (member-if 2) (member-if-not 2) (adjoin 2) (union 2)
   (intersection 2) (set-difference 2) (set-exclusive-or 2) (subsetp 2)
   ;; Association list functions.
   (acons 3) (pairlis 2) (pairlis 3) (assoc 2) (assoc-if 2) (assoc-if-not 2)
   (rassoc 2) (rassoc-if 2) (rassoc-if-not 2)
   ;; Types.
   (type-of 1) (coerce 2)
   ;; System
   (posix-argv 0))
  (export-macro
   ;; Export control structure macros.
   do
  ;; Export CL-style if and cond, which we don't use internally.
   if cond))

;;; Boolean conversion functions.

(defun make-lfe-bool                    ;Make an LFE bool from a CL value
  "cl-boolean
   Make an LFE bool from a CL value."
  ([()] 'false)
  ([_]  'true))                         ;Everything else is true

(defun make-cl-bool                     ;Make a CL bool from an LFE value
  "lfe-boolean
   Make a CL bool from an LFE value."
  (['false] ())
  (['true] 'true))

;; Control structure.

(defmacro do args
  "vars (end-test result) body"
  (let* ((`(,pars (,test ,ret) . ,body) args)
	 ((tuple vs is cs)
	  (lists:foldr (match-lambda
			 ([(list v i c) (tuple vs is cs)]
			  (tuple (cons v vs) (cons i is) (cons c cs))))
		       (tuple () () ()) pars)))
    `(letrec-function ((|\|-do-func-\||
			(lambda ,vs
			  (if ,test ,ret
			      (let ((do-state (progn . ,body)))
				(|\|-do-func-\|| . ,cs))))))
       (|\|-do-func-\|| . ,is))))

(defun mapcar (func list)
  "function list"
  (lists:map func list))

(defun maplist
  "function list"
  ([func (= (cons _ rest) list)]
   (cons (funcall func list) (maplist func rest)))
  ([func ()] ()))

(defun mapc (func list)
  "function list"
  (lists:foreach func list)
  list)

(defun mapl (func list)
  "function list"
  (fletrec ((mapl-loop
             ([(= (cons _ rest) list)]
              (funcall func list)
              (mapl-loop rest))
             ([()] ())))
    (mapl-loop list)
    list))

;; Symbol function functions.
;;  get, getl, putprop and remprop should really only work on a
;;  symbols plist not just a plist. This is coming. Hence including
;;  getf, putf and remf.

(defun ensure-plist-table ()
  (case (ets:info 'lfe-symbol-plist 'type)
    ('undefined
     (let ((init-pid (erlang:whereis 'init)))
       (ets:new 'lfe-symbol-plist
        (list 'set 'public 'named_table (tuple 'heir init-pid ())))))
    (_ 'ok)))

(defun symbol-plist (symbol)
  "symbol
   Get the property list for symbol."
  (ensure-plist-table)
  (case (ets:lookup 'lfe-symbol-plist symbol)
    (`(#(,_ ,plist)) plist)
    (() ())))

(defun symbol-name (symb)
  "symbol
   Get the name of symbol as a list."
  (atom_to_list symb))

(defun get (symbol pname)
  "symbol pname
   Get the property pname of symbol."
  (get symbol pname ()))

;;(defun get (plist pname def) (getf plist pname def))

(defun get (symbol pname def)
  "symbol pname default"
  (ensure-plist-table)
  (let ((plist (symbol-plist symbol)))
    (getf plist pname def)))

(defun getl (symbol pnames)
  "symbol pnames"
  (ensure-plist-table)
  (let ((plist (symbol-plist symbol)))
    (fletrec ((getl-loop
               ([(= (list* p v plist-rest) plist) pnames]
                (if (member p pnames)
                  plist
                  (getl-loop plist-rest pnames)))
               ([() pnames] ())))
      (getl-loop plist pnames))))

;; (defun putprop (plist val pname) (putf plist val pname))

(defun putprop (symbol val pname)
  "symbol value pname"
  (ensure-plist-table)
  (let* ((plist (symbol-plist symbol))
         (plist (putf plist val pname)))
    (ets:insert 'lfe-symbol-plist (tuple symbol plist))))

;; (defun getprop (plist pname) (remf plist pname))

(defun remprop (symbol pname)
  "symbol pname"
  (ensure-plist-table)
  (let* ((plist (symbol-plist symbol))
         (plist (remf plist pname)))
    ;; Delete element if plist empty
    (if (=:= plist ())
      (ets:delete 'lfe-symbol-plist symbol)
      (ets:insert 'lfe-symbol-plist (tuple symbol plist)))))

;; Property list functions.

(defun getf (plist pname)
  "plist pname"
  (getf plist pname ()))

(defun getf
  "plist pname default"
  ([(list* p v plist) p def]  v)
  ([(list* _ _ plist) pname def] (getf plist pname def))
  ([() _m def] def))

(defun putf                             ;This doesn't exist in CL
  "plist value pname"
  ([(list* p _ plist) val p]
   (list* p val plist))
  ([(list* p v plist) val pname]
   (list* p v (putf plist val pname)))
  ([() val pname] (list pname val)))

(defun remf
  "plist pname"
  ([(list* p _ plist) p] plist)
  ([(list* p v plist) pname]
   (list* p v (remf plist pname)))
  ([() pname] ()))

(defun get-properties
  "plist pnames"
  ([(= (list* p v plist-rest) plist) pnames]
   (if (member p pnames)
     (tuple p v plist)
     (get-properties plist-rest pnames)))
  ([() pnames] (tuple () () ())))

;; Arrays.

;; (defun aref (array i j)
;;   (elt j (elt i array)))

;; Sequences.
;; Simple sequence functions.

(defun elt
  ((n seq) (when (is_list seq))
   (nth n seq))
  ((n seq) (when (is_tuple seq))
   (tref seq (+ n 1))))

(defun length
  ([seq] (when (is_list seq))
   (length seq))
  ([seq] (when (is_tuple seq))
   (tuple_size seq)))

(defun reverse
  ([seq] (when (is_list seq))
   (lists:reverse seq))<commit_msg>Make sure we call system length not recursively call ourselves<commit_after>;; Copyright (c) 2015-2018 <NAME>
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

;; File    : cl.lfe
;; Author  : <NAME>, <NAME>
;; Purpose : LFE Common Lisp interface library.

(defmodule cl
  "LFE Common Lisp interface library."
  (export
   ;; Boolean conversion functions.
   (make-lfe-bool 1) (make-cl-bool 1)
   ;; Control structure.
   (mapcar 2) (maplist 2) (mapc 2) (mapl 2)
   ;; Symbol functions.
   (symbol-plist 1) (symbol-name 1)
   (get 2) (get 3) (getl 2) (putprop 3) (remprop 2)
   ;; Property list functions.
   (getf 2) (getf 3) (putf 3) (remf 2) (get-properties 2)
   ;; Sequences.
   (elt 2) (length 1) (reverse 1) (some 2) (every 2) (notany 2) (notevery 2)
   (reduce 2) (reduce 4) (reduce 6)
   (remove 2) (remove-if 2) (remove-if-not 2) (remove-duplicates 1)
   (substitute 3) (substitute-if 3) (substitute-if-not 3)
   (find 2) (find-if 2) (find-if-not 2)
   (position 2) (position-if 2) (position-if-not 2)
   (count 2) (count-if 2) (count-if-not 2)
   ;; Lists.
   (car 1) (cdr 1) (first 1) (rest 1) (nth 2)
   (nthcdr 2) (last 1) (butlast 1)
   ;; Substitution of expressions.
   (subst 3) (subst-if 3) (subst-if-not 3) (sublis 2)
   ;; Lists as sets.
   (member 2) (member-if 2) (member-if-not 2) (adjoin 2) (union 2)
   (intersection 2) (set-difference 2) (set-exclusive-or 2) (subsetp 2)
   ;; Association list functions.
   (acons 3) (pairlis 2) (pairlis 3) (assoc 2) (assoc-if 2) (assoc-if-not 2)
   (rassoc 2) (rassoc-if 2) (rassoc-if-not 2)
   ;; Types.
   (type-of 1) (coerce 2)
   ;; System
   (posix-argv 0))
  (export-macro
   ;; Export control structure macros.
   do
  ;; Export CL-style if and cond, which we don't use internally.
   if cond))

;;; Boolean conversion functions.

(defun make-lfe-bool                    ;Make an LFE bool from a CL value
  "cl-boolean
   Make an LFE bool from a CL value."
  ([()] 'false)
  ([_]  'true))                         ;Everything else is true

(defun make-cl-bool                     ;Make a CL bool from an LFE value
  "lfe-boolean
   Make a CL bool from an LFE value."
  (['false] ())
  (['true] 'true))

;; Control structure.

(defmacro do args
  "vars (end-test result) body"
  (let* ((`(,pars (,test ,ret) . ,body) args)
         ((tuple vs is cs)
          (lists:foldr (match-lambda
                         ([(list v i c) (tuple vs is cs)]
                          (tuple (cons v vs) (cons i is) (cons c cs))))
                       (tuple () () ()) pars)))
    `(letrec-function ((|\|-do-func-\||
                        (lambda ,vs
                          (if ,test ,ret
                              (let ((do-state (progn . ,body)))
                                (|\|-do-func-\|| . ,cs))))))
       (|\|-do-func-\|| . ,is))))

(defun mapcar (func list)
  "function list"
  (lists:map func list))

(defun maplist
  "function list"
  ([func (= (cons _ rest) list)]
   (cons (funcall func list) (maplist func rest)))
  ([func ()] ()))

(defun mapc (func list)
  "function list"
  (lists:foreach func list)
  list)

(defun mapl (func list)
  "function list"
  (fletrec ((mapl-loop
             ([(= (cons _ rest) list)]
              (funcall func list)
              (mapl-loop rest))
             ([()] ())))
    (mapl-loop list)
    list))

;; Symbol function functions.
;;  get, getl, putprop and remprop should really only work on a
;;  symbols plist not just a plist. This is coming. Hence including
;;  getf, putf and remf.

(defun ensure-plist-table ()
  (case (ets:info 'lfe-symbol-plist 'type)
    ('undefined
     (let ((init-pid (erlang:whereis 'init)))
       (ets:new 'lfe-symbol-plist
        (list 'set 'public 'named_table (tuple 'heir init-pid ())))))
    (_ 'ok)))

(defun symbol-plist (symbol)
  "symbol
   Get the property list for symbol."
  (ensure-plist-table)
  (case (ets:lookup 'lfe-symbol-plist symbol)
    (`(#(,_ ,plist)) plist)
    (() ())))

(defun symbol-name (symb)
  "symbol
   Get the name of symbol as a list."
  (atom_to_list symb))

(defun get (symbol pname)
  "symbol pname
   Get the property pname of symbol."
  (get symbol pname ()))

;;(defun get (plist pname def) (getf plist pname def))

(defun get (symbol pname def)
  "symbol pname default"
  (ensure-plist-table)
  (let ((plist (symbol-plist symbol)))
    (getf plist pname def)))

(defun getl (symbol pnames)
  "symbol pnames"
  (ensure-plist-table)
  (let ((plist (symbol-plist symbol)))
    (fletrec ((getl-loop
               ([(= (list* p v plist-rest) plist) pnames]
                (if (member p pnames)
                  plist
                  (getl-loop plist-rest pnames)))
               ([() pnames] ())))
      (getl-loop plist pnames))))

;; (defun putprop (plist val pname) (putf plist val pname))

(defun putprop (symbol val pname)
  "symbol value pname"
  (ensure-plist-table)
  (let* ((plist (symbol-plist symbol))
         (plist (putf plist val pname)))
    (ets:insert 'lfe-symbol-plist (tuple symbol plist))))

;; (defun getprop (plist pname) (remf plist pname))

(defun remprop (symbol pname)
  "symbol pname"
  (ensure-plist-table)
  (let* ((plist (symbol-plist symbol))
         (plist (remf plist pname)))
    ;; Delete element if plist empty
    (if (=:= plist ())
      (ets:delete 'lfe-symbol-plist symbol)
      (ets:insert 'lfe-symbol-plist (tuple symbol plist)))))

;; Property list functions.

(defun getf (plist pname)
  "plist pname"
  (getf plist pname ()))

(defun getf
  "plist pname default"
  ([(list* p v plist) p def]  v)
  ([(list* _ _ plist) pname def] (getf plist pname def))
  ([() _m def] def))

(defun putf                             ;This doesn't exist in CL
  "plist value pname"
  ([(list* p _ plist) val p]
   (list* p val plist))
  ([(list* p v plist) val pname]
   (list* p v (putf plist val pname)))
  ([() val pname] (list pname val)))

(defun remf
  "plist pname"
  ([(list* p _ plist) p] plist)
  ([(list* p v plist) pname]
   (list* p v (remf plist pname)))
  ([() pname] ()))

(defun get-properties
  "plist pnames"
  ([(= (list* p v plist-rest) plist) pnames]
   (if (member p pnames)
     (tuple p v plist)
     (get-properties plist-rest pnames)))
  ([() pnames] (tuple () () ())))

;; Arrays.

;; (defun aref (array i j)
;;   (elt j (elt i array)))

;; Sequences.
;; Simple sequence functions.

(defun elt
  ((n seq) (when (is_list seq))
   (nth n seq))
  ((n seq) (when (is_tuple seq))
   (tref seq (+ n 1))))

(defun length
  ([seq] (when (is_list seq))
   (erlang:length seq))                 ;To ensure we call system length
  ([seq] (when (is_tuple seq))
   (tuple_size seq)))

(defun reverse
  ([seq] (when (is_list seq))
   (lists:reverse seq))
{'fraction_non_alphanumeric': 0.1558478291613633, 'fraction_numerical': 0.012728044123886296, 'mean_word_length': 2.6917253980683893, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7001267', 'n_tokens_mistral': 5417, 'n_tokens_neox': 5027, 'n_words': 1716}