cl-awk-1/0042755000175000001440000000000007562767407011125 5ustar mrduserscl-awk-1/license.txt0100755000175000001440000000263307540243122013265 0ustar mrdusersCopyright (c) 2000,2001,2002 Kenneth Michael Parker All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-awk-1/clawk.translations0100755000175000001440000000022507446234174014655 0ustar mrdusers #+:Lispworks (setf (logical-pathname-translations "CLAWK") '(("CLAWK:SYS;*" "d:/lisp/*") ("CLAWK:SRC;*" "d:/lisp/clawk/*"))) cl-awk-1/clawk.system0100755000175000001440000000116207540244110013443 0ustar mrdusers;;; -*- Mode: Lisp; Syntax: ANSI-Common-lisp; Package: CL-USER; Base: 10 -*- (in-package "CL-USER") (load-logical-pathname-translations "CLAWK") (mk:defsystem "CLAWK" :source-extension "lisp" :source-pathname (translate-logical-pathname "CLAWK:SRC;") :depends-on ("REGEX") :components ( (:file "packages") (:file "clawk" :depends-on ("packages")) (:file "clawktest" :depends-on ("packages" "clawk")))) (defun lc-clawk () (mk:compile-system "CLAWK")) (defun ld-clawk () (mk:load-system "CLAWK")) cl-awk-1/packages.lisp0100755000175000001440000000471707540241432013560 0ustar mrdusers;;; -*- Mode: Lisp; Syntax: Common-Lisp; Base: 10 -*- (defpackage CLAWK #+:Genera (:use COMMON-LISP CLOS REGEX) #-:Genera (:use COMMON-LISP REGEX) #+:Genera (:import-from "SCL" DEFINE-SYMBOL-MACRO) (:export ;; install the #/../ reader "INSTALL-REGEX-SYNTAX" ;; convert any accepted representation of a pattern into a compiled pattern "GET-MATCHER-FOR-PATTERN" ;; Specials "*CURFILE*" "*CURLINE*" "*FS*" "*RSTART*" "*RLENGTH*" "*REND*" "*REGS*" "*FIELDS*" "*NR*" "*FNR*" "*NF*" "*SUBSEP*" "*LAST-MATCH*" "*LAST-SUCCESSFUL-MATCH*" ;; AWK-like functions "SUB" "GSUB" "SPLIT" "INDEX" "MATCH" "SUBSTR" ;; Handy macros "WITH-PATTERNS" "WITH-FIELDS" "WITH-REGS" "WITH-SUBMATCHES" "IF-MATCH" "WITH-MATCH" "MATCH-CASE" "MATCH-WHEN" "TOKENIZE" ;; iterate across a stream or file, evaluating the body for each ;; line "FOR-STREAM-LINES" "FOR-FILE-LINES" ;; iterate across a stream or file, splitting the lines and ;; evaluating the body for each line "FOR-STREAM-FIELDS" "FOR-FILE-FIELDS" ;; iterate across the lines in a stream or file, splitting the lines ;; and evaluating the AWK-like clauses for each line. "WHEN-STREAM-FIELDS" "WHEN-FILE-FIELDS" ;; define a function on a set of files that closely mimics the ;; structure of an AWK program. "DEFAWK" ;; handy generic functions "$+" "$-" "$*" "$/" "$REM" "$++" "$==" "$<" "$>" "$<=" "$>=" "$/=" "$MIN" "$MAX" "$ZEROP" "$LENGTH" ;; arithmetic functions "$ATAN2" "$COS" "$SIN" "$EXP" "$EXPT" "$INT" "$LOG" "$SQRT" "$SRAND" "$RAND" ;; AWK-like I/O "$PRINT" "$FPRINT" ;; hashtable-based "arrays" "$ARRAY" "$AREF" "$FOR" "$IN" "$DELETE" ;; Fields access. These don't follow the *..* convention, but they ;; still stand out visually, so I think the goal of that convention ;; is still met "$N" "$0" "$1" "$2" "$3" "$4" "$5" "$6" "$7" "$8" "$9" "$10" "$11" "$12" "$13" "$14" "$15" "$16" "$17" "$18" "$19" "$20" ;; Coercion routines, although the generic functions above reduce ;; the need for them. "STR" "NUM" "INT" ;; Register access. "%N" "%0" "%1" "%2" "%3" "%4" "%5" "%6" "%7" "%8" "%9" "%10" "%11" "%12" "%13" "%14" "%15" "%16" "%17" "%18" "%19" "%20" )) (defpackage CLAWK-TEST (:use COMMON-LISP CLAWK)) (defun delete-clawk () (delete-package :CLAWK-TEST) (delete-package :CLAWK)) cl-awk-1/clawk.lisp0100755000175000001440000011330607454462436013113 0ustar mrdusers;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CLAWK; Base: 10 -*- (in-package :CLAWK) ;;; ;;; change the #/.../ readmacro to generate a regex-matcher object, ;;; and use the make-load-form function to define the loader and initializer ;;; ;;; ;;; reader macro for #/.../ regex symbols ;;; (defun |#/-reader| (strm subchar arg) (declare (ignore subchar arg)) (let ((symname "")) (loop (let ((c (read-char strm))) (cond ((char= c #\/) (return-from |#/-reader| (list 'quote (intern symname *package*)))) ((char= c #\\) (let ((c2 (read-char strm))) (cond ((char= c2 #\/) (setq symname (concatenate 'string symname (string #\/)))) ((or (char= c2 #\n) (char= c2 #\N) (char= c2 #\r) (char= c2 #\R) (char= c2 #\t) (char= c2 #\T)) (setq symname (concatenate 'string symname (string c) (string c2)))) ((digit-char-p c2) (setq symname (concatenate 'string symname (string c) (string c2)))) (t (setq symname (concatenate 'string symname (string c2))))))) ((or (char= c #\Return) (char= c #\Newline)) (error "Unterminated regular expression: " symname)) (t (setq symname (concatenate 'string symname (string c))))))))) (defun install-regex-syntax () (set-dispatch-macro-character #\# #\/ #'|#/-reader|) t) #-:Symbolics (progn (defun |#`-reader| (strm subchar arg) (declare (ignore subchar arg)) (let ((cmdname-strm (make-string-output-stream))) (loop (let ((c (read-char strm))) (cond ((char= c #\`) (return-from |#`-reader| `(call-system-catching-output ,(get-output-stream-string cmdname-strm)))) ((char= c #\\) (let ((c2 (read-char strm))) (cond ((char= c2 #\`) (princ c2 cmdname-strm)) (t (princ c cmdname-strm) (princ c2 cmdname-strm))))) ((or (char= c #\Return) (char= c #\Newline)) (error "Unterminated shell command: " (get-output-stream-string cmdname-strm))) (t (princ c cmdname-strm))))))) (defun install-cmd-syntax () (set-dispatch-macro-character #\# #\` #'|#`-reader|) t) ) ;(defun test () ; (for-stream-lines (#`command.com /c dir`) ; ($print *FNR* " " $0))) #+Lispworks (progn (defun call-system-catching-output (cmd) (let ((cmd-output (make-string-output-stream))) (sys:call-system-showing-output cmd :prefix "" :output-stream cmd-output :wait t :show-cmd nil) (make-string-input-stream (get-output-stream-string cmd-output)))) (defun get-shell-pgm () (or (lispworks:environment-variable "COMSPEC") (lispworks:environment-variable "SHELL") (lispworks:environment-variable "shell"))) ) (defgeneric get-matcher-for-pattern (pattern)) (defmethod get-matcher-for-pattern ((pattern symbol)) (let ((matcher (get pattern 'regex-matcher))) (if matcher matcher (let ((matcher (compile-str (symbol-name pattern)))) (if matcher (setf (get pattern 'regex-matcher) matcher)) matcher)))) (defmethod get-matcher-for-pattern ((pattern string)) (compile-str pattern)) (defmethod get-matcher-for-pattern ((pattern matcher)) pattern) (defvar *CURFILE*) (defvar *CURLINE* "") (defvar *FS* "[ \\t]+") (defvar *RSTART* 0) (defvar *RLENGTH* 0) (defvar *REND* 0) (defvar *REGS* (make-array 0)) (defvar *FIELDS* (make-array 0)) (defvar *NR* 0) ; total num recs read (defvar *FNR* 0) ; num recs read in current file (defvar *NF* 0) ; number of fields in current record (defvar *SUBSEP* (string (code-char #o34))) (defvar *OFS* " ") (defvar *ORS* "\n") (defvar *LAST-SUCCESSFUL-MATCH*) (define-symbol-macro $0 *curline*) (define-symbol-macro $1 ($n 1)) (define-symbol-macro $2 ($n 2)) (define-symbol-macro $3 ($n 3)) (define-symbol-macro $4 ($n 4)) (define-symbol-macro $5 ($n 5)) (define-symbol-macro $6 ($n 6)) (define-symbol-macro $7 ($n 7)) (define-symbol-macro $8 ($n 8)) (define-symbol-macro $9 ($n 9)) (define-symbol-macro $10 ($n 10)) (define-symbol-macro $11 ($n 11)) (define-symbol-macro $12 ($n 12)) (define-symbol-macro $13 ($n 13)) (define-symbol-macro $14 ($n 14)) (define-symbol-macro $15 ($n 15)) (define-symbol-macro $16 ($n 16)) (define-symbol-macro $17 ($n 17)) (define-symbol-macro $18 ($n 18)) (define-symbol-macro $19 ($n 19)) (define-symbol-macro $20 ($n 20)) (define-symbol-macro %0 (%n 0)) (define-symbol-macro %1 (%n 1)) (define-symbol-macro %2 (%n 2)) (define-symbol-macro %3 (%n 3)) (define-symbol-macro %4 (%n 4)) (define-symbol-macro %5 (%n 5)) (define-symbol-macro %6 (%n 6)) (define-symbol-macro %7 (%n 7)) (define-symbol-macro %8 (%n 8)) (define-symbol-macro %9 (%n 9)) (define-symbol-macro %10 (%n 10)) (define-symbol-macro %11 (%n 11)) (define-symbol-macro %12 (%n 12)) (define-symbol-macro %13 (%n 13)) (define-symbol-macro %14 (%n 14)) (define-symbol-macro %15 (%n 15)) (define-symbol-macro %16 (%n 16)) (define-symbol-macro %17 (%n 17)) (define-symbol-macro %18 (%n 18)) (define-symbol-macro %19 (%n 19)) (define-symbol-macro %20 (%n 20)) (defun FS () (if (stringp *FS*) (setq *FS* (get-matcher-for-pattern *FS*)) *FS*)) ;;; ;;; STR ;;; (defgeneric str (x)) (defmethod str ((x string)) x) (defmethod str ((x (eql nil))) "") (defmethod str ((x number)) (format nil "~D" x)) ;;; ;;; NUM ;;; (defgeneric num (x)) (defmethod num ((x number)) x) (defmethod num ((x (eql nil))) 0) (defmethod num ((x string)) (let ((val (read (make-string-input-stream x)))) (if (numberp val) val 0))) ;;; ;;; INT ;;; (defgeneric int (x)) (defmethod int ((x integer)) x) (defmethod int ((x number)) (round x)) (defmethod int ((x (eql nil))) 0) (defmethod int ((x string)) (let ((val (read (make-string-input-stream x) nil 0))) (if (numberp val) (round val) 0))) ;;; ;;; SUB ;;; ;;; Substitute the first occurrence of pattern. ;;; (defun sub (pattern replacement &optional (source *CURLINE*)) "Replace the first occurrence of pattern in the source string." (let ((matcher (get-matcher-for-pattern pattern)) (srclen (length source))) (multiple-value-bind (matchedp matchstart matchlen) (regex:scan-str matcher source :start 0 :length srclen) (if matchedp (concatenate 'string (subseq source 0 matchstart) replacement (subseq source (+ matchstart matchlen) srclen)) source)))) (defun $sub (pattern replacement &optional (source *CURLINE*)) "Replace the first occurrence of pattern in the source string. Coerces its arguments to the appropriate type." (sub pattern (str replacement) (str source))) ;;; ;;; GSUB ;;; ;;; Globally substitute all occurrences of pattern. ;;; (defun gsub (pattern replacement &optional (source *CURLINE*)) "Replace all occurrences of pattern in the source string." (let* ((matcher (get-matcher-for-pattern pattern)) (total-len (length source)) (len-remaining total-len) (new-string "") (matchedp t) (prior-end 0) (match-start 0) (match-len 0)) (loop (multiple-value-setq (matchedp match-start match-len) (regex:scan-str matcher source :start match-start :length len-remaining)) (if matchedp (setf new-string (concatenate 'string new-string (subseq source prior-end match-start) replacement) prior-end (+ match-start match-len) match-start prior-end len-remaining (- total-len match-start)) (return-from gsub (concatenate 'string new-string (subseq source prior-end total-len))))))) (defun $gsub (pattern replacement &optional (source *CURLINE*)) "Replaces all occurrences of pattern in the source string. Coerces its arguments to the appropriate type." (gsub pattern (str replacement) (str source))) ;;; ;;; SPLIT ;;; ;;; Splits a string up based on an optional field separator pattern ;;; (uses *FS* as a default). If no string is supplied, it will split ;;; *CURLINE* and set *FIELDS* and the various $n variables. ;;; (defun split (&optional (source nil not-splitting-curline) (fieldsep-pattern (FS))) "Split a string up into a list of multiple fields based on the field-separator pattern." (when (or (null source) (eq source *CURLINE*)) (setf source *CURLINE* not-splitting-curline nil)) (let* ((fieldsep-matcher (get-matcher-for-pattern fieldsep-pattern)) (fields nil) (total-len (length source)) (len-remaining (length source)) (matchedp t) (prior-end 0) (match-start 0) (match-len 0)) (loop (multiple-value-setq (matchedp match-start match-len) (regex:scan-str fieldsep-matcher source :start match-start :length len-remaining)) (cond (matchedp ;; don't push an empty string if the first thing we ;; find is a separator (when (> match-start 0) (push (subseq source prior-end match-start) fields)) ;; now step over this match and continue splitting (setf prior-end (+ match-start match-len) match-start prior-end len-remaining (- total-len match-start)) ) (t (when (< prior-end total-len) (push (subseq source prior-end match-len) fields)) (setf fields (nreverse fields)) (unless not-splitting-curline (setf *FIELDS* (make-array (length fields) :initial-contents fields))) (return-from split fields)))))) (defun $split (&optional (source nil source-supplied-p) (fieldsep-pattern (FS))) "Split a string up into a list of multiple fields based on the field-separator pattern. Coerces its arguments to the appropriate type." (split (if (and source source-supplied-p) (str source) source) fieldsep-pattern)) ;;; ;;; MATCH ;;; ;;; Searches for the first occurrence of a pattern in a string. ;;; Takes an optional offset. If successful, sets *RSTART*, ;;; *RLENGTH*, *REND*, and *REGS*. ;;; (defun match (source pattern &optional (start 0)) "Scan for first occurrence of a pattern within the source string." (let ((matcher (get-matcher-for-pattern pattern))) (multiple-value-bind (matchedp start len regs) (regex:scan-str matcher source :start start :length (- (length source) start) :start-is-anchor t :end-is-anchor t) (when matchedp (setf *RSTART* start *RLENGTH* len *REND* (+ start len) *REGS* regs *LAST-SUCCESSFUL-MATCH* source)) matchedp))) (defun $match (source pattern &optional (start 0)) "Scan for first occurrence of a pattern within the source string. Coerces its arguments to the appropriate type." (match (str source) pattern (int start))) ;;; ;;; INDEX ;;; ;;; Searches for the first occurrence of a substring within a string. ;;; Takes an optional offset. ;;; (declaim (inline index)) (defun index (pat str &optional (start 0)) (search pat str :start2 start)) (defun $index (pat str &optional (start 0)) (index (str pat) (str str) (int start))) ;;; ;;; SUBSTR ;;; ;;; Extract a substring. Like subseq, but takes length instead of end. ;;; (declaim (inline substr)) (defun substr (str start len) (subseq str start (+ start len))) (defun $substr (str start len) (substr (str str) (int start) (int len))) ;;; ;;; ~ !~ /~ ;;; ;;; test if string contains the pattern ;;; (defun ~ (pattern string) "Test if pattern matches the string." (let* ((matcher (get-matcher-for-pattern pattern)) (string (str string))) (multiple-value-bind (matchedp) (regex:scan-str matcher string :start 0 :length (length string) :start-is-anchor t :end-is-anchor t) matchedp))) (declaim (inline /~)) (defun /~ (pattern string) "Test if pattern isn't present in the string." (not (~ pattern string))) (declaim (inline !~)) (defun !~ (pattern string) "Test if pattern isn't present in the string." (/~ pattern string)) ;;; ;;; WITH-PATTERNS ;;; (defmacro with-patterns (pats &rest body) "Execute the body in an environment that includes the compiled patterns bound to their respective variables." #+Symbolics (declare (zwei:indentation 1 1)) (expand-with-patterns pats `(progn ,@body))) #+:Lispworks (editor:setup-indent "with-patterns" 1 2 6) (defun expand-with-pattern (var strpat body) `(let ((,var (get-matcher-for-pattern ,strpat))) (when ,var (locally (declare (type matcher ,var)) ,body))) ) (defun expand-with-patterns (pats body) (if pats (expand-with-pattern (caar pats) (cadar pats) (expand-with-patterns (cdr pats) body)) body)) ;;; ;;; WITH-FIELDS ;;; ;;; Allows stuff like ;;; (with-fields ((a b c d &rest rest) str) ;;; ($print "Fields:" a b c d "Rest: " rest)) ;;; ;;; as well as the slightly more awk-ish ;;; (with-fields (nil str) ;;; ($print "Fields:" $1 $2 $3 $4)) ;;; which splits STR into the $ vars, ;;; ;;; or even ;;; (with-fields () ;;; ($print "Fields:" $1 $2 $3 $4)) ;;; which will split the current line into the $ vars. ;;; (defmacro with-fields ((&optional fields sourcestr (fieldsep-pattern '(FS))) &rest body) "Split the source string into fields based on the field separator, bind the field array to the fields variable." #+Symbolics (declare (zwei:indentation 1 1)) (expand-with-fields fields sourcestr fieldsep-pattern body)) #+:Lispworks (editor:setup-indent "with-fields" 1 2 6) (defun expand-with-fields (fields sourcestr fieldsep-pattern body) (let ((tmp-splits (gensym))) (if (null fields) `(let (*FIELDS*) (let* ((,tmp-splits (split ,sourcestr ,fieldsep-pattern)) (*NF* (length ,tmp-splits))) ,@body)) `(let* ((,tmp-splits (split ,sourcestr ,fieldsep-pattern)) (*NF* (length ,tmp-splits))) (declare (special *NF*)) (destructuring-bind ,fields ,tmp-splits ,@body))))) ;;; ;;; $ ;;; ;;; Field access to a computed field ;;; (defun $n (n) "Access a field." (let ((n (int n))) (cond ((zerop n) *CURLINE*) ((and (>= n 0) (<= n (array-dimension *FIELDS* 0))) (aref *FIELDS* (1- n)))))) (defsetf $n (n) (val) (let ((tmpvar (gensym))) `(let ((,tmpvar (int ,n))) (cond ((zerop ,tmpvar) (setf *CURLINE* ,val)) ((and (>= ,tmpvar 0) (<= ,tmpvar (array-dimension *FIELDS* 0))) (setf (aref *FIELDS* (1- ,tmpvar)) ,val)))))) ;;; ;;; WITH-SUBMATCHES ;;; ;;; Allows stuff like ;;; (with-submatches (a b c d) ;;; ($print "Regs:" a b c d)) ;;; ;;; which is handy in match-case clauses ;;; (defmacro with-submatches (&optional fields &rest body) "Bind the submatch variables to the corresponding strings from the registers array." #+Symbolics (declare (zwei:indentation 1 1)) (expand-with-submatches fields body)) #+:Lispworks (editor:setup-indent "with-submatches" 1 2 6) (defun expand-with-submatches (fields body) (if fields `(destructuring-bind ,fields (make-register-list *LAST-SUCCESSFUL-MATCH* *REGS*) ,@body) `(progn ,@body))) ;;; ;;; IF-MATCH ;;; ;;; Allows stuff like ;;; (if-match ("a*b" str) ;;; ($print "Regs:" %0 %1 %2 %3 %4) ;;; ($print "No match") ;;; (defmacro if-match ((pat str &optional (pos 0)) consequent alternative) "Match the pattern to the string, and if it matches, bind the *RSTART*, *RLENGTH*, and *REGS* and evaluate the consequent, otherwise evaluate the alternative." #+Symbolics (declare (zwei:indentation 1 1)) (expand-if-match pat str pos consequent alternative)) #+:Lispworks (editor:setup-indent "if-match" 2 2 4) (defun expand-if-match (pat str pos consequent alternative) (utils:once-only (str pos) `(multiple-value-bind (matchedp *RSTART* *RLENGTH* *REGS*) (regex:match-str (get-matcher-for-pattern ,pat) ,str :start ,pos) (if matchedp (let ((*last-successful-match* ,str)) ,consequent) ,alternative)))) ;;; ;;; WITH-MATCH ;;; ;;; Allows stuff like ;;; (with-match ((a b c d &rest rest) pat str) ;;; ($print "Regs:" a b c d "Rest: " rest)) ;;; ;;; as well as the slightly less readable ;;; (with-match (nil pat str) ;;; ($print "Regs:" %1 %2 %3 %4)) ;;; which matches pat against str, and loads the submatches into the % vars, ;;; ;;; or even ;;; (with-match (nil pat) ;;; ($print "Fields:" %1 %2 %3 %4)) ;;; which will split the current line into the % vars. (defmacro with-match ((&optional fields pat sourcestr) &rest body) "Split the source string into registers based on the pattern, bind the register variables to the registers array." #+Symbolics (declare (zwei:indentation 1 1)) (expand-with-match pat fields sourcestr body)) #+:Lispworks (editor:setup-indent "with-match" 1 2 6) (defun expand-with-match (pat fields sourcestr body) (cond ((and pat fields) `(when (match (or ,sourcestr *CURLINE*) ,pat) (destructuring-bind ,fields (make-register-list *LAST-SUCCESSFUL-MATCH* *REGS*) ,@body))) ((and pat (null fields)) `(let (*LAST-SUCCESSFUL-MATCH* *REGS*) (declare (special *LAST-SUCCESSFUL-MATCH* *REGS*)) (when (match (or ,sourcestr *CURLINE*) ,pat) ,@body))) ((and (null pat) fields (null sourcestr)) `(destructuring-bind ,fields (make-register-list *LAST-SUCCESSFUL-MATCH* *REGS*) ,@body)) ((and (null pat) (null fields) sourcestr) (error "WITH-MATCH requires a pattern to match the string ~A against" sourcestr)) ((and (null pat) (null fields) (null sourcestr)) `(progn ,@body)))) (defun make-register-list (str regs) (let ((nregs (array-dimension regs 0))) (loop for i from 0 below nregs collect (get-reg-str str regs i)))) ;;; ;;; % ;;; ;;; Register access ;;; (defun get-reg-str (str regs n) "Access a register." (let ((rstart (register-start regs n)) (rend (register-end regs n))) (if (and (numberp rstart) (numberp rend)) (subseq str rstart rend)))) (defun %n (n) "Access a register." (let ((n (int n))) (if (and (stringp *LAST-SUCCESSFUL-MATCH*) (< n (array-dimension *REGS* 0)) (>= n 0)) (get-reg-str *LAST-SUCCESSFUL-MATCH* *REGS* n)))) ;;; ;;; MATCH-CASE ;;; ;;; Allows stuff like: ;;; (match-case str ;;; (#/foo/ (format t "foo")) ;;; (#/bar/ (format t "bar")) ;;; ((#/baz/ #/qux/) (format t "either baz or qux")) ;;; (else (format t "unknown"))) ;;; ;;; The matches are done by MATCH, so the various special variables are set ;;; appropriately ;;; (defmacro match-case (strexpr &rest clauses) #+Symbolics (declare (zwei:indentation 1 1)) (expand-match-case strexpr clauses)) #+:Lispworks (editor:setup-indent "match-case" 1 2 6) (defun expand-match-case (strexpr clauses) (let ((tmpstrsym (gensym))) `(let ((,tmpstrsym ,strexpr)) ,(expand-match-case-clauses tmpstrsym clauses)))) (defun expand-match-case-clauses (strexpr clauses) (if clauses (let ((clause (first clauses)) (other-clauses (rest clauses))) (cond ((member (car clause) '(t else otherwise)) `(progn ,@(rest clause))) ((atom (car clause)) `(if (match ,strexpr ,(car clause)) (progn ,@(cdr clause)) ,(expand-match-case-clauses strexpr other-clauses))) (t `(if (or ,@(mapcar #'(lambda (x) `(,strexpr match ,x)) clause)) (progn ,@(cdr clause)) ,(expand-match-case-clauses strexpr other-clauses))))) `())) ;;; ;;; MATCH-WHEN ;;; ;;; Takes a set of clauses that correspond to the AWK toplevel forms, ;;; but just evaluates the clauses (BEGIN clause first, then pattern ;;; clauses, then END clause), without any looping. ;;; (defmacro match-when (&rest clauses) #+Symbolics (declare (zwei:indentation 1 1)) (let ((docs-and-decs (extract-docs-and-decs clauses)) (begin-clauses (extract-begin-clauses clauses)) (end-clauses (extract-end-clauses clauses)) (pattern-clauses (extract-pattern-clauses clauses))) `(locally ,@docs-and-decs (progn ,@(mapcan #'rest begin-clauses) ,@(mapcar #'expand-match-when-clause pattern-clauses) ,@(mapcar #'rest end-clauses))))) #+:Lispworks (editor:setup-indent "match-when" 0 2) (defun is-special-clause (clause type) (and (listp clause) (symbolp (first clause)) (string-equal (symbol-name (first clause)) type))) (defun extract-docs-and-decs (clauses) (loop for clause in clauses while (or (stringp clause) (is-special-clause clause "DECLARE")) collect clause)) (defun extract-begin-clauses (clauses) (loop for clause in clauses when (is-special-clause clause "BEGIN") collect clause)) (defun extract-end-clauses (clauses) (loop for clause in clauses when (is-special-clause clause "END") collect clause)) (defun extract-pattern-clauses (clauses) (loop for clause in clauses unless (or (not (listp clause)) (is-special-clause clause "BEGIN") (is-special-clause clause "END") (is-special-clause clause "DECLARE")) collect clause)) ; ; (t . body) --> (progn . body) ; (nil . body) --> (progn . body) ; ((quote sym) . body) --> (when (match *CURLINE* (quote sym)) . body) ; (stringlit . body) --> (when (match *CURLINE* stringlit) . body) ; (form . body) --> (when form . body) ; (defun expand-match-when-clause (clause) (cond ((null clause) nil) ((stringp (first clause)) `(when (match *CURLINE* ,(first clause)) ,@(expand-match-when-consequent (rest clause)))) ((member (first clause) '("t" "always") :test #'symbol-name-eq) (rest clause)) ((atom (first clause)) `(when ,(first clause) ,@(expand-match-when-consequent (rest clause)))) (t (let ((condition (first clause)) (consequents (rest clause))) (if (eq (first condition) 'quote) `(when (match *CURLINE* ,condition) ,@(expand-match-when-consequent consequents)) `(when ,condition ,@(expand-match-when-consequent consequents))))))) ; provide the default action if one isn't present (defun expand-match-when-consequent (consequent) (if consequent consequent '(($print *CURLINE*)))) ; sym-name-eq (defun symbol-name-eq (x y) (if (symbolp x) (if (symbolp y) (string= (symbol-name x) (symbol-name y)) (if (stringp y) (string= (symbol-name x) y))) (if (stringp x) (if (symbolp y) (string= x (symbol-name y)) (if (stringp y) (string= x y)))))) ;;; ;;; FOR-STREAM-LINES ;;; ;;; Iterate the body over the lines of the stream. Don't split the ;;; lines, but keep the current line in both *CURLINE* and $0. ;;; (defmacro for-stream-lines ((stream &optional (strmvar (gensym)) (linevar (gensym))) &rest body) #+Symbolics (declare (zwei:indentation 1 1)) (expand-for-stream-lines strmvar linevar stream body)) #+:Lispworks (editor:setup-indent "for-stream-lines" 1 2 6) (defun expand-for-stream-lines (streamvar linevar stream body &aux (nextlbl (gensym))) `(let ((,streamvar ,stream)) (when (eq ,streamvar 't) (setq ,streamvar *standard-input*)) (unless (null ,streamvar) (let ((*CURFILE* nil) (*CURLINE* "") (*FNR* -1)) (macrolet ((next () (list 'throw ',nextlbl nil))) (prog ,(if (eq linevar '*CURLINE*) nil (list linevar)) ,nextlbl (setq ,linevar (read-line ,streamvar nil :eof)) (unless (eq ,linevar :eof) (setq *CURLINE* ,linevar $0 ,linevar) (incf *NR*) (incf *FNR*) (catch ',nextlbl ,@body) (go ,nextlbl)))))))) ;;; ;;; FOR-FILE-LINES ;;; ;;; Iterate the body over the lines of the file. Don't split the ;;; lines, but keep the current line in both *CURLINE* and $0. ;;; ;;; Need to do this with prog or labels, and macrolet (next) to jump to ;;; the read-next-line logic. ;;; (defmacro for-file-lines ((path &optional (streamvar (gensym)) (linevar (gensym))) &rest body) #+symbolics (declare (zwei:indentation 1 1)) (expand-for-file-lines streamvar linevar path body)) #+:Lispworks (editor:setup-indent "for-file-lines" 1 2 6) (defun expand-for-file-lines (streamvar linevar path body) `(with-open-file (,streamvar ,path :direction :input :element-type 'character :if-does-not-exist :error) ,(expand-for-stream-lines streamvar linevar streamvar body))) ;;; ;;; FOR-STREAM-FIELDS ;;; ;;; Iterate the body over the lines of the stream. Split the lines ;;; based on *FS*. Depending on what fieldspec you provide, the ;;; various $n vars may or may not be set (except for $0, which is the ;;; current line). ;;; ;;; As a special case, the value 't will use *standard-input* as the stream. ;;; (defmacro for-stream-fields ((stream &optional fieldspec (strmvar (gensym)) (linevar (gensym))) &rest body) #+Symbolics (declare (zwei:indentation 1 1)) (expand-for-stream-fields strmvar linevar fieldspec stream body)) #+:Lispworks (editor:setup-indent "for-stream-fields" 1 2 6) (defun expand-for-stream-fields (strmvar linevar fieldspec stream body &key (curfile-name stream curfile-name-p) &aux (nextlbl (gensym))) `(let ((,strmvar ,stream)) (if (eq ,strmvar 't) (setq ,strmvar *standard-input*)) (unless (null ,strmvar) (let (,@(if curfile-name-p `((*CURFILE* ,curfile-name))) (*CURLINE* "") (*FNR* -1)) (macrolet ((next () (list 'throw ',nextlbl nil))) (prog ,(if (eq linevar '*CURLINE*) nil (list linevar)) ,nextlbl (setq ,linevar (read-line ,strmvar nil :eof)) (unless (eq ,linevar :eof) (setq *CURLINE* ,linevar $0 ,linevar) (incf *NR*) (incf *FNR*) (catch ',nextlbl ,(expand-with-fields fieldspec linevar '*FS* body)) (go ,nextlbl)))))))) ;;; ;;; FOR-FILE-FIELDS ;;; ;;; Open the filepath, then iterate the body over the lines. Split the lines ;;; based on *FS*. Depending on what fieldspec you provide, the various $n vars ;;; may or may not be set (except for $0, which is the current line). ;;; (defmacro for-file-fields ((path &optional fieldspec (strmvar (gensym)) (linevar (gensym))) &rest body) #+Symbolics (declare (zwei:indentation 1 1)) (expand-for-file-fields strmvar linevar fieldspec path body)) #+:Lispworks (editor:setup-indent "for-file-fields" 1 2 6) (defun expand-for-file-fields (strmvar linevar fieldspec path body) `(with-open-file (,strmvar ,path :direction :input :element-type 'character :if-does-not-exist :error) ,(expand-for-stream-fields strmvar linevar fieldspec strmvar body :curfile-name path))) ;;; ;;; WHEN-STREAM-FIELDS ;;; ;;; Guts of AWK toplevel for a file, but unlike AWK this can be ;;; used anywhere. ;;; (defmacro when-stream-fields ((stream &optional fieldspec) &rest clauses) #+Symbolics (declare (zwei:indentation 1 1)) (let ((docs-and-decs (extract-docs-and-decs clauses)) (begin-clauses (extract-begin-clauses clauses)) (end-clauses (extract-end-clauses clauses)) (pattern-clauses (extract-pattern-clauses clauses))) `(locally ,@docs-and-decs (progn ,@(mapcan #'rest begin-clauses) (for-stream-fields (,stream ,fieldspec) ,@(mapcar #'expand-match-when-clause pattern-clauses)) ,@(mapcan #'rest end-clauses))))) #+:Lispworks (editor:setup-indent "when-stream-fields" 1 2 6) (defmacro when-file-fields ((path &optional fieldspec) &rest clauses) #+Symbolics (declare (zwei:indentation 1 1)) (let ((docs-and-decs (extract-docs-and-decs clauses)) (begin-clauses (extract-begin-clauses clauses)) (end-clauses (extract-end-clauses clauses)) (pattern-clauses (extract-pattern-clauses clauses))) `(locally ,@docs-and-decs (progn ,@(mapcan #'rest begin-clauses) (for-file-fields (,path ,fieldspec) ,@(mapcar #'expand-match-when-clause pattern-clauses)) ,@(mapcan #'rest end-clauses))))) #+:Lispworks (editor:setup-indent "when-file-fields" 1 2 6) ;;; ;;; Fakes a reasonably close equivalent to a top-level awk program. ;;; ;;; ;;; This needs to be modified to run the BEGIN clauses *ONCE* before ;;; any files are processed, and similarly run the END clauses once ;;; after the files are processed. ;;; (defmacro defawk (name (&rest parms) &rest clauses) (let ((file-or-stream (gensym)) (process-stream-fn (gensym)) (strm (gensym)) (docs-and-decs (extract-docs-and-decs clauses)) (begin-clauses (extract-begin-clauses clauses)) (end-clauses (extract-end-clauses clauses)) (pattern-clauses (extract-pattern-clauses clauses))) `(defun ,name (&rest ARGS ,@parms ,@(if (member '&key parms) '((&allow-other-keys)))) ;; docstrings and declarations ,@docs-and-decs ;; shadow our globals with their good values (let ((*CURFILE*) (*CURLINE* "") (*FS* "[ \\t]+") (*RSTART* 0) (*RLENGTH* 0) (*REND* 0) (*REGS* (make-array 0)) (*FIELDS* (make-array 0)) (*NR* 0) (*FNR* 0) (*NF* 0) (*SUBSEP* (string (code-char #o34))) (*OFS* " ") (*ORS* "\n") (*LAST-SUCCESSFUL-MATCH*)) (declare (special *CURFILE* *CURLINE* *FS* *RSTART* *RLENGTH* *REND* *REGS* *FIELDS* *NR* *FNR* *NF* *SUBSEP* *OFS* *ORS* *LAST-SUCCESSFUL-MATCH*)) (flet ((,process-stream-fn (,strm) ,(expand-for-stream-fields strm '*CURLINE* nil strm (mapcar #'expand-match-when-clause pattern-clauses)))) ;; run BEGIN clauses ,@(mapcan #'rest begin-clauses) ;; process files (dolist (,file-or-stream ARGS) (cond ((eq ,file-or-stream 't) (,process-stream-fn *standard-input*)) ((and (streamp ,file-or-stream) (input-stream-p ,file-or-stream)) (,process-stream-fn ,file-or-stream)) ((or (pathnamep ,file-or-stream) (stringp ,file-or-stream)) (let ((*CURFILE* ,file-or-stream)) (declare (special *CURFILE*)) (with-open-file (,strm ,file-or-stream :direction :input :element-type 'character :if-does-not-exist :error) (,process-stream-fn ,strm)))))) ;; run END clauses ,@(mapcan #'rest end-clauses)))))) ;;; ;;; misc generic functions ;;; (defun $+ (&rest rest) (reduce #'+ (mapcar #'num rest))) (defun $- (&rest rest) (reduce #'- (mapcar #'num rest))) (defun $* (&rest rest) (reduce #'* (mapcar #'num rest))) (defun $/ (&rest rest) (reduce #'/ (mapcar #'num rest))) (defun $rem (x y) (rem (num x) (num y))) (defun $exp (y) ($exp (num y))) (defun $expt (x y) (expt (num x) (num y))) (defun $atan2 (x y) (atan (num x) (num y))) (defun $cos (x) (cos (num x))) (defun $sin (x) (sin (num x))) (defun $int (x) (truncate (num x))) (defun $log (x) (log (num x))) (defun $sqrt (x) (sqrt (num x))) (defun $rand () (random 1.0)) (defvar *random-states* (make-hash-table)) (defun $srand (x) (let ((nx (num x))) (let ((oldstate (gethash nx *random-states*))) (if oldstate (setq *random-state* oldstate) (setf *random-state* (make-random-state) (gethash nx *random-states*) *random-state*))))) (defun $++ (&rest rest) (reduce #'(lambda (x y) (concatenate 'string x (str y))) (mapcar #'str rest))) (defgeneric ! (x)) (defmethod ! ((x number)) (zerop x)) (defmethod ! ((x (eql nil))) 1) (defmethod ! ((x string)) (zerop (num x))) (defgeneric $== (x y)) (defmethod $== (x y) (= (num x) (num y))) (defmethod $== ((x number) (y number)) (= x y)) (defmethod $== ((x number) (y string)) (= x (num y))) (defmethod $== ((x string) (y number)) (= (num x) y)) (defmethod $== ((x string) (y string)) (string= x y)) (defgeneric $< (x y)) (defmethod $< (x y) (< (num x) (num y))) (defmethod $< ((x number) (y number)) (< x y)) (defmethod $< ((x number) (y string)) (< x (num y))) (defmethod $< ((x string) (y number)) (< (num x) y)) (defmethod $< ((x string) (y string)) (string< x y)) (defgeneric $> (x y)) (defmethod $> (x y) (> (num x) (num y))) (defmethod $> ((x number) (y number)) (> x y)) (defmethod $> ((x number) (y string)) (> x (num y))) (defmethod $> ((x string) (y number)) (> (num x) y)) (defmethod $> ((x string) (y string)) (string> x y)) (defgeneric $<= (x y)) (defmethod $<= (x y) (<= (num x) (num y))) (defmethod $<= ((x number) (y number)) (<= x y)) (defmethod $<= ((x number) (y string)) (<= x (num y))) (defmethod $<= ((x string) (y number)) (<= (num x) y)) (defmethod $<= ((x string) (y string)) (string<= x y)) (defgeneric $>= (x y)) (defmethod $>= (x y) (>= (num x) (num y))) (defmethod $>= ((x number) (y number)) (>= x y)) (defmethod $>= ((x number) (y string)) (>= x (num y))) (defmethod $>= ((x string) (y number)) (>= (num x) y)) (defmethod $>= ((x string) (y string)) (string>= x y)) (defgeneric $/= (x y)) (defmethod $/= (x y) (/= (num x) (num y))) (defmethod $/= ((x number) (y number)) (/= x y)) (defmethod $/= ((x number) (y string)) (/= x (num y))) (defmethod $/= ((x string) (y number)) (/= (num x) y)) (defmethod $/= ((x string) (y string)) (string/= x y)) (defun != (x y) ($/= x y)) (defgeneric $max (x &rest rest)) (defmethod $max (x &rest rest) (reduce #'max (mapcar #'num rest) :initial-value (num x))) (defmethod $max ((x number) &rest rest) (reduce #'max (mapcar #'num rest) :initial-value x)) (defmethod $max ((x string) &rest rest) (reduce #'max (mapcar #'str rest) :initial-value x)) (defgeneric $min (x &rest rest)) (defmethod $min (x &rest rest) (reduce #'min (mapcar #'num rest) :initial-value (num x))) (defmethod $min ((x number) &rest rest) (reduce #'min (mapcar #'num rest) :initial-value x)) (defmethod $min ((x string) &rest rest) (reduce #'min (mapcar #'str rest) :initial-value x)) (defgeneric $zerop (x)) (defmethod $zerop (x) (declare (ignore x)) nil) (defmethod $zerop ((x number)) (zerop x)) (defmethod $zerop ((x (eql nil))) t) (defmethod $zerop ((x string)) (not (null (or (string= x "") (string= x "0") (string= x "0.0"))))) (defgeneric $length (x)) (defmethod $length (x) (length x)) (defmethod $length ((x number)) (length (str x))) (defmethod $length ((x (eql nil))) 0) (defun $print (&rest rest) (do-$fprint *standard-output* rest)) (defun $fprint (stream &rest rest) (do-$fprint stream rest)) (defun do-$fprint (stream lst) (if (string= *ORS* "\n") (format stream "~%") (format stream "~A" *ORS*)) (loop for item in lst do (format stream "~A~A" (str item) *OFS*))) ;;; ;;; Awk-like associative arrays (built on hashtable, obviously) ;;; (defun $array () (make-hash-table :test 'equalp)) ;; AWK associative-arrays have the odd characteristic that simply ;; checking for the presence of a key adds it to the array. (defun assoc-array-ref (tbl index) (multiple-value-bind (val foundp) (gethash index tbl) (if foundp val (setf (gethash index tbl) "")))) (defsetf assoc-array-ref (tbl index) (val) `(setf (gethash ,index ,tbl) ,val)) (defmacro $aref (tbl index &rest other-indices) (if (null other-indices) `(assoc-array-ref ,tbl (str ,index)) `(assoc-array-ref ,tbl (concatenate 'string (str ,index) ,@(mapcan #'(lambda (x) `(*SUBSEP* (str ,x))) other-indices))))) ; equivalent to: for (x in a) ... (defmacro $for ((keyvar in tbl) &rest body) (declare (ignore in)) #+Symbolics (declare (zwei:indentation 1 1)) `(loop for ,keyvar being the hash-keys of ,tbl do (progn ,@body))) #+:Lispworks (editor:setup-indent "$for" 1 2 6) ; equivalent to: x in a (defun $in (key tbl) (multiple-value-bind (val presentp) (getf key tbl) (declare (ignore val)) presentp)) ; equivalent to either delete a[i] or delete a (defun $delete (tbl &optional (elt nil eltp)) (if eltp (remhash elt tbl) (clrhash tbl))) ; return the cardinality of the table (defmethod $length ((x hash-table)) (hash-table-count x)) cl-awk-1/clawktest.lisp0100755000175000001440000001304407432027450013776 0ustar mrdusers;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CLAWK-TEST; Base: 10 -*- (in-package :CLAWK-TEST) ;;; ;;; Various tests, based on translations of AWK examples from the AWK ;;; book ;;; ; Chapter 1, page 1, example 1 ; Print all employees that have worked this week ; ; $3 > 0 { print $1 $2 $3 } ; (defun test-1-1-1 (&optional (filename "emp.data")) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (when ($> hrsworked 0) ($print name payrate hrsworked))))) ; alternatively like this (defun test-1-1-2 (&optional (filename "emp.data")) (for-file-fields (filename (name payrate hrsworked)) (when ($> hrsworked 0) ($print name payrate hrsworked)))) ; or this (defun test-1-1-3 (&optional (filename "emp.data")) (for-file-fields (filename) (when ($> $3 0) ($print $1 $2 $3)))) ; or even like this (defawk test-1-1-4 () "Print out the employees that have worked this week." (($> $3 0) ($print $1 $2 $3))) (defun test-1-2 (&optional (filename "emp.data")) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (when ($zerop hrsworked) ($print name payrate hrsworked))))) ;;; also awk-like (defawk test-1-6 () (t ($print *NR* $0))) (defun test-1-7 (&optional (filename "emp.data")) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) ($print "total pay for" name "is" ($* payrate hrsworked))))) (defun test-1-9 (&optional (filename "emp.data")) (for-file-lines (filename inf line) (with-fields ((name payrate hrsworked)) (declare (ignore name hrsworked)) (when ($>= payrate 5) ($print line))))) ; as close to the original awk as possible (defawk test-1-11-1 () ((/= *NF* 3) ($print $0 "number of fields is not equal to 3")) (($< $2 3.35) ($print $0 "rate is below minimum wage")) (($> $2 10) ($print $0 "rate exceeds $10 per hour")) (($< $3 0) ($print $0 "negative hours worked")) (($> $3 60) ($print $0 "too many hours worked")) ) ; as close to the original awk as possible (defawk test-1-11-2 () (BEGIN ($print "NAME RATE HOURS") ($print)) (t ($print $0)) ) ; empty condition (defun test-1-12-1 (&optional (filename "emp.data") &aux (emp 0)) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (declare (ignore name payrate)) (when ($> hrsworked 15) (incf emp)))) ($print emp "employees worked more than 15 hours")) (defawk test-1-12-3 (&aux (pay 0)) (t (incf pay ($* $2 $3))) (END ($print *NR* "employees") ($print "total pay is" pay) ($print "average pay is" (/ pay *NR*)))) (defun sample (filename &aux (pay 0) (nr 0)) (for-file-fields (filename (name payrate hrsworked)) (declare (ignore name)) (incf pay (* (num payrate) (num hrsworked))) (incf nr) ) (format t "~%~D employees" nr) (format t "~%total pay is ~F" pay) (format t "~%average pay is ~F" (/ pay nr)) ) (defun test-1-12-4 (&optional (filename "emp.data") &aux maxrate maxemp) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (declare (ignore hrsworked)) (when ($> payrate maxrate) (setq maxrate payrate maxemp name)))) ($print "highest hourly rate:" maxrate "for" maxemp)) (defun test-1-13-1 (&optional (filename "emp.data") &aux names) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (declare (ignore payrate hrsworked)) (setq names ($++ names name " ")))) ($print names)) (defun test-1-13-2 (&optional (filename "emp.data") &aux last) "Print last line" (for-file-lines (filename inf line) (setq last line)) ($print last)) (defun test-1-14-1 (&optional (filename "emp.data")) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (declare (ignore payrate hrsworked)) ($print name ($length name))))) (defun test-1-14-2 (filename &aux (nc 0) (nw 0)) "Count lines, words, and characters" (setq *NR* 0) ; the low-level macros don't do this for you (for-file-lines (filename inf line) (with-fields ((&rest rest)) (declare (ignore rest)) (incf nc (1+ (length line))) (incf nw *NF*))) ($print *NR* "lines," nw "words," nc "characters")) (defun test-1-14-3 (&optional (filename "emp.data") &aux (n 0) (pay 0)) (for-file-lines (filename) (with-fields ((name payrate hrsworked)) (declare (ignore name)) (when ($> payrate 6) (incf n) (incf pay ($* payrate hrsworked))))) (if (> n 0) ($print n "employees, total pay is" pay "average pay is" (/ pay n)) ($print "no employees are paid more than $6/hour"))) ; doesn't use emp.data (defun test-1-15 (filename) "Input lines: amount rate years" (for-file-lines (filename inf line) (with-fields ((&optional amount rate years)) ($print line) (loop for i from 1 by 1 while ($<= i years) do (format t "~%~t~.2F" ($* amount ($expt ($+ 1 rate) i))))))) (defun test-1-16-2-1 (filename &aux lines) "Print lines in reverse order" (for-file-lines (filename inf line) (push line lines)) (loop for line in lines do ($print line))) ;; even more like the original awk, but not as quick (defawk test-1-16-2-2 (&aux (lines ($array))) "Print lines in reverse order" (t (setf ($aref lines *NR*) $0)) (END (loop for i from *NR* above 0 do ($print ($aref lines i))))) (defun test-1-17-3-1 (filename) "Print the last field of every input line" (for-file-lines (filename) (with-fields ((&rest fields)) ($print (elt fields (1- *NF*)))))) ; even more like awk (defawk test-1-17-3-2 () (t ($print ($n *NF*)))) cl-awk-1/emp.data0100755000175000001440000000016007431617332012516 0ustar mrdusersBeth 4.00 0 Dan 3.75 0 Kathy 4.00 10 Mark 5.00 20 Mary 5.50 22 Suzie 4.25 18