Some simple syntax on lisp and perl

I am learning perl and common lisp these days.

I think perl’s syntax is beautiful and simple and I am getting used to it. I like it very much. I learn it just to do some text tasks.

Besides, I once thought lisp’s braces are so confusing. I even like those now. It is interesting to write in lisp.

Here, I place some meaningless codes here to help me remember the syntax in future. ;-)

#Learning Perl

##chapter 2

#!/usr/bin/env perl 
#===============================================================================
#
#         FILE: ch_2.pl
#
#        USAGE: ./ch_2.pl  
#
#  DESCRIPTION: no
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: ---
#       AUTHOR: YOUR NAME (), 
# ORGANIZATION: 
#      VERSION: 1.0
#      CREATED: 08/15/2014 10:27:44 PM
#     REVISION: ---
#===============================================================================

#use strict;
use warnings;
use utf8;
use 5.010;

say "Hello world!";
say "This is a program for Chapter Two";
$count = 0;
while ($count < 10) {
	$count += 2;
	print "count is now $count\n";
}
$n1 = 1.25;
$n1_1 = 1.;
$n2 = -1.2e-23;
say "n1 = $n1";
say "n2 = $n2";
say "n1_1 = $n1_1";
$n3 = 61_298_040_283_768;
$n4 = 0xff;
$n5 = 0377;
$n6 = 0b11111111;
say "n3 = $n3";
say "n4 = $n4";
say "n5 = $n5";
say "n6 = $n6";

print "Hello and " . "world\n";
print "fred " x 3 . "\n";
print 5 x 4.8 . "\n";

print "The answer is ", 6 * 7, ".\n";

$meal = "bronto saurus steak";
$barney = "fred ate a $meal";
print $barney . "\n";

print 'The barney is $barney' . "\n";

$que = ord('?');
print "que is $que\n";
$Que = chr($que);
print "que is $Que\n";

$name = "wred";
if ($name gt 'fred')
{
	print "'$name' comes afger 'fred' in sorted order.\n";
}

if (! '0')
{
	print "'0' is false!\n";
}

$still_true = !! 'Fred';
$still_false = !! '0';

print "still_true is $still_true\n";
print "still_false is $still_false\n";

$mul_line = "This is multiple
line\n";
print "multiple line is the Following:$mul_line";

#$line = <STDIN>;
$line = "Hi\n";
if ($line eq "\n")
{
	print "Thas was just a blank line.\n";
}
else
{
	print "That line of input was: $line";
}

#$text = <STDIN>;
#chomp($text = <STDIN>);
#print "text = $text\n";

$n = 1;
$sum = undef;
while ($n < 10)
{
	$sum += $n;
	$n += 2;
}
print "The total was $sum.\n";

$un_define = undef;
print "un_define is <$un_define>\n";

$madonna = <STDIN>;
if (defined($madonna)) 
{
	print "The input was $madonna";
}
else
{
	print "No input available!\n";
}

print "This is the last line.\n";

##chapter 3

#!/usr/bin/env perl 
#===============================================================================
#
#         FILE: ch_3.pl
#
#        USAGE: ./ch_3.pl  
#
#  DESCRIPTION: just for test some perl's grammer
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: ---
#       AUTHOR: YOUR NAME (), 
# ORGANIZATION: 
#      VERSION: 1.0
#      CREATED: 08/16/2014 04:52:51 PM
#     REVISION: ---
#===============================================================================

#use strict;
use warnings;
use utf8;
use 5.010;

$fred[0] = "yabba";
$fred[1] = "dabba";
$fred[2] = "doo";
say $fred[0];
say $fred[1];
say $fred[2];
$fred[2] .= "diddley";
say $fred[2];
$fred[5] = "Fifth";
$i = 0;
while ($i <= 5)
{
	if (defined($fred[$i])) 
	{
		say "$i == > ", $fred[$i];
	}
	else {
		say "does not exist!";
	}
	$i += 1;
}
say "There are $#fred elements in fred array.";

@lst = (2..5);
say @lst;
@lst = 2..5;
say @lst;
@lst = qw(fred barney bety wilma dino);
#say @lst;

($fred, $barney, $dino) = qw / flintstone, rubble, undef /;
say "fred = ", $fred;
say "barney = ", $barney;
say "dino = ", $dino;
($fred, $barney) = ($barney, $fred);
say "fred = ", $fred;
say "barney = ", $barney;
if (defined($dino))
{
	say "dino is defined";
}
($fred, $dino) = ("FRED", undef);
if (defined($dino))
{
	say "dino is defined";
}
else 
{
	say "dino is not defined";
}
($rocks[0], $rocks[1], $rocks[2], $rocks[3]) = 
qw / talc
	mica
	feldspar
	quartz
	/;
