Some work on getting scripts to work, hopefully not too messy.
This commit is contained in:
parent
bf522a863d
commit
b9006ffd64
|
@ -63,3 +63,6 @@ stamp-h[0-9]
|
||||||
tmp
|
tmp
|
||||||
/.version
|
/.version
|
||||||
/doc/stamp-[0-9]
|
/doc/stamp-[0-9]
|
||||||
|
|
||||||
|
scripts/*
|
||||||
|
!scripts/*.in
|
31
Makefile.am
31
Makefile.am
|
@ -1,4 +1,5 @@
|
||||||
bin_SCRIPTS =
|
bin_SCRIPTS = scripts/join-rps \
|
||||||
|
scripts/do-rps
|
||||||
|
|
||||||
# Handle substitution of fully-expanded Autoconf variables.
|
# Handle substitution of fully-expanded Autoconf variables.
|
||||||
do_subst = $(SED) \
|
do_subst = $(SED) \
|
||||||
|
@ -32,8 +33,10 @@ SUFFIXES = .scm .go
|
||||||
.scm.go:
|
.scm.go:
|
||||||
$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
|
$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
|
||||||
|
|
||||||
SOURCES = gib-gab-gob/rps.scm \
|
SOURCES = gib-gab-gob/utils.scm \
|
||||||
gib-gab-gob/actors.scm
|
gib-gab-gob/rps.scm \
|
||||||
|
gib-gab-gob/actors.scm \
|
||||||
|
gib-gab-gob/lib.scm
|
||||||
|
|
||||||
TESTS =
|
TESTS =
|
||||||
|
|
||||||
|
@ -51,14 +54,28 @@ AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)"
|
||||||
|
|
||||||
AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
|
AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
|
||||||
|
|
||||||
info_TEXINFOS = doc/gib-gab-gob.texi
|
info_TEXINFOS = doc/version.texi \
|
||||||
|
doc/gib-gab-gob.texi
|
||||||
dvi: # Don't build dvi docs
|
dvi: # Don't build dvi docs
|
||||||
|
|
||||||
EXTRA_DIST += README \
|
EXTRA_DIST += ChangeLog \
|
||||||
HACKING \
|
AUTHORS \
|
||||||
|
NEWS \
|
||||||
|
doc/.dirstamp \
|
||||||
|
doc/stamp-vti \
|
||||||
|
doc/gib-gab-gob.info \
|
||||||
|
doc/version.info \
|
||||||
COPYING \
|
COPYING \
|
||||||
.gitignore \
|
HACKING \
|
||||||
|
README \
|
||||||
|
pre-inst-env.in \
|
||||||
|
build-aux/texinfo.tex \
|
||||||
|
build-aux/test-driver.scm \
|
||||||
|
build-aux/missing \
|
||||||
|
build-aux/install-sh \
|
||||||
|
build-aux/mdate-sh \
|
||||||
hall.scm \
|
hall.scm \
|
||||||
|
.gitignore \
|
||||||
build-aux/test-driver.scm \
|
build-aux/test-driver.scm \
|
||||||
$(TESTS)
|
$(TESTS)
|
||||||
|
|
||||||
|
|
|
@ -12,7 +12,8 @@ AM_SILENT_RULES([yes])
|
||||||
|
|
||||||
AC_CONFIG_FILES([Makefile])
|
AC_CONFIG_FILES([Makefile])
|
||||||
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
|
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
|
||||||
|
AC_CONFIG_FILES([scripts/join-rps],[chmod +x scripts/join-rps])
|
||||||
|
AC_CONFIG_FILES([scripts/do-rps],[chmod +x scripts/do-rps])
|
||||||
dnl Search for 'guile' and 'guild'. This macro defines
|
dnl Search for 'guile' and 'guild'. This macro defines
|
||||||
dnl 'GUILE_EFFECTIVE_VERSION'.
|
dnl 'GUILE_EFFECTIVE_VERSION'.
|
||||||
GUILE_PKG([3.0 2.2 2.0])
|
GUILE_PKG([3.0 2.2 2.0])
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
#:use-module (gib-gab-gob lib) ;; to go into goblins eventually!
|
#:use-module (gib-gab-gob lib) ;; to go into goblins eventually!
|
||||||
#:use-module (gib-gab-gob utils)
|
#:use-module (gib-gab-gob utils)
|
||||||
#:use-module (goblins)
|
#:use-module (goblins)
|
||||||
|
#:use-module (goblins vat)
|
||||||
#:use-module (goblins actor-lib methods)
|
#:use-module (goblins actor-lib methods)
|
||||||
#:use-module (goblins actor-lib sealers)
|
#:use-module (goblins actor-lib sealers)
|
||||||
#:use-module (oop goops)
|
#:use-module (oop goops)
|
||||||
|
@ -71,21 +72,22 @@
|
||||||
|
|
||||||
;; Convert from a prompt to a valid move.
|
;; Convert from a prompt to a valid move.
|
||||||
;; TODO: validation
|
;; TODO: validation
|
||||||
|
;; Careful! This does not play nice with the REPL!
|
||||||
(define (prompt->move)
|
(define (prompt->move)
|
||||||
(format #t "enter move? > ")
|
(format #t "enter move? > ")
|
||||||
(map string->number (string-tokenize (read-line (current-input-port)) char-set:digit)))
|
(map string->number (string-tokenize (read-line (current-input-port)) char-set:digit)))
|
||||||
|
|
||||||
;; Do our move.
|
;; Do our move.
|
||||||
(define (move!)
|
(define (move!)
|
||||||
(let ((move (prompt->move)))
|
(on (spawn-fibrous-vow (lambda () (prompt->move)))
|
||||||
(format #t "move is ~s\n" move)
|
(lambda (move)
|
||||||
($ board 'choose! move mark)
|
(format #t "move is ~s\n" move)
|
||||||
move))
|
($ board 'choose! move mark)
|
||||||
|
move)))
|
||||||
|
|
||||||
(define (loop-move peer)
|
(define (loop-move peer)
|
||||||
(format #t "begin move w ~s\n" peer)
|
(format #t "begin move w ~s\n" peer)
|
||||||
(on (<- peer 'exchange-move receiver
|
(on (<- peer 'exchange-move receiver (move!))
|
||||||
(move!))
|
|
||||||
;; get exchange
|
;; get exchange
|
||||||
(lambda (peer-move)
|
(lambda (peer-move)
|
||||||
;; Actually respond to the move
|
;; Actually respond to the move
|
||||||
|
@ -115,9 +117,9 @@
|
||||||
|
|
||||||
(methods
|
(methods
|
||||||
;; Switch coords for clarity
|
;; Switch coords for clarity
|
||||||
[(ref coords) (
|
[(ref coords)
|
||||||
(format #t "coords are ~s\n" coords)
|
((format #t "coords are ~s\n" coords)
|
||||||
(match coords ((x y) (array-ref arr y x))))]
|
(match coords ((x y) (array-ref arr y x))))]
|
||||||
[(chosen? coords) (not (not ($ ($ self 'ref coords) 'get)))]
|
[(chosen? coords) (not (not ($ ($ self 'ref coords) 'get)))]
|
||||||
[(choose! coords mark-char)
|
[(choose! coords mark-char)
|
||||||
(if ($ self 'chosen? coords)
|
(if ($ self 'chosen? coords)
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
#:use-module (goblins ocapn ids)
|
#:use-module (goblins ocapn ids)
|
||||||
#:use-module (goblins ocapn netlayer testuds)
|
#:use-module (goblins ocapn netlayer testuds)
|
||||||
#:use-module (oop goops)
|
#:use-module (oop goops)
|
||||||
#:export (<rps-host> <rps-client> join-rps pick-rps rps-winner rock-paper-scissors))
|
#:export (do-rps join-rps pick-rps rps-winner rock-paper-scissors))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Host logic
|
;; Host logic
|
||||||
|
@ -30,6 +30,9 @@
|
||||||
(unless (access? tmp X_OK) (mkdir tmp))
|
(unless (access? tmp X_OK) (mkdir tmp))
|
||||||
(spawn ^testuds-netlayer tmp))
|
(spawn ^testuds-netlayer tmp))
|
||||||
|
|
||||||
|
(define (do-rps user-name)
|
||||||
|
(make <rps-host> #:user-name user-name))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Client logic
|
;; Client logic
|
||||||
;;
|
;;
|
||||||
|
|
57
guix.scm
57
guix.scm
|
@ -15,7 +15,62 @@
|
||||||
(version "0.1")
|
(version "0.1")
|
||||||
(source "./gib-gab-gob-0.1.tar.gz")
|
(source "./gib-gab-gob-0.1.tar.gz")
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(arguments `())
|
(arguments
|
||||||
|
`(#:modules
|
||||||
|
((ice-9 match)
|
||||||
|
(ice-9 ftw)
|
||||||
|
,@%gnu-build-system-modules)
|
||||||
|
#:phases
|
||||||
|
(modify-phases
|
||||||
|
%standard-phases
|
||||||
|
(add-after
|
||||||
|
'install
|
||||||
|
'hall-wrap-binaries
|
||||||
|
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||||
|
(let* ((compiled-dir
|
||||||
|
(lambda (out version)
|
||||||
|
(string-append
|
||||||
|
out
|
||||||
|
"/lib/guile/"
|
||||||
|
version
|
||||||
|
"/site-ccache")))
|
||||||
|
(uncompiled-dir
|
||||||
|
(lambda (out version)
|
||||||
|
(string-append
|
||||||
|
out
|
||||||
|
"/share/guile/site"
|
||||||
|
(if (string-null? version) "" "/")
|
||||||
|
version)))
|
||||||
|
(dep-path
|
||||||
|
(lambda (env modules path)
|
||||||
|
(list env
|
||||||
|
":"
|
||||||
|
'prefix
|
||||||
|
(cons modules
|
||||||
|
(map (lambda (input)
|
||||||
|
(string-append
|
||||||
|
(assoc-ref inputs input)
|
||||||
|
path))
|
||||||
|
,''("guile-goblins"))))))
|
||||||
|
(out (assoc-ref outputs "out"))
|
||||||
|
(bin (string-append out "/bin/"))
|
||||||
|
(site (uncompiled-dir out "")))
|
||||||
|
(match (scandir site)
|
||||||
|
(("." ".." version)
|
||||||
|
(for-each
|
||||||
|
(lambda (file)
|
||||||
|
(wrap-program
|
||||||
|
(string-append bin file)
|
||||||
|
(dep-path
|
||||||
|
"GUILE_LOAD_PATH"
|
||||||
|
(uncompiled-dir out version)
|
||||||
|
(uncompiled-dir "" version))
|
||||||
|
(dep-path
|
||||||
|
"GUILE_LOAD_COMPILED_PATH"
|
||||||
|
(compiled-dir out version)
|
||||||
|
(compiled-dir "" version))))
|
||||||
|
,''("join-rps" "do-rps"))
|
||||||
|
#t))))))))
|
||||||
(native-inputs
|
(native-inputs
|
||||||
`(("autoconf" ,autoconf)
|
`(("autoconf" ,autoconf)
|
||||||
("automake" ,automake)
|
("automake" ,automake)
|
||||||
|
|
12
hall.scm
12
hall.scm
|
@ -16,12 +16,15 @@
|
||||||
(files (libraries
|
(files (libraries
|
||||||
((directory
|
((directory
|
||||||
"gib-gab-gob"
|
"gib-gab-gob"
|
||||||
((compiled-scheme-file "actors")
|
((scheme-file "utils")
|
||||||
(scheme-file "rps")
|
(scheme-file "rps")
|
||||||
(scheme-file "actors")
|
(scheme-file "actors")
|
||||||
(compiled-scheme-file "rps")))))
|
(scheme-file "lib")))))
|
||||||
(tests ((directory "tests" ())))
|
(tests ((directory "tests" ())))
|
||||||
(programs ((directory "scripts" ())))
|
(programs
|
||||||
|
((directory
|
||||||
|
"scripts"
|
||||||
|
((in-file "join-rps") (in-file "do-rps")))))
|
||||||
(documentation
|
(documentation
|
||||||
((text-file "ChangeLog")
|
((text-file "ChangeLog")
|
||||||
(text-file "AUTHORS")
|
(text-file "AUTHORS")
|
||||||
|
@ -32,14 +35,13 @@
|
||||||
(text-file ".dirstamp")
|
(text-file ".dirstamp")
|
||||||
(text-file "stamp-vti")
|
(text-file "stamp-vti")
|
||||||
(info-file "gib-gab-gob")
|
(info-file "gib-gab-gob")
|
||||||
|
(info-file "version")
|
||||||
(texi-file "gib-gab-gob")))
|
(texi-file "gib-gab-gob")))
|
||||||
(text-file "COPYING")
|
(text-file "COPYING")
|
||||||
(text-file "HACKING")
|
(text-file "HACKING")
|
||||||
(text-file "README")))
|
(text-file "README")))
|
||||||
(infrastructure
|
(infrastructure
|
||||||
((in-file "pre-inst-env")
|
((in-file "pre-inst-env")
|
||||||
(automake-file "Makefile")
|
|
||||||
(autoconf-file "configure")
|
|
||||||
(directory
|
(directory
|
||||||
"build-aux"
|
"build-aux"
|
||||||
((tex-file "texinfo")
|
((tex-file "texinfo")
|
||||||
|
|
|
@ -0,0 +1,8 @@
|
||||||
|
#!@GUILE@ --no-auto-compile
|
||||||
|
-*- scheme -*-
|
||||||
|
!#
|
||||||
|
|
||||||
|
(use-modules (gib-gab-gob rps))
|
||||||
|
(apply do-rps (cdr (command-line)))
|
||||||
|
|
||||||
|
(while #t #f) ;; indefinitely
|
|
@ -0,0 +1,8 @@
|
||||||
|
#!@GUILE@ --no-auto-compile
|
||||||
|
-*- scheme -*-
|
||||||
|
!#
|
||||||
|
|
||||||
|
(use-modules (gib-gab-gob rps))
|
||||||
|
(apply join-rps (cdr (command-line)))
|
||||||
|
|
||||||
|
(while #t #f) ;; indefinitely
|
Loading…
Reference in New Issue