a fresh take on Forth in the spirit of Common Lisp
Common Lisp
Fetching latest commit…
Cannot retrieve the latest commit at this time.
Permalink
Failed to load latest commit information.
.gitignore import Jan 29, 2017
LICENSE.txt project setup Jan 30, 2017
README.md struct readme Feb 20, 2017
init-abc.lisp reversed macro eval order Feb 20, 2017
init-array.lisp added more speed Feb 17, 2017
init-cmp.lisp reversed macro eval order Feb 20, 2017
init-crypt.lisp rewrote encryption example Feb 17, 2017
init-env.lisp moved put and removed clear-env Feb 17, 2017
init-flow.lisp reversed macro eval order Feb 20, 2017
init-hash.lisp moved put and removed clear-env Feb 17, 2017
init-io.lisp added more speed Feb 17, 2017
init-list.lisp added more speed Feb 17, 2017
init-meta.lisp reversed macro eval order Feb 20, 2017
init-scope.lisp reversed macro eval order Feb 20, 2017
init-seq.lisp added more speed Feb 17, 2017
init-sig.lisp reversed macro eval order Feb 20, 2017
init-stack.lisp extracted separate struct init and thread package Feb 20, 2017
init-stat.lisp added more speed Feb 17, 2017
init-str.lisp added more speed Feb 17, 2017
init-struct.lisp simplified define-lifoo-struct Feb 20, 2017
init-task.lisp reversed macro eval order Feb 20, 2017
init-thread.lisp extracted separate struct init and thread package Feb 20, 2017
init-trace.lisp added more speed Feb 17, 2017
init-trans.lisp reversed macro eval order Feb 20, 2017
init-word.lisp reversed macro eval order Feb 20, 2017
lifoo.asd extracted separate struct init and thread package Feb 20, 2017
lifoo.lisp fixed $ expansion Feb 20, 2017
tests.lisp fixed $ expansion Feb 20, 2017
todo.org fixed $ expansion Feb 20, 2017

README.md

lifoo

a fresh take on Forth in the spirit of Common Lisp

welcome

Welcome to Lifoo, a fresh take on Forth in the spirit of Common Lisp. Besides this document, tests, inline documentation in the implementation, and built-in words in init-X.lisp; the language is documented in a series of articles here.

setup

Lifoo is included in Quicklisp, evaluating (ql:quickload "lifoo") should get you started.

repl

A basic REPL is provided for playing around with code in real time.

CL-USER> (lifoo:lifoo-repl)
Welcome to Lifoo,
press enter on empty line to evaluate,
exit ends session

Lifoo> "hello Lifoo!" print ln

hello Lifoo!
NIL

Lifoo> 1 2 +

3

Lifoo> (1 2 +)

(1 2 +)

Lifoo> (((0)
         (1)
         (t dec dup fib swap dec fib +)) match) 
       (number) :fib define

NIL

Lifoo> 21 fib

10946

Lifoo> exit

NIL
CL-USER> 

designed for embedded use

Since Lifoo was designed for embedded use, it delegates most of it's heavy lifting to Lisp. All functionality available within the language is also accessible from the outside, and calling out to Lisp is trivial.

CL-USER> (with-lifoo ()
         (lifoo-init '(:abc))
         (lifoo-push 1)
         (do-lifoo () 2 +))
3

CL-USER> (with-lifoo ()
         (lifoo-init '(:abc))
         (let ((fn (lifoo-compile-fn '(2 +))))
           (lifoo-push 1)
           (funcall fn)
           (lifoo-pop)))
3

CL-USER> (with-lifoo ()
         (lifoo-init '(:abc :meta))
         (do-lifoo ()
           (lifoo-push 1)@@
           eval 2 +))
3

stack operations

Lifoo provides several words to deal with the stack; stack pushes a list copy of the stack; dup, drop and swap will feel familiar from Forth; while swing and reset are new in town. rotl moves the top of the stack past previous two, and rotr performs the reverse operation. pick moves the picked argument to the top instead of copying and allows indexing from start or end of stack depending on sign, while stash is the opposite of pick. Code that uses pick and stash a lot should either be rewritten using basic operations or re-factored to clean up the stack; indexing the stack as a regular array is tempting but leads to sub-optimal code.

Lifoo> 1 2 3 stack

(3 2 1)

Lifoo> 1 2 3 dup stack

(3 3 2 1)

Lifoo> 1 2 3 swap stack

(2 3 1)

Lifoo> 1 2 3 drop stack

(2 1)

Lifoo> 1 2 3 swing stack

(1 2 3)

Lifoo> 1 2 3 rotl stack

(2 1 3)

Lifoo> 1 2 3 rotr stack

(1 3 2)

Lifoo> 1 2 3 0 pick stack

(1 3 2)

Lifoo> 1 2 3 -1 pick stack

(2 3 1)

Lifoo> 1 2 3 0 stash stack

(2 1 3)

Lifoo> 1 2 3 -1 stash stack

(2 3 1)

Lifoo> 1 2 3 reset stack

NIL

defining words

Lifoo offers several ways of defining new words in Lisp or Lifoo.

Lifoo> (:foo cons) () :foo define
       :bar foo
       () :foo word undefine

(:FOO . :BAR)

(define-word :array (hash-table) ()
  list array)

(define-lisp-word :cmp (nil)
  (let ((lhs (lifoo-pop))
        (rhs (lifoo-pop)))
    (lifoo-push (compare lhs rhs))))

(define-macro-word :@ (in out)
  (declare (ignore in))
  (let ((f (first out)))
    (cons (cons (first f)
                `(lifoo-push (lambda ()
                               ,(lifoo-optimize
                                 :speed (lambda-speed *lifoo*))
                               ,@(lifoo-compile
                                  (first (first out))))))
          (rest out)))))

meta

True to it's Lisp origins, Lifoo provides full support for reading, evaluating, writing and compiling code dynamically.

Lifoo> (1 2 +) eval

3

Lifoo> "1 2 +" read

(1 2 +)

Lifoo> (1 2 +) write

"1 2 +"

Lifoo> (1 2 +) write read eval

3

Lifoo> (1 2 +) compile

(PROGN (LIFOO-PUSH 1) (LIFOO-PUSH 2) (LIFOO-CALL '+))

Lifoo> (1 2 +) compile link

#<FUNCTION {1005F27E5B}>

Lifoo> (1 2 +) lambda

#<FUNCTION (LAMBDA ()) {1003B87C5B}>

Lifoo> (1 2 +) lambda call

3

Lifoo> (lifoo-push 1) lisp 41 +

42

Lifoo> (+ (lifoo:lifoo-pop) (lifoo:lifoo-pop)) link

#<FUNCTION {100649999B}>

Lifoo> 1 2 
       (lifoo:lifoo-push (+ (lifoo:lifoo-pop) (lifoo:lifoo-pop)))
       link call

3

strings

The :str protocol provides support for common string operations.

Lifoo> "abc" len

3

Lifoo> "aBc" up

"ABC"

Lifoo> "AbC" down

"abc"

Lifoo> (1 2 3 :abc "def" (4 5 6)) str

"123ABCdef(4 5 6)"

Lifoo> (1 2 3) "~a+~a=~a" fmt

"1+2=3"

Lifoo> nil "abc def, ghi." (push)@ each-word reverse

("abc" "def" "ghi")

string i/o

The :str :io protocol provides support for common character stream operations. Streams are automatically closed with the current scope.

Lifoo> (("abc" "def" "ghi") stream
        (pop)@ dump-lines
        stream-str) scope

"abc
def
ghi
"

Lifoo> (nil "abc~%def~%ghi~%" fmt
        str-stream
        nil swap
        (push)@ slurp-lines
        reverse) scope

("abc" "def" "ghi")

lists

The :list protocol provides support for common list operations.

Lifoo> 1 2 cons first 3 set drop

(3 . 1)

Lifoo> (1 . 2) rest 3 set drop

(1 . 3)

Lifoo> ((:foo . 1) (:bar . 2)) :bar get 3 set drop

((:FOO . 1) (:BAR . 3))

Lifoo> (1 2 3) 1 nth del

(1 3)

Lifoo> nil 1 push 2 push 3 push reverse

(1 2 3)

Lifoo> ((:abc . 3) (:ghi . 1) (:def . 2)) (first)@ sort

((:ABC . 3) (:DEF . 2) (:GHI . 1))

structs

The :struct protocol provides a simple but effective interface to defstruct. Structs defined from within Lifoo are anonymous in Lisp to not clash with existing definitions. Words are automatically generated for make-foo, foo-p and fields with setters when the struct word is evaluated.

Lifoo> (:struct) init

NIL

Lifoo> ((bar -1) baz) :foo struct
       nil make-foo foo?

T

Lifoo> (:bar 42) make-foo
       foo-bar

42

Lifoo> (:bar 42) make-foo
       foo-bar 43 set
       foo-bar

43

flow

The flow protocol provides various kinds of support for manipulating control flow.

goto

Lifoo provides support for goto as a basic building block for more convenient abstractions, and as a backup where opening a new scope is not an option.

Lifoo> (0 :foo label inc dup 10 > (:foo go) when) labels

10

branching

Lifoo> 1 1 = :false (:true) ?

:TRUE

Lifoo> 1 2 > :ok when

:OK

Lifoo> 1 2 < (:ok) unless

:OK

Lifoo> 42
       ((41 :fail-1) 
       (42 :ok) 
       (t :fail-2)) match cons

(:OK . 42)

looping

Besides common looping constructs; Lifoo also provides map, filter and reduce for a more functional approach.

Lifoo> 0 (inc dup 100 >) while

100

Lifoo> nil 3 (push) times

(2 1 0)

Lifoo> (1 2 3) (print ln)@ each

1
2
3
NIL

Lifoo> 0 (1 2 3) (+)@ each

6

Lifoo> (1 2 3) (2 *)@ map

(2 4 6)

Lifoo> "abacadabra" (#\a eq?)@ filter

"bcdbr"

Lifoo> (1 2 3) (+)@ reduce

6

throw & catch

Code passed to catch runs when values are thrown from preceding expressions in the same scope. The thrown value is pushed before the handler is called. label and go may be used within catch blocks without opening a labels scope. Throwing and catching is currently around twice as fast as using signals.

Lifoo> (:frisbee throw
        "fail" error)
       catch

:FRISBEE

always

Code passed to always runs even if the provided block signals errors or throws values.

Lifoo> (("fail" error)
        (:ok) always)
       handle drop

:OK

Lifoo> ((:up throw "fail" error)
        (:always) always) 
       catch cons

(:UP . :ALWAYS)

deferred actions

The :scope protocol provides support for deferring actions until scope exit.

Lifoo> (("deferred" print ln) defer 
        "hello" print ln) scope

hello
deferred
NIL

Lifoo> (41 (inc) defer 41 asseq) scope

42

signals

The :sig protocol provides support for conditions, called signals in Lifoo-speak, words are provided for signalling and handling conditions. handle pushes the condition if any, otherwise NIL.

Lifoo> ("message" error 
        :fail)
       handle error-message

"message"

variables

The :env protocol provides support for variables in the form of a global environment. Since the name-space is shared, using unique symbols for variable names is strongly recommended.

Lifoo> nil sym var 42 set env

((:G21026 . 42))

Lifoo> nil sym dup 
       var 42 set 
       drop var

42

Lifoo> nil sym dup 
       var 42 set del
       drop var

NIL

transactions

The :trans protocol provides system wide transaction support that tracks updates to the stack, any place that can be set or deleted; and the word dictionary. Transactions may be committed and rolled back several times during their lives, and are reset each time.

Lifoo> 1 2 (3 4 rollback) trans stack

(2 1)

Lifoo> 1 2 (3 4 commit 5 6 rollback) trans stack

(4 3 2 1)

Lifoo>  ((1 . :foo) (2 . :bar)) hash
        (1 get del rollback) trans
        list nil sort

((1 . :FOO) (2 . :BAR))

Lifoo> ((drop drop 42) (number number) :+ define rollback) trans
       1 2 +

3

multi-threading

All Lifoo code runs in a lifoo-exec object, the result of accessing a lifoo-exec from multiple threads at the same time is undefined. The :thread protocol allows spawning new threads as clones of the current exec. Channels are used for communicating between threads. chan takes buffer size as argument and spawn expects a channel and number of stack entries to copy to the newly started exec. All thread functionality lives in a separate package called lifoo-thread, the protocol has to be imported manually in the repl.

Lifoo> (use-package 'lifoo-thread) lisp

NIL

Lifoo> (:thread) init

NIL

Lifoo> 0 chan 
       (1 2 + send :done)@ 1 spawn swap 
       recv swap drop swap 
       wait cons

(:DONE . 3)

processes

The :thread :proc protocol simplifies dealing with threads and channels. A process is a thread with a channel and a set of word overloads to delegate functionality. proc takes a channel and expression to evaluate.

Lifoo> (use-package 'lifoo-thread) lisp

NIL

Lifoo> (:thread :proc) init

NIL

Lifoo> 1 chan (recv inc)@ proc 41 send stop

42
sinks

Lifoo provides sinks to simplify translating problems into process networks. sink takes a channel, an init expression and an expression that's run for every message with accumulated result and message pushed; and returns a new sink process. Stopping the process returns accumulated result.

Lifoo> (use-package 'lifoo-thread) lisp

NIL

Lifoo> (:thread :proc) init

NIL

Lifoo> 1 chan (nil)@ (push)@ sink
       :foo send
       :bar send
       :baz send
       stop

(:BAZ :BAR :FOO)

Lifoo> 1 chan (nil hash)@ (get dec drop)@ sink
       "abc" send
       "def" send
       "def" send
       stop list (rest)@ sort

(("def" . -2) ("abc" . -1))

Lifoo> 1 chan
       (nil hash)@
       (first -2 pick swap get
        -2 pick rest swap drop
        push drop)@
       sink
       (:foo . 1) send
       (:bar . 2) send
       (:bar . 3) send
       stop list (first)@ sort

((:BAR 3 2) (:FOO 1))

cooperative tasks

The :task protocol provides support for cooperative multi-tasking. When there is no need for actual concurrent execution, tasks offer a light weight alternative. All tasks run in the same exec thread, each with their own stack; and leave the decision of when to yield to user code. Yielding is only allowed from tag scope, but label and go may be used without opening a labels scope. Tasks have a more consistent performance profile than preemptive threads and are currently around 20x faster.

Lifoo> :foo :bar 2 () task task-stack

(:BAR :FOO)

Lifoo> 41 1 (1 task-yield +) task 
       run run
       done? swap result swap drop cons

(42 . T)

Lifoo> :foo 0 () task queue 
       :bar 1 () task queue tasks

([task: G12549 @0 (BAR) done? NIL] 
 [task: G12548 @0 (NIL) done? NIL])

Lifoo> 38 
       1 (inc task-yield inc) task queue
       1 (inc task-yield inc) task queue
       finish-tasks drop

encryption

The :crypt protocol is based on AES in CTR mode with SHA256-hashed keys, and requires identical seed and message sequence for encrypt and decrypt.

Lifoo> crypt-seed dup "secret key" dup swing swap
       crypt swing swap crypt
       "secret message" encrypt decrypt

"secret message"

classification

The :stat protocol implements a general purpose Bayesian classifier that supports any kind of tags and any number of classes. It's just as usable for classifying text based on language as emails based on subject category or badly formatted log entries based on severity.

Lifoo> bayes 
10 (drop "foo" :spam train) times 
5  (drop "foo" :ham train)  times 
15 (drop "bar" :ham train)  times 
("foo") score (rest 1 -) sort

((:SPAM . 0.65625) (:HAM . 0.34375003))

tracing

When splicing stack print ln into the code doesn't solve your problem, the :trace protocol offers sharper tools to help untangle messy stacks. Enabling tracing for individual words is supported by trace, while untrace disables all currently traced words.

Lifoo> (number number) :+ word trace

NIL

Lifoo> "Every :+ entry and exit is traced from here" log

NIL

Lifoo> 1 2 +

3

Lifoo> untrace

NIL

Lifoo> "Nothing is traced from here" log

NIL

Lifoo> 3 4 +

7

Lifoo> print-trace

LOG   Nothing is traced from here
EXIT  + #(3)
ENTER + #(1 2)
LOG   Every :+ entry and exit is traced from here
NIL

tests

Lifoo comes with a suite of tests in tests.lisp. Evaluating (cl4l-test:run-suite '(:lifoo) :reps 3) repeats all tests 3 times, cl4l:*cl4l-speed* may be set to a value between 1 and 3 to optimize most of the code involved in one go.

support

This project is running on a shoestring budget. I am completely fed up with the creative and collective compromises that come with playing the profit game. And despite hard times, I remain convinced that doing the right thing is the only way forward from here; information wants to be free and knowledge belongs everyone. Please consider helping out if you can, every contribution counts.

ps

You are perfect, immortal spirit; whole and innocent.
All is forgiven and released.

peace, out