@giant = 1..5;
@stuff = (@giant, undef, @giant);
$dino = "granite";
@tiny = ();
@quarry = (@rocks, "crushed rock", @tiny, $dino);

@copy = @quarry;

@array = 5..9;
say "@array";
$fred = pop @array;
say "@array";
push @array, 11;
say "@array";
push @array, @giant;
say "@array";
$m = shift @array;
say "m = ", $m;
$m = shift @array;
say "m = ", $m;
unshift @array, kk;
say "@array";
@removed = splice @array, 2, 0, $m;
say "removed = @removed";
say "array = @array";
$y = "2*4";
$y = "2";
$y -= 1;
say "y = $y";
$array="kiss";
print "this is ${array}[0]\n";
say "This is $array[0]";

say "rocks = @rocks";
$rock = "This is origin rock...";
foreach $rock (@rocks) {
	$rock = "\t$rock";
	$rock .= "\n";
}
say "the Rocks are:\n", @rocks;
say "Now, Rock is $rock";
$_ = "Yabba dabba doo\n";
print;
foreach (1..5)
{
	print "I can count to $_!\n";
}
print;
say "rocks == >\n@rocks";
@rocks = reverse @rocks;
say "rocks == >\n @rocks";

@rocks = qw /
	bedrock
	slate
	rubble
	granite
	/;
@sort_rocks = sort @rocks;
say "rocks = @rocks";
say "sort_rocks = @sort_rocks";
while (($index, $value) = each @rocks)
{
	say "$index: $value";
}
@people = qw / fred barney betty /;
@people_sorted = sort @people;
$number = 42 + @people;
say "people is: @people";
say "people_sorted is: @people_sorted";
say "number = $number";

$backwards = reverse qw / a b c d /;
say "backwards is: $backwards";

@fred = 6 * 7;
@barney = ( "hello" , ' ' , "world" );
say "fred = @fred";
say "barney = @barney";
say "This is the last line of the program.";

@rocks = qw / aa bb cc dd /;
say "rocks = @rocks";
say "How many rocks do you have?";
print "I have ", scalar @rocks, " rocks!\n";

chomp(@lines = <STDIN>);
#@lines = <STDIN>;
print "lines is:\n@lines";

##chapter 4

#!/usr/bin/env perl 
#===============================================================================
#
#         FILE: ch_4.pl
#
#        USAGE: ./ch_4.pl  
#
#  DESCRIPTION: no
#
#      OPTIONS: ---
# REQUIREMENTS: ---
#         BUGS: ---
#        NOTES: ---
#       AUTHOR: YOUR NAME (), 
# ORGANIZATION: 
#      VERSION: 1.0
#      CREATED: 08/16/2014 11:09:22 PM
#     REVISION: ---
#===============================================================================

#use strict;
use warnings;
use utf8;
use 5.010;

sub marine
{
	$n += 1;
	print "Hello, sailor number $n\n";
}

&marine();
&marine();
&marine();
&marine();

$fred = 3;
$barney = 4;
$wilma = &sum_of_fred_and_barney;
print "\$wilma is $wilma.\n";

$betty = &sum_of_fred_and_barney * 3;
print "\$wilma is $betty.\n";

sub sum_of_fred_and_barney
{
	print "Hey, you called the sum_of_fred_and_barney subroutine!\n";
	$fred + $barney;
}

sub max
{
#	my ($m, $n);
#	($m, $n) = @_;
#	my ($m, $n) = @_;
#	if ($m > $n) {
#		$m;
#	}
#	else {
#		$n;
#	}
	my ($max_so_far) = shift @_;
	foreach (@_)
	{
		if ($_ > $max_so_far) {
			$max_so_far = $_;
		}
	}
	$max_so_far;
#	if ($_[0] > $_[1]) {
#		$_[0];
#	} else {
#		$_[1];
#	}
}
$n = &max(10, 15, 3, 5, 100, 101);
print "n = $n\n";

foreach (1..5)
{
	my ($square) = $_ * $_;
	print "$_ squared is $square.\n";
}

my @names = qw / fred barney betty dino wilma pebbles
		bamm-bamm/;
