arduino-copilot 1.4.0 → 1.5.0

raw patch · 19 files changed

+1026/−248 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +27/−0
• README +1/−1
• TODO +27/−60
• arduino-copilot.cabal +9/−1
• examples/eepromrange/demo.hs +8/−1
• examples/robot/Makefile +127/−0
• examples/robot/README +24/−0
• examples/robot/demo.hs +90/−0
• examples/robot/pre-build-hook.sh +2/−0
• examples/waterheater/Makefile +127/−0
• examples/waterheater/README +24/−0
• examples/waterheater/demo.hs +68/−0
• examples/waterheater/pre-build-hook.sh +2/−0
• src/Copilot/Arduino.hs +88/−30
• src/Copilot/Arduino/Internals.hs +187/−59
• src/Copilot/Arduino/Library/EEPROMex.hs +158/−63
• src/Copilot/Arduino/Library/Serial.hs +9/−2
• src/Copilot/Arduino/Library/Serial/Device.hs +33/−25
• src/Copilot/Arduino/Main.hs +15/−6

@@ -1,3 +1,30 @@+arduino-copilot (1.5.0) unstable; urgency=medium++  * Added whenB and scheduleB sketch combinators.+  * Replaced Copolot's ifThenElse with a polymorphic one that, as well+    as choosing between two Streams, can choose between two Sketches+    or two TypedBehaviors.+  * Added robot example, a simple line-follower that is an example+    of using ifB to compose simple Sketches into a more complex one.+  * Added liftB and liftB2, which let Copilot DSL expressions operate on+    TypedBehavior.+  * Added waterheater example, which shows how to keep units of measurement+    separated using TypedBehavior.+  * Copolot.Arduino now exports IsDigitalIOPin, IsAnalogInputPin, IsPWMPin,+    and the TypedBehavior constructor.+  * Reading from the same input in different parts of the same program+    no longer generates C that fails to compile. Instead, a single read+    is done per iteration.+  * Writing to the same output in different parts of a sketch no longer+    generates C code that fails to compile. However, if different values+    are written in the same iteration, it's undefined what order the writes+    will happen in.+  * Add EEPROMex.scanRange to read from EEPROM.+  * Fix bug in serial str's handling of special characters in the string.+  * Copilot.Arduino.Internals API changed.++ -- Joey Hess <id@joeyh.name>  Fri, 07 Feb 2020 14:44:02 -0800+ arduino-copilot (1.4.0) unstable; urgency=medium    * New Copilot.Arduino.Library.EEPROMex module.

@@ -8,7 +8,7 @@ 	import Copilot.Arduino 	main = arduino $ do 		led =: blinking-		delay =: constant 100+		delay =: MilliSeconds (constant 100)  This and other examples are included in the examples/ directory, each with their own README explaining how to build and use them.

@@ -1,65 +1,26 @@--* Currently all Inputs run each time through the loop, which could be a-  problem when an input is slow. It would be good if the @: operator could-  also rate limit when Inputs occur.--  Copilot does not let `extern` be limited, but the actual input operation-  is done by ardino-copilot's readInput, and extern then just uses the-  value it sets. So, make each Input add a trigger, that sets a flag-  variable, and in readInput just check if the flag is set.--  It should be possible to implement this w/o adding overhead when @: is-  not used on an Input. Either, avoid checking the flag in this case,-  or check that the C compiler can optimise away a check of a flag that-  always succeeds.--  (Note that, if @: makes the first read be skipped, or all of them,-  there would need to be a default value produced. Or, to avoid default-  values, it could force the first read to always occur.)--  An Input returns a Behavior; with @: it should really return an Event.-  But, that would need boilerplate to get the Stream out to use.-- 	- foo <- input pin4- 	+ Event foo _ <- input pin4 @: longer_and_longer-	  pin5 =: streamfunc foo--  Seems not worth the distinction of Behavior vs Event here.-  -* If @: could somehow be applied to a whole Sketch () action, it would be-  possible to write some interesting combinators based on it, eg:--  ifM :: Stream Bool -> Sketch a -> Sketch a -> Sketch a--  schedule :: Stream Int -> [(Int, Sketch a] -> Sketch a--  Although, it may be that these would cause some explosion of the binary-  size, since each trigger in a Sketch's guard would, presumably, turn-  into a C function that duplicates the same code. Perhaps the C compiler-  could notice the common expressions and optimise them?--  Anyway, this would need the Sketch () to contain not a Spec, which I-  think is too opaque, but a data structure that allows adjusting the-  guards of `trigger` and an equivilant guard be added for `extern`.-  (See also, previous item.) And, it pushes things in the direction of-  needing to support multiple calls to Serial.display and wait with -  different parameters, and generally never hardcode the name of the C-  function called by a trigger.--  Now, I like the way that @: currently turns a behavior into an event, in-  FRP style. If @: is applied to a whole Sketch, it would stop doing that.-  That feels like a loss. So, perhaps @: stays as-is, and there's a new-  combinator to do the same thing to a Sketch. Internally, they would both-  adjust the guards of triggers. A bit redundant, but seems worth it to-  keep @: FRP style. (Making @: more polymorphic is also a possibility.)+* liftB and liftB2 imply liftB[3..5] at least ought to exist. -  Another combinator, that I considered but rejected is:+  Really, want something like Applicative. But apparently TypedBehavior+  is not a Functor, and so cannot be Applicative. There might be some+  way to use type classes to do arbitrary arity lifting. Take a look+  at QuickCheck and printf for ideas. Also see+  https://www.seas.upenn.edu/~sweirich/papers/aritygen -  (|:) :: Sketch a -> Sketch a -> Sketch a +  Alternative might be to wrap all of Copilot DSL's functions like (>)+  with ones that operate on TypedBehavior and Event. +  (Then rename TypedBehavior to Behavior and make everything produce+  and consume that, rather than the underlying Stream?) -  The problem with this is that in foo |: bar |: baz, one of the-  three never runs, because both combinators must branch on the same-  Stream Bool.+* using whenB with an input' makes the interpretation see+  each value from the list, even when the whenB is supposed to prevent the+  input' from having run, and the value should be whatever was input+  previously. This may not be fixable w/o Copilot DSL support+  for limiting when inputs happen, at least as far as what the interpreter+  displays as values of the input goes. But, it should be fixable+  as far as the value that is input, at least in theory, by ignoring+  the input values that should not have been input. The  Copilot+  DSL code used to do that may increase the size of the C program+  unncessarily though.  * The way serial output works is somewhat unsatisfying, because   it does not take a Stream FormatOutput. So the Copilot DSL can't be used@@ -72,6 +33,9 @@   seems like it would probably get in the way of actually constructing such   a stream: https://github.com/Copilot-Language/copilot/issues/36 +  The workaround, for now, is to use ifM_ etc to switch between different+  sketches for the different output formats.+ * analogReference()   Takes one of a set of defines, which vary depending on board,   so how to pass that through Copilot? Could write a C@@ -88,5 +52,8 @@ * EEPROMex supports writing individial bits of a byte, but the haskell   library does not expose it. What would be a good haskell interface to   that, a Stream (Array 8 Bool)?-* reading from EEPROMex ranges * Factor out Range from EEPROMex, and use it to also implement RAM ranges.+  Maybe redundant with Copilot's support for Array, but Copilot's+  facilities for operating on Array are limited so it could be useful to+  have a Range interface too.+

@@ -1,5 +1,5 @@ Name: arduino-copilot-Version: 1.4.0+Version: 1.5.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -53,6 +53,14 @@   examples/eepromrange/README   examples/eepromrange/demo.hs   examples/eepromrange/pre-build-hook.sh+  examples/robot/Makefile+  examples/robot/README+  examples/robot/demo.hs+  examples/robot/pre-build-hook.sh+  examples/waterheater/Makefile+  examples/waterheater/README+  examples/waterheater/demo.hs+  examples/waterheater/pre-build-hook.sh   test.hs  Library

