Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

70 lines (55 sloc) 1.96 KB
;; Augmented Transition Networks using continuations.
(load "Nutils:cl_utils")
(load "")
(set g-atn-cur nil)
(macro defnode (name *arcs)
`(=function ,name (pos regs) (choose ,@*arcs)))
(macro down (sub next *cmds)
`(=bind (g-atn-cur pos regs) (,sub pos (cons nil regs))
(,next pos ,(compile-cmds *cmds))))
(macro cat (cat next *cmds)
`(if (== ($sent length) pos)
(let ((g-atn-cur (nth pos $sent)))
(if (member ',cat (types g-atn-cur))
(,next (1+ pos) ,(compile-cmds *cmds)))
(macro jump (next *cmds)
`(,next pos ,(compile-cmds *cmds)))
(function compile-cmds (cmds)
(if (null? cmds)
(then 'regs)
`(,@(car cmds) ,(compile-cmds (cdr cmds))))))
(macro up (expr)
`(let ((g-atn-cur (nth pos $sent)))
(=values ,expr pos (cdr regs))))
(macro getr (key *regs)
(if (null? *regs) ;; regs is optional
(then (set __regs 'regs)) ;; default value
(else (set __regs (car regs))))
`(let ((result (cdr (assoc ',key (car ,__regs)))))
(if (cdr result)
(then result)
(else (car result)))))
(macro set-register (key val regs)
`(cons (cons (cons ,key ,val) (car ,regs))
(cdr ,regs)))
(macro setr (key val regs)
`(set-register ',key (list ,val) ,regs))
(macro pushr (key val regs)
`(set-register ',key
(cons ,val (cdr (assoc ',key (car ,regs))))
(macro with-parses (node sent *body)
(set $sent ,sent)
(set $paths nil)
(=bind (parse __pos __regs) (,node 0 '(nil))
(if (== __pos ($sent length))
(then (progn ,@*body (fail)))
(else (fail))))))
Jump to Line
Something went wrong with that request. Please try again.