my $result = &which_element_is("dino", @names);
sub which_element_is
{
	my ($what, @array) = @_;
	foreach (0..$#array) {
		if ($what eq $array[$_]) {
			return $_;
		}
	}
	-1;
}
print "index is: $result.\n";

sub chomp 
{
	print "Muuch, muuch!\n";
}

&chomp;

sub gene_list
{
	my ($a, $b) = @_;
	if ($a < $b) {
		$a..$b;
	} else {
		reverse $b..$a;
	}
}

my @re = &gene_list(10, 6);
say "@re";
my @se = &gene_list(6, 10);
say "@se";

sub marine 
{
	state $n = 0;
	$n += 1;
	say "Hello, sailor number $n!";
}

&marine;
&marine;
&marine;

sub running_sum 
{
	state $sum = 0;
	state @numbers ;
	foreach my $number (@_)
	{
		push @numbers, $number;
		$sum += $number;
	}
	say "The sum of (@numbers) is $sum";
}

running_sum(5, 6);
running_sum(1..3);
running_sum(4);

#ANSI Common Lisp

(let ((x 1) (y 2))
 (+ x y))

(defun ask-number ()
 (format t "Please enter a number.")
 (let ((val (read)))
	(if (numberp val)
	 val
	 (ask-number))))

(defparameter *glob* 99)

(defconstant limit (+ *glob* 1))

(setf *glob* 98) 

(let ((n 10))
 (setf n 2)
 n)

(setf x (list 'a 'b 'c))

(setf (car x) 'n)

(setf a 'b 
 			c 'd
			e 'f)

(setf lst '(c a r a t))

(remove 'a lst)

(setf x (remove 'a x))

(defun show-squares (start end)
 (do ((i start (+ i 1)))
	((> i end) 'done)
	(format t "~A ~A ~%" i (* i i))))

(defun show-squares-1 (i end)
 (if (> i end)
	'done
	(progn
	 (format t "~A ~A ~%" i (* i i))
	 (show-squares-1 (+ i 1) end))))

(defun our-length (lst)
 (let ((len 0))
	(dolist (obj lst)
	 (setf len (+ len 1)))
	len))

(defun our-length-1 (lst)
 (if (null lst)
	0
	(+ 1 (our-length-1 (cdr lst)))))

(defun our-listp (x)
 (or (null x) (consp x)))

(defun our-atom (x)
 (not (consp x)))

(setf x '(a b c)
 			y (copy-list x))

(defun n-elt (n elt)
 (if (> n 1)
	(list n elt)
	elt))

(defun compr (current num rst)
 (if (null rst)
	(list (n-elt num current))
 (if (eql current (car rst))
	(compr current (+ 1 num) (cdr rst))
	(cons (n-elt num current) (compr (car rst) 1 (cdr rst))))))

(defun his-compr (elt n lst)
 (if (null lst)
	(list (n-elts elt n))
	(let ((next (car lst)))
	 (if (eql next elt)
		(his-compr elt (+ 1 n) (cdr lst))
		(cons (n-elts elt n)
		 (his-compr next 1 (cdr lst)))))))

(defun compress (lst)
 (if (null lst)
	nil
	(compr (car lst) 1 (cdr lst))))

(defun his-compress (x)
 (if (consp x)
	(his-compr (car x) 1 (cdr x))
	x))


(defun n-elts (elt n)
 (if (> n 1)
	(list n elt)
	elt))

(setf lst '(1 1 1 0 1 0 0 0 0 1 2 2 3))

(defun list-of (num cur)
 (if (zerop num)
	nil
	(cons cur (list-of (- num 1) cur))))

(defun uncompress (lst)
 (if (null lst)
	nil
	(let ((current (car lst)))
	 (if (listp current)
		(append (list-of (car current) (second current))
		 (uncompress (cdr lst)))
		(cons current (uncompress (cdr lst)))))))

(defun his-uncompress (lst)
 (if (null lst)
	nil
	(let ((elt (car lst))
				(rest (his-uncompress (cdr lst))))
	 (if (consp elt)
		(append (apply #'list-of elt) rest)
		(cons elt rest)))))

(setf lst-c '((3 1) 0 1 (4 0) 1 (2 2) 3))

BTW, it feels great to write lisp in vim. I CAN NOT STAND EMACS AT LAST!

One more thing, I remove those articles whose title are /run-[0-9]/ (RE;-) and backup them on my computer. Maybe I should write more blogs about techniques instead of complaining or those about myself.

Good night. 18/08/2014 00:22 AM