@@ -34,7 +34,14 @@ 	range <- EEPROM.allocRange sz :: Sketch (EEPROM.Range ADC) 	v <- input' a1 ([10, 20..] :: [ADC]) 	range =: EEPROM.sweepRange 0 v @: frequency 3+	oldv <- input' (EEPROM.scanRange range 1) [11..] :: Sketch (Behavior ADC) 	led =: frequency 3-	Serial.device =: [ Serial.show v, Serial.char '\n']+	Serial.device =:+		[ Serial.str "a1:"+		, Serial.show v+		, Serial.str " old EEPROM value:"+		, Serial.show oldv+		, Serial.char '\n'+		] 	delay =: MilliSeconds (constant 10000) 	Serial.baud 9600

@@ -0,0 +1,127 @@+# Arduino Make file. Refer to https://github.com/sudar/Arduino-Makefile+BOARD_TAG    = uno+include /usr/share/arduino/Arduino.mk++# --- leonardo (or pro micro w/leo bootloader)+#BOARD_TAG    = leonardo+#MONITOR_PORT = /dev/ttyACM0+#include /usr/share/arduino/Arduino.mk++# --- mega2560 ide 1.0+#BOARD_TAG    = mega2560+#ARDUINO_PORT = /dev/ttyACM0+#include /usr/share/arduino/Arduino.mk++# --- mega2560 ide 1.6+#BOARD_TAG    = mega+#BOARD_SUB    = atmega2560+#MONITOR_PORT = /dev/ttyACM0+#ARDUINO_DIR  = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- nano ide 1.0+#BOARD_TAG    = nano328+#MONITOR_PORT = /dev/ttyUSB0+#include /usr/share/arduino/Arduino.mk++# --- nano ide 1.6+#BOARD_TAG   = nano+#BOARD_SUB   = atmega328+#ARDUINO_DIR = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- pro mini+#BOARD_TAG    = pro5v328+#MONITOR_PORT = /dev/ttyUSB0+#include /usr/share/arduino/Arduino.mk++# --- sparkfun pro micro+#BOARD_TAG         = promicro16+#ALTERNATE_CORE    = promicro+#BOARDS_TXT        = $(HOME)/arduino/hardware/promicro/boards.txt+#BOOTLOADER_PARENT = $(HOME)/arduino/hardware/promicro/bootloaders+#BOOTLOADER_PATH   = caterina+#BOOTLOADER_FILE   = Caterina-promicro16.hex+#ISP_PROG     	   = usbasp+#AVRDUDE_OPTS 	   = -v+#include /usr/share/arduino/Arduino.mk++# --- chipkit+#BOARD_TAG = mega_pic32+#MPIDE_DIR = /where/you/installed/mpide-0023-linux64-20130817-test+#include /usr/share/arduino/chipKIT.mk++# --- pinoccio+#BOARD_TAG         = pinoccio256+#ALTERNATE_CORE    = pinoccio+#BOOTLOADER_PARENT = $(HOME)/arduino/hardware/pinoccio/bootloaders+#BOOTLOADER_PATH   = STK500RFR2/release_0.51+#BOOTLOADER_FILE   = boot_pinoccio.hex+#CFLAGS_STD        = -std=gnu99+#CXXFLAGS_STD      = -std=gnu++11+#include /usr/share/arduino/Arduino.mk++# --- fio+#BOARD_TAG = fio+#include /usr/share/arduino/Arduino.mk++# --- atmega-ng ide 1.6+#BOARD_TAG    = atmegang+#BOARD_SUB    = atmega168+#MONITOR_PORT = /dev/ttyACM0+#ARDUINO_DIR  = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- arduino-tiny ide 1.0+#ISP_PROG     	    = usbasp+#BOARD_TAG          = attiny85at8+#ALTERNATE_CORE     = tiny+#ARDUINO_VAR_PATH   = $(HOME)/arduino/hardware/tiny/cores/tiny+#ARDUINO_CORE_PATH  = $(HOME)/arduino/hardware/tiny/cores/tiny+#AVRDUDE_OPTS 	    = -v+#include /usr/share/arduino/Arduino.mk++# --- arduino-tiny ide 1.6+#ISP_PROG       = usbasp+#BOARD_TAG      = attiny85at8+#ALTERNATE_CORE = tiny+#ARDUINO_DIR    = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- damellis attiny ide 1.0+#ISP_PROG       = usbasp+#BOARD_TAG      = attiny85+#ALTERNATE_CORE = attiny-master+#AVRDUDE_OPTS   = -v+#include /usr/share/arduino/Arduino.mk++# --- damellis attiny ide 1.6+#ISP_PROG       = usbasp+#BOARD_TAG      = attiny+#BOARD_SUB      = attiny85+#ALTERNATE_CORE = attiny+#F_CPU          = 16000000L+#ARDUINO_DIR    = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- teensy3+#BOARD_TAG 	 = teensy31+#ARDUINO_DIR = /where/you/installed/the/patched/teensy/arduino-1.0.6+#include /usr/share/arduino/Teensy.mk++# --- mighty 1284p+#BOARD_TAG         = mighty_opt+#BOARDS_TXT        = $(HOME)/arduino/hardware/mighty-1284p/boards.txt+#BOOTLOADER_PARENT = $(HOME)/arduino/hardware/mighty-1284p/bootloaders+#BOOTLOADER_PATH   = optiboot+#BOOTLOADER_FILE   = optiboot_atmega1284p.hex+#ISP_PROG     	   = usbasp+#AVRDUDE_OPTS 	   = -v+#include /usr/share/arduino/Arduino.mk++# --- atmega328p on breadboard+#BOARD_TAG    = atmega328bb+#ISP_PROG     = usbasp+#AVRDUDE_OPTS = -v+#BOARDS_TXT   = $(HOME)/arduino/hardware/breadboard/boards.txt+#include /usr/share/arduino/Arduino.mk

@@ -0,0 +1,24 @@+This is a demo program using arduino-copilot. ++To build the C code:++	runghc demo.hs++The resulting `.ino` sketch can be loaded into the Arduino IDE and flashed+to an Arduino Uno board using the IDE.++## Arduino-Makefile integration++The `Makefile` and `pre-build-hook.sh` show how to integrate arduino-copilot+with <https://github.com/sudar/Arduino-Makefile>. This automates generating+the C code, compiling that, and flashing it onto an Arduino Uno board,+with a single command++	make upload++Note that you will need to manually build the C code once, as shown above+, since the Arduino-Makefile expects to find a `.ino` file.++The path in the `Makefile` to `Arduino.mk` may need to be adjusted (the+default is the location where on a Debian system, `apt-get install+arduino-mk` will install it).

@@ -0,0 +1,90 @@+{- A simple line-following robot.+ -+ - This is not the most efficient or best way to implement it+ - (it compiles to around 500 lines of C code), but+ - it is a good example of building up a Sketch by combining+ - simpler Sketches.+ -}++{-# LANGUAGE RebindableSyntax #-}++import Copilot.Arduino.Uno+import qualified Copilot.Arduino.Library.Serial.XBee as XBee++main :: IO ()+main = arduino $ do+	XBee.configure pin2 pin3 (XBee.Baud 9600)+	emergencystop <- input pin4+	if emergencystop+		then stop+		else do+			ll <- leftLineSensed+			rl <- rightLineSensed+			if ll && rl+				then stop+				else if ll+					then turnLeft+					else if rl+						then turnRight+						else goForward++stop :: Sketch ()+stop = do+	led =: true+	XBee.device =: [XBee.str "stopped\n"]+	rightWheelMotor true (constant 0)+	leftWheelMotor true (constant 0)++goForward :: Sketch ()+goForward = do+	led =: false+	XBee.device =: [XBee.str "forward\n"]+	leftWheelMotor true (constant 255)+	rightWheelMotor true (constant 255)++turnLeft :: Sketch ()+turnLeft = do+	led =: blinking+	XBee.device =: [XBee.str "turn left\n"]+	rightWheelMotor true (constant 128)+	leftWheelMotor false (constant 128)++turnRight :: Sketch ()+turnRight = do+	led =: blinking+	XBee.device =: [XBee.str "turn right\n"]+	rightWheelMotor false (constant 128)+	leftWheelMotor true (constant 128)++leftLineSensed :: Sketch (Behavior Bool)+leftLineSensed = lineSensed a1 "left"++rightLineSensed :: Sketch (Behavior Bool)+rightLineSensed = lineSensed a2 "right"++lineSensed :: IsAnalogInputPin t => Pin t -> [Char] -> Sketch (Stream Bool)+lineSensed pin desc = do+	v <- input pin :: Sketch (Behavior ADC)+	XBee.device =: +		[ XBee.str (desc <> " line sensor:")+		, XBee.show v+		, XBee.char '\n'+		]+	return (v > 50)++leftWheelMotor :: Behavior Bool -> Behavior Word8 -> Sketch ()+leftWheelMotor = wheelMotor pin5 pin6++rightWheelMotor :: Behavior Bool -> Behavior Word8 -> Sketch ()+rightWheelMotor = wheelMotor pin9 pin10++wheelMotor+	:: (IsPWMPin t1, IsPWMPin t2)+	=> Pin t1 -- ^ pin to drive motor forward+	-> Pin t2 -- ^ pin to drive motor backward+	-> Behavior Bool -- ^ True when driving forward+	-> Behavior Word8 -- ^ How hard to drive the motor.+	-> Sketch ()+wheelMotor forwardpin backwardpin forward power = do+	forwardpin =: pwm (if forward then power else constant 0)+	backwardpin =: pwm (if forward then constant 0 else power)

@@ -0,0 +1,2 @@+#!/bin/sh+exec runghc demo.hs

@@ -0,0 +1,127 @@+# Arduino Make file. Refer to https://github.com/sudar/Arduino-Makefile+BOARD_TAG    = uno+include /usr/share/arduino/Arduino.mk++# --- leonardo (or pro micro w/leo bootloader)+#BOARD_TAG    = leonardo+#MONITOR_PORT = /dev/ttyACM0+#include /usr/share/arduino/Arduino.mk++# --- mega2560 ide 1.0+#BOARD_TAG    = mega2560+#ARDUINO_PORT = /dev/ttyACM0+#include /usr/share/arduino/Arduino.mk++# --- mega2560 ide 1.6+#BOARD_TAG    = mega+#BOARD_SUB    = atmega2560+#MONITOR_PORT = /dev/ttyACM0+#ARDUINO_DIR  = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- nano ide 1.0+#BOARD_TAG    = nano328+#MONITOR_PORT = /dev/ttyUSB0+#include /usr/share/arduino/Arduino.mk++# --- nano ide 1.6+#BOARD_TAG   = nano+#BOARD_SUB   = atmega328+#ARDUINO_DIR = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- pro mini+#BOARD_TAG    = pro5v328+#MONITOR_PORT = /dev/ttyUSB0+#include /usr/share/arduino/Arduino.mk++# --- sparkfun pro micro+#BOARD_TAG         = promicro16+#ALTERNATE_CORE    = promicro+#BOARDS_TXT        = $(HOME)/arduino/hardware/promicro/boards.txt+#BOOTLOADER_PARENT = $(HOME)/arduino/hardware/promicro/bootloaders+#BOOTLOADER_PATH   = caterina+#BOOTLOADER_FILE   = Caterina-promicro16.hex+#ISP_PROG     	   = usbasp+#AVRDUDE_OPTS 	   = -v+#include /usr/share/arduino/Arduino.mk++# --- chipkit+#BOARD_TAG = mega_pic32+#MPIDE_DIR = /where/you/installed/mpide-0023-linux64-20130817-test+#include /usr/share/arduino/chipKIT.mk++# --- pinoccio+#BOARD_TAG         = pinoccio256+#ALTERNATE_CORE    = pinoccio+#BOOTLOADER_PARENT = $(HOME)/arduino/hardware/pinoccio/bootloaders+#BOOTLOADER_PATH   = STK500RFR2/release_0.51+#BOOTLOADER_FILE   = boot_pinoccio.hex+#CFLAGS_STD        = -std=gnu99+#CXXFLAGS_STD      = -std=gnu++11+#include /usr/share/arduino/Arduino.mk++# --- fio+#BOARD_TAG = fio+#include /usr/share/arduino/Arduino.mk++# --- atmega-ng ide 1.6+#BOARD_TAG    = atmegang+#BOARD_SUB    = atmega168+#MONITOR_PORT = /dev/ttyACM0+#ARDUINO_DIR  = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- arduino-tiny ide 1.0+#ISP_PROG     	    = usbasp+#BOARD_TAG          = attiny85at8+#ALTERNATE_CORE     = tiny+#ARDUINO_VAR_PATH   = $(HOME)/arduino/hardware/tiny/cores/tiny+#ARDUINO_CORE_PATH  = $(HOME)/arduino/hardware/tiny/cores/tiny+#AVRDUDE_OPTS 	    = -v+#include /usr/share/arduino/Arduino.mk++# --- arduino-tiny ide 1.6+#ISP_PROG       = usbasp+#BOARD_TAG      = attiny85at8+#ALTERNATE_CORE = tiny+#ARDUINO_DIR    = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- damellis attiny ide 1.0+#ISP_PROG       = usbasp+#BOARD_TAG      = attiny85+#ALTERNATE_CORE = attiny-master+#AVRDUDE_OPTS   = -v+#include /usr/share/arduino/Arduino.mk++# --- damellis attiny ide 1.6+#ISP_PROG       = usbasp+#BOARD_TAG      = attiny+#BOARD_SUB      = attiny85+#ALTERNATE_CORE = attiny+#F_CPU          = 16000000L+#ARDUINO_DIR    = /where/you/installed/arduino-1.6.5+#include /usr/share/arduino/Arduino.mk++# --- teensy3+#BOARD_TAG 	 = teensy31+#ARDUINO_DIR = /where/you/installed/the/patched/teensy/arduino-1.0.6+#include /usr/share/arduino/Teensy.mk++# --- mighty 1284p+#BOARD_TAG         = mighty_opt+#BOARDS_TXT        = $(HOME)/arduino/hardware/mighty-1284p/boards.txt+#BOOTLOADER_PARENT = $(HOME)/arduino/hardware/mighty-1284p/bootloaders+#BOOTLOADER_PATH   = optiboot+#BOOTLOADER_FILE   = optiboot_atmega1284p.hex+#ISP_PROG     	   = usbasp+#AVRDUDE_OPTS 	   = -v+#include /usr/share/arduino/Arduino.mk++# --- atmega328p on breadboard+#BOARD_TAG    = atmega328bb+#ISP_PROG     = usbasp+#AVRDUDE_OPTS = -v+#BOARDS_TXT   = $(HOME)/arduino/hardware/breadboard/boards.txt+#include /usr/share/arduino/Arduino.mk

@@ -0,0 +1,24 @@+This is a demo program using arduino-copilot. ++To build the C code:++	runghc demo.hs++The resulting `.ino` sketch can be loaded into the Arduino IDE and flashed+to an Arduino Uno board using the IDE.++## Arduino-Makefile integration++The `Makefile` and `pre-build-hook.sh` show how to integrate arduino-copilot+with <https://github.com/sudar/Arduino-Makefile>. This automates generating+the C code, compiling that, and flashing it onto an Arduino Uno board,+with a single command++	make upload++Note that you will need to manually build the C code once, as shown above+, since the Arduino-Makefile expects to find a `.ino` file.++The path in the `Makefile` to `Arduino.mk` may need to be adjusted (the+default is the location where on a Debian system, `apt-get install+arduino-mk` will install it).

@@ -0,0 +1,68 @@+{- Controlling a hot water heater.+ -+ - This shows how additional types can be used to eg, keep track of units+ - of measurement, while using the Copilot DSL.+ -}++{-# LANGUAGE RebindableSyntax #-}++import Copilot.Arduino.Uno+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as L++-- For use as phantom types in TypedBehavior+data PSI+data Celsius++maxSafePSI :: TypedBehavior PSI Float+maxSafePSI = TypedBehavior (constant 45)++maxWaterTemp :: TypedBehavior Celsius Float+maxWaterTemp = TypedBehavior (constant 35)++warmWaterTemp :: TypedBehavior Celsius Float+warmWaterTemp = TypedBehavior (constant 30)++isSafeTemp :: TypedBehavior Celsius Float -> Behavior Bool+isSafeTemp t = liftB2 (<) t maxWaterTemp++isSafePSI :: TypedBehavior PSI Float -> Behavior Bool+isSafePSI p = liftB2 (<) p maxSafePSI++-- Avoid explosions and scalding water.+isSafeToHeat :: TypedBehavior PSI Float -> NonEmpty (TypedBehavior Celsius Float) -> Behavior Bool+isSafeToHeat p cs = foldl (&&) (isSafePSI p) (L.map isSafeTemp cs)++-- Convert a raw value read from an ADC into a temperature in Celsius.+--+-- Assumes the ADC value is 0 at 0F, and 1024 at 200F.+adcToCelsius :: Behavior ADC -> TypedBehavior Celsius Float+adcToCelsius v = TypedBehavior $ v' * (constant 200 / constant 1024)+  where+	v' :: Behavior Float+	v' = unsafeCast v++-- Convert a raw value read from an ADC into a PSI.+--+-- Assumes the ADCI value is 0 at 0 PSI, and 1024 at 150 PSI.+adcToPSI :: Behavior ADC -> TypedBehavior PSI Float+adcToPSI v = TypedBehavior $ v' * (constant 150 / constant 1024)+  where+	v' :: Behavior Float+	v' = unsafeCast v++main :: IO ()+main = arduino $ do+	uppertemp <- adcToCelsius <$> input a1+	lowertemp <- adcToCelsius <$> input a2+	pressure <- adcToPSI <$> input a3+	let upperheatingelement = pin4+	let lowerheatingelement = pin5+	whenB (isSafeToHeat pressure (uppertemp :| [lowertemp])) $ do+		-- Run the upper heating element if the upper water temp is+		-- low, to provide hot water on demand. Run the lower+		-- heating element only when the upper is off.+		let runupper = liftB2 (<) uppertemp warmWaterTemp+		upperheatingelement =: runupper+		lowerheatingelement =: not runupper+	delay =: MilliSeconds 1000

@@ -0,0 +1,2 @@+#!/bin/sh+exec runghc demo.hs

@@ -11,6 +11,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Copilot.Arduino ( 	-- * Arduino sketch generation@@ -19,7 +20,7 @@ 	Pin, 	-- * Functional reactive programming 	Behavior,-	TypedBehavior,+	TypedBehavior(..), 	Event, 	(@:), 	-- * Inputs@@ -45,17 +46,27 @@ 	MicroSeconds(..), 	ClockMillis, 	ClockMicros,+	IsDigitalIOPin,+	IsAnalogInputPin,+	IsPWMPin, 	-- * Utilities 	blinking, 	firstIteration, 	frequency, 	sketchSpec,+	-- * Combinators+	liftB,+	liftB2,+	whenB,+	scheduleB,+	ifThenElse,+	IfThenElse, 	-- * Copilot DSL 	---	-- | The Copilot.Language module is re-exported here, including-	-- a version of the Prelude modified for it. You should enable-	-- the RebindableSyntax language extension in your program-	-- to use the Copilot DSL.+	-- | Most of the Copilot.Language module is re-exported here,+	-- including a version of the Prelude modified for it. You+	-- should enable the RebindableSyntax language extension in+	-- your program to use the Copilot DSL. 	-- 	-- > {-# LANGUAGE RebindableSyntax #-} 	--@@ -65,8 +76,9 @@ 	module X, ) where -import Language.Copilot as X hiding (Stream)+import Language.Copilot as X hiding (Stream, ifThenElse) import Language.Copilot (Stream)+import qualified Language.Copilot import Copilot.Arduino.Internals import Copilot.Arduino.Main import Control.Monad.Writer@@ -116,13 +128,24 @@ data Delay = Delay  instance Output Delay MilliSeconds where-	Delay =: (MilliSeconds n) = tell-		[(trigger "delay" true [arg n], mempty)]+	Delay =: (MilliSeconds n) = do+		(f, triggername) <- defineTriggerAlias "delay" mempty+		tell [(go triggername, \_ -> f)]+	  where+		go triggername tl =+			let c = getTriggerLimit tl+			in trigger triggername c [arg n]  instance Output Delay MicroSeconds where-	Delay =: (MicroSeconds n) = tell-		[(trigger "delayMicroseconds" true [arg n], mempty)]+	Delay =: (MicroSeconds n) = do+		(f, triggername) <- defineTriggerAlias "delayMicroseconds" mempty+		tell [(go triggername, \_ -> f)]+	  where+		go triggername tl = +			let c = getTriggerLimit tl+			in trigger triggername c [arg n] + -- | Number of MillisSeconds since the Arduino booted. -- -- > n <- input millis@@ -151,9 +174,11 @@ inputClock :: [Char] -> [Word32] -> Sketch (Behavior Word32) inputClock src interpretvalues = mkInput $ InputSource 	{ setupInput = []-	, defineVar = [CLine $ showCType (Proxy @Word32) <> " " <> varname <>";"]+	, defineVar = mkCChunk+		[CLine $ showCType (Proxy @Word32) <> " " <> varname <>";"] 	, inputPinmode = mempty-	, readInput = [CLine $ varname <> " = " <> src <> "();"]+	, readInput = mkCChunk+		[CLine $ varname <> " = " <> src <> "();"] 	, inputStream = extern varname interpretvalues' 	}   where@@ -162,23 +187,6 @@ 		| null interpretvalues = Nothing 		| otherwise = Just interpretvalues --- | Use this to read a value from a component of the Arduino.------ For example, to read a digital value from pin12 and turn on the --- led when the pin is high:------ > buttonpressed <- input pin12--- > led =: buttonpressed------ Some pins support multiple types of reads, for example pin a0--- supports a digital read (`Bool`), and an analog to digital converter--- read (`ADC`). In such cases you may need to specify the type of--- data to read:------ > v <- input a0 :: Sketch (Behavior ADC)-input :: Input o t => o -> Sketch (Behavior t)-input o = input' o []- -- | Normally when a digital value is read from a `Pin`, it is configured -- without the internal pullup resistor being enabled. Use this to enable -- the pullup register for all reads from the `Pin`.@@ -188,7 +196,7 @@ -- -- > pullup pin12 pullup :: Pin t -> Sketch ()-pullup (Pin p) = tell [(return (), f)]+pullup (Pin p) = tell [(\_ -> return (), \_ -> f)]   where 	f = mempty 		{ pinmodes = M.singleton p (S.singleton InputPullupMode)@@ -207,9 +215,59 @@ led :: Pin '[ 'DigitalIO ] led = Pin (PinId 13) +class IfThenElse t a where+	-- | This allows "if then else" expressions to be written+	-- that choose between two Streams, or Behaviors, or TypedBehaviors,+	-- or Sketches, when the RebindableSyntax language extension is+	-- enabled.+	--+	-- > {-# LANGUAGE RebindableSyntax #-}+	-- > buttonpressed <- input pin3+	-- > if buttonpressed then ... else ...+	ifThenElse :: Behavior Bool -> t a -> t a -> t a++instance Typed a => IfThenElse Stream a where+	ifThenElse = Language.Copilot.ifThenElse++instance Typed a => IfThenElse (TypedBehavior p) a where+	ifThenElse c (TypedBehavior a) (TypedBehavior b) =+		TypedBehavior (ifThenElse c a b)++instance IfThenElse Sketch () where+	ifThenElse c a b = do+		whenB c a+		whenB (not c) b++instance Typed a => IfThenElse Sketch (Behavior a) where+	ifThenElse c a b = do+		ra <- whenB c a+		rb <- whenB (not c) b+		return $ Language.Copilot.ifThenElse c ra rb++-- | Schedule when to perform different Sketches.+scheduleB :: (Typed t, Eq t) => Behavior t -> [(t, Sketch ())] -> Sketch ()+scheduleB b = sequence_ . map go+  where+	go (v, s) = whenB (b == constant v) s+ -- | Extracts a copilot `Spec` from a `Sketch`. -- -- This can be useful to intergrate with other libraries  -- such as copilot-theorem. sketchSpec :: Sketch a -> Spec sketchSpec = fromMaybe (return ()) . fst . evalSketch++-- | Apply a Copilot DSL function to a `TypedBehavior`.+liftB+	:: (Behavior a -> Behavior r)+	-> TypedBehavior t a+	-> Behavior r+liftB f (TypedBehavior b) = f b++-- | Apply a Copilot DSL function to two `TypedBehavior`s.+liftB2+	:: (Behavior a -> Behavior b -> Behavior r)+	-> TypedBehavior t a+	-> TypedBehavior t b+	-> Behavior r+liftB2 f (TypedBehavior a) (TypedBehavior b) = f a b

@@ -49,16 +49,16 @@ -- Arduino at any point in time. -- -- Under the hood, the `Sketch` is run in a loop. On each iteration, it first--- reads all inputs and then updates outputs as needed.+-- reads inputs and then updates outputs as needed. -- -- While it is a monad, a Sketch's outputs are not updated in any -- particular order, because Copilot does not guarantee any order.-newtype Sketch t = Sketch (WriterT [(Spec, Framework)] (State UniqueIds) t)+newtype Sketch t = Sketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> Framework)] (State UniqueIds) t) 	deriving  		( Monad 		, Applicative 		, Functor-		, MonadWriter [(Spec, Framework)]+		, MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> Framework)] 		, MonadState UniqueIds 		) @@ -68,45 +68,103 @@ instance Semigroup (Sketch t) where 	(Sketch a) <> (Sketch b) = Sketch (a >> b) -newtype UniqueIds = UniqueIds [Integer]+newtype UniqueIds = UniqueIds (M.Map String Integer) +newtype UniqueId = UniqueId Integer++data TriggerLimit+	= TriggerLimit (Behavior Bool)+	| NoTriggerLimit++getTriggerLimit :: TriggerLimit -> Behavior Bool+getTriggerLimit (TriggerLimit b) = b+getTriggerLimit NoTriggerLimit = true++addTriggerLimit :: TriggerLimit -> Behavior Bool -> Behavior Bool+addTriggerLimit tl c = getTriggerLimit (tl <> TriggerLimit c)++instance Monoid TriggerLimit where+	mempty = NoTriggerLimit++instance Semigroup TriggerLimit where+	TriggerLimit a <> TriggerLimit b =+		TriggerLimit (a Language.Copilot.&& b)+	a <> NoTriggerLimit = a+	NoTriggerLimit <> b = b+ evalSketch :: Sketch a -> (Maybe Spec, Framework)-evalSketch (Sketch s) = (spec, mconcat fs)+evalSketch (Sketch s) = (spec, f)   where 	(is, fs) = unzip $ -		runIdentity $ evalStateT (execWriterT s) (UniqueIds [1..])+		runIdentity $ evalStateT (execWriterT s) (UniqueIds mempty)+	f = mconcat (map (\f' -> f' NoTriggerLimit) fs) 	-- Copilot will throw an ugly error if given a spec that does 	-- nothing at all, so return Nothing to avoid that.+	spec :: Maybe Spec 	spec = if null is 		then Nothing-		else Just (sequence_ is)+		else Just $ sequence_ $ map (\i -> i NoTriggerLimit) is -getUniqueId :: Sketch Integer-getUniqueId = do-	v <- get-	case v of-		UniqueIds (u:us) -> do-			put (UniqueIds us)-			return u-		UniqueIds [] -> error "somehow UniqueIds ran out"+-- | Limit the effects of a `Sketch` to times when a `Behavior` `Bool` is True.+--+-- When applied to `=:`, this does the same thing as `@:` but without+-- the FRP style conversion the input `Behavior` into an `Event`. So `@:`+-- is generally better to use than this.+--+-- But, this can also be applied to `input`, to limit how often input+-- gets read. Useful to avoid performing slow input operations on every+-- iteration of a Sketch.+--+-- > v <- whenB (frequency 10) $ input pin12+--+-- (It's best to think of the value returned by that as an Event,+-- but it's currently represented as a Behavior, since the Copilot DSL+-- cannot operate on Events.)+whenB :: Behavior Bool -> Sketch t -> Sketch t+whenB c (Sketch s) = do+	ids <- get+	let ((r, w), ids') = runIdentity $ runStateT (runWriterT s) ids+	put ids'+	let (is, fs) = unzip w+	let spec = combinetl $ \c' -> sequence_ (map (\i -> i c') is)+	tell [(spec, mempty)]+	forM_ fs $ \f -> tell [(const (return ()), combinetl f)]+	return r+  where+	combinetl :: (TriggerLimit -> a) -> TriggerLimit -> a+	combinetl g tl = g (TriggerLimit c <> tl) +-- | Gets a unique id.+getUniqueId :: String -> Sketch UniqueId+getUniqueId s = do+	UniqueIds m <- get+	let u = maybe 1 succ (M.lookup s m)+	put $ UniqueIds $ M.insert s u m+	return (UniqueId u)++-- | Generates a unique name.+uniqueName :: String -> UniqueId -> String+uniqueName s (UniqueId i)+	| i Prelude.== 1 = s+	| otherwise = s <> "_" <>  show i++uniqueName' :: String -> UniqueId -> String+uniqueName' s (UniqueId i) = s <> "_" <>  show i+ -- | The framework of an Arduino sketch. data Framework = Framework-	{ defines :: [CLine]+	{ defines :: [CChunk] 	-- ^ Things that come before the C code generated by Copilot.-	, setups :: [CLine]+	, setups :: [CChunk] 	-- ^ Things to do at setup, not including configuring pins.-	, earlySetups :: [CLine]+	, earlySetups :: [CChunk] 	-- ^ Things to do at setup, before the setups. 	, pinmodes :: M.Map PinId (S.Set PinMode) 	-- ^ How pins are used.-	, loops :: [CLine]+	, loops :: [CChunk] 	-- ^ Things to run in `loop`. 	} --- | A line of C code.-newtype CLine = CLine { fromCLine :: String }- instance Semigroup Framework where 	a <> b = Framework 		{ defines = defines a <> defines b@@ -119,43 +177,88 @@ instance Monoid Framework where 	mempty = Framework mempty mempty mempty mempty mempty +-- | A line of C code.+newtype CLine = CLine { fromCLine :: String }+	deriving (Eq, Show, Ord)++-- | A chunk of C code. Identical chunks get deduplicated.+newtype CChunk = CChunk [CLine]+	deriving (Eq, Show, Ord, Semigroup, Monoid)++mkCChunk :: [CLine] -> [CChunk]+mkCChunk l = [CChunk l]+ -- | Copilot only supports calling a trigger with a given name once -- per Spec; the generated C code will fail to build if the same name is--- used in two triggers. This generates a name from a suffix, which should--- be somehow unique.-defineTriggerAlias :: String -> String -> Framework -> (Framework, String)-defineTriggerAlias suffix cfuncname f = -	(f { defines = define : defines f }, triggername)-  where-	triggername = cfuncname <> "_" <> suffix-	define = CLine $ "#define " <> triggername <> " " <> cfuncname+-- used in two triggers. This generates a unique alias that can be +-- used in a trigger.+defineTriggerAlias :: String -> Framework -> Sketch (Framework, String)+defineTriggerAlias = defineTriggerAlias' "" +defineTriggerAlias' :: String -> String -> Framework -> Sketch (Framework, String)+defineTriggerAlias' suffix cfuncname f = do+	let basetname = if null suffix +		then cfuncname+		else cfuncname <> "_" <> suffix+	u <- getUniqueId basetname+	let triggername = uniqueName basetname u+	let define = if cfuncname Prelude./= triggername+		then mkCChunk [ CLine $ "#define " <> triggername <> " " <> cfuncname	]+		else mempty+	return (f { defines = define <> defines f }, triggername)+ data InputSource t = InputSource-	{ defineVar :: [CLine]+	{ defineVar :: [CChunk] 	-- ^ Added to the `Framework`'s `defines`, this typically 	-- defines a C variable.-	, setupInput :: [CLine]+	, setupInput :: [CChunk] 	-- ^ How to set up the input, not including pin mode. 	, inputPinmode :: M.Map PinId PinMode-	, readInput :: [CLine]+	-- ^ How pins are used by the input.+	, readInput :: [CChunk] 	-- ^ How to read a value from the input, this typically 	-- reads a value into a C variable. 	, inputStream :: Stream t+	-- ^ How to use Copilot's extern to access the input values. 	}  mkInput :: InputSource t -> Sketch (Behavior t) mkInput i = do-	tell [(return (), f)]+	u <- getUniqueId "input"+	tell [(mkspec u, f u)] 	return (inputStream i)   where-	f = Framework-		{ defines = defineVar i+	f u ratelimited = Framework+		{ defines = defineVar i <> mkdefine u ratelimited 		, setups = setupInput i 		, earlySetups = mempty 		, pinmodes = M.map S.singleton (inputPinmode i)-		, loops = readInput i+		, loops = mkloops u ratelimited (readInput i) 		} +	varname = uniqueName "update_input"+	triggername = uniqueName "input"+	+	mkdefine _ NoTriggerLimit = []+	mkdefine u (TriggerLimit _) = mkCChunk $ map CLine+		[ "bool " <> varname u <> " = true;"+		, "void " <> triggername u <> " (bool v) {"+		, "  " <> varname u <> " = v;"+		, "}"+		]+	+	mkloops _ NoTriggerLimit reader = reader+	mkloops u (TriggerLimit _) reader = mkCChunk $ concat+		[ [ CLine $ "if (" <> varname u <> ") {" ]+		, map (\(CLine l) -> CLine $ "  " <> l ) readerlines+		, [ CLine "}" ]+		]+	  where+		readerlines = concatMap (\(CChunk l) -> l) reader++	mkspec _ NoTriggerLimit = return ()+	mkspec u (TriggerLimit c) = trigger (triggername u) true [arg c]+ -- | A pin on the Arduino board. -- -- For definitions of pins like `Copilot.Arduino.Uno.pin12`, @@ -211,25 +314,26 @@ class Output o t where 	(=:) :: o -> t -> Sketch () 	-- ^ Connect a `Behavior` or `Event` to an `Output`-	--+	--  	-- > led =: blinking-	--+	--  	-- When a `Behavior` is used, its current value is written on each 	-- iteration of the `Sketch`. -	--+	--  	-- For example, this constantly turns on the LED, even though it will 	-- already be on after the first iteration, because `true` 	-- is a `Behavior` (that is always True).-	--+	--  	-- > led =: true-	--+	--  	-- To avoid unncessary work being done, you can use an `Event` 	-- instead. Then the write only happens at the points in time-	-- when the `Event` occurs.+	-- when the `Event` occurs. To turn a `Behavior` into an `Event`,+	-- use `@:` 	--  	-- So to make the LED only be turned on in the first iteration, 	-- and allow it to remain on thereafter without doing extra work:-	--	+	--  	-- > led =: true @: firstIteration  -- Same fixity as =<<@@ -254,7 +358,7 @@ type instance BehaviorToEvent (TypedBehavior p v) = Event p (Stream v)  class IsBehavior behavior where-	-- | Generate an event, from some type of behavior,+	-- | Generate an Event, from some type of behavior, 	-- that only occurs when the `Behavior` Bool is True. 	(@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior @@ -265,30 +369,53 @@ 	(@:) (TypedBehavior b) c = Event b c  instance IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) where-	(Pin p@(PinId n)) =: (Event b c) = tell [(go, f)]+	(Pin p@(PinId n)) =: (Event b c) = do+		(f, triggername) <- defineTriggerAlias' ("pin_" <> show n) "digitalWrite" $+			mempty { pinmodes = M.singleton p (S.singleton OutputMode) }+		tell [(go triggername, const f)] 	  where-		go = trigger triggername c [arg (constant n), arg b]-		(f, triggername) = -			defineTriggerAlias (show n) "digitalWrite" $-				mempty { pinmodes = M.singleton p (S.singleton OutputMode) }+		go triggername tl = +			let c' = addTriggerLimit tl c+			in trigger triggername c' [arg (constant n), arg b]  instance IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) where-	(Pin (PinId n)) =: (Event v c) = tell [(go, f)]+	(Pin (PinId n)) =: (Event v c) = do+		(f, triggername) <- defineTriggerAlias' ("pin_" <> show n) "analogWrite" mempty+		tell [(go triggername, const f)] 	  where-		go = trigger triggername c [arg (constant n), arg v]+		go triggername tl = +			let c' = addTriggerLimit tl c+			in trigger triggername c' [arg (constant n), arg v] 		-- analogWrite does not need any pinmodes set up-		(f, triggername) = defineTriggerAlias (show n) "analogWrite" mempty  class Input o t where 	-- | The list is input to use when simulating the Sketch. 	input' :: o -> [t] -> Sketch (Behavior t) +-- | Use this to read a value from a component of the Arduino.+--+-- For example, to read a digital value from pin12 and turn on the +-- led when the pin is high:+--+-- > buttonpressed <- input pin12+-- > led =: buttonpressed+--+-- Some pins support multiple types of reads, for example pin a0+-- supports a digital read (`Bool`), and an analog to digital converter+-- read (`ADC`). In such cases you may need to specify the type of+-- data to read:+--+-- > v <- input a0 :: Sketch (Behavior ADC)+input :: Input o t => o -> Sketch (Behavior t)+input o = input' o []+ instance IsDigitalIOPin t => Input (Pin t) Bool where 	input' (Pin p@(PinId n)) interpretvalues = mkInput $ InputSource-		{ defineVar = [CLine $ "bool " <> varname <> ";"]-		, setupInput = []+		{ defineVar = mkCChunk [CLine $ "bool " <> varname <> ";"]+		, setupInput = mempty 		, inputPinmode = M.singleton p InputMode-		, readInput = [CLine $ varname <> " = digitalRead(" <> show n <> ");"]+		, readInput = mkCChunk+			[CLine $ varname <> " = digitalRead(" <> show n <> ");"] 		, inputStream = extern varname interpretvalues' 		} 	  where@@ -302,10 +429,11 @@  instance IsAnalogInputPin t => Input (Pin t) ADC where 	input' (Pin (PinId n)) interpretvalues = mkInput $ InputSource-		{ defineVar = [CLine $ "int " <> varname <> ";"]-		, setupInput = []+		{ defineVar = mkCChunk [CLine $ "int " <> varname <> ";"]+		, setupInput = mempty 		, inputPinmode = mempty-		, readInput = [CLine $ varname <> " = analogRead(" <> show n <> ");"]+		, readInput = mkCChunk+			[CLine $ varname <> " = analogRead(" <> show n <> ");"] 		, inputStream = extern varname interpretvalues' 		} 	  where

@@ -32,12 +32,15 @@ 	sweepRange, 	sweepRange', 	RangeWrites(..),+	scanRange,+	RangeReads(..), ) where  import Copilot.Arduino import Copilot.Arduino.Internals import Control.Monad.Writer import Data.Proxy+import qualified Prelude  -- | Set the maximum number of writes to EEPROM that can be made while -- the Arduino is running. When too many writes have been made,@@ -59,17 +62,17 @@ -- EEPROMex C library gets built. When you use this, it generates C -- code that makes sure that is enabled. maxAllowedWrites :: Word16 -> Sketch ()-maxAllowedWrites n = tell [(return (), f)]+maxAllowedWrites n = tell [(\_ -> return (), \_ -> f)]   where 	f = mempty-		{ earlySetups = +		{ earlySetups = mkCChunk 			[ CLine "#ifdef _EEPROMEX_DEBUG" 			, CLine $ "EEPROM.setMaxAllowedWrites(" <> show n <> ");" 			, CLine "#else" 			, CLine "#error \"maxAllowedWrites cannot be checked because _EEPROMEX_DEBUG is not set.\"" 			, CLine "#endif" 			]-		, defines = [ includeCLine ]+		, defines = mkCChunk [ includeCLine ] 		}  -- | The address of the first byte of the EEPROM that will be allocated@@ -94,19 +97,20 @@ -- -- > EEPROM.memPool 0 (EndAddress sizeOfEEPROM) memPool :: StartAddress -> EndAddress -> Sketch ()-memPool (StartAddress start) (EndAddress end) = tell [(return (), f)]+memPool (StartAddress start) (EndAddress end) =+	tell [(\_ -> return (), \_ -> f)]   where 	f = mempty 		-- setMemPool() has to come before any 		-- getAddress(), so do it in earlySetups.-		{ earlySetups = +		{ earlySetups = mkCChunk 			[ CLine $ "EEPROM.setMemPool(" 				<> show start 				<> ", " 				<> show end 				<> ");" 			]-		, defines = [ includeCLine ]+		, defines = mkCChunk [ includeCLine ] 		}  -- | Allocates a location in the EEPROM. @@ -152,23 +156,24 @@ -- set. alloc' :: forall t. (EEPROMable t) => t -> Sketch (Behavior t, Location t) alloc' interpretval = do-	i <- getUniqueId-	let addrvarname = "eeprom_address" <> show i-	let bootvarname = "eeprom_boot_val" <> show i-	let writername = "eeprom_write" <> show i+	i <- getUniqueId "eeprom"+	let addrvarname = uniqueName "eeprom_address" i+	let bootvarname = uniqueName "eeprom_boot_val" i 	let proxy = Proxy @t 	bootval <- mkInput $ InputSource 		{ defineVar = -			[ includeCLine-			, CLine $ "int " <> addrvarname <> ";"-			, CLine $ showCType proxy <> " " <> bootvarname <> ";"-			, CLine $ "void " <> writername-				<> "(" <> showCType proxy <> " value) {"-			, CLine $ "  EEPROM." <> writeValue proxy-				<> "(" <> addrvarname <> ", value);"-			, CLine "}"+			[ CChunk [includeCLine]+			, CChunk+				[ CLine $ "int " <> addrvarname <> ";"+				, CLine $ showCType proxy <> " " <> bootvarname <> ";"+				, CLine $ "void " <> eepromWriterName i+					<> "(" <> showCType proxy <> " value) {"+				, CLine $ "  EEPROM." <> writeValue proxy+					<> "(" <> addrvarname <> ", value);"+				, CLine "}"+				] 			]-		, setupInput =+		, setupInput = mkCChunk 			[ CLine $ addrvarname <>  				" = EEPROM.getAddress(sizeof("  				<> showCType proxy <> "));"@@ -180,17 +185,25 @@ 		, inputStream = extern bootvarname (Just (repeat interpretval)) 		, inputPinmode = mempty 		}-	return (bootval, Location writername)+	return (bootval, Location i) -data Location t = Location String+eepromWriterName :: UniqueId -> String+eepromWriterName = uniqueName' "eeprom_write" +data Location t = Location UniqueId+ instance EEPROMable t => Output (Location t) (Event () (Stream t)) where-	Location writername =: (Event v c) =-		tell [(trigger writername c [arg v], mempty)]+	Location i =: (Event v c) = do+		(f, triggername) <- defineTriggerAlias (eepromWriterName i) mempty+		tell [(go triggername, \_ -> f)]+	  where+		go triggername tl =+			let c' = addTriggerLimit tl c+			in trigger triggername c' [arg v]  -- | A range of values in the EEPROM. data Range t = Range-	{ rangeStart :: Location (Range t)+	{ rangeLocation :: Location (Range t) 	, rangeSize :: Word16 -- ^ number of `t` values in the Range 	} @@ -212,40 +225,10 @@ -- -- Do note that the EEPROM layout is controlled by the order of calls to -- `allocRange` and `alloc`, so take care when reordering or deleting calls.-allocRange :: forall t. (EEPROMable t) => Word16 -> Sketch (Range t)+allocRange :: (EEPROMable t) => Word16 -> Sketch (Range t) allocRange sz = do-	i <- getUniqueId-	let startaddrvarname = "eeprom_range_address" <> show i-	let writername = "eeprom_range_write" <> show i-	let proxy = Proxy @t-	let f = Framework-		{ defines = -			[ includeCLine-			, CLine $ "int " <> startaddrvarname <> ";"-			, CLine $ "void " <> writername-				<> "(" <> showCType proxy <> " value"-				<> ", " <> showCType (Proxy @Word16) <> " offset"-				<> ") {"-			, CLine $ "  EEPROM." <> writeValue proxy-				<> "(" <> startaddrvarname -					<> " + offset*sizeof(" -						<> showCType proxy-						<> ")"-				<> ", value);"-			, CLine "}"-			]-		, setups = -			[ CLine $ startaddrvarname <> " = EEPROM.getAddress"-				<> "(sizeof(" <> showCType proxy <> ")" -				<> " * " <> show sz-				<> ");"-			]-		, earlySetups = []-		, pinmodes = mempty-		, loops = mempty-		}-	tell [(return (), f)]-	return (Range (Location writername) sz)+	i <- getUniqueId "eeprom"+	return (Range (Location i) sz)  -- | Description of writes made to a Range. --@@ -286,15 +269,53 @@  type instance BehaviorToEvent (RangeWrites t) = Event () (RangeWrites t) -writeRange :: EEPROMable t => Behavior Bool -> Range t -> RangeWrites t -> Sketch()-writeRange c range (RangeWrites idx v) = -	tell [(trigger writername c [arg idx', arg v], mempty)]+writeRange :: forall t. EEPROMable t => Behavior Bool -> Range t -> RangeWrites t -> Sketch()+writeRange c range (RangeWrites idx v) = do+	(f', triggername) <- defineTriggerAlias writername f+	tell [(spec triggername, \_ -> f')]   where-	Location writername = rangeStart range+	Location i = rangeLocation range 	idx' = idx c `mod` constant (rangeSize range)+	startaddrvarname = eepromRangeStartAddrName i+	writername = uniqueName "eeprom_range_write" i+	proxy = Proxy @t+	f = Framework+		{ defines = +			[ CChunk [includeCLine]+			, CChunk+				[ CLine $ "int " <> startaddrvarname <> ";"+				, CLine $ "void " <> writername+					<> "(" <> showCType proxy <> " value"+					<> ", " <> showCType (Proxy @Word16) <> " offset"+					<> ") {"+				, CLine $ "  EEPROM." <> writeValue proxy+					<> "(" <> startaddrvarname +						<> " + offset*sizeof(" +							<> showCType proxy+							<> ")"+					<> ", value);"+				, CLine "}"+				]+			]+		, setups = mkCChunk+			[ CLine $ startaddrvarname <> " = EEPROM.getAddress"+				<> "(sizeof(" <> showCType proxy <> ")" +				<> " * " <> show (rangeSize range)+				<> ");"+			]+		, earlySetups = []+		, pinmodes = mempty+		, loops = mempty+		}+	spec triggername tl =+		let c' = addTriggerLimit tl c+		in trigger triggername c' [arg idx', arg v] --- | Treat the range as a ring buffer, and starting with the specified--- `RangeIndex`, sweep over the range writing values from the+eepromRangeStartAddrName :: UniqueId -> String+eepromRangeStartAddrName = uniqueName "eeprom_range_address"++-- | Treat the `Range` as a ring buffer, and starting with the specified+-- `RangeIndex`, sweep over the `Range` writing values from the -- `Behavior`. sweepRange :: RangeIndex -> Behavior t -> RangeWrites t sweepRange start = RangeWrites (sweepRange' start)@@ -307,6 +328,80 @@   where 	cnt = [start] ++ rest 	rest = if c then cnt + 1 else cnt++-- | Description of how to read a` Range`.+--+-- The first read is made at the specified RangeIndex, and the location+-- to read from subsequently comes from the Behavior RangeIndex.+data RangeReads t = RangeReads (Range t) RangeIndex (Behavior RangeIndex)++-- | Scan through the `Range`, starting with the specified `RangeIndex`.+--+-- > range <- EEPROM.allocRange 100 :: Sketch (EEPROM.Range ADC)+-- > v <- input $ scanRange range 0+-- +-- Once the end of the `Range` is reached, input continues+-- from the start of the `Range`.+--+-- It's fine to write and read from the same range in the same Sketch,+-- but if the RangeIndex being read and written is the same, it's not+-- defined in what order the two operations will happen.+--+-- Also, when interpreting a Sketch that both reads and writes to a range,+-- the input from that range won't reflect the writes made to it,+-- but will instead come from the list of values passed to `input'`.+scanRange :: Range t -> RangeIndex -> RangeReads t+scanRange r startidx = RangeReads r startidx cnt+  where+	cnt = [startidx+1] ++ rest+	rest = cnt + 1++instance (ShowCType t, EEPROMable t) => Input (RangeReads t) t where+	input' (RangeReads range startidx idx) interpretvalues = do+		-- This trigger writes value of idx+		-- to indexvarname. The next time through the loop,+		-- the extern uses that to determine where to read from.+		(f, triggername) <- defineTriggerAlias indexvarupdatername mempty+		let t tl = +			let c = getTriggerLimit tl+			in trigger triggername c [arg idx']+		tell [(t, \_ -> f)]+		mkInput $ InputSource+			{ defineVar = mkCChunk+				[ CLine $ showCType proxy <> " " <> valname <> ";"+				, CLine $ "int " <> indexvarname <> ";"+				, CLine $ "void " <> indexvarupdatername <> " (int idx) {"+				, CLine $ "  " <> indexvarname <> " = idx;"+				, CLine $ "}"+				]+			, setupInput =  mkCChunk+				-- Prime with startidx on the first time+				-- through the loop.+				[ CLine $ indexvarname <> " = " <> show startidx' <> ";" ]+			, readInput = mkCChunk+				[ CLine $ valname <> " = EEPROM." <> readValue proxy+					<> "("+						<> eepromRangeStartAddrName i+						<> " + " <> indexvarname +						<> "*sizeof("+						<> showCType proxy+						<> ")"+					<> ");"+				]+			, inputStream = extern valname interpretvalues'+			, inputPinmode = mempty+			}+	  where+		Location i = rangeLocation range+		idx' = idx `mod` constant (rangeSize range)+		startidx' = startidx `Prelude.mod` rangeSize range+		proxy = Proxy @t+		indexvarname = uniqueName "eeprom_range_read_index" i+		indexvarupdatername = uniqueName "eeprom_range_read" i+		valname = uniqueName "eeprom_range_val" i+		interpretvalues'+			| null interpretvalues = Nothing+			| otherwise = Just interpretvalues  class (ShowCType t, Typed t) => EEPROMable t where 	readValue :: Proxy t -> String

@@ -38,8 +38,7 @@ -- | Use this to communicate with the serial port, both input and output. -- -- To output to the serial port, simply connect this to a [`FormatOutput`]--- that describes the serial output. Note that you can only do this once--- in a Sketch.+-- that describes the serial output. -- -- > main = arduino $ do -- > 	Serial.baud 9600@@ -49,6 +48,14 @@ -- > 		, Serial.show b -- > 		, Serial.char '\n' -- > 		]+-- +-- You can output different things to a serial port at different times,+-- eg using `whenB`, but note that if multiple outputs are sent at the+-- same time, the actual order is not defined. This example may output+-- "world" before "hello"+--+-- > Serial.device =: [Serial.str "hello "]+-- > Serial.device =: [Serial.str "world"] -- -- To input from the serial port, use this with `input`. --

@@ -29,10 +29,11 @@ newtype SerialDeviceName = SerialDeviceName String  baudD :: SerialDeviceName -> Int -> Sketch ()-baudD (SerialDeviceName devname) n = tell [(return (), f)]+baudD (SerialDeviceName devname) n = tell [(\_ -> return (), \_ -> f)]   where 	f = mempty-		{ setups = [CLine $ devname <> ".begin(" <> Prelude.show n <> ");"]+		{ setups = mkCChunk+			[CLine $ devname <> ".begin(" <> Prelude.show n <> ");"] 		}  newtype Baud = Baud Int@@ -47,18 +48,20 @@ 	-> Sketch () configureD d@(SerialDeviceName devname) (Pin (PinId rxpin)) (Pin (PinId txpin)) (Baud n) = do 	baudD d n-	tell [(return (), f)]+	tell [(\_ -> return (), \_ -> f)]   where 	f = mempty-		{ defines = -			[ CLine $ "#include <SoftwareSerial.h>"-			, CLine $ "SoftwareSerial " <> devname-				<> " = SoftwareSerial"-				<> "("-				<> Prelude.show rxpin-				<> ", "-				<> Prelude.show txpin-				<> ");"+		{ defines =+			[ CChunk [ CLine $ "#include <SoftwareSerial.h>" ]+			, CChunk+				[ CLine $ "SoftwareSerial " <> devname+					<> " = SoftwareSerial"+					<> "("+					<> Prelude.show rxpin+					<> ", "+					<> Prelude.show txpin+					<> ");"+				] 			] 		} @@ -69,10 +72,12 @@ 		mkInput s 	  where 		s = InputSource-			{ defineVar = [CLine $ "int " <> varname <> ";"]+			{ defineVar = mkCChunk+				[CLine $ "int " <> varname <> ";"] 			, setupInput = [] 			, inputPinmode = mempty-			, readInput = [CLine $ varname <> " = " <> devname <> ".read();"]+			, readInput = mkCChunk+				[CLine $ varname <> " = " <> devname <> ".read();"] 			, inputStream = extern varname interpretvalues' 			} 		varname = "input_" <> devname@@ -88,16 +93,19 @@ 	sdn =: l = sdn =: (Event l true :: Event () [FormatOutput])  instance Output SerialDevice (Event () [FormatOutput]) where-	SerialDevice sdn@(SerialDeviceName devname) =: (Event l c) =-		tell [(go, f)]+	SerialDevice sdn@(SerialDeviceName devname) =: (Event l c) = do+		u <- getUniqueId "serial"+		let outputfuncname = uniqueName ("output_" <> devname) u+		let f = mempty { defines = printer outputfuncname }+		(f', triggername) <- defineTriggerAlias outputfuncname f+		tell [(go triggername, \_ -> f')] 	  where-		go = trigger triggername c (mapMaybe formatArg l)-		f = mempty { defines = printer }--		triggername = "output_" <> devname+		go triggername tl = +			let c' = addTriggerLimit tl c+			in trigger triggername c' (mapMaybe formatArg l) 	-		printer = concat-			[ [CLine $ "void " <> triggername <> "("+		printer outputfuncname = mkCChunk $ concat+			[ [CLine $ "void " <> outputfuncname <> "(" 				<> intercalate ", " arglist <> ") {"] 			, map (\(fmt, n) -> CLine ("  " <> fromCLine (fmt n))) 				(zip (map (\fo -> formatCLine fo sdn) l) argnames)@@ -134,9 +142,9 @@ quoteString :: String -> String quoteString s = '"' : concatMap esc s <> "\""   where-	esc '"' = "\""-	esc '\\' = "\\"-	esc '\n' = "\\\n"+	esc '"' = "\\\""+	esc '\\' = "\\\\"+	esc '\n' = "\\n" 	esc c = [c]  class OutputString t where

@@ -107,19 +107,20 @@ 		, "#include <stdint.h>" 		, blank 		]-	, map fromCLine (defines f)+	, map fromCLine (fromchunks (defines f)) 	, [blank] 	, map fromCLine ccode 	, [blank] 	, 		[ "void setup()" 		]-	, codeblock $ map fromCLine (earlySetups f <> setups f)+	, codeblock $ map fromCLine+		(fromchunks (earlySetups f) <> fromchunks (setups f)) 	, [blank] 	, 		[ "void loop()" 		]-	, codeblock $ map fromCLine (loops f) <>+	, codeblock $ map fromCLine (fromchunks (loops f)) <> 		[ "step();" 		] 	]@@ -127,10 +128,18 @@ 	blank = "" 	indent l = "  " <> l 	codeblock l = ["{"] <> map indent l <> ["}"]+	-- If two CChunks are identical, only include it once.+	-- This can happen when eg, the same setup code is generated+	-- to use a resource that's accessed more than once in a program.+	-- Note: Does not preserve order of chunks in the list.+	fromchunks :: [CChunk] -> [CLine]+	fromchunks cl = concatMap (\(CChunk l) -> l) $+		S.toList $ S.fromList cl  finalizeFramework :: Framework -> Framework finalizeFramework f = -	let pinsetups = mapMaybe setuppinmode (M.toList $ pinmodes f)+	let pinsetups = concat $+		mapMaybe setuppinmode (M.toList $ pinmodes f) 	in f { setups = pinsetups <> setups f }   where 	setuppinmode (PinId n, s)@@ -151,5 +160,5 @@ 			unwords (map show (S.toList s)) ++ "). " ++ 			"This is not currently supported by arduino-copilot." 	-	setmode n v = Just $ CLine $-		"pinMode(" <> show n <> ", " ++ v ++ ");"+	setmode n v = Just $ mkCChunk+		[ CLine $ "pinMode(" <> show n <> ", " ++ v ++ ");